ajfilebrowser.pas

FileBrowser, source code for delphi

            FileHandle    := CreateFile(PChar(Filename),
                                        GENERIC_READ or GENERIC_WRITE, FILE_SHARE_READ or FILE_SHARE_WRITE,
                                        nil, OPEN_EXISTING, FILE_FLAG_WRITE_THROUGH or FILE_FLAG_BACKUP_SEMANTICS, 0);
            if (ModalResult = mrNone) then begin
              if (Item.SubItems[pred(cColDirFile)] = 'D') then
                Caption := 'Edit Dir Params - '  + ExtractFileName(Filename)
              else
                Caption := 'Edit File Params - ' + ExtractFileName(Filename);
              ShowModal;
              Update;
              NewParameters.dwFileAttributes  := dwFileAttributes;
              NewParameters.ftCreationTime    := ftCreationTime;
              NewParameters.ftLastWriteTime   := ftLastWriteTime;
              NewParameters.ftLastAccessTime  := ftLastAccessTime;
            end; {if}
          end; {with}
          with NewParameters do begin
            if (ModalResult = mrOK) then begin
              if (FileHandle <> INVALID_HANDLE_VALUE) then begin
                if (ftCreationTime.dwLowDateTime   <> 0) or (ftCreationTime.dwHighDateTime   <> 0) then
                  SetFileTime(FileHandle, @ftCreationTime, nil, nil  );
                if (ftLastWriteTime.dwLowDateTime  <> 0) or (ftLastWriteTime.dwHighDateTime  <> 0) then
                  SetFileTime(FileHandle, nil, nil, @ftLastWriteTime );
                if (ftLastAccessTime.dwLowDateTime <> 0) or (ftLastAccessTime.dwHighDateTime <> 0) then
                  SetFileTime(FileHandle, nil, @ftLastAccessTime, nil);
                CloseHandle(FileHandle);
                FileHandle  := INVALID_HANDLE_VALUE;
              end; {if}
              if SaveAttributes then
                SetFileAttributes(PChar(Filename), dwFileAttributes)
              else
                SetFileAttributes(PChar(Filename), OldAttributes);
            end else
              SetFileAttributes(PChar(Filename), OldAttributes);
            if (FileHandle <> INVALID_HANDLE_VALUE) then
              CloseHandle(FileHandle);
          end; {with}
        end; {if}
        Item  := lvFiles.GetNextItem(Item, sdAll, [isSelected]);
      end; {while}
    finally
      Free;
    end; {try}
  end; {with}
  RefreshlvFiles;
end; {mnuEditFileTimeClick}

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

procedure TfrmFileBrowser.mnuExitClick(Sender : TObject);
// Looks like we're leaving !
begin
  if fIsPropertyEditor then
    ModalResult := mrCancel
  else
    Close;
end; {mnuExitClick}

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

function TfrmFileBrowser.FileFindAndSelect(ListView : TListView; FileCaption : string) : boolean;
var
  ListItem  : TListItem;
begin
  ListItem  := ListView.FindCaption(0, FileCaption, false, true, false);
  Result    := (ListItem <> nil);
  if Result then
    ListView.ItemFocused   := ListItem;
  HighlightFocusedItem(ListView);
end; {FileFindAndSelect}

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

procedure TfrmFileBrowser.RefreshlvFiles;
var
  Caption : string;
begin
  if (lvFiles.Selected <> nil) then
    Caption := lvFiles.Selected.Caption
  else
    Caption := '';
  UpdateFileListView(fFileMask, fFileAttributes);                         // Go and get the same old stuff again.
  FileFindAndSelect(lvFiles, Caption);
end; {RefreshlvFiles}

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

procedure TfrmFileBrowser.RefreshlvDrives;
var
  Caption : string;
begin
  if (lvDrives.Selected <> nil) then
    Caption := lvDrives.Selected.Caption
  else
    Caption := '';
  AddDrives;
  FileFindAndSelect(lvDrives, Caption);
end; {RefreshlvDrives}

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

procedure TfrmFileBrowser.mnuRefreshClick(Sender : TObject);
// Guess what ? - it refreshes the current list view ... just in case something changed !
begin
  if lvDrives.Visible then
    RefreshlvDrives
  else
    RefreshlvFiles;
end; {mnuRefreshClick}

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

procedure TfrmFileBrowser.mnuShowFoldersClick(Sender : TObject);
// Hide or reveal folders.
begin
  TMenuItem(Sender).Checked := not TMenuItem(Sender).Checked;             // Toggle me.
  fFoldersHidden            := not TMenuItem(Sender).Checked;             // Decide whether we get the folders.
  if lvFiles.Visible then
    UpdateFileListView(fFileMask, fFileAttributes);                       // ... and just do it.
end; {mnuShowFoldersClick}

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

procedure TfrmFileBrowser.mnuUpdateClick(Sender : TObject);
// Closing time but tell the property manager that it's OK to update the new value.
begin
  if fIsPropertyEditor then
    ModalResult := mrOK
  else
    Close;
end; {mnuUpdateClick}

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

procedure TfrmFileBrowser.mnuViewTypeClick(Sender : TObject);
// Select view preference ... large icons, small icons, list or details.
begin
  if (Sender is TMenuItem) then begin
    with Sender as TMenuItem do begin
      case Tag of
        0 : btnLargeIcons.Down    := true;
        1 : btnSmallIcons.Down    := true;
        2 : btnList.Down          := true;
        3 : btnDetails.Down       := true;
      end; {case}
      Checked             := true;                                            // Toggle me.
      lvDrives.ViewStyle  := TViewStyle(Tag);
      lvFiles.ViewStyle   := TViewStyle(Tag);                                 // Note that the menu tags are used.
    end; {with}
  end else if (Sender is TSpeedButton) then begin
    with Sender as TSpeedButton do begin
      case Tag of
        0 : mnuLargeIcons.Checked := true;
        1 : mnuSmallIcons.Checked := true;
        2 : mnuList.Checked       := true;
        3 : mnuDetails.Checked    := true;
      end; {case}
      lvDrives.ViewStyle  := TViewStyle(Tag);
      lvFiles.ViewStyle   := TViewStyle(Tag);                                 // Note that the button tags are used.
    end; {with}
  end; {if}
  if (lvFiles.ViewStyle = vsReport) then
    SetColumnBitmap(lvFiles.Column[fColumnToSort]);
end; {mnuViewTypeClick}

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

procedure TfrmFileBrowser.mnuXPMenuClick(Sender : TObject);
// Set XP menu styles.
begin
  with Sender as TMenuItem do begin
    Checked               := not Checked;                                 // Toggle me.
    fajAlterMenu.Enabled  := Checked;                                     // Switch on the fancy stuff ...
  end; {with}                                                             // or maybe switch us off.
end; {mnuXPMenuClick}

{--------------------------------------------------------------------------------------------------}
{                                         Other Events                                             }
{--------------------------------------------------------------------------------------------------}

procedure TfrmFileBrowser.SetColumnBitmap(Column : TListColumn);          // Gosh ... all this just to put
var                                                                       // an up/down arrow in the column
  HeaderHandle  : THandle;                                                // header ... lot of work !
  HdItem        : THdItem;
  lp1           : Integer;
begin
  HeaderHandle  := ListView_GetHeader(lvFiles.Handle);
  if (HeaderHandle <> 0) then begin
    for lp1 := 0 to pred(lvFiles.Columns.Count) do begin
      HdItem.Mask := HDI_FORMAT;
      Header_GetItem(HeaderHandle, lp1, HdItem);
      HdItem.Mask := HDI_BITMAP or HDI_FORMAT;
      if (lp1 = Column.Index) then begin
        HdItem.hbm  := fSortArrows[ord(fSortAscending)].Handle;
        HdItem.fmt  := HdItem.fmt or HDF_BITMAP;
        if (lvFiles.Columns[lp1].Alignment = taLeftJustify) then
          HdItem.fmt  := HdItem.fmt or HDF_BITMAP_ON_RIGHT;
      end else
        HdItem.fmt  := HdItem.fmt and not HDF_BITMAP;
      Header_SetItem(HeaderHandle, lp1, HdItem);
    end; {for}
  end; {if}
end; {SetColumnBitmap}

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

procedure TfrmFileBrowser.lvFilesColumnClick(Sender : TObject; Column : TListColumn);
begin
  if (fColumnToSort = Column.Index) then                                  // Set the sort direction.
    fSortAscending  := not fSortAscending
  else begin
    fColumnToSort   := Column.Index;
    fSortAscending  := true;
  end;
  (Sender as TCustomListView).AlphaSort;                                 // Execute the sort and then
  SetColumnBitmap(Column);                                               // show us which column.
end; {lvFilesColumnClick}

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

procedure TfrmFileBrowser.lvFilesCompare(Sender : TObject; Item1, Item2 : TListItem; Data : integer; var Compare : integer);

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

  function NumberStringToInt64(NumStr : string) : Int64;                  // Convert a numeric string to an Int64.
  var                                                                     // Better than StrToIntDef ...
    lp1 : integer;                                                        // This one deals with anthying that's not
  begin                                                                   // numeric by ignoring it.
    Result  := 0;
    for lp1 := 1 to Length(NumStr) do
      if NumStr[lp1] in ['0'..'9'] then
        Result  := Result * 10 + ord(NumStr[lp1]) - 48;
  end; {NumberStringToDWORD}

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

  function CompareFileSize(DirFile1, Filename1, SizeStr1, DirFile2, Filename2, SizeStr2 : string) : integer;
  var
    Num1  : Int64;                                                        // Compare file sizes.
    Num2  : Int64;
  begin
    if (DirFile1 = 'D') and (DirFile2 = 'D') then                         // Directories have no size ...
      Result  := CompareText(Filename1, Filename2)                        // so sort them by name.
    else begin
      Num1  := NumberStringToInt64(SizeStr1);                             // Get the sizes and compare them.
      Num2  := NumberStringToInt64(SizeStr2);
      if (Num1 > Num2) then
        Result  := 1
      else if (Num1 < Num2) then
        Result  := -1
      else                                                                // Same size so sort them by name.
        Result  := CompareText(Filename1, Filename2);
    end; {if}
  end; {CompareFileSize}

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

  function ReconstructDate(DateStr : string) : TDateTime;
  var                                                                     // This one was hard.
    TimePos     : integer;                                                // Parse out the date and convert
    h, m, s, n  : WORD;                                                   // it back to TDateTime.
  begin                                                                   // Then parse out the time and add
    TimePos := Pos(' ', DateStr);                                         // that to our TDateTime ... and then
    if (TimePos = 0) then                                                 // we can do the comparison.
      Result  := StrToDate(DateStr)                                       
    else begin
      Result  := StrToDate(Copy(DateStr, 1, pred(TimePos)));