Rev 2 | Go to most recent revision | Show entire file | Regard whitespace | Details | Blame | Last modification | View Log | RSS feed
Rev 2 | Rev 3 | ||
---|---|---|---|
Line 1... | Line 1... | ||
1 | unit Functions; |
1 | unit Functions; |
2 | 2 | ||
3 | interface |
3 | interface |
4 | 4 | ||
5 | uses |
5 | uses |
6 | Forms, Windows, Classes, SysUtils, ShellAPI, ShlObj, ActiveX, |
6 | Forms, Windows, Classes, SysUtils, ShellAPI, |
7 | ZipMstr19, ZmUtils19; |
7 | ZipMstr19, ZmUtils19, ShlObj, ActiveX; |
8 | 8 | ||
9 | type |
9 | type |
10 | TLineBreak = (lbWindows, lbLinux, lbMac); |
10 | TLineBreak = (lbWindows, lbLinux, lbMac); |
11 | 11 | ||
12 | function RawFileCopy(ASrc, ADst: string): boolean; |
12 | function RawFileCopy(ASrc, ADst: string): boolean; |
Line 15... | Line 15... | ||
15 | function LooksLikeDir(s: string): boolean; |
15 | function LooksLikeDir(s: string): boolean; |
16 | function GetTempDirectory: String; |
16 | function GetTempDirectory: String; |
17 | function NormalizeLineBreaks(s: string; mode: TLineBreak): string; |
17 | function NormalizeLineBreaks(s: string; mode: TLineBreak): string; |
18 | function ExtractFileNameWithoutExt(const fil: string): string; |
18 | function ExtractFileNameWithoutExt(const fil: string): string; |
19 | function SearchNextFreeName(s: string; wantDir: boolean): 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; |
20 | function GetSpecialFolderPath(const Folder: integer): string; |
24 | function IsExtractable(AFilename: string): boolean; |
21 | function IsExtractable(AFilename: string): boolean; |
25 | 22 | ||
26 | implementation |
23 | implementation |
27 | 24 | ||
Line 185... | Line 182... | ||
185 | inc(i); |
182 | inc(i); |
186 | until not DirectoryExists(result) and not FileExists(result); |
183 | until not DirectoryExists(result) and not FileExists(result); |
187 | end; |
184 | end; |
188 | end; |
185 | end; |
189 | 186 | ||
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, |
187 | // GetSpecialFolderPath |
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 |
188 | // Ref: http://www.wer-weiss-was.de/theme159/article1058561.html |
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; |
189 | function GetSpecialFolderPath(const Folder: integer): string; |
299 | var |
190 | var |
300 | PIDL: PItemIDList; |
191 | PIDL: PItemIDList; |
301 | Path: array[0..MAX_PATH] of char; |
192 | Path: array[0..MAX_PATH] of char; |
302 | Malloc: IMalloc; |
193 | Malloc: IMalloc; |
Line 323... | Line 214... | ||
323 | q := uz.QueryZip(AFilename); |
214 | q := uz.QueryZip(AFilename); |
324 | result := true; |
215 | result := true; |
325 | if (q and zqbHasLocal) <> zqbHasLocal then result := false; |
216 | if (q and zqbHasLocal) <> zqbHasLocal then result := false; |
326 | if (q and zqbHasCentral) <> zqbHasCentral then result := false; |
217 | if (q and zqbHasCentral) <> zqbHasCentral then result := false; |
327 | if ((q and zqbHasEOC) <> zqbHasEOC) and |
218 | if ((q and zqbHasEOC) <> zqbHasEOC) and |
328 | ((q and zqbHasEOC64) <> zqbHasEOC) then result := false; |
219 | ((q and zqbHasEOC64) <> zqbHasEOC64) then result := false; |
329 | finally |
220 | finally |
330 | uz.Free; |
221 | uz.Free; |
331 | end; |
222 | end; |
332 | end; |
223 | end; |
333 | 224 |