WebSVN – autosfx – Diff – /Functions.pas

 unit Functions;
 interface
 uses
-  Forms, Windows, Classes, SysUtils, ShellAPI, ShlObj, ActiveX,
+  Forms, Windows, Classes, SysUtils, ShellAPI,
-  ZipMstr19, ZmUtils19;
+  ZipMstr19, ZmUtils19, ShlObj, ActiveX;
 type
   TLineBreak = (lbWindows, lbLinux, lbMac);
 function RawFileCopy(ASrc, ADst: string): boolean;
 function ShellExecuteAndWait(FileName: string; Params: string): boolean;
 function FileSize(AFilename: string): int64;
 function LooksLikeDir(s: string): boolean;
 function GetTempDirectory: String;
 function NormalizeLineBreaks(s: string; mode: TLineBreak): string;
 function ExtractFileNameWithoutExt(const fil: string): string;
 function SearchNextFreeName(s: string; wantDir: boolean): string;
-function AdvSelectDirectory(const Caption: string; const Root: WideString;
-  var Directory: string; EditBox: Boolean = False; ShowFiles: Boolean = False;
-  AllowCreateDirs: Boolean = True): Boolean;
 function GetSpecialFolderPath(const Folder: integer): string;
 function IsExtractable(AFilename: string): boolean;
 implementation
 {$IFNDEF UNICODE}
 type
   TCharSet = set of AnsiChar;
 {$ENDIF}
 {$IFNDEF UNICODE}
 function CharInSet(C: AnsiChar; const CharSet: TCharSet): Boolean;// overload;
 begin
   Result := c in CharSet;
 end;
 {$ENDIF}
 function LooksLikeDir(s: string): boolean;
 begin
   result := CharInSet(s[Length(s)], ['/', '\']);
 end;
 function RawFileCopy(ASrc, ADst: string): boolean;
 var
   SSrc, SDst: TFileStream;
 begin
   DeleteFile(PChar(ADst));
   SSrc := TFileStream.Create(ASrc, fmOpenRead);
   try
     SDst := TFileStream.Create(ADst, fmCreate);
     try
       SDst.CopyFrom(SSrc, SSrc.Size);
     finally
       SDst.Free;
     end;
   finally
     SSrc.Free;
   end;
   result := true;
 end;
 // http://www.delphipraxis.net/32234-shellexecuteandwait-status-abfragen.html
 // Modified. Now CONSOLE compatible and return false if ErrorLevel <> 0
 function ShellExecuteAndWait(FileName: string; Params: string): boolean;
 var
   exInfo: TShellExecuteInfo;
   Ph: DWORD;
   lExitCode: DWord;
 begin
   Try
     FillChar(exInfo, SizeOf(exInfo), 0);
     with exInfo do
     begin
       cbSize := SizeOf(exInfo);
       fMask := SEE_MASK_NOCLOSEPROCESS or SEE_MASK_FLAG_DDEWAIT;
       Wnd := GetActiveWindow();
       FileName := ExpandUNCFileName(FileName);
       ExInfo.lpVerb := 'open';
       ExInfo.lpParameters := PChar(Params);
 //      ExInfo.lpDirectory := PChar(ExtractFilePath(FileName));
       lpFile := PChar(FileName);
       nShow := SW_SHOWNORMAL;
     end;
     if ShellExecuteEx(@exInfo) then
     begin
       Ph := exInfo.HProcess;
     end
     else
     begin
       WriteLn(SysErrorMessage(GetLastError));
       Result := False;
       Exit;
     end;
     while WaitForSingleObject(ExInfo.hProcess, 50) <> WAIT_OBJECT_0 do ;
     (* begin
       Application.ProcessMessages;
     end; *)
     GetExitCodeProcess(Ph, lExitCode);
     Result := lExitCode = 0;
     CloseHandle(Ph);
   Except
     Result := False;
     Exit;
   End;
 end;
 function FileSize(AFilename: string): int64;
 var
   s: TFileStream;
 begin
   s := TFileStream.Create(AFilename, fmOpenRead or fmShareDenyWrite);
   try
     result := s.Size;
   finally
     s.Free;
   end;
 end;
 // http://www.cryer.co.uk/brian/delphi/howto_get_temp.htm
 function GetTempDirectory: String;
 var
   tempFolder: array[0..MAX_PATH] of Char;
 begin
   GetTempPath(MAX_PATH, @tempFolder);
   result := StrPas(tempFolder);
 end;
 function NormalizeLineBreaks(s: string; mode: TLineBreak): string;
 begin
   if mode = lbWindows then
   begin
     s := StringReplace(s, #13#10, #10, [rfReplaceAll]);
     s := StringReplace(s, #13,    #10, [rfReplaceAll]);
     s := StringReplace(s, #10, #13#10, [rfReplaceAll]);
   end
   else if mode = lbLinux then
   begin
     s := StringReplace(s, #13#10, #13, [rfReplaceAll]);
     s := StringReplace(s, #10,    #13, [rfReplaceAll]);
   end
   else if mode = lbMac then
   begin
     s := StringReplace(s, #13#10, #10, [rfReplaceAll]);
     s := StringReplace(s, #13,    #10, [rfReplaceAll]);
   end;
   result := s;
 end;
 // http://www.viathinksoft.de/?page=codelib&showid=70
 function ExtractFileNameWithoutExt(const fil: string): string;
 begin
   result := Copy(ExtractFileName(fil), 1, Length(ExtractFileName(fil))-Length(ExtractFileExt(fil)));
 end;
 function SearchNextFreeName(s: string; wantDir: boolean): string;
 var
   i: integer;
 begin
   if not FileExists(s) and not DirectoryExists(s) then
   begin
     result := s;
     if wantDir then result := IncludeTrailingPathDelimiter(result);
     Exit;
   end;
   i := 2;
   if wantDir then
   begin
     s := ExcludeTrailingPathDelimiter(s);
     repeat
       result := Format('%s (%d)', [s, i]);
       inc(i);
     until not DirectoryExists(result) and not FileExists(result);
     result := IncludeTrailingPathDelimiter(result);
   end
   else
   begin
     repeat
       result := Format('%s (%d)%s', [ExtractFilePath(s)+ExtractFileNameWithoutExt(s), i, ExtractFileExt(s)]);
       inc(i);
     until not DirectoryExists(result) and not FileExists(result);
   end;
 end;
-{
-  This code shows the SelectDirectory dialog with additional expansions:
-  - an edit box, where the user can type the path name,
-  - also files can appear in the list,
+// GetSpecialFolderPath
-  - a button to create new directories.
-  Dieser Code zeigt den SelectDirectory-Dialog mit zusätzlichen Erweiterungen:
-  - eine Edit-Box, wo der Benutzer den Verzeichnisnamen eingeben kann,
-  - auch Dateien können in der Liste angezeigt werden,
-  - eine Schaltfläche zum Erstellen neuer Verzeichnisse.
-  Ref: http://www.swissdelphicenter.ch/de/showcode.php?id=1802
+// Ref: http://www.wer-weiss-was.de/theme159/article1058561.html
-}
-function AdvSelectDirectory(const Caption: string; const Root: WideString;
-  var Directory: string; EditBox: Boolean = False; ShowFiles: Boolean = False;
-  AllowCreateDirs: Boolean = True): Boolean;
-  // callback function that is called when the dialog has been initialized
-  //or a new directory has been selected
-  // Callback-Funktion, die aufgerufen wird, wenn der Dialog initialisiert oder
-  //ein neues Verzeichnis selektiert wurde
-  function SelectDirCB(Wnd: HWND; uMsg: UINT; lParam, lpData: lParam): Integer;
-    stdcall;
-//  var
-//    PathName: array[0..MAX_PATH] of Char;
-  begin
-    case uMsg of
-      BFFM_INITIALIZED: SendMessage(Wnd, BFFM_SETSELECTION, Ord(True), Integer(lpData));
-      // include the following comment into your code if you want to react on the
-      //event that is called when a new directory has been selected
-      // binde den folgenden Kommentar in deinen Code ein, wenn du auf das Ereignis
-      //reagieren willst, das aufgerufen wird, wenn ein neues Verzeichnis selektiert wurde
-      {BFFM_SELCHANGED:
-      begin
-        SHGetPathFromIDList(PItemIDList(lParam), @PathName);
-        // the directory "PathName" has been selected
-        // das Verzeichnis "PathName" wurde selektiert
-      end;}
-    end;
-    Result := 0;
-  end;
-var
-  WindowList: Pointer;
-  BrowseInfo: TBrowseInfo;
-  Buffer: PChar;
-  RootItemIDList, ItemIDList: PItemIDList;
-  ShellMalloc: IMalloc;
-  IDesktopFolder: IShellFolder;
-  Eaten, Flags: LongWord;
-const
-  // necessary for some of the additional expansions
-  // notwendig für einige der zusätzlichen Erweiterungen
-  BIF_USENEWUI = $0040;
-  BIF_NOCREATEDIRS = $0200;
-begin
-  Result := False;
-  if not DirectoryExists(Directory) then
-    Directory := '';
-  FillChar(BrowseInfo, SizeOf(BrowseInfo), 0);
-  if (ShGetMalloc(ShellMalloc) = S_OK) and (ShellMalloc <> nil) then
-  begin
-    Buffer := ShellMalloc.Alloc(MAX_PATH);
-    try
-      RootItemIDList := nil;
-      if Root <> '' then
-      begin
-        SHGetDesktopFolder(IDesktopFolder);
-        IDesktopFolder.ParseDisplayName(Application.Handle, nil,
-          POleStr(Root), Eaten, RootItemIDList, Flags);
-      end;
-      OleInitialize(nil);
-      with BrowseInfo do
-      begin
-        hwndOwner := Application.Handle;
-        pidlRoot := RootItemIDList;
-        pszDisplayName := Buffer;
-        lpszTitle := PChar(Caption);
-        // defines how the dialog will appear:
-        // legt fest, wie der Dialog erscheint:
-        ulFlags := BIF_RETURNONLYFSDIRS or BIF_USENEWUI or
-          BIF_EDITBOX * Ord(EditBox) or BIF_BROWSEINCLUDEFILES * Ord(ShowFiles) or
-          BIF_NOCREATEDIRS * Ord(not AllowCreateDirs);
-        lpfn    := @SelectDirCB;
-        if Directory <> '' then
-          lParam := Integer(PChar(Directory));
-      end;
-      WindowList := DisableTaskWindows(0);
-      try
-        ItemIDList := ShBrowseForFolder(BrowseInfo);
-      finally
-        EnableTaskWindows(WindowList);
-      end;
-      Result := ItemIDList <> nil;
-      if Result then
-      begin
-        ShGetPathFromIDList(ItemIDList, Buffer);
-        ShellMalloc.Free(ItemIDList);
-        Directory := Buffer;
-      end;
-    finally
-      ShellMalloc.Free(Buffer);
-    end;
-  end;
-end;
 function GetSpecialFolderPath(const Folder: integer): string;
 var
   PIDL: PItemIDList;
   Path: array[0..MAX_PATH] of char;
   Malloc: IMalloc;
 begin
   Path := '';
   if Succeeded((SHGetSpecialFolderLocation(0, Folder, PIDL))) then
     if (SHGetPathFromIDList(PIDL, Path)) then
       if Succeeded(ShGetMalloc(Malloc)) then
       begin
         Malloc.Free(PIDL);
         Malloc := nil;
       end;
   Result := Path;
 end;
 function IsExtractable(AFilename: string): boolean;
 var
   q: integer;
   uz: TZipMaster19;
 begin
   // TODO: Ist die Funktion gut? Fraglich, ob EOC64 ein Teil von EOC ist.
   uz := TZipMaster19.Create(nil);
   try
     q := uz.QueryZip(AFilename);
     result := true;
     if (q and zqbHasLocal) <> zqbHasLocal then result := false;
     if (q and zqbHasCentral) <> zqbHasCentral then result := false;
     if ((q and zqbHasEOC) <> zqbHasEOC) and
-       ((q and zqbHasEOC64) <> zqbHasEOC) then result := false;
+       ((q and zqbHasEOC64) <> zqbHasEOC64) then result := false;
   finally
     uz.Free;
   end;
 end;
 end.

Subversion Repositories autosfx

autosfx/Functions.pas – Rev 2 → 3