⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 filesdlg.pas

📁 Asta For d2006 自己修改版 经典中间件 速度超快
💻 PAS
字号:
unit FilesDlg;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ComCtrls, ExtCtrls, Buttons, StdCtrls, ImgList, Menus;

type
  TFilesForm = class(TForm)
    Panel1: TPanel;
    FileList: TListView;
    DriveCombo: TComboBox;
    GetDirBut: TSpeedButton;
    BackBut: TSpeedButton;
    DirLabel: TLabel;
    SaveDialog1: TSaveDialog;
    ImageList1: TImageList;
    FilePopup: TPopupMenu;
    GetFile1: TMenuItem;
    N1: TMenuItem;
    LaunchFile1: TMenuItem;
    procedure GetDirButClick(Sender: TObject);
    procedure FileListDblClick(Sender: TObject);
    procedure BackButClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure DriveComboChange(Sender: TObject);
    procedure FileListCompare(Sender: TObject; Item1, Item2: TListItem;
      Data: integer; var Compare: integer);
    procedure LaunchFile1Click(Sender: TObject);
  private
    { Private declarations }
  public
    CurDir: string;
    DirStack: TStringList;
    CurFile: string;
    procedure SetDriveList(const DriveList: string);
    procedure SetDirData(const DirData: string);
    procedure SetFileData(const FileData: string);
  end;

var
  FilesForm: TFilesForm;

implementation

uses ClientFrm;

{$R *.DFM}

function IsDir(const FileName: string): boolean;
begin
  Result := Copy(FileName, Length(FileName), 1) = '\';
end;

procedure TFilesForm.SetDriveList(const DriveList: string);
var
  i: integer;
  OrigIdx: integer;
  s: string;
begin
  OrigIdx := DriveCombo.ItemIndex;
  DriveCombo.Items.Text := DriveList;

  if OrigIdx = -1 then 
  begin
    for i := 0 to DriveCombo.Items.Count - 1 do 
    begin
      s := DriveCombo.Items[i];
      if UpperCase(Copy(s, 1, 1)) = 'C' then
        DriveCombo.ItemIndex := i;
    end;
  end 
  else 
  begin
    DriveCombo.ItemIndex := OrigIdx;
  end;
end;

procedure TFilesForm.GetDirButClick(Sender: TObject);
begin
  with (Owner as TClientForm) do 
  begin
    CurDir := DriveCombo.Items[DriveCombo.ItemIndex];
    DirStack.Clear;
    cl.getdirectory(CurDir + '*.*');
    GetDirBut.Enabled := False;
  end;
end;

procedure TFilesForm.BackButClick(Sender: TObject);
begin
  with (Owner as TClientForm) do 
  begin
    if DirStack.Count > 0 then 
    begin
      CurDir := DirStack[DirStack.Count - 1];
      DirStack.Delete(DirStack.Count - 1);
      cl.getDirectory(CurDir + '*.*');
      if DirStack.Count = 0 then BackBut.Enabled := False;
    end 
    else 
    begin
      Beep;
    end;
  end;
end;

procedure TFilesForm.SetDirData(const DirData: string);
var
  DirList: TStringList;
  CommaList: TStringList;
  i: integer;
  li: TListItem;
begin
  DirLabel.Caption := 'Contents of ''' + Copy(CurDir, 1, Length(CurDir) - 1) + '''';

  Screen.Cursor := crHourGlass;
  DirList := TStringList.Create;
  CommaList := TStringList.Create;

  DirList.Text := DirData;
  FileList.Items.BeginUpdate;
  FileList.Items.Clear;
  for i := 0 to DirList.Count - 1 do 
  begin
    CommaList.CommaText := DirList[i];

    li := FileList.Items.Add;
    li.Caption := CommaList[0];
    if not IsDir(CommaList[0]) then li.SubItems.Add(CommaList[1])
    else 
      li.SubItems.Add('');
    li.SubItems.Add(CommaList[2]);

    if IsDir(CommaList[0]) then 
    begin
      li.ImageIndex := 0;
    end 
    else 
    begin
      li.ImageIndex := 1;
    end;
  end;
  FileList.SortType := stData;
  FileList.Items.EndUpdate;
  Screen.Cursor := crDefault;

  CommaList.Free;
  DirList.Free;
end;

procedure TFilesForm.FileListDblClick(Sender: TObject);
var
  li: TListItem;
begin
  li := FileList.Selected;
  if li = nil then exit;

  with (Owner as TClientForm) do 
  begin
    if IsDir(li.Caption) then 
    begin
      DirStack.Add(CurDir);
      CurDir := CurDir + li.Caption;
      cl.getDirectory(CurDir + '*.*');
      BackBut.Enabled := True;
    end 
    else 
    begin
      CurFile := CurDir + li.Caption;
      cl.FileList(CurFile);
    end;
  end;
end;

procedure TFilesForm.FormCreate(Sender: TObject);
begin
  DirStack := TStringList.Create;
end;

procedure TFilesForm.FormDestroy(Sender: TObject);
begin
  DirStack.Free;
end;

procedure TFilesForm.DriveComboChange(Sender: TObject);
begin
  GetDirBut.Enabled := True;
end;

procedure TFilesForm.SetFileData(const FileData: string);
var
  fs: TFileStream;
begin
  SaveDialog1.FileName := CurFile;
  if SaveDialog1.Execute then 
  begin
    fs := TFileStream.Create(SaveDialog1.FileName, fmCreate);
    fs.Write(FileData[1], Length(FileData));
    fs.Free;
  end;
end;

procedure TFilesForm.FileListCompare(Sender: TObject; Item1,
  Item2: TListItem; Data: integer; var Compare: integer);
var
  d1, d2: integer;
begin
  if IsDir(Item1.Caption) then d1 := 0 
  else 
    d1 := 1;
  if IsDir(Item2.Caption) then d2 := 0 
  else 
    d2 := 1;

  if d1 = d2 then
    Compare := AnsiCompareText(Item1.Caption, Item2.Caption)
  else
    Compare := d1 - d2;
end;

procedure TFilesForm.LaunchFile1Click(Sender: TObject);
var
  li: TListItem;
begin
  li := FileList.Selected;
  if li = nil then exit;

  with (Owner as TClientForm) do 
  begin
    CurFile := CurDir + li.Caption;
    cl.Remotelaunch(CurDir);
  end;
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -