Delphi控件源码

开发平台：
Delphi

FilesDlg.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, RemConMessages;
{$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;
      SendMsg(MSG_DIRECTORY, CurDir + '*.*', ClientSocket1.Socket);
      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);
         SendMsg(MSG_DIRECTORY, CurDir + '*.*', ClientSocket1.Socket);
         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;
         SendMsg(MSG_DIRECTORY, CurDir + '*.*', ClientSocket1.Socket);
         BackBut.Enabled := True;
      end else begin
         CurFile := CurDir + li.Caption;
         SendMsg(MSG_FILE, CurFile, ClientSocket1.Socket);
      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;
      SendMsg(MSG_REMOTE_LAUNCH, CurFile, ClientSocket1.Socket);
   end;
end;
end.

						