copyto.pas

最好的局域网搜索软件

unit CopyTo;

interface

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

type
  TCopyToForm = class(TForm)
    CopyToPopupMenu: TPopupMenu;
    N_CP_Begin: TMenuItem;
    N_CP_Del: TMenuItem;
    Panel1: TPanel;
    Panel2: TPanel;
    Label1: TLabel;
    Label2: TLabel;
    Panel3: TPanel;
    Label3: TLabel;
    BtnDirList: TSpeedButton;
    ComboBox1: TComboBox;
    Panel4: TPanel;
    BtnCopy: TSpeedButton;
    BtnCancel: TSpeedButton;
    CopyListView: TListView;
    cbSave: TCheckBox;
    N_CP_Pause: TMenuItem;
    N_CP_Resume: TMenuItem;
    Panel5: TPanel;
    Label4: TLabel;
    N_CP_OpenLocal: TMenuItem;
    N_CP_OpenRemote: TMenuItem;
    procedure BtnDirListClick(Sender: TObject);
    procedure BtnCancelClick(Sender: TObject);
    procedure ComboBox1Change(Sender: TObject);
    procedure BtnCopyClick(Sender: TObject);
    //procedure CopyListViewClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Panel3MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Label4MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure CopyToPopupMenuPopup(Sender: TObject);
    procedure N_CP_BeginClick(Sender: TObject);
    procedure N_CP_DelClick(Sender: TObject);
    procedure CopyListViewDblClick(Sender: TObject);
    procedure CopyListViewDragOver(Sender, Source: TObject; X, Y: Integer;
      State: TDragState; var Accept: Boolean);
    procedure CopyListViewDragDrop(Sender, Source: TObject; X, Y: Integer);
    procedure FormDestroy(Sender: TObject);
    procedure N_CP_PauseClick(Sender: TObject);
    procedure N_CP_ResumeClick(Sender: TObject);
    procedure cbSaveClick(Sender: TObject);
    procedure N_CP_OpenLocalClick(Sender: TObject);
    procedure N_CP_OpenRemoteClick(Sender: TObject);
    procedure ComboBox1Enter(Sender: TObject);
  private
    { Private declarations }
    procedure AddToListView(FileName: String; DirLen: integer; FileSize: DWORD);
    procedure AddFtpToListView(FileName: String; DirLen: integer; FileSize: DWORD);
  public
    { Public declarations }
    procedure LoadCopyRecord;
    procedure SaveCopyRecord;
  end;

  TCopyFile = class(TThread)
  public
    Percent    : Integer;
    Done,ToDo  : Integer;
    ListIndex   : integer;
    Start      : TDateTime;
    constructor Create(Src, Dest: String);
  private
    { Private declarations }
    IName,OName : String;
  protected
    procedure Execute; override;
    procedure CopyProgress;
    procedure TotalCopyProgress;
    procedure ShowError;
  end;

//========================================================
  TSearchFileThread = class(TThread)   // 拷贝文件夹时用
  private
    MyFileName: string;
    FileSize: DWORD;
    procedure SearchFile(DirName: string);
    procedure DeelWithFile;
    procedure SearchComplete;
  public
    MyDirName: string;
    DirLen: integer; // just for create new dir.
  protected
    procedure Execute; override;

  end;

  TSearchFtpFileThread = class(TThread)  // 拷贝文件夹时用
  private
    FileName: string;
    FileSize: DWORD;
    procedure AddItem;
    procedure GetFindData(Dir: string);
    procedure SearchComplete;
  public
    FtpHandle: HINTERNET;
    MyDir: string;
    MyHost: string;
  protected
    procedure Execute; override;
  end;
//========================================================
{
  TFtpGetThread = class(TThread)
  public
    FtpHandle: HINTERNET;
    ProxyName, ProxyPass: string;
    //MyDir: string;
    SrcFile: string;
    DestFile: string;
    FileSize: DWORD;
    GetSize: DWORD;
    MyListItem: TListItem;
  protected
    procedure Execute; override;
    procedure ShowProgress;
    procedure OpenFailed;
  end;
}
const
  sc_DragMove:longint=$F012;
  KB1 = 1024;
  MB1 = 1024*KB1;
  GB1 = 1024*MB1;
  // ---------------------------
  del_img_set=[22,24,25,111];
  copy_img_set=[22,25];
  
var
  CopyToForm: TCopyToForm;
  iCopy:integer;
{
function FtpGetFileSize(
    hFile: HINTERNET;
    lpdwFileSizeHigh: LPDWORD): DWORD;  stdcall; external 'wininet.dll';
}
implementation
uses Main, ShellAPI, FileCtrl, FmxUtils, ShlObj, ActiveX, Config,
  FtpDownloadThread, About;
{$R *.DFM}

procedure TSearchFtpFileThread.AddItem;
var
  DirLen: integer;
  s1, s2: string;
  i, j: integer;
begin
  //CopyToForm.Caption := MyHost + ' : ' + MyDir;
  s1 := 'ftp://' + MyHost;
  s2 := s1 + FileName;
  j := 0;
  for i := 1 to length(MyDir) do if MyDir[i]='/' then j := i;
  DirLen := length(s1) + j;
  CopyToForm.AddFtpToListView(s2, DirLen, FileSize);
end;

procedure TSearchFtpFileThread.GetFindData(Dir: string);
var
  FindData : TWin32FindData;
  FindHandle : HInternet;
  DirList: TStringList;
  i: integer;
  b, bb: boolean;
begin

  DirList := TStringList.Create;
  
  FindHandle := FtpFindFirstFile(FtpHandle, pchar('*.*'), FindData, 0, 0);
  if FindHandle <> nil then
  if FindData.dwFileAttributes = FILE_ATTRIBUTE_DIRECTORY then
  begin
    FileName := FindData.CFileName;

    if (FileName <> '.') and (FileName <> '..') then
    begin
      DirList.Add(FileName);

      FileName := Dir + '/' + FileName + '/';
      ///synchronize(AddItem);
    end;
  end
  else
  begin
    FileName := Dir + '/' + FindData.CFileName;
    FileSize := FindData.nFileSizeLow;
    synchronize(AddItem);
  end;

  while InternetFindNextFile(FindHandle, @FindData) do
  if FindData.dwFileAttributes = FILE_ATTRIBUTE_DIRECTORY then
  begin
    FileName := FindData.CFileName;

    if (FileName <> '.') and (FileName <> '..') then
    begin
      DirList.Add(FileName);

      FileName := Dir + '/' + FileName + '/';
      ///synchronize(AddItem);
    end;
  end
  else
  begin
    FileName := Dir + '/' + FindData.CFileName;
    FileSize := FindData.nFileSizeLow;
    synchronize(AddItem);
  end;

  InternetCloseHandle(Findhandle);

  for i:=0 to (DirList.Count-1) do
  begin
    b := false;
    while (not b) do
    b := FtpSetCurrentDirectory(FTPHandle, PChar(DirList.Strings[i]));
    
    GetFindData(Trim(Dir) + '/' + DirList.Strings[i]);

    bb := false;
    while (not bb) do
    bb := FtpSetCurrentDirectory(FTPHandle, '..');
  end;

  DirList.Free;
   
end;

procedure TSearchFtpFileThread.SearchComplete;
begin
  CopyToForm.Label4.Caption := '目录“' + 'ftp://' + MyHost + MyDir + '”搜索完毕';
end;

procedure TSearchFtpFileThread.Execute;
begin
  FtpSetCurrentDirectory(FTPHandle, PChar(MyDir)); 
  GetFindData(Trim(MyDir));
  synchronize(SearchComplete);
end;

{
procedure TFtpGetThread.OpenFailed;
begin
  MyListItem.ImageIndex := 25;
end;

procedure TFtpGetThread.ShowProgress;
var
  percent: integer;
begin
  with CopyToForm do
  begin
    if FileSize = 0 then exit;
    percent := Round(GetSize/FileSize*100);
    MyListItem.SubItems[0]:= inttostr(percent)+'%';
    if percent>=100 then MyListItem.ImageIndex :=24;     
  end;
end;

procedure TFtpGetThread.Execute;
var
  FileHandle, InetHandle: HINTERNET;
  buf: pointer;
  BufSize: DWORD;
  NumRead: DWORD;
  fo: TFileStream;
  FtpSvr, FtpDir: string;
  UsrName, PassWord: string;
  //cmd: string;
  //CmdRet: boolean;
  //phFtpCommand: HINTERNET;
begin
  // 由于目前是同步方式打开的
  InetHandle := InternetOpen('LanExplorer', 0, pchar(ProxyName), pchar(ProxyPass), 0);

  if InetHandle = nil then
  begin
  	synchronize(OpenFailed);
  	exit;
  end;

  ParseFtpUrl(MyListItem.Caption, FtpSvr, FtpDir);
  ConfigForm.GiveFtpUserPassWord(FtpSvr, UsrName, PassWord);

  FtpHandle := InternetConnect(InetHandle, PChar(FtpSvr),
        INTERNET_DEFAULT_FTP_PORT,
        PChar(UsrName),
        PChar(PassWord),
        INTERNET_SERVICE_FTP,
        INTERNET_FLAG_PASSIVE, //0,
        255
        );

  if FtpHandle = nil then
  FtpHandle := InternetConnect(InetHandle, PChar(FtpSvr),
        0,
        PChar(UsrName),
        PChar(PassWord),
        INTERNET_SERVICE_FTP,
        0,
        255
        );

  if FtpHandle = nil then
  begin
  	synchronize(OpenFailed);
  	exit;
  end;

  if FtpHandle <> nil then
  begin
    FtpSetCurrentDirectory(FTPHandle, PChar(''));
    GetSize := 0;
    BufSize := 1024;
    FileHandle := FtpOpenFile(FtpHandle, pchar(SrcFile), GENERIC_READ, FTP_TRANSFER_TYPE_BINARY, 0);
    if FileHandle <> nil then
    begin
      FileSize := FtpGetFileSize(FileHandle, @FileSize);
      GetMem(buf, BufSize);
      fo := TFileStream.Create(DestFile, fmCreate);
      //fo.Seek(0, soFromBeginning);
      repeat
        InternetReadFile(FileHandle, buf, BufSize, NumRead);
        fo.WriteBuffer(buf^, NumRead);
        GetSize := GetSize + NumRead;
        synchronize(ShowProgress);
      until NumRead < BufSize;
      fo.Free;
      FreeMem(buf);
    end
    else
    begin
      synchronize(OpenFailed);
    end;
    InternetCloseHandle(FileHandle);
  end;

  InternetCloseHandle(InetHandle);
end;
}
//=======================================================
procedure TSearchFileThread.DeelWithFile;
begin
  CopyToForm.AddToListView(MyFileName, DirLen, FileSize);
end;

procedure TSearchFileThread.SearchFile(DirName: String);
Var
  Found: integer;
  SearchRec: TSearchRec;
begin
  Found := FindFirst(DirName + '*.*',faAnyFile,searchrec);
  while Found = 0 do
  begin
    if ((SearchRec.Attr and faDirectory)<>0) then  //directory
    begin
      if(SearchRec.Name <> '.')and(SearchRec.Name <> '..') then
        SearchFile(DirName + SearchRec.Name + '\');
    end
    else  //file
    begin
      MyFileName := DirName + SearchRec.Name;
      FileSize := SearchRec.Size;
      Synchronize(DeelWithFile);
    end;
    Found := FindNext(SearchRec);
  end;
  FindClose(SearchRec);
end;

procedure TSearchFileThread.SearchComplete;
begin
  CopyToForm.Label4.Caption := '目录“' + MyDirName + '”搜索完毕';
end;

procedure TSearchFileThread.Execute;
begin
  SearchFile(MyDirName);
  Synchronize(SearchComplete);
end;
//=======================================================

constructor TCopyFile.Create(Src, Dest : String);
begin
  IName := Src;
  OName := Dest;
  Percent := 0;
  Start := Now;
  FreeOnTerminate := True;
  inherited Create(True);
end;