copyto.pas

该程序用D5编译

unit CopyTo;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Buttons, ComCtrls, ExtCtrls, Menus;//,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;
    Label4: TLabel;
    BtnCopy: TSpeedButton;
    BtnCancel: TSpeedButton;
    CopyListView: TListView;
    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);
  private
    { Private declarations }
  public
    { Public declarations }
  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;

const
  sc_DragMove:longint=$F012;
  KB1 = 1024;
  MB1 = 1024*KB1;
  GB1 = 1024*MB1;
  // ---------------------------
  del_img_set=[22,24,25];
  copy_img_set=[22,25];
  
var
  CopyToForm: TCopyToForm;
  iCopy:integer;

implementation
uses Main,ShellAPI,FileCtrl,FmxUtils,ShlObj,ActiveX;
{$R *.DFM}

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

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

procedure TCopyFile.CopyProgress;
begin
  with CopyToForm do
  begin
     //listview1.items[ListIndex].SubItems.BeginUpdate;
     CopyListview.items[ListIndex].SubItems[0]:= 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;
begin
  Start := Now;
  //try
    { Open existing destination }
    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;
begin
 Sc := '';
  if SelectDirectory('Select Directory', '', Sc) then
    begin
    ComboBox1.Items.Add(combobox1.text);
    if sc[length(sc)]<>'\' then sc:=sc+'\';
    combobox1.text:=sc;
    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;
  files,fulls: string;
begin
    //listview1.Items.BeginUpdate;
    iCopy:=0;
    caption:='正在复制...';
    Label4.Caption := '多线程复制文件......';
    if ComboBox1.Text[length(ComboBox1.Text)] <> '\'
      then ComboBox1.Text := ComboBox1.Text + '\';
    for i:= 1 to CopyListview.Items.Count do
    if (CopyListview.Items[i-1].ImageIndex = 22)or(CopyListview.Items[i-1].ImageIndex = 25) then
    begin
      fulls:= CopyListview.Items[i-1].Caption;
      files:=extractfilename(fulls);
      CopyListview.Items[i-1].ImageIndex := 23;
      CopyThread:=TCopyFile.Create(fulls,ComboBox1.Text+files);
      CopyThread.ListIndex:= i-1;
      CopyThread.Resume;
    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+'\';
  CopyListView.DoubleBuffered := true;
  if bk<>nil then Brush.Bitmap :=  bk;
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;
  fulls,files   : string;
  CopyThread    : TCopyFile;
begin

    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
      fulls:= CopyListview.Items[i-1].Caption;
      files:=extractfilename(fulls);
      CopyListview.Items[i-1].ImageIndex := 23;
      CopyThread:=TCopyFile.Create(fulls,ComboBox1.Text+files);
      CopyThread.ListIndex:= i-1;
      CopyThread.Resume;
    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;

procedure TCopyToForm.CopyListViewDblClick(Sender: TObject);
var
  CopyThread    : TCopyFile;
  files,fulls   : string;
begin

  if CopyListview.SelCount <> 0 then
  begin
    caption:='正在复制...';
    Label4.Caption := '多线程复制文件......';

    if (CopyListview.selected.ImageIndex in copy_img_set) then
    begin
    fulls:= CopyListview.selected.Caption;
    files:=extractfilename(fulls);
    CopyListview.Selected.ImageIndex := 23;
    CopyThread:=TCopyFile.Create(fulls,ComboBox1.Text+files);
    CopyThread.ListIndex:= CopyListview.Selected.Index;
    CopyThread.Resume;
    end;
  end;

end;

procedure TCopyToForm.CopyListViewDragOver(Sender, Source: TObject; X,
  Y: Integer; State: TDragState; var Accept: Boolean);
begin
  if Source=MainForm.CurListView then accept :=true;
end;

procedure TCopyToForm.CopyListViewDragDrop(Sender, Source: TObject; X,
  Y: Integer);
var
  CopyItem,TemItem      : TListItem;
  i                     : integer;
begin

  for i:=1 to MainForm.CurListView.Items.Count  do
  if MainForm.CurListView.Items[i-1].Selected then
  begin
    With Source as TListView do TemItem:= MainForm.CurListView.Items[i-1];
    CopyItem:=CopyListView.Items.Add;
    CopyItem.ImageIndex := 22;
    CopyItem.Caption := MainForm.CurDirName+TemItem.Caption;
    CopyItem.SubItems.Add('尚未开始');
  end;

end;

end.