Rev 1 | Rev 3 | Go to most recent revision | Only display areas with differences | Regard whitespace | Details | Blame | Last modification | View Log | RSS feed
Rev 1 | Rev 2 | ||
---|---|---|---|
1 | unit Functions; |
1 | unit Functions; |
2 | 2 | ||
3 | interface |
3 | interface |
4 | 4 | ||
5 | uses |
5 | uses |
6 | Windows, Classes, SysUtils, ShellAPI; |
6 | Forms, Windows, Classes, SysUtils, ShellAPI, ShlObj, ActiveX, |
- | 7 | ZipMstr19, ZmUtils19; |
|
7 | 8 | ||
8 | type |
9 | type |
9 | TLineBreak = (lbWindows, lbLinux, lbMac); |
10 | TLineBreak = (lbWindows, lbLinux, lbMac); |
10 | 11 | ||
11 | function RawFileCopy(ASrc, ADst: string): boolean; |
12 | function RawFileCopy(ASrc, ADst: string): boolean; |
12 | function ShellExecuteAndWait(FileName: string; Params: string): boolean; |
13 | function ShellExecuteAndWait(FileName: string; Params: string): boolean; |
13 | function FileSize(AFilename: string): int64; |
14 | function FileSize(AFilename: string): int64; |
14 | function LooksLikeDir(s: string): boolean; |
15 | function LooksLikeDir(s: string): boolean; |
15 | function GetTempDirectory: String; |
16 | function GetTempDirectory: String; |
16 | function NormalizeLineBreaks(s: string; mode: TLineBreak): string; |
17 | function NormalizeLineBreaks(s: string; mode: TLineBreak): string; |
17 | function ExtractFileNameWithoutExt(const fil: string): string; |
18 | function ExtractFileNameWithoutExt(const fil: string): string; |
18 | function SearchNextFreeName(s: string): string; |
19 | function SearchNextFreeName(s: string; wantDir: boolean): string; |
- | 20 | function AdvSelectDirectory(const Caption: string; const Root: WideString; |
|
- | 21 | var Directory: string; EditBox: Boolean = False; ShowFiles: Boolean = False; |
|
- | 22 | AllowCreateDirs: Boolean = True): Boolean; |
|
- | 23 | function GetSpecialFolderPath(const Folder: integer): string; |
|
- | 24 | function IsExtractable(AFilename: string): boolean; |
|
19 | 25 | ||
20 | implementation |
26 | implementation |
21 | 27 | ||
22 | {$IFNDEF UNICODE} |
28 | {$IFNDEF UNICODE} |
23 | type |
29 | type |
24 | TCharSet = set of AnsiChar; |
30 | TCharSet = set of AnsiChar; |
25 | {$ENDIF} |
31 | {$ENDIF} |
26 | 32 | ||
27 | {$IFNDEF UNICODE} |
33 | {$IFNDEF UNICODE} |
28 | function CharInSet(C: AnsiChar; const CharSet: TCharSet): Boolean;// overload; |
34 | function CharInSet(C: AnsiChar; const CharSet: TCharSet): Boolean;// overload; |
29 | begin |
35 | begin |
30 | Result := c in CharSet; |
36 | Result := c in CharSet; |
31 | end; |
37 | end; |
32 | {$ENDIF} |
38 | {$ENDIF} |
33 | 39 | ||
34 | function LooksLikeDir(s: string): boolean; |
40 | function LooksLikeDir(s: string): boolean; |
35 | begin |
41 | begin |
36 | result := CharInSet(s[Length(s)], ['/', '\']); |
42 | result := CharInSet(s[Length(s)], ['/', '\']); |
37 | end; |
43 | end; |
38 | 44 | ||
39 | function RawFileCopy(ASrc, ADst: string): boolean; |
45 | function RawFileCopy(ASrc, ADst: string): boolean; |
40 | var |
46 | var |
41 | SSrc, SDst: TFileStream; |
47 | SSrc, SDst: TFileStream; |
42 | begin |
48 | begin |
43 | DeleteFile(PChar(ADst)); |
49 | DeleteFile(PChar(ADst)); |
44 | 50 | ||
45 | SSrc := TFileStream.Create(ASrc, fmOpenRead); |
51 | SSrc := TFileStream.Create(ASrc, fmOpenRead); |
46 | try |
52 | try |
47 | SDst := TFileStream.Create(ADst, fmCreate); |
53 | SDst := TFileStream.Create(ADst, fmCreate); |
48 | try |
54 | try |
49 | SDst.CopyFrom(SSrc, SSrc.Size); |
55 | SDst.CopyFrom(SSrc, SSrc.Size); |
50 | finally |
56 | finally |
51 | SDst.Free; |
57 | SDst.Free; |
52 | end; |
58 | end; |
53 | finally |
59 | finally |
54 | SSrc.Free; |
60 | SSrc.Free; |
55 | end; |
61 | end; |
56 | 62 | ||
57 | result := true; |
63 | result := true; |
58 | end; |
64 | end; |
59 | 65 | ||
60 | // http://www.delphipraxis.net/32234-shellexecuteandwait-status-abfragen.html |
66 | // http://www.delphipraxis.net/32234-shellexecuteandwait-status-abfragen.html |
61 | // Modified. Now CONSOLE compatible and return false if ErrorLevel <> 0 |
67 | // Modified. Now CONSOLE compatible and return false if ErrorLevel <> 0 |
62 | function ShellExecuteAndWait(FileName: string; Params: string): boolean; |
68 | function ShellExecuteAndWait(FileName: string; Params: string): boolean; |
63 | var |
69 | var |
64 | exInfo: TShellExecuteInfo; |
70 | exInfo: TShellExecuteInfo; |
65 | Ph: DWORD; |
71 | Ph: DWORD; |
66 | lExitCode: DWord; |
72 | lExitCode: DWord; |
67 | begin |
73 | begin |
68 | Try |
74 | Try |
69 | FillChar(exInfo, SizeOf(exInfo), 0); |
75 | FillChar(exInfo, SizeOf(exInfo), 0); |
70 | with exInfo do |
76 | with exInfo do |
71 | begin |
77 | begin |
72 | cbSize := SizeOf(exInfo); |
78 | cbSize := SizeOf(exInfo); |
73 | fMask := SEE_MASK_NOCLOSEPROCESS or SEE_MASK_FLAG_DDEWAIT; |
79 | fMask := SEE_MASK_NOCLOSEPROCESS or SEE_MASK_FLAG_DDEWAIT; |
74 | Wnd := GetActiveWindow(); |
80 | Wnd := GetActiveWindow(); |
75 | FileName := ExpandUNCFileName(FileName); |
81 | FileName := ExpandUNCFileName(FileName); |
76 | ExInfo.lpVerb := 'open'; |
82 | ExInfo.lpVerb := 'open'; |
77 | ExInfo.lpParameters := PChar(Params); |
83 | ExInfo.lpParameters := PChar(Params); |
78 | // ExInfo.lpDirectory := PChar(ExtractFilePath(FileName)); |
84 | // ExInfo.lpDirectory := PChar(ExtractFilePath(FileName)); |
79 | lpFile := PChar(FileName); |
85 | lpFile := PChar(FileName); |
80 | nShow := SW_SHOWNORMAL; |
86 | nShow := SW_SHOWNORMAL; |
81 | end; |
87 | end; |
82 | if ShellExecuteEx(@exInfo) then |
88 | if ShellExecuteEx(@exInfo) then |
83 | begin |
89 | begin |
84 | Ph := exInfo.HProcess; |
90 | Ph := exInfo.HProcess; |
85 | end |
91 | end |
86 | else |
92 | else |
87 | begin |
93 | begin |
88 | WriteLn(SysErrorMessage(GetLastError)); |
94 | WriteLn(SysErrorMessage(GetLastError)); |
89 | Result := False; |
95 | Result := False; |
90 | Exit; |
96 | Exit; |
91 | end; |
97 | end; |
92 | while WaitForSingleObject(ExInfo.hProcess, 50) <> WAIT_OBJECT_0 do ; |
98 | while WaitForSingleObject(ExInfo.hProcess, 50) <> WAIT_OBJECT_0 do ; |
93 | (* begin |
99 | (* begin |
94 | Application.ProcessMessages; |
100 | Application.ProcessMessages; |
95 | end; *) |
101 | end; *) |
96 | GetExitCodeProcess(Ph, lExitCode); |
102 | GetExitCodeProcess(Ph, lExitCode); |
97 | Result := lExitCode = 0; |
103 | Result := lExitCode = 0; |
98 | CloseHandle(Ph); |
104 | CloseHandle(Ph); |
99 | Except |
105 | Except |
100 | Result := False; |
106 | Result := False; |
101 | Exit; |
107 | Exit; |
102 | End; |
108 | End; |
103 | end; |
109 | end; |
104 | 110 | ||
105 | function FileSize(AFilename: string): int64; |
111 | function FileSize(AFilename: string): int64; |
106 | var |
112 | var |
107 | s: TFileStream; |
113 | s: TFileStream; |
108 | begin |
114 | begin |
109 | s := TFileStream.Create(AFilename, fmOpenRead or fmShareDenyWrite); |
115 | s := TFileStream.Create(AFilename, fmOpenRead or fmShareDenyWrite); |
110 | try |
116 | try |
111 | result := s.Size; |
117 | result := s.Size; |
112 | finally |
118 | finally |
113 | s.Free; |
119 | s.Free; |
114 | end; |
120 | end; |
115 | end; |
121 | end; |
116 | 122 | ||
117 | // http://www.cryer.co.uk/brian/delphi/howto_get_temp.htm |
123 | // http://www.cryer.co.uk/brian/delphi/howto_get_temp.htm |
118 | function GetTempDirectory: String; |
124 | function GetTempDirectory: String; |
119 | var |
125 | var |
120 | tempFolder: array[0..MAX_PATH] of Char; |
126 | tempFolder: array[0..MAX_PATH] of Char; |
121 | begin |
127 | begin |
122 | GetTempPath(MAX_PATH, @tempFolder); |
128 | GetTempPath(MAX_PATH, @tempFolder); |
123 | result := StrPas(tempFolder); |
129 | result := StrPas(tempFolder); |
124 | end; |
130 | end; |
125 | 131 | ||
126 | function NormalizeLineBreaks(s: string; mode: TLineBreak): string; |
132 | function NormalizeLineBreaks(s: string; mode: TLineBreak): string; |
127 | begin |
133 | begin |
128 | if mode = lbWindows then |
134 | if mode = lbWindows then |
129 | begin |
135 | begin |
130 | s := StringReplace(s, #13#10, #10, [rfReplaceAll]); |
136 | s := StringReplace(s, #13#10, #10, [rfReplaceAll]); |
131 | s := StringReplace(s, #13, #10, [rfReplaceAll]); |
137 | s := StringReplace(s, #13, #10, [rfReplaceAll]); |
132 | s := StringReplace(s, #10, #13#10, [rfReplaceAll]); |
138 | s := StringReplace(s, #10, #13#10, [rfReplaceAll]); |
133 | end |
139 | end |
134 | else if mode = lbLinux then |
140 | else if mode = lbLinux then |
135 | begin |
141 | begin |
136 | s := StringReplace(s, #13#10, #13, [rfReplaceAll]); |
142 | s := StringReplace(s, #13#10, #13, [rfReplaceAll]); |
137 | s := StringReplace(s, #10, #13, [rfReplaceAll]); |
143 | s := StringReplace(s, #10, #13, [rfReplaceAll]); |
138 | end |
144 | end |
139 | else if mode = lbMac then |
145 | else if mode = lbMac then |
140 | begin |
146 | begin |
141 | s := StringReplace(s, #13#10, #10, [rfReplaceAll]); |
147 | s := StringReplace(s, #13#10, #10, [rfReplaceAll]); |
142 | s := StringReplace(s, #13, #10, [rfReplaceAll]); |
148 | s := StringReplace(s, #13, #10, [rfReplaceAll]); |
143 | end; |
149 | end; |
144 | result := s; |
150 | result := s; |
145 | end; |
151 | end; |
146 | 152 | ||
147 | // http://www.viathinksoft.de/?page=codelib&showid=70 |
153 | // http://www.viathinksoft.de/?page=codelib&showid=70 |
148 | function ExtractFileNameWithoutExt(const fil: string): string; |
154 | function ExtractFileNameWithoutExt(const fil: string): string; |
149 | begin |
155 | begin |
150 | result := Copy(ExtractFileName(fil), 1, Length(ExtractFileName(fil))-Length(ExtractFileExt(fil))); |
156 | result := Copy(ExtractFileName(fil), 1, Length(ExtractFileName(fil))-Length(ExtractFileExt(fil))); |
151 | end; |
157 | end; |
152 | 158 | ||
153 | function SearchNextFreeName(s: string): string; |
159 | function SearchNextFreeName(s: string; wantDir: boolean): string; |
154 | var |
160 | var |
155 | i: integer; |
161 | i: integer; |
156 | begin |
162 | begin |
157 | if not FileExists(s) and not DirectoryExists(s) then |
163 | if not FileExists(s) and not DirectoryExists(s) then |
158 | begin |
164 | begin |
159 | result := s; |
165 | result := s; |
- | 166 | if wantDir then result := IncludeTrailingPathDelimiter(result); |
|
160 | Exit; |
167 | Exit; |
161 | end; |
168 | end; |
162 | 169 | ||
163 | i := 2; |
170 | i := 2; |
164 | 171 | ||
165 | if FileExists(s) then |
172 | if wantDir then |
166 | begin |
173 | begin |
- | 174 | s := ExcludeTrailingPathDelimiter(s); |
|
167 | repeat |
175 | repeat |
168 | result := Format('%s (%d)%s', [ExtractFileNameWithoutExt(s), i, ExtractFileExt(s)]); |
176 | result := Format('%s (%d)', [s, i]); |
169 | inc(i); |
177 | inc(i); |
170 | until not DirectoryExists(result); |
178 | until not DirectoryExists(result) and not FileExists(result); |
- | 179 | result := IncludeTrailingPathDelimiter(result); |
|
171 | end |
180 | end |
172 | else if DirectoryExists(s) then |
181 | else |
173 | begin |
182 | begin |
174 | s := ExcludeTrailingPathDelimiter(s); |
- | |
175 | repeat |
183 | repeat |
176 | result := Format('%s (%d)', [s, i]); |
184 | result := Format('%s (%d)%s', [ExtractFilePath(s)+ExtractFileNameWithoutExt(s), i, ExtractFileExt(s)]); |
177 | inc(i); |
185 | inc(i); |
178 | until not DirectoryExists(result); // Todo: Legt man sich hier nun auf einen ordnernamen fest??? |
186 | until not DirectoryExists(result) and not FileExists(result); |
- | 187 | end; |
|
- | 188 | end; |
|
- | 189 | ||
- | 190 | { |
|
- | 191 | This code shows the SelectDirectory dialog with additional expansions: |
|
- | 192 | - an edit box, where the user can type the path name, |
|
- | 193 | - also files can appear in the list, |
|
- | 194 | - a button to create new directories. |
|
- | 195 | ||
- | 196 | ||
- | 197 | Dieser Code zeigt den SelectDirectory-Dialog mit zusätzlichen Erweiterungen: |
|
- | 198 | - eine Edit-Box, wo der Benutzer den Verzeichnisnamen eingeben kann, |
|
- | 199 | - auch Dateien können in der Liste angezeigt werden, |
|
- | 200 | - eine Schaltfläche zum Erstellen neuer Verzeichnisse. |
|
- | 201 | ||
- | 202 | ||
- | 203 | Ref: http://www.swissdelphicenter.ch/de/showcode.php?id=1802 |
|
- | 204 | } |
|
- | 205 | ||
- | 206 | function AdvSelectDirectory(const Caption: string; const Root: WideString; |
|
- | 207 | var Directory: string; EditBox: Boolean = False; ShowFiles: Boolean = False; |
|
- | 208 | AllowCreateDirs: Boolean = True): Boolean; |
|
- | 209 | // callback function that is called when the dialog has been initialized |
|
- | 210 | //or a new directory has been selected |
|
- | 211 | ||
- | 212 | // Callback-Funktion, die aufgerufen wird, wenn der Dialog initialisiert oder |
|
- | 213 | //ein neues Verzeichnis selektiert wurde |
|
- | 214 | function SelectDirCB(Wnd: HWND; uMsg: UINT; lParam, lpData: lParam): Integer; |
|
- | 215 | stdcall; |
|
- | 216 | // var |
|
- | 217 | // PathName: array[0..MAX_PATH] of Char; |
|
- | 218 | begin |
|
- | 219 | case uMsg of |
|
- | 220 | BFFM_INITIALIZED: SendMessage(Wnd, BFFM_SETSELECTION, Ord(True), Integer(lpData)); |
|
- | 221 | // include the following comment into your code if you want to react on the |
|
- | 222 | //event that is called when a new directory has been selected |
|
- | 223 | // binde den folgenden Kommentar in deinen Code ein, wenn du auf das Ereignis |
|
- | 224 | //reagieren willst, das aufgerufen wird, wenn ein neues Verzeichnis selektiert wurde |
|
- | 225 | {BFFM_SELCHANGED: |
|
- | 226 | begin |
|
- | 227 | SHGetPathFromIDList(PItemIDList(lParam), @PathName); |
|
- | 228 | // the directory "PathName" has been selected |
|
- | 229 | // das Verzeichnis "PathName" wurde selektiert |
|
- | 230 | end;} |
|
- | 231 | end; |
|
- | 232 | Result := 0; |
|
- | 233 | end; |
|
- | 234 | var |
|
- | 235 | WindowList: Pointer; |
|
- | 236 | BrowseInfo: TBrowseInfo; |
|
- | 237 | Buffer: PChar; |
|
- | 238 | RootItemIDList, ItemIDList: PItemIDList; |
|
- | 239 | ShellMalloc: IMalloc; |
|
- | 240 | IDesktopFolder: IShellFolder; |
|
- | 241 | Eaten, Flags: LongWord; |
|
- | 242 | const |
|
- | 243 | // necessary for some of the additional expansions |
|
- | 244 | // notwendig für einige der zusätzlichen Erweiterungen |
|
- | 245 | BIF_USENEWUI = $0040; |
|
- | 246 | BIF_NOCREATEDIRS = $0200; |
|
- | 247 | begin |
|
- | 248 | Result := False; |
|
- | 249 | if not DirectoryExists(Directory) then |
|
- | 250 | Directory := ''; |
|
- | 251 | FillChar(BrowseInfo, SizeOf(BrowseInfo), 0); |
|
- | 252 | if (ShGetMalloc(ShellMalloc) = S_OK) and (ShellMalloc <> nil) then |
|
- | 253 | begin |
|
- | 254 | Buffer := ShellMalloc.Alloc(MAX_PATH); |
|
- | 255 | try |
|
- | 256 | RootItemIDList := nil; |
|
- | 257 | if Root <> '' then |
|
- | 258 | begin |
|
- | 259 | SHGetDesktopFolder(IDesktopFolder); |
|
- | 260 | IDesktopFolder.ParseDisplayName(Application.Handle, nil, |
|
- | 261 | POleStr(Root), Eaten, RootItemIDList, Flags); |
|
- | 262 | end; |
|
- | 263 | OleInitialize(nil); |
|
- | 264 | with BrowseInfo do |
|
- | 265 | begin |
|
- | 266 | hwndOwner := Application.Handle; |
|
- | 267 | pidlRoot := RootItemIDList; |
|
- | 268 | pszDisplayName := Buffer; |
|
- | 269 | lpszTitle := PChar(Caption); |
|
- | 270 | // defines how the dialog will appear: |
|
- | 271 | // legt fest, wie der Dialog erscheint: |
|
- | 272 | ulFlags := BIF_RETURNONLYFSDIRS or BIF_USENEWUI or |
|
- | 273 | BIF_EDITBOX * Ord(EditBox) or BIF_BROWSEINCLUDEFILES * Ord(ShowFiles) or |
|
- | 274 | BIF_NOCREATEDIRS * Ord(not AllowCreateDirs); |
|
- | 275 | lpfn := @SelectDirCB; |
|
- | 276 | if Directory <> '' then |
|
- | 277 | lParam := Integer(PChar(Directory)); |
|
- | 278 | end; |
|
- | 279 | WindowList := DisableTaskWindows(0); |
|
- | 280 | try |
|
- | 281 | ItemIDList := ShBrowseForFolder(BrowseInfo); |
|
- | 282 | finally |
|
- | 283 | EnableTaskWindows(WindowList); |
|
- | 284 | end; |
|
179 | result := IncludeTrailingPathDelimiter(result); |
285 | Result := ItemIDList <> nil; |
- | 286 | if Result then |
|
- | 287 | begin |
|
- | 288 | ShGetPathFromIDList(ItemIDList, Buffer); |
|
- | 289 | ShellMalloc.Free(ItemIDList); |
|
- | 290 | Directory := Buffer; |
|
- | 291 | end; |
|
- | 292 | finally |
|
- | 293 | ShellMalloc.Free(Buffer); |
|
- | 294 | end; |
|
- | 295 | end; |
|
- | 296 | end; |
|
- | 297 | ||
- | 298 | function GetSpecialFolderPath(const Folder: integer): string; |
|
- | 299 | var |
|
- | 300 | PIDL: PItemIDList; |
|
- | 301 | Path: array[0..MAX_PATH] of char; |
|
- | 302 | Malloc: IMalloc; |
|
- | 303 | begin |
|
- | 304 | Path := ''; |
|
- | 305 | if Succeeded((SHGetSpecialFolderLocation(0, Folder, PIDL))) then |
|
- | 306 | if (SHGetPathFromIDList(PIDL, Path)) then |
|
- | 307 | if Succeeded(ShGetMalloc(Malloc)) then |
|
- | 308 | begin |
|
- | 309 | Malloc.Free(PIDL); |
|
- | 310 | Malloc := nil; |
|
- | 311 | end; |
|
- | 312 | Result := Path; |
|
- | 313 | end; |
|
- | 314 | ||
- | 315 | function IsExtractable(AFilename: string): boolean; |
|
- | 316 | var |
|
- | 317 | q: integer; |
|
- | 318 | uz: TZipMaster19; |
|
- | 319 | begin |
|
- | 320 | // TODO: Ist die Funktion gut? Fraglich, ob EOC64 ein Teil von EOC ist. |
|
- | 321 | uz := TZipMaster19.Create(nil); |
|
- | 322 | try |
|
- | 323 | q := uz.QueryZip(AFilename); |
|
- | 324 | result := true; |
|
- | 325 | if (q and zqbHasLocal) <> zqbHasLocal then result := false; |
|
- | 326 | if (q and zqbHasCentral) <> zqbHasCentral then result := false; |
|
- | 327 | if ((q and zqbHasEOC) <> zqbHasEOC) and |
|
- | 328 | ((q and zqbHasEOC64) <> zqbHasEOC) then result := false; |
|
- | 329 | finally |
|
- | 330 | uz.Free; |
|
180 | end; |
331 | end; |
181 | end; |
332 | end; |
182 | 333 | ||
183 | end. |
334 | end. |
184 | 335 |