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