ajfilebrowser.pas

FileBrowser, source code for delphi

            SubItems.Add(FormatFloat('###,###,##0 KB', DI.Capacity  div 1024));
            SubItems.Add(FormatFloat('###,###,##0 KB', DI.FreeSpace div 1024));
            SubItems.Add(IntToHex(HiWord(DI.Serial), 4) + '-' +  IntToHex(LoWord(DI.Serial), 4));
          end; {if}
          SubItems.Add(Drv);
        except
        //  Items.Delete(NewItem.Index);
        end; {try}
      end; {with}
    end; {if}
  end; {for}
  lvDrives.Items.EndUpdate;
end; {AddDrives}

{--------------------------------------------------------------------------------------------------}

procedure TfrmFileBrowser.UpdateFileListView(FileMask : string; Attribute : DWORD);
var
  FileCount : integer;                                                    // No. files found.
  DirCount  : integer;                                                    // No. directories found.

  {................................................................................................}

  function  DefaultFileType(Filename : string; FileAttributes : DWORD) : string;
  begin
    if (FileAttributes and FILE_ATTRIBUTE_DIRECTORY > 0) then
      Result  := 'File Folder'
    else begin
        Result  := UpperCase(ExtractFileExt(Filename));
      if (Result = '.') then
        Result  := ''
      else
        Result  := Copy(Result, 2, pred(Length(Result))) + ' File';
    end; {if}
  end; {DefaultFileType}

  {................................................................................................}

  function AttributeString(Attribute  : DWORD) : string;                  // Generate a string based on
  begin                                                                   // the given attribute word.
    Result  := '';
    if (FILE_ATTRIBUTE_READONLY and Attribute > 0) then
      Result  := 'R';
    if (FILE_ATTRIBUTE_HIDDEN   and Attribute > 0) then
      Result  := Result + 'H';
    if (FILE_ATTRIBUTE_SYSTEM   and Attribute > 0) then
      Result  := Result + 'S';
    if (FILE_ATTRIBUTE_ARCHIVE  and Attribute > 0) then
      Result  := Result + 'A';
    if (FILE_ATTRIBUTE_NORMAL   and Attribute > 0) then
      Result  := Result + 'N';
    if (Result = '') then
      Result  := '.';
  end; {AttributeString}

  {................................................................................................}

  procedure AddFileToList(SearchRec : TSearchRec);                        // Add a file to the list.
  var
    ShInfo    : TSHFileInfo;
    Filename  : string;
  begin
    Filename  := ExtractFilePath(fFilename) + SearchRec.Name;
    SHGetFileInfo(PChar(Filename), 0, ShInfo, SizeOf(ShInfo), SHGFI_TYPENAME or SHGFI_SYSICONINDEX or SHGFI_DISPLAYNAME);
    with lvFiles.Items.Add, SearchRec.FindData do begin
      if (ShInfo.szDisplayName <> '') then                                // If it's got a name then use it ...
        Caption := ShInfo.szDisplayName
      else                                                                // otherwise use this one instead.
        Caption := SearchRec.Name;
      if (SearchRec.Name = '..') then begin                               // If it's the parent root directory then
        Caption     := ExtractFilename(ExpandFileName(FileName));         // get its name from the filename ...
        if (Caption = '') then                                            // might be nothing left at the root, so give
          Caption := '..';                                                // it the dot dot ...
        Caption     := Format('[%s]', [Caption]);                         // Add the square brackets and give it one of our
        if (lvFiles.SmallImages <> nil) then                              // home-made icons.
          ImageIndex  := fRootIconIndex
      end else if (lvFiles.SmallImages <> nil) then                       // Otherwise use an icon that Bill made !
          ImageIndex  := ShInfo.iIcon;
      if ((dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) > 0) then       // Everyone assumes that directories take no space ...
        SubItems.Add('')                                                  // and so do I ... so don't give it a size !
      else                                                                // Otherwise ... give its size in bytes.
        SubItems.Add(FormatFloat('#0,', nFileSizeHigh * MAXDWORD + nFileSizeLow));
      if (SHInfo.szTypeName = '') then                                    // Add on its type name ... look out for
        SubItems.Add(DefaultFileType(Filename, dwFileAttributes))         // the shell not recognising the file type ...
      else                                                                // so we have to do it ourselves.
        SubItems.Add(ShInfo.szTypeName);
      SubItems.Add(FileTimeToDateTimeStr(ftCreationTime  ));              // Now add on the file time stamp stuff.
      SubItems.Add(FileTimeToDateTimeStr(ftLastWriteTime ));              // Be aware that 95 and 98 always has
      SubItems.Add(FileTimeToDateTimeStr(ftLastAccessTime));              // zero accessed time.
      if ((dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) > 0) then begin
        if (SearchRec.Name = '..') then begin
          Filename  := Copy(Filename, 1, Length(Filename) - 2);
          SubItems.Add(AttributeString(GetFileAttributes(PChar(Filename))));
          SubItems.Add(Filename);
        end else begin
          SubItems.Add(AttributeString(dwFileAttributes));                // These are invisible but needed - long filename.
          SubItems.Add(ExpandFileName(Filename));                         // Now a flag character to say whether it's
          inc(DirCount);                                                  // a directory or a file ... and while we're
        end; {if}                                                         // at it, update our counts.
        SubItems.Add('D');
      end else begin
        SubItems.Add(AttributeString(dwFileAttributes));                  // Now its attributes.
        SubItems.Add(Filename);                                           // These are invisible but needed - long filename.
        inc(FileCount);
        SubItems.Add('F');
      end; {if}
    end; {with}
  end; {AddFileToList}
  
  {................................................................................................}

var
  lp1           : integer;
  SearchRec     : TSearchRec;
  HasDriveRoot  : boolean;
begin
  if SetCurrentDir(ExtractFilePath(fFilename)) then begin
    FileMask  := '*.*';
    FileCount := 0;
    DirCount  := 0;

    lvFiles.Items.BeginUpdate;
    lvFiles.Items.Clear;

    HasDriveRoot  := (ExtractFileDir(fFilename) = ExtractFilePath(fFilename));
    if HasDriveRoot then begin
      with lvFiles.Items.Add do begin
        Caption := '[Drives]';
        if (lvFiles.SmallImages <> nil) then
          ImageIndex  := fRootIconIndex;
        for lp1 := cColSize to cColFullName do
          SubItems.Add('');
        SubItems.Add('D');                                                                                                  // and so do I ... so don't give it a size !
      end; {with}
    end; {if}

    if (FindFirst(FileMask, faAnyFile, SearchRec) = 0) then begin
      try
        Screen.Cursor := crHourGlass;
        repeat
          if (SearchRec.Name <> '.') and not (HasDriveRoot and (SearchRec.Name = '..')) then begin
            if (SearchRec.Attr and FILE_ATTRIBUTE_DIRECTORY = 0) then begin // Don't come in here with these boys ...
              with SearchRec.FindData do begin
                if (((Attribute and dwFileAttributes and FILE_ATTRIBUTE_READONLY > 0))  or
                    ((Attribute and dwFileAttributes and FILE_ATTRIBUTE_HIDDEN   > 0))  or
                    ((Attribute and dwFileAttributes and FILE_ATTRIBUTE_SYSTEM   > 0))  or
                    ((Attribute and dwFileAttributes and FILE_ATTRIBUTE_ARCHIVE  > 0))  or
                    ((Attribute and dwFileAttributes and FILE_ATTRIBUTE_NORMAL   > 0))) or
                    (dwFileAttributes = 0) then
                  AddFileToList(SearchRec);                                 // OK ... put me on the list.
              end; {with}
            end else if not fFoldersHidden then
              AddFileToList(SearchRec);
          end; {if}
        until (FindNext(SearchRec) <> 0);                                   // Keep on looking.
      finally
        FindClose(SearchRec);                                               // Close and put the cursor back.
        Screen.Cursor := crDefault;
      end; {try}
    end; {if}
                                                                            // Release the list view.
    lvFiles.Items.EndUpdate;

    StatusBar.Panels[0].Text  := 'Files: '   + IntToStr(FileCount);         // Tell us how many we got.
    StatusBar.Panels[1].Text  := 'Folders: ' + IntToStr(DirCount );

    lvDrives.Visible          := false;
    lvFiles.Visible           := true;

  end; {if}
end; {UpdateFileListView}

{--------------------------------------------------------------------------------------------------}
{                                         Menu Events                                              }
{--------------------------------------------------------------------------------------------------}

procedure TfrmFileBrowser.mnuAboutClick(Sender : TObject);
// What else ? - it shows the about box !
begin
  with TfrmAbout.Create(nil) do begin
    try
      if fIsPropertyEditor then
        Caption  := 'Key Maker Package'
      else
        Caption  := 'File Browser';
      ShowModal;
    finally
      Free;
    end; {try}
  end; {with}
end; {mnuAboutClick}

{--------------------------------------------------------------------------------------------------}

procedure TfrmFileBrowser.mnuAttributesClick(Sender : TObject);
// Revise the file attributes filter.
begin
  TMenuItem(Sender).Checked := not TMenuItem(Sender).Checked;             // Toggle me !
  SetFileAttributesFilter;                                                // Set up the attributes filter.
  UpdateFileListView(fFileMask, fFileAttributes);                         // Go and get the boys in the list.
end; {mnuAttributesClick}

{--------------------------------------------------------------------------------------------------}

procedure TfrmFileBrowser.mnuBookmarkClick(Sender : TObject);
begin
  if (lvFiles.Selected <> nil) then begin
    if (TWinControl(Sender).Tag = cAddBookmark) then
      fajRecentKeys.UpdateRecentKeys(lvFiles.Selected.SubItems.Strings[pred(cColFullName)], tAdd)
    else
      fajRecentKeys.UpdateRecentKeys(lvFiles.Selected.SubItems.Strings[pred(cColFullName)], tDelete);
    SetBookmarkControls(TWinControl(Sender).Tag);
  end; {if}
end; {mnuBookmarkClick}

{--------------------------------------------------------------------------------------------------}

procedure TfrmFileBrowser.mnuColumnsClick(Sender : TObject);
// Hide or reveal chosen column - restores previously used column width.
begin
  with TMenuItem(Sender) do begin
    Checked := not Checked;                                               // Toggle me too !
    fColumnSettings[tag].Visible  := Checked;                             // Note that the menus use the tags.
    if Checked then                                                       // If visible now then restore
      lvFiles.Columns[tag].Width  := fColumnSettings[tag].DefWidth        // the last known width.
    else                                                                  // Otherwise conceal this column
      lvFiles.Columns[tag].Width  := 0;                                   // by setting its width to zero.
  end; {with}                                                             // Hey ... don't forget that the new
end; {mnuColumnsClick}                                                    // window proc will have done its stuff too.

{--------------------------------------------------------------------------------------------------}

procedure TfrmFileBrowser.mnuCopyPathClick(Sender : TObject);
var
  Item  : TListItem;
  Path  : string;
begin
  Path  := '';
  Item  := lvFiles.Selected;
  repeat
    Path  := Path + Item.SubItems[pred(cColFullName)] + #13;
    Item  := lvFiles.GetNextItem(Item, sdAll, [isSelected]);
  until (Item = nil);
  Path  := Copy(Path, 1, pred(Length(Path)));
  Clipboard.SetTextBuf(PChar(Path));
end; {mnuCopyPathClick}

{--------------------------------------------------------------------------------------------------}

procedure TfrmFileBrowser.mnuEditFileParamsClick(Sender : TObject);
var
  NewParameters : TWin32FindData;
  Filename      : string;
  OldAttributes : DWORD;
  Item          : TListItem;
begin
  with TfrmEditFileParams.Create(nil) do begin
    FillMemory(@NewParameters, SizeOf(NewParameters), 0);
    try
      Item  := lvFiles.Selected;
      while (Item <> nil) do begin
        Filename  := ExcludeTrailingBackSlash(Item.SubItems[pred(cColFullName)]);

        if GetFileAttributesEx(PChar(Filename), GetFileExInfoStandard, @Win32FindData) then begin
          with Win32FindData do begin
            OldAttributes := dwFileAttributes;
            SetFileAttributes(PChar(Filename), 0);