copyto.pas

最好的局域网搜索软件

procedure TCopyFile.ShowError;
begin
  CopyToForm.CopyListView.items[ListIndex].ImageIndex :=25;
  ShowMessage('无法读取源文件'+IName+'，此次拷贝将是不完整的，请以后再试。');
end;

procedure TCopyFile.CopyProgress;
begin

  with CopyToForm do
  begin
  
     if CopyListview.items[ListIndex] = nil then exit;  // when program closed.

     //listview1.items[ListIndex].SubItems.BeginUpdate;
     CopyListview.items[ListIndex].SubItems[1]:= inttostr(Percent)+'%';
     if percent>=100 then CopyListview.items[ListIndex].ImageIndex :=24;
     //label4.Caption := '已复制'+ inttostr(Round((ListIndex+1)/listview1.Items.Count*100))+'%';
     //listview1.items[ListIndex].SubItems.EndUpdate;
  end;

end;

procedure TCopyFile.TotalCopyProgress;
begin
  with CopyToForm do
  begin
     inc(iCopy);
     label4.Caption := '已复制'+ inttostr(Round((iCopy)/CopyListview.Items.Count*100))+'%';
     caption:='拷贝文件('+label4.Caption+')';
     if iCopy=CopyListview.Items.Count then
     begin
          label4.Caption := '复制完成。';
          BtnCancel.Caption :='关闭';
          //speedbutton4.Enabled := false;
          show;
          CopyToForm.WindowState := wsNormal;
          //listview1.items[ListIndex].SubItems.EndUpdate;
     end;
  end;
end;

procedure TCopyFile.Execute;
var
  fi,fo       : TFileStream;
  dod,did     : Integer;
  cnt,max     : Integer;
  DirName     : string;
begin
  Start := Now;
  //try
    { Open existing destination }
    DirName := ExtractFilePath(oName);
    if not DirectoryExists(DirName) then ForceDirectories(DirName);

    if FileExists(oName) then      //断点续传！
    begin
      try
      fo := TFileStream.Create(OName, fmOpenReadWrite);
      except on EFOpenError do
      begin
             {CopyToForm.CopyListView.items[ListIndex].ImageIndex :=25;
             ShowMessage('无法读取源文件'+OName+'，此次拷贝将是不完整的，请以后再试。'); }
             synchronize(ShowError);
             exit;
      end;
      end;//end of try
      fo.Position:=fo.size;
    end
  //except
    { otherwise Create destination }
    else fo := TFileStream.Create(OName, fmCreate);
  //end;
  try
    { open source }
    try
    fi := TFileStream.Create(IName, fmOpenRead);
    except on EFOpenError do
      begin
             synchronize(ShowError);
             exit;
      end;
    end;//end of try

    try
      { synchronise dest en src }
      cnt:= fo.Position;
      fi.Position := cnt;
      max := fi.Size;
      ToDo := Max-cnt;
      Done := 0;
      did:=0; // zw
      { start copying }
      Repeat
        dod := KB1; // Block size
        if cnt+dod>max then dod := max-cnt;
        try
          if dod>0 then did := fo.CopyFrom(fi, dod);
        except on EReadError do
        begin
             {CopyToForm.CopyListView.items[ListIndex].ImageIndex :=25;
             ShowMessage('无法读取源文件'+OName+'，此次拷贝将是不完整的，请以后再试。');}
             synchronize(ShowError);
             exit;
        end
        end; // end of try
        cnt:=cnt+did;
        Percent := Round(Cnt/Max*100);
        synchronize(CopyProgress);
        Done := Done+did;
        ToDo := Max;
      until (dod=0) or (Terminated);

    finally
      fi.free;
    end;
  finally
    fo.free;
  end;
  synchronize(TotalCopyProgress);
end;

procedure TCopyToForm.BtnDirListClick(Sender: TObject);
var
  Sc:string;
  i: integer;
  exist: boolean;
begin

  Sc := '';
  if SelectDirectory('Select Directory', '', Sc) then
  begin

    {exist := false;
    for i:=0 to (ComboBox1.Items.Count-1) do
    begin
      if ComboBox1.Items[i] = ComboBox1.text then exist := true;
    end;
    if (not exist ) then ComboBox1.Items.Add(ComboBox1.text);}

    if sc[length(sc)]<>'\' then sc:=sc+'\';
    ComboBox1.text:=sc;

    exist := false;
    for i:=0 to (ComboBox1.Items.Count-1) do
    begin
      if ComboBox1.Items[i] = ComboBox1.text then exist := true;
    end;
    if (not exist ) then ComboBox1.Items.Add(ComboBox1.text);

  end;

end;

procedure TCopyToForm.BtnCancelClick(Sender: TObject);
begin
  Close;
end;

procedure TCopyToForm.ComboBox1Change(Sender: TObject);
begin
  BtnCopy.Enabled := true;
end;

procedure TCopyToForm.BtnCopyClick(Sender: TObject);
var
  CopyThread            : TCopyFile;
  i                     : integer;
  SrcFile, DestFile     : string;
  DirName               : string;
  {
  FtpGetThread          : TFtpGetThread;
  s: string;
  }
  FtpDown: TFtpDownloadThread;
begin
    //listview1.Items.BeginUpdate;
    iCopy:=0;
    caption:='正在复制...';
    Label4.Caption := '多线程复制文件......';

    DirName := ComboBox1.Text;
    if DirName[length(DirName)] <> '\' then DirName := DirName + '\';
    //if not DirectoryExists(DirName) then ForceDirectories(DirName);
    
    for i:= 1 to CopyListview.Items.Count do
    if (CopyListview.Items[i-1].ImageIndex = 22)or(CopyListview.Items[i-1].ImageIndex = 25) then
    begin
      SrcFile := CopyListview.Items[i-1].Caption;
      DestFile := CopyListview.Items[i-1].SubItems[2];

      if (CopyListview.Items[i-1].ImageIndex = 22) then// 05.10.7
      begin
        CopyListview.Items[i-1].SubItems[2] := DirName + DestFile;
      end;

      DestFile := CopyListview.Items[i-1].SubItems[2];

      CopyListview.Items[i-1].ImageIndex := 23;

      if pos('ftp://', SrcFile) <> 1 then
      begin
        CopyThread:=TCopyFile.Create(SrcFile, DestFile);
        CopyThread.ListIndex:= i-1;
        CopyListview.Items[i-1].Data := CopyThread;
        CopyThread.Resume;
      end
      else // FTP
      begin
        {
        s := SrcFile;
        delete(s, 1, 6);
        delete(s, 1, pos('/', s)-1);
        FtpGetThread := TFtpGetThread.Create(true);
        FtpGetThread.SrcFile := s;
        FtpGetThread.DestFile := DestFile;
        FtpGetThread.MyListItem := CopyListview.Items[i-1];
        FtpGetThread.FreeOnTerminate := true;
        CopyListview.Items[i-1].Data := FtpGetThread;
        FtpGetThread.Resume;
        }

        FtpDown := TFtpDownloadThread.Create(true);
        FtpDown.FtpUrl := CopyListview.Items[i-1].Caption;
        FtpDown.LocalFile := DestFile;
        FtpDown.MyListItem := CopyListview.Items[i-1];
        CopyListview.Items[i-1].Data := FtpDown;
        FtpDown.OnStatusEvent := AboutForm.FtpDownDebug;
        FtpDown.Resume;
      end;
    end;

end;

{procedure TCopyToForm.CopyListViewClick(Sender: TObject);
begin
end;}

{function GetDesktopDir: string;
var
  Buffer: PChar;
begin
  Result := '';
  GetMem(Buffer, MAX_PATH);
  try
    if ShGetSpecialFolderPath(Application.Handle,Buffer, CSIDL_DESKTOP, False) then
      SetString(Result, Buffer, StrLen(Buffer));
  finally
    FreeMem(Buffer);    
  end;
end; }

function GetDesktopDir: string;
var
  Buffer        : PChar;
  ItemIDList    : PItemIDList;
  ShellMalloc   : IMalloc;
begin
  Result := '';
  if (ShGetMalloc(ShellMalloc) = S_OK) and (ShellMalloc <> nil) then
  begin
    Buffer := ShellMalloc.Alloc(MAX_PATH);
    try
      if SHGetSpecialFolderLocation(Application.Handle, CSIDL_DESKTOP, ItemIDList) = S_OK then
        if SHGetPathFromIDList(ItemIDList,Buffer) then
          SetString(Result, Buffer, StrLen(Buffer));
    finally
      ShellMalloc.Free(Buffer);
    end;
  end;
end;

{function GetDesktopDir: string;
var myreg : tregistry;
begin
  MyReg:=TRegistry.create;
  MyReg.RootKey := HKEY_CURRENT_USER;
  MyReg.OpenKey('Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders',false);
  Result:= MyReg.ReadString('DeskTop');
  MyReg.Free;
end;}


procedure TCopyToForm.FormCreate(Sender: TObject);
begin
  ComboBox1.Text := GetDesktopDir+'\';
  ComboBox1.Items.Add(ComboBox1.Text);
  CopyListView.DoubleBuffered := true;
  if bk<>nil then Brush.Bitmap :=  bk;
  LoadCopyRecord;
end;

procedure TCopyToForm.Panel3MouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin

 ReleaseCapture;
 SendMessage(handle,wm_SysCommand,sc_DragMove,0);

end;

procedure TCopyToForm.Label4MouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin

 ReleaseCapture;
 SendMessage(handle,wm_SysCommand,sc_DragMove,0);

end;

procedure TCopyToForm.CopyToPopupMenuPopup(Sender: TObject);
begin

  if CopyListView.SelCount = 0 then
  begin
    N_CP_Begin.Enabled := false;
    N_CP_Del.Enabled := false;
  end
  else
  begin
    N_CP_Begin.Enabled := true;
    N_CP_Del.Enabled := true;
  end;

end;

procedure TCopyToForm.N_CP_BeginClick(Sender: TObject);
var
  i                     : integer;
  SrcFile, DestFile     : string;
  CopyThread            : TCopyFile;
  DirName               : string;
  {
  FtpGetThread          : TFtpGetThread;
  s: string;
  }
  FtpDown: TFtpDownloadThread;
begin

    DirName := ComboBox1.Text;
    if DirName[length(DirName)] <> '\' then DirName := DirName + '\';
    //if not DirectoryExists(DirName) then ForceDirectories(DirName);

    for i:= 1 to CopyListview.Items.Count do
    if (CopyListview.Items[i-1].Selected)
      and(CopyListview.Items[i-1].ImageIndex in copy_img_set) then
    begin
      SrcFile := CopyListview.Items[i-1].Caption;
      DestFile := CopyListview.Items[i-1].SubItems[2];

      if CopyListview.Items[i-1].ImageIndex = 22 then
        CopyListview.Items[i-1].SubItems[2] := DirName + DestFile;

      CopyListview.Items[i-1].ImageIndex := 23;
      DestFile := CopyListview.Items[i-1].SubItems[2];

      if pos('ftp://', SrcFile) <> 1 then
      begin
        CopyThread:=TCopyFile.Create(SrcFile, DestFile);
        CopyThread.ListIndex:= i-1;
        CopyListview.Items[i-1].Data := CopyThread;
        CopyThread.Resume;
      end
      else // FTP
      begin
        {
        s := SrcFile;
        delete(s, 1, 6);
        delete(s, 1, pos('/', s)-1);
        FtpGetThread := TFtpGetThread.Create(true);
        FtpGetThread.SrcFile := s;
        FtpGetThread.DestFile := DestFile;
        FtpGetThread.MyListItem := CopyListview.Items[i-1];
        FtpGetThread.FreeOnTerminate := true;
        CopyListview.Items[i-1].Data := FtpGetThread;
        FtpGetThread.Resume;
        }

        FtpDown := TFtpDownloadThread.Create(true);
        FtpDown.FtpUrl := CopyListview.Items[i-1].Caption;
        FtpDown.LocalFile := DestFile;
        FtpDown.MyListItem := CopyListview.Items[i-1];
        CopyListview.Items[i-1].Data := FtpDown;
        FtpDown.OnStatusEvent := AboutForm.FtpDownDebug;
        FtpDown.Resume;
      end;
    end;

end;

procedure TCopyToForm.N_CP_DelClick(Sender: TObject);
var
  i: integer;
begin

    for i:=CopyListview.Items.Count downto 1 do
    if (CopyListview.Items[i-1].Selected)and(CopyListview.Items[i-1].ImageIndex in del_img_set) then
    begin
      CopyListview.Items[i-1].delete;
    end;

end;