copyunit.pas

vc-mfc编程实例 很简单的东西,以后回多传自己的东西

{ SimpFTP  by Eric W. Engler.  This is Freeware.  
  A Simple FTP Client for Delphi that uses TFtpCli VCL from
  Francois Piette. }

unit copyunit;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, FileCtrl, ExtCtrls, Grids;

type
  Tcopyform = class(TForm)
    Panel1: TPanel;
    Panel2: TPanel;
    Panel3: TPanel;
    DriveComboBox1: TDriveComboBox;
    FileListBox1: TFileListBox;
    Panel4: TPanel;
    DirectoryListBox1: TDirectoryListBox;
    Panel5: TPanel;
    UploadBut: TButton;
    DownloadBut: TButton;
    CancelBut: TButton;
    Panel6: TPanel;
    Panel7: TPanel;
    Label1: TLabel;
    Panel8: TPanel;
    SelectAllBut: TButton;
    Label3: TLabel;
    RadioGroup1: TRadioGroup;
    Memo1: TMemo;
    RemoteDirList: TListBox;
    StringGrid1: TStringGrid;
    Panel9: TPanel;
    Label2: TLabel;
    RemoteDirEdit: TEdit;
    ChgDirBut: TButton;
    RmDirBut: TButton;
    MkDirBut: TButton;
    DelRemFileBut: TButton;
    DelLocFileBut: TButton;
    AdvMenuCB: TCheckBox;
    ViewBut: TButton;
    procedure CancelButClick(Sender: TObject);
    procedure SelectAllButClick(Sender: TObject);
    function  AppendSlash(const sDir : String): String;
    procedure FormCreate(Sender: TObject);
    procedure ParseDir;
    procedure ParseDirEntry(s: String);
    procedure ChgDirButClick(Sender: TObject);
    procedure RemoteDirListClick(Sender: TObject);
    procedure UploadButClick(Sender: TObject);
    procedure DownloadButClick(Sender: TObject);
    procedure AdvMenuCBClick(Sender: TObject);
    procedure RmDirButClick(Sender: TObject);
    procedure MkDirButClick(Sender: TObject);
    procedure DelRemFileButClick(Sender: TObject);
    procedure DelLocFileButClick(Sender: TObject);
    procedure ViewButClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  copyform: Tcopyform;
  WinTempDir: String;
  RemFilename, RemDateTime, RemSize: String;
  RemDirectory: Boolean;
  
implementation

uses unit1;

{$R *.DFM}

procedure Tcopyform.CancelButClick(Sender: TObject);
begin
   Close;
end;

procedure Tcopyform.SelectAllButClick(Sender: TObject);
var
   i: Integer;
begin
   for i := 0 to FileListBox1.Items.Count - 1 do
      FileListBox1.Selected[i]:=True;
end;

function Tcopyform.AppendSlash(const sDir : String): String;
begin
  Result := sDir;
  if (Length(sDir)>0) and (sDir[Length(sDir)]<>'\') then
     Result := Result+'\';
end;

procedure Tcopyform.FormCreate(Sender: TObject);
var
   TempDir: array[0..255] of Char;
begin
   RadioGroup1.Itemindex:=0;   // default to binary mode
   AdvMenuCB.Checked:=False;   // default to the simple menu only
   AdvMenuCBClick(Self);       // make it so

   GetTempPath(255, @TempDir);  // Get the name of the Windows temp dir
   WinTempDir := StrPas(TempDir); // keep it in a global Pascal string

   with StringGrid1 do
   begin
     ColWidths[0]:=150;
     ColWidths[1]:=64;
     ColWidths[2]:=80;
     RowCount:=2;  { first row is fixed, and used for column headers }
     FixedRows:=1;
     Cells[0,0] := 'File Name';
     Cells[1,0] := 'File Size';
     Cells[2,0] := 'Date/Time';
  end;
end;

procedure TCopyForm.ParseDir;
var
   Fi: System.Text;
   S: String;
begin
  RemoteDirList.Items.Clear;
  if RemoteDirEdit.text <> '/' then
     RemoteDirList.Items.Add('<up one dir>');
  StringGrid1.RowCount:=1;
  If FileExists(WinTempDir+'ftpdir.txt') then
  begin
     System.Assign(Fi, WinTempDir+'ftpdir.txt');
     Reset(Fi); { open for read }
     repeat
        readln(Fi, S);
        if Length(S) < 20 then
           continue;
        ParseDirEntry(s);
        if RemDirectory then
           RemoteDirList.Items.Add(RemFilename)
        else
        begin
           with StringGrid1 do
           begin
              RowCount:=RowCount+1;
              Cells[0,RowCount-1] := RemFilename;
              Cells[1,RowCount-1] := RemSize;
              Cells[2,RowCount-1] := RemDateTime;
           end;
        end;
     until Eof(Fi);
     System.Close(Fi);
     DeleteFile(WinTempDir+'ftpdir.txt');
     if StringGrid1.RowCount = 1 then
     begin
        StringGrid1.RowCount:=2;
        StringGrid1.Rows[1].Clear;
     end;
     StringGrid1.FixedRows:=1;
  end;
end;

procedure TCopyForm.ParseDirEntry(s: String);
var
   i, j: Integer;
begin
   i:=0;
   if LowerCase(s[1]) = 'd' then
      RemDirectory:=True
   else
      RemDirectory:=False;

   // skip permissions - locate first whitespace
   repeat
      Inc(i);
   until s[i] = ' ';

   // skip whitespace
   repeat
      Inc(i);
   until s[i] <> ' ';

   // skip over # of links
   repeat
      Inc(i);
   until s[i] = ' ';

   // skip whitespace
   repeat
      Inc(i);
   until s[i] <> ' ';

   // skip over owner
   repeat
      Inc(i);
   until s[i] = ' ';

   // skip whitespace
   repeat
      Inc(i);
   until s[i] <> ' ';

   // skip over group
   repeat
      Inc(i);
   until s[i] = ' ';

   // skip whitespace
   repeat
      Inc(i);
   until s[i] <> ' ';

   // collect filesize
   RemSize:='';
   repeat
      RemSize:=RemSize+s[i];
      Inc(i);
   until s[i] = ' ';

   // skip whitespace
   repeat
      Inc(i);
   until s[i] <> ' ';

   // Collect Month
   RemDateTime:='';
   repeat
      RemDateTime:=RemDateTime+s[i];
      Inc(i);
   until s[i] = ' ';
   RemDateTime:=RemDateTime+' ';

   // skip whitespace
   repeat
      Inc(i);
   until s[i] <> ' ';

   // collect the day
   repeat
      RemDateTime:=RemDateTime+s[i];
      Inc(i);
   until s[i] = ' ';
   RemDateTime:=RemDateTime+' ';

   // skip whitespace
   repeat
      Inc(i);
   until s[i] <> ' ';

   // collect the time/year combo field
   repeat
      RemDateTime:=RemDateTime+s[i];
      Inc(i);
   until s[i] = ' ';

   // skip whitespace
   repeat
      Inc(i);
   until s[i] <> ' ';

   // Collect the name
   RemFilename:='';
   repeat
      RemFilename:=RemFilename+s[i];
      Inc(i);
   until i > Length(s);

   // Entries beginning with 'l' are Unix soft links.  They point at either
   // a directory, or another file.

   // I'm not currently allowing users to download files by using the name
   // of the link.  I'm allowing Windows to complain about the '>' in the
   // filename as my way of saying "you can't do that".  There are 2 reasons
   // to prevent downloads of files by soft link: 1) the link itself
   // only has a small size - I don't know the size of the real file. 2) The
   // user may mistake the name of the link for the real name of the file,
   // since MS-DOS/Windows has no links itself.

   // However, directory links are widespread in Unix, and I'm allowing
   // users to CD to directory links.  I don't even tell the user that it's
   // a link - I remove the real name that the link points to.

   // We can't easily determine if the link points to a file, or a directory.
   // I am doing it the easy way here: if there's a period in the name, I'll
   // assume it's a link to a file, not a dir.  This won't be 100% accurate,
   // but will be a good guess in most cases.
   if Lowercase(s[1]) = 'l' then
      if Pos('.', RemFilename) = 0 then
         RemDirectory:=True;

   // Fix the name of dir links   (Example: linkname -> /path1/path2 )
   // Pull out the arrow and the real name being pointed-to.
   if (RemDirectory) and (Length(RemFilename) > 4) then
      for j:= 4 to Length(RemFileName) do
      begin
         if (RemFilename[j] = '>')
         and (RemFilename[j-1] = '-')
         and (RemFilename[j-2] = ' ') then
         begin
            SetLength(RemFileName,j-3);
            break;
         end;
      end;
end;

procedure Tcopyform.ChgDirButClick(Sender: TObject);
var
  i: integer;
  done: boolean;
begin
  done:=False;
  for i := 0 to (RemoteDirList.Items.Count - 1) do
    if RemoteDirList.Selected[i] then
    begin
       if RemoteDirList.Items[i] = '<up one dir>' then
       begin
          // Change to parent directory
          Form1.FtpClient1.CdUp;
          Memo1.Lines.Add('cdup');
          Form1.Memo1.Lines.Add('cdup');
       end
       else
       begin
          // change to the selected directory
          Form1.FtpClient1.HostDirName:=RemoteDirList.Items[i];
          Memo1.Lines.Add('chdir ' + RemoteDirList.Items[i]);
          Form1.Memo1.Lines.Add('chdir ' + RemoteDirList.Items[i]);
          Form1.FtpClient1.Cwd;
       end;
       done:=True;
       break;
    end;
  if not done then
  begin
     // We didn't find a dir selected in the list box.
     // Assume user put desired dir in the edit box.
     Form1.FtpClient1.HostDirName:=RemoteDirEdit.text;
     Memo1.Lines.Add('chdir ' + RemoteDirEdit.text);
     Form1.Memo1.Lines.Add('chdir ' + RemoteDirEdit.text);
     Form1.FtpClient1.Cwd;
  end;
end;

procedure Tcopyform.RemoteDirListClick(Sender: TObject);
begin
   ChgDirButClick(self);
end;

procedure Tcopyform.UploadButClick(Sender: TObject);
var
   i: Integer;
begin
   Form1.FileNames.Clear;
   for i := 0 to FileListBox1.Items.Count - 1 do
   begin
      if FileListBox1.Selected[i] then
      begin
         // Get filenames that are selected in the FileListBox
         Form1.FileNames.Add(AppendSlash(
             DirectoryListBox1.Directory) + FileListBox1.Items[i]);
         FileListBox1.Selected[i]:=False;
      end;
   end;
   Form1.UploadAll;
end;

procedure Tcopyform.DownloadButClick(Sender: TObject);
var
   i: Integer;
   FName: String;
begin
   Form1.FileNames.Clear;
   if Form1.AutoDirCB.Checked then
   begin
      // Get filenames that are selected in the stringlist
      with StringGrid1 do
      begin
         if Selection.Bottom > 0 then
            for i := Selection.Top to Selection.Bottom do
               Form1.FileNames.Add(Cells[0,i]);
      end;
   end
   else
   begin
      // prompt the user for filename
      FName := '';
      FName := InputBox('Download a File','Enter File Name','');
      if length(FName) = 0 then
         exit;
      Form1.FileNames.Add(FName);
   end;
   if Form1.FileNames.Count > 0 then
      Form1.DownloadAll;
end;

procedure Tcopyform.AdvMenuCBClick(Sender: TObject);
begin
   if AdvMenuCB.Checked then
   begin
      RmDirBut.Visible:=True;
      MkDirBut.Visible:=True;
      ViewBut.Visible:=True;
      DelRemFileBut.Visible:=True;
      DelLocFileBut.Visible:=True;
   end
   else
   begin
      RmDirBut.Visible:=False;
      MkDirBut.Visible:=False;
      ViewBut.Visible:=False;
      DelRemFileBut.Visible:=False;
      DelLocFileBut.Visible:=False;
   end;
end;

procedure Tcopyform.RmDirButClick(Sender: TObject);
var
   DirName: ShortString;
begin
   DirName := '';
   DirName := InputBox('Remove Directory','Enter Directory Name','');
   if length(DirName) = 0 then
      exit;
   Form1.FtpClient1.HostFileName:=DirName;
   Memo1.Lines.Add('rmdir ' + DirName);
   Form1.Memo1.Lines.Add('rmdir ' + DirName);
   Form1.FtpClient1.Rmd;
end;

procedure Tcopyform.MkDirButClick(Sender: TObject);
var
   DirName: ShortString;
begin
   DirName := '';
   DirName := InputBox('Create Directory','Enter Directory Name','');
   if length(DirName) = 0 then
      exit;
   Form1.FtpClient1.HostFileName:=DirName;
   Memo1.Lines.Add('mkdir ' + DirName);
   Form1.Memo1.Lines.Add('mkdir ' + DirName);
   Form1.FtpClient1.Mkd;
end;

procedure Tcopyform.DelRemFileButClick(Sender: TObject);
var
   i: Integer;
   FName: String;
begin
   Form1.FileNames.Clear;
   if Form1.AutoDirCB.Checked then
   begin
      // Get filenames that are selected in the stringlist
      with StringGrid1 do
      begin
         if Selection.Bottom > 0 then
            for i := Selection.Top to Selection.Bottom do
               Form1.FileNames.Add(Cells[0,i]);
      end;
   end
   else
   begin
      // prompt the user for filename
      FName := '';
      FName := InputBox('Delete a File','Enter File Name','');
      if length(FName) = 0 then
         exit;
      Form1.FileNames.Add(FName);
   end;
   if Form1.FileNames.Count > 0 then
   begin
      Form1.FilesLeft := Form1.FileNames.Count;
      Form1.RemoteDelete;
   end;
end;

procedure Tcopyform.DelLocFileButClick(Sender: TObject);
var
   i: Integer;
begin
   Form1.FileNames.Clear;
   for i := 0 to FileListBox1.Items.Count - 1 do
   begin
      if FileListBox1.Selected[i] then
      begin
         Form1.FileNames.Add(AppendSlash(
             DirectoryListBox1.Directory) + FileListBox1.Items[i]);
         FileListBox1.Selected[i]:=False;
      end;
   end;
   if Form1.FileNames.Count > 0 then
   begin
      Form1.FilesLeft := Form1.FileNames.Count;
      Form1.LocalDelete;
   end;
end;

procedure Tcopyform.ViewButClick(Sender: TObject);
var
   i: Integer;
   FName: String;
begin
   Form1.FileNames.Clear;
   Form1.ViewMode:=True;
   if Form1.AutoDirCB.Checked then
   begin
      // Find the first filenames that is selected in the stringlist
      with StringGrid1 do
      begin
         if Selection.Bottom > 0 then
            for i := Selection.Top to Selection.Bottom do
            begin
               Form1.FileNames.Add(Cells[0,i]);
               break;
            end;
      end;
   end
   else
   begin
      // prompt the user for filename
      FName := '';
      FName := InputBox('View a File','Enter File Name','');
      if length(FName) = 0 then
         exit;
      Form1.FileNames.Add(FName);
   end;
   if Form1.FileNames.Count > 0 then
      Form1.View;
end;

end.