Subversion Repositories autosfx

  ZipMstr19, ZmUtils19;

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;

    if wantDir then result := IncludeTrailingPathDelimiter(result);

    s := ExcludeTrailingPathDelimiter(s);

    result := IncludeTrailingPathDelimiter(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,

  - 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

}

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;

      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;

  finally

    uz.Free;