Subversion Repositories autosfx

Rev

Rev 2 | Go to most recent revision | Details | Last modification | View Log | RSS feed

Rev Author Line No. Line
1 daniel-mar 1
unit Functions;
2
 
3
interface
4
 
5
uses
6
  Windows, Classes, SysUtils, ShellAPI;
7
 
8
type
9
  TLineBreak = (lbWindows, lbLinux, lbMac);
10
 
11
function RawFileCopy(ASrc, ADst: string): boolean;
12
function ShellExecuteAndWait(FileName: string; Params: string): boolean;
13
function FileSize(AFilename: string): int64;
14
function LooksLikeDir(s: string): boolean;
15
function GetTempDirectory: String;
16
function NormalizeLineBreaks(s: string; mode: TLineBreak): string;
17
function ExtractFileNameWithoutExt(const fil: string): string;
18
function SearchNextFreeName(s: string): string;
19
 
20
implementation
21
 
22
{$IFNDEF UNICODE}
23
type
24
  TCharSet = set of AnsiChar;
25
{$ENDIF}
26
 
27
{$IFNDEF UNICODE}
28
function CharInSet(C: AnsiChar; const CharSet: TCharSet): Boolean;// overload;
29
begin
30
  Result := c in CharSet;
31
end;
32
{$ENDIF}
33
 
34
function LooksLikeDir(s: string): boolean;
35
begin
36
  result := CharInSet(s[Length(s)], ['/', '\']);
37
end;
38
 
39
function RawFileCopy(ASrc, ADst: string): boolean;
40
var
41
  SSrc, SDst: TFileStream;
42
begin
43
  DeleteFile(PChar(ADst));
44
 
45
  SSrc := TFileStream.Create(ASrc, fmOpenRead);
46
  try
47
    SDst := TFileStream.Create(ADst, fmCreate);
48
    try
49
      SDst.CopyFrom(SSrc, SSrc.Size);
50
    finally
51
      SDst.Free;
52
    end;
53
  finally
54
    SSrc.Free;
55
  end;
56
 
57
  result := true;
58
end;
59
 
60
// http://www.delphipraxis.net/32234-shellexecuteandwait-status-abfragen.html
61
// Modified. Now CONSOLE compatible and return false if ErrorLevel <> 0
62
function ShellExecuteAndWait(FileName: string; Params: string): boolean;
63
var
64
  exInfo: TShellExecuteInfo;
65
  Ph: DWORD;
66
  lExitCode: DWord;
67
begin
68
  Try
69
    FillChar(exInfo, SizeOf(exInfo), 0);
70
    with exInfo do
71
    begin
72
      cbSize := SizeOf(exInfo);
73
      fMask := SEE_MASK_NOCLOSEPROCESS or SEE_MASK_FLAG_DDEWAIT;
74
      Wnd := GetActiveWindow();
75
      FileName := ExpandUNCFileName(FileName);
76
      ExInfo.lpVerb := 'open';
77
      ExInfo.lpParameters := PChar(Params);
78
//      ExInfo.lpDirectory := PChar(ExtractFilePath(FileName));
79
      lpFile := PChar(FileName);
80
      nShow := SW_SHOWNORMAL;
81
    end;
82
    if ShellExecuteEx(@exInfo) then
83
    begin
84
      Ph := exInfo.HProcess;
85
    end
86
    else
87
    begin
88
      WriteLn(SysErrorMessage(GetLastError));
89
      Result := False;
90
      Exit;
91
    end;
92
    while WaitForSingleObject(ExInfo.hProcess, 50) <> WAIT_OBJECT_0 do ;
93
    (* begin
94
      Application.ProcessMessages;
95
    end; *)
96
    GetExitCodeProcess(Ph, lExitCode);
97
    Result := lExitCode = 0;
98
    CloseHandle(Ph);
99
  Except
100
    Result := False;
101
    Exit;
102
  End;
103
end;
104
 
105
function FileSize(AFilename: string): int64;
106
var
107
  s: TFileStream;
108
begin
109
  s := TFileStream.Create(AFilename, fmOpenRead or fmShareDenyWrite);
110
  try
111
    result := s.Size;
112
  finally
113
    s.Free;
114
  end;
115
end;
116
 
117
// http://www.cryer.co.uk/brian/delphi/howto_get_temp.htm
118
function GetTempDirectory: String;
119
var
120
  tempFolder: array[0..MAX_PATH] of Char;
121
begin
122
  GetTempPath(MAX_PATH, @tempFolder);
123
  result := StrPas(tempFolder);
124
end;
125
 
126
function NormalizeLineBreaks(s: string; mode: TLineBreak): string;
127
begin
128
  if mode = lbWindows then
129
  begin
130
    s := StringReplace(s, #13#10, #10, [rfReplaceAll]);
131
    s := StringReplace(s, #13,    #10, [rfReplaceAll]);
132
    s := StringReplace(s, #10, #13#10, [rfReplaceAll]);
133
  end
134
  else if mode = lbLinux then
135
  begin
136
    s := StringReplace(s, #13#10, #13, [rfReplaceAll]);
137
    s := StringReplace(s, #10,    #13, [rfReplaceAll]);
138
  end
139
  else if mode = lbMac then
140
  begin
141
    s := StringReplace(s, #13#10, #10, [rfReplaceAll]);
142
    s := StringReplace(s, #13,    #10, [rfReplaceAll]);
143
  end;
144
  result := s;
145
end;
146
 
147
// http://www.viathinksoft.de/?page=codelib&showid=70
148
function ExtractFileNameWithoutExt(const fil: string): string;
149
begin
150
  result := Copy(ExtractFileName(fil), 1, Length(ExtractFileName(fil))-Length(ExtractFileExt(fil)));
151
end;
152
 
153
function SearchNextFreeName(s: string): string;
154
var
155
  i: integer;
156
begin
157
  if not FileExists(s) and not DirectoryExists(s) then
158
  begin
159
    result := s;
160
    Exit;
161
  end;
162
 
163
  i := 2;
164
 
165
  if FileExists(s) then
166
  begin
167
    repeat
168
      result := Format('%s (%d)%s', [ExtractFileNameWithoutExt(s), i, ExtractFileExt(s)]);
169
      inc(i);
170
    until not DirectoryExists(result);
171
  end
172
  else if DirectoryExists(s) then
173
  begin
174
    s := ExcludeTrailingPathDelimiter(s);
175
    repeat
176
      result := Format('%s (%d)', [s, i]);
177
      inc(i);
178
    until not DirectoryExists(result);                  // Todo: Legt man sich hier nun auf einen ordnernamen fest???
179
    result := IncludeTrailingPathDelimiter(result);
180
  end;
181
end;
182
 
183
end.