main.pas

delphi中文件复制操作

unit main;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ComCtrls, FileCtrl, StdCtrls, ExtCtrls, Buttons, ShellAPI, RXCtrls, RxGrdCpt,
  Menus, ToolEdit, Mask;

type
  TMainForm = class(TForm)
    EditMask: TEdit;
    TextListBox1: TTextListBox;
    RxLabel2: TRxLabel;
    RxLabel3: TRxLabel;
    RxLabel4: TRxLabel;
    RxGradientCaption1: TRxGradientCaption;
    ButtonSearch: TBitBtn;
    RxLabel1: TRxLabel;
    ButtonClose: TBitBtn;
    DateEdit1: TDateEdit;
    RxLabel5: TRxLabel;
    DateTimePicker1: TDateTimePicker;
    ButtonInfo: TBitBtn;
    CheckBox: TCheckBox;
    PopupMenu: TPopupMenu;
    TouchItem: TMenuItem;
    CopyItem: TMenuItem;
    MoveItem: TMenuItem;
    RenameItem: TMenuItem;
    DeleteItem: TMenuItem;
    N1: TMenuItem;
    SelectAllItem: TMenuItem;
    UnselectAllItem: TMenuItem;
    StatusBar: TStatusBar;
    DirectoryEdit1: TDirectoryEdit;
    DirectoryEdit2: TDirectoryEdit;
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure ButtonSearchClick(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure ButtonInfoClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure SelectAllItemClick(Sender: TObject);
    procedure UnselectAllItemClick(Sender: TObject);
    procedure TouchItemClick(Sender: TObject);
    procedure CopyItemClick(Sender: TObject);
    procedure MoveItemClick(Sender: TObject);
    procedure RenameItemClick(Sender: TObject);
    procedure DeleteItemClick(Sender: TObject);
    procedure PopupMenuPopup(Sender: TObject);
  private
    { Private-Deklarationen }
    TouchTimeDate: TDateTime;
    procedure GetAllFiles(mask: string; var count: LongInt);
    procedure ShowHint(Sender: TObject);
  public
    { Public-Deklarationen }
  end;

var
  MainForm: TMainForm;

implementation

uses info;

{$R *.DFM}

procedure TMainForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  CanClose:=False;
  if MessageDlg('Wollen Sie das Programm jetzt beenden?', mtConfirmation, [mbYes, mbNo], 0)=mrYes then CanClose:=True;
end;

procedure TMainForm.ButtonSearchClick(Sender: TObject);
var
  directory: string;
  count: LongInt;
begin
  count:=0;
  if EditMask.Text='' then EditMask.Text:='*.*';
  Screen.Cursor:=crHourGlass;
  TextListBox1.Items.Clear;
  directory:=DirectoryEdit1.Text;
  if directory[Length(directory)]<>'\' then directory:=directory+'\';
  GetAllFiles(directory+EditMask.Text, count);
  Screen.Cursor:=crDefault;
  ShowMessage(IntToStr(count)+' Datei(en) gefunden!');
end;

procedure TMainForm.GetAllFiles(mask: string; var count: LongInt);
var
  search: TSearchRec;
  verz, such: string;
begin
  such:=ExtractFileName(mask);
  verz:=ExtractFilePath(mask);
  if verz[Length(verz)]<>'\' then verz:=verz+'\';
  if FindFirst(mask, faArchive, search)=0 then
  repeat
    TextListBox1.Items.Add(verz+search.name);
    Inc(count);
  until FindNext(search)<>0;
  FindClose(search);
  if not CheckBox.Checked then exit;
  if FindFirst(verz+'*.*', faDirectory, search)=0 then
  repeat
    if ((search.Attr and faDirectory)=fadirectory) and (search.name[1]<>'.') then
      GetAllFiles(verz+search.name+'\'+such, count);
  until FindNext(search)<>0;
  FindClose(search);
end;

procedure TMainForm.FormActivate(Sender: TObject);
begin
  DateEdit1.Text:=DateToStr(Now);
end;

procedure TMainForm.ButtonInfoClick(Sender: TObject);
begin
  InfoForm.ShowModal;
end;

procedure TMainForm.FormCreate(Sender: TObject);
begin
  Application.OnHint:=ShowHint;
end;

procedure TMainForm.ShowHint(Sender: TObject);
begin
  StatusBar.SimpleText:=Application.Hint;
end;

procedure TMainForm.SelectAllItemClick(Sender: TObject);
var
  i: LongInt;
begin
  if (TextListBox1.Items.Count=0) then exit;
  i:=0;
  Screen.Cursor:=crHourGlass;
  while i<TextListBox1.Items.Count do
  begin
    TextListBox1.Selected[i]:=True;
    Inc(i);
  end;
  Screen.Cursor:=crDefault;
end;

procedure TMainForm.UnselectAllItemClick(Sender: TObject);
var
  i: LongInt;
begin
  if (TextListBox1.Items.Count=0) then exit;
  i:=0;
  Screen.Cursor:=crHourGlass;
  while i<TextListBox1.Items.Count do
  begin
    if TextListBox1.Selected[i]=True then TextListBox1.Selected[i]:=False;
    Inc(i);
  end;
  Screen.Cursor:=crDefault;
end;

procedure TMainForm.TouchItemClick(Sender: TObject);
var
  i, h: LongInt;
begin
  if (TextListBox1.Items.Count=0) or (TextListBox1.SelCount=0) then exit;
  TouchTimeDate:=Int(StrToDate(DateEdit1.Text))+Frac(DateTimePicker1.Time);
  i:=0;
  if MessageDlg('Datum und Zeit der markierte Datei(en) aktualisieren?', mtConfirmation, [mbYes, mbNo], 0)=mrNo then
  begin
    UnselectAllItemClick(Sender);
    exit;
  end;
  while i<TextListBox1.Items.Count do
  begin
    if TextListBox1.Selected[i]=True then
    begin
      h:=FileOpen(TextListBox1.Items.Strings[i], fmOpenReadWrite);
      if FileSetDate(h, DateTimeToFileDate(TouchTimeDate))<>0 then
        ShowMessage(TextListBox1.Items.Strings[i]+': Kann Datum + Zeit nicht 鋘dern!');
      FileClose(h);
    end;
    Inc(i);
  end;
  TextListBox1.Clear;
end;

procedure TMainForm.CopyItemClick(Sender: TObject);
var
  i: LongInt;
  files: String;
  shellinfo: TSHFileOpStructA;
begin
  if (TextListBox1.Items.Count=0) or (TextListBox1.SelCount=0) then exit;
  files:='';
  if MessageDlg('Markierte Datei(en) nach '+DirectoryEdit2.Text+' kopieren?', mtConfirmation, [mbYes, mbNo], 0)=mrNo then
  begin
    UnselectAllItemClick(Sender);
    exit;
  end;
  for i:=0 to TextListBox1.Items.Count-1 do
    if TextListBox1.Selected[i]=True then files:=files+TextListBox1.Items.Strings[i]+#0;
  files:=files+#0;
  with shellinfo do
  begin
    Wnd:=handle;
    wFunc:=FO_COPY;
    pFrom:=PChar(files);
    pTo:=PChar(DirectoryEdit2.Text);
    fFlags:=FOF_SIMPLEPROGRESS or FOF_RENAMEONCOLLISION;
    lpszProgressTitle:=PChar('Dateien kopieren');
  end;
  SHFileOperation(shellinfo);
  TextListBox1.Clear;
end;

procedure TMainForm.MoveItemClick(Sender: TObject);
var
  i: LongInt;
  files: String;
  shellinfo: TSHFileOpStructA;
begin
  if (TextListBox1.Items.Count=0) or (TextListBox1.SelCount=0) then exit;
  files:='';
  if MessageDlg('Markierte Datei(en) nach '+DirectoryEdit2.Text+' verschieben?', mtConfirmation, [mbYes, mbNo], 0)=mrNo then
  begin
    UnselectAllItemClick(Sender);
    exit;
  end;
  for i:=0 to TextListBox1.Items.Count-1 do
    if TextListBox1.Selected[i]=True then files:=files+TextListBox1.Items.Strings[i]+#0;
  files:=files+#0;
  with shellinfo do
  begin
    Wnd:=handle;
    wFunc:=FO_MOVE;
    pFrom:=PChar(files);
    pTo:=PChar(DirectoryEdit2.Text);
    fFlags:=FOF_SIMPLEPROGRESS or FOF_RENAMEONCOLLISION;
    lpszProgressTitle:=PChar('Dateien verschieben');
  end;
  SHFileOperation(shellinfo);
  TextListBox1.Clear;
end;

procedure TMainForm.RenameItemClick(Sender: TObject);
var
  i: LongInt;
  files: String;
  shellinfo: TSHFileOpStructA;
begin
  if (TextListBox1.Items.Count=0) or (TextListBox1.SelCount=0) then exit;
  files:='';
  if MessageDlg('Markierte Datei(en) in '+EditMask.Text+' umbenennen?', mtConfirmation, [mbYes, mbNo], 0)=mrNo then
  begin
    UnselectAllItemClick(Sender);
    exit;
  end;
  for i:=0 to TextListBox1.Items.Count-1 do
    if TextListBox1.Selected[i]=True then files:=files+TextListBox1.Items.Strings[i]+#0;
  files:=files+#0;
  with shellinfo do
  begin
    Wnd:=handle;
    wFunc:=FO_RENAME;
    pFrom:=PChar(files);
    pTo:=PChar(DirectoryEdit1.Text+'\'+EditMask.Text);
    fFlags:=FOF_SIMPLEPROGRESS or FOF_RENAMEONCOLLISION;
    lpszProgressTitle:=PChar('Dateien umbenennen');
  end;
  SHFileOperation(shellinfo);
  TextListBox1.Clear;
end;

procedure TMainForm.DeleteItemClick(Sender: TObject);
var
  i: LongInt;
  files: String;
  shellinfo: TSHFileOpStructA;
begin
  if (TextListBox1.Items.Count=0) or (TextListBox1.SelCount=0) then exit;
  files:='';
  for i:=0 to TextListBox1.Items.Count-1 do
    if TextListBox1.Selected[i]=True then files:=files+TextListBox1.Items.Strings[i]+#0;
  files:=files+#0;
  with shellinfo do
  begin
    Wnd:=handle;
    wFunc:=FO_DELETE;
    pFrom:=PChar(files);
    pTo:='';
    fFlags:=FOF_SIMPLEPROGRESS or FOF_ALLOWUNDO;
    lpszProgressTitle:=PChar('Dateien l鰏chen');
  end;
  SHFileOperation(shellinfo);
  TextListBox1.Clear;
end;

procedure TMainForm.PopupMenuPopup(Sender: TObject);
begin
  if TextListBox1.Items.Count=0 then
  begin
    SelectAllItem.Enabled:=False;
    UnselectAllItem.Enabled:=False;
  end
  else
  begin
    SelectAllItem.Enabled:=True;
    UnselectAllItem.Enabled:=False;
  end;
  if TextListBox1.SelCount=0 then
  begin
    TouchItem.Enabled:=False;
    CopyItem.Enabled:=False;
    MoveItem.Enabled:=False;
    RenameItem.Enabled:=False;
    DeleteItem.Enabled:=False;
  end
  else
  begin
    TouchItem.Enabled:=True;
    CopyItem.Enabled:=True;
    MoveItem.Enabled:=True;
    RenameItem.Enabled:=True;
    DeleteItem.Enabled:=True;
    UnselectAllItem.Enabled:=True;
  end;
end;

end.