Delphi 文件的操作：重命名、復制、移動、刪除
第一種方法：
RenameFile('Oldname', 'Newname'); CopyFile(PChar('Oldname'), PChar('Newname'), False); MoveFile(PChar('Oldname'), PChar('Newname')); DeleteFile(文件名);
第二種方法：
在Delphi可以使用ShellApi單元中的函數SHFileOperation來實現消息上傳控件的制作，
SHFileOperation函數可以實現各種文件操作，只需將文件操作命令(拷貝、剪切、刪除、重命名)發送給
它，它就會實現Windows資源管理器那樣的文件操作功能。該函數的聲明如下：
function SHFileOperation(constract lpFileOp : LPSHFILEOPSTRUCT): Integer;stdcall; LPSHFILEOPSTRUCT的結構類型： typedef struct _SHFILEOPSTRUCT{ HWND hwnd; // 顯示對話框的句柄 UINT wFunc; // 指明操作類型,支持4種操作：FO_COPY拷貝、FO_MOVE剪切、 FO_DELETE刪除、FO_RENAME重命名。 LPCSTR pFrom; // 源文件路徑，可以是多個文件 LPCSTR pTo; // 目標路徑，可以是路徑或文件名，FO_DELETE時，該參數不起作用 FILEOP_FLAGS fFlags; // 標志，附加的風格選項 BOOL fAnyOperationsAborted; // 是否可被中斷 LPVOID hNameMappings; // 文件映射名字，可在其它 Shell 函數中使用 LPCSTR lpszProgressTitle; // 只在 FOF_SIMPLEPROGRESS 時，指定對話框的標題。 }SHFILEOPSTRUCT;
例如：
uses ShellAPI; type TFileCommand=(fcCopy,fcMove,fcDelete,fcRename); procedure TForm1.FileOperation(aCommand: FileCommand; var aFromFile, aToFile: String); var FileOp: TSHFileOPStruct; begin ZeroMemory(@FileOp, sizeof(FileOp)); FileOp.Wnd := Form1.Handle; //顯示一個進度對話框，但不顯示文件名。 FileOp.fFlags := FOF_SimpleProgress; //String類型轉換到PAnsiChar類型，需要經過AnsiString類型 FileOp.pFrom := PAnsiChar( AnsiString(aFromFile)); FileOp.pTo := PAnsiChar( AnsiString(aToFile)); case aCommand of fcCopy: FileOp.wFunc := FO_COPY; // 復制文件 fcMove: FileOp.wFunc := FO_MOVE; // 移動文件 fcDelete: FileOp.wFunc := FO_DELETE; // 刪除文件 fcRename: FileOp.wFunc := FO_RENAME; // 重命名文件 end; SHFileOperation(FileOp); end;
Delphi 判斷文件是否存在，是否正在使用
function IsFileInUse(fName: string): boolean; var HFileRes: HFILE; begin Result := false; if not FileExists(fName) then //如果文件不存在 exit; HFileRes := CreateFile(pchar(fName), GENERIC_READ or GENERIC_WRITE, 0 {this is the trick!}, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0); Result := (HFileRes = INVALID_HANDLE_VALUE); if not Result then CloseHandle(HFileRes); end; 調用 procedure TForm1.Button1Click(Sender: TObject); begin if OpenDialog1.Execute then begin if IsFileInUse(OpenDialog1.FileName) = true then showmessage('文件正在使用') else showmessage('文件沒有使用'); end; end;
Delphi刪除或移動正在使用的文件
Delphi刪除文件容易，但刪除正在使用的文件，那就需要手段了，因為正在使用的文件是不允許被刪除的，看代碼：
unit Unit1; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls; const FILE_DELETE=1; FILE_RENAME=2; type TForm1 = class(TForm) Button1: TButton; Label1: TLabel; Label2: TLabel; RadioGroup1: TRadioGroup; Edit1: TEdit; Edit2: TEdit; Button2: TButton; Button3: TButton; OpenDialog1: TOpenDialog; procedure Button2Click(Sender: TObject); procedure Button3Click(Sender: TObject); procedure Button1Click(Sender: TObject); procedure Edit2Change(Sender: TObject); procedure RadioGroup1Click(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form1: TForm1; implementation {$R *.DFM} function DeleteRenameFileAfterBoot(lpFileNameToSrc,lpFileNameToDes: PChar;flag:Uint): Boolean; var WindowsDirs: array [0..MAX_PATH + 1] of Char; lpDirSrc,lpDirDes: array [0..MAX_PATH + 1] of Char; VerPlatForm: TOSVersionInfoA; StrLstDelte: TStrings; filename,s :String; i:integer; begin Result := FALSE; ZeroMemory(@VerPlatForm, SizeOf(VerPlatForm)); VerPlatForm.dwOSVersionInfoSize := SizeOf(VerPlatForm); GetVersionEx(VerPlatForm); if VerPlatForm.dwPlatformId = VER_PLATFORM_WIN32s then begin SetLastError(ERROR_NOT_SUPPORTED); Exit; end else if VerPlatForm.dwPlatformId = VER_PLATFORM_WIN32_NT then begin if flag=FILE_DELETE then Result := MoveFileEx(PChar(lpFileNameToSrc), nil, MOVEFILE_REPLACE_EXISTING + MOVEFILE_DELAY_UNTIL_REBOOT) else if (flag=FILE_RENAME) then Result := MoveFileEx(lpFileNameToSrc, lpFileNameToDes, MOVEFILE_REPLACE_EXISTING + MOVEFILE_DELAY_UNTIL_REBOOT); end else begin StrLstDelte := TStringList.Create; GetWindowsDirectory(WindowsDirs, MAX_PATH + 1); filename:=WindowsDirs; if filename[length(filename)]<>'\' then filename:=filename+'\'; filename:=filename+'wininit.ini'; if FileExists(filename) then StrLstDelte.LoadFromFile(filename); if StrLstDelte.IndexOf('[rename]') = -1 then StrLstDelte.Add('[rename]'); GetShortPathName(lpFileNameToSrc, lpDirSrc, MAX_PATH + 1); if fileexists(lpFileNameToDes) then GetShortPathName(lpFileNameToDes, lpDirDes, MAX_PATH + 1) else begin s:=extractfilename(lpFileNameToDes); i:=pos('.',s); if (i=0) then begin if length(s)>8 then raise exception.create('不是有效的短文件名(8+3格式)!'); end else begin if (i-1>8)or(length(s)-i>3) then raise exception.create('不是有效的短文件名(8+3格式)!'); end; strcopy(lpDirDes,lpFileNameToDes); end; if (flag=FILE_DELETE) then {刪除} StrLstDelte.Insert(StrLstDelte.IndexOf('[rename]') + 1, 'NUL='+string(lpDirSrc)) else if (flag=FILE_RENAME) then {改名} StrLstDelte.Insert(StrLstDelte.IndexOf('[rename]') + 1, string(lpDirDes)+'='+string(lpDirSrc)); StrLstDelte.SaveToFile(filename); Result := TRUE; StrLstDelte.Free; end; end; procedure TForm1.Button2Click(Sender: TObject); begin if OpenDialog1.Execute then edit1.text:=OpenDialog1.FileName; end; procedure TForm1.Button3Click(Sender: TObject); begin if OpenDialog1.Execute then edit2.text:=OpenDialog1.FileName; end; procedure TForm1.Button1Click(Sender: TObject); var i:uint; begin if RadioGroup1.ItemIndex=0 then i:=FILE_DELETE else i:=FILE_RENAME; if edit1.text='' then raise exception.create('源文件為空！'); if (i=FILE_RENAME)and(edit2.text='') then raise exception.create('目標文件為空！'); if not DeleteRenameFileAfterBoot(pchar(edit1.text),pchar(edit2.text),i) then showmessage('出錯了') else showmessage('操作完成'); end; procedure TForm1.Edit2Change(Sender: TObject); var VerPlatForm: TOSVersionInfoA; buf: array [0..MAX_PATH + 1] of Char; begin if not fileexists(edit2.text) then exit; ZeroMemory(@VerPlatForm, SizeOf(VerPlatForm)); VerPlatForm.dwOSVersionInfoSize := SizeOf(VerPlatForm); GetVersionEx(VerPlatForm); if VerPlatForm.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS then begin GetShortPathName(pchar(edit2.text), buf, MAX_PATH + 1); edit2.text:=buf; end; end; procedure TForm1.RadioGroup1Click(Sender: TObject); begin edit2.Enabled:=RadioGroup1.ItemIndex=1; button2.Enabled:=RadioGroup1.ItemIndex=1; end; end.
其實就是利用Windows重啟的瞬間來刪除或移動文件。
文件，文件夾刪除移動和拷貝
function WinErasefile(Owner: Integer; WichFiles: string; SendToRecycleBin, Confirm: Boolean): Boolean; //用於將文件直接刪除或移動到回收站 var Struct : TSHFileOpStructA; begin FillChar(Struct, SizeOf(Struct), 0); While pos(';', WichFiles)>0 do WichFiles[pos(';', WichFiles)] := #0; WichFiles := WichFiles + #0#0; with Struct do begin wnd := Owner; wFunc := FO_Delete; pFrom := PChar(WichFiles); pTo := nil; If not Confirm then fFlags := FOF_NOCONFIRMATION; If SendToRecycleBin then fFLags := fFlags or FOF_ALLOWUNDO or FOF_FILESONLY else fFlags := fFlags or 0 or FOF_FILESONLY; hNameMappings := nil; lpszProgressTitle := nil; end; result := (SHFileOperationA(Struct)=0) and (not Struct.fAnyOperationsAborted); end; function WinErasepath(Owner: Integer; WichFiles: string; SendToRecycleBin, Confirm: Boolean): Boolean; //用於將目錄直接刪除或移動到回收站 var Struct : TSHFileOpStructA; begin FillChar(Struct, SizeOf(Struct), 0); While pos(';', WichFiles)>0 do WichFiles[pos(';', WichFiles)] := #0; WichFiles := WichFiles + #0#0; with Struct do begin wnd := Owner; wFunc := FO_Delete; pFrom := PChar(WichFiles); pTo := nil; If not Confirm then fFlags := FOF_NOCONFIRMATION; If SendToRecycleBin then fFLags := fFlags or FOF_ALLOWUNDO else fFlags := fFlags or 0 or FOF_FILESONLY; hNameMappings := nil; lpszProgressTitle := nil; end; result := (SHFileOperationA(Struct)=0) and (not Struct.fAnyOperationsAborted); end; function WinMovepath(Owner:Integer;FromFile, Tofile:string;ReNameOnCollision, Confirm:Boolean):Boolean; //用於將目錄進行移動 var Struct : TSHFileOpStructA; MultDest: Boolean; begin FillChar(Struct, SizeOf(Struct), 0); MultDest := pos(';', ToFile)>0; While pos(';', FromFile)>0 do FromFile[pos(';', FromFile)] := #0; While pos(';', ToFile)>0 do ToFile[pos(';', ToFile)] := #0; FromFile := FromFile + #0#0; ToFile := ToFile + #0#0; with Struct do begin wnd := Owner; wFunc := FO_Move; pFrom := PChar(FromFile); pTo := PChar(ToFile); fFlags := FOF_ALLOWUNDO; If MultDest then fFLags := fFlags or FOF_MULTIDESTFILES; If ReNameOnCollision then fFLags := fFlags or FOF_RENameONCOLLISION; If Confirm then fFLags := fFlags or FOF_NOCONFIRMATION; hNameMappings := nil; lpszProgressTitle := nil; end; result := (SHFileOperationA(Struct)=0) and (not Struct.fAnyOperationsAborted); end; function WinMovefile(Owner:Integer;FromFile, Tofile:string;ReNameOnCollision, Confirm:Boolean):Boolean; //用於將文件進行移動 var Struct : TSHFileOpStructA; MultDest: Boolean; begin FillChar(Struct, SizeOf(Struct), 0); MultDest := pos(';', ToFile)>0; While pos(';', FromFile)>0 do FromFile[pos(';', FromFile)] := #0; While pos(';', ToFile)>0 do ToFile[pos(';', ToFile)] := #0; FromFile := FromFile + #0#0; ToFile := ToFile + #0#0; with Struct do begin wnd := Owner; wFunc := FO_Move; pFrom := PChar(FromFile); pTo := PChar(ToFile); fFlags := FOF_ALLOWUNDO or FOF_FILESONLY; If MultDest then fFLags := fFlags or FOF_MULTIDESTFILES; If ReNameOnCollision then fFLags := fFlags or FOF_RENameONCOLLISION; If Confirm then fFLags := fFlags or FOF_NOCONFIRMATION; hNameMappings := nil; lpszProgressTitle := nil; end; result := (SHFileOperationA(Struct)=0) and (not Struct.fAnyOperationsAborted); end; function WinCopypath(Owner: Integer; FromFile, Tofile: string;ReNameOnCollision, Confirm: Boolean): Boolean; //拷貝目錄 var Struct : TSHFileOpStructA; MultDest: Boolean; begin FillChar(Struct, SizeOf(Struct), 0); MultDest := pos(';', ToFile)>0; While pos(';', FromFile)>0 do FromFile[pos(';', FromFile)] := #0; While pos(';', ToFile)>0 do ToFile[pos(';', ToFile)] := #0; FromFile := FromFile + #0#0; ToFile := ToFile + #0#0; with Struct do begin wnd := Owner; wFunc := FO_Copy; pFrom := PChar(FromFile); pTo := PChar(ToFile); fFlags := FOF_ALLOWUNDO; If MultDest then fFLags := fFlags or FOF_MULTIDESTFILES; If ReNameOnCollision then fFLags := fFlags or FOF_RENameONCOLLISION; If not Confirm then begin fFLags := fFlags or FOF_NOCONFIRMATION or FOF_NOCONFIRMMKDIR; end; hNameMappings := nil; lpszProgressTitle := nil; end; result := (SHFileOperationA(Struct)=0) and (not Struct.fAnyOperationsAborted); end; function WinCopyfile(Owner: Integer; FromFile, Tofile: string;ReNameOnCollision, Confirm: Boolean): Boolean; //拷貝文件 var Struct : TSHFileOpStructA; MultDest: Boolean; begin FillChar(Struct, SizeOf(Struct), 0); MultDest := pos(';', ToFile)>0; While pos(';', FromFile)>0 do FromFile[pos(';', FromFile)] := #0; While pos(';', ToFile)>0 do ToFile[pos(';', ToFile)] := #0; FromFile := FromFile + #0#0; ToFile := ToFile + #0#0; with Struct do begin wnd := Owner; wFunc := FO_Copy; pFrom := PChar(FromFile); pTo := PChar(ToFile); fFlags := FOF_ALLOWUNDO or FOF_FILESONLY; If MultDest then fFLags := fFlags or FOF_MULTIDESTFILES; If ReNameOnCollision then fFLags := fFlags or FOF_RENameONCOLLISION; If not Confirm then begin fFLags := fFlags or FOF_NOCONFIRMATION or FOF_NOCONFIRMMKDIR; end; hNameMappings := nil; lpszProgressTitle := nil; end; result := (SHFileOperationA(Struct)=0) and (not Struct.fAnyOperationsAborted); end;
遍歷目錄查找文件中的字符並替換
public { Public declarations } function replaceStr(sT:string;nSt:string;file1:string):integer; function findStr(st:string;file1:string):integer; function CheckExt(allExt:string;file1:string):integer; procedure getdirlist(dir: string;isrep:integer); function findStrandRep(st:string;nSt:string;file1:string):integer; function ReadDirectoryNames(const ParentDirectory: string; dirList: TStringList; filelist: TStringList): Integer; end; var Form1: TForm1; implementation {$R *.dfm} procedure TForm1.btSingleRepClick(Sender: TObject); var file1:string; begin if edit1.text='' then begin showmessage('沒有需要替換的字符。'); exit; end; if MessageDlg('你確定要替換所有文件中的字符:'+#13+'" '+edit1.text+'" 替換成:"'+edit2.text+'" 嗎?', mtWarning, [mbYes, mbNo], 0) = mrNo then begin exit; end; memo1.Lines.Clear; file1:=FileListBox1.FileName; if file1='' then exit; if checkExt(edExt.Text,file1) = 1 then if findstr(edit1.Text,file1)=1 then replaceStr(edit1.text,edit2.text,file1) else showmessage('沒有找到匹配！'); end; //查找字符 function TForm1.findStr(st:string;file1:string):integer; var sl:TStringList; i,j:integer; begin result:=0; try sl:=TStringList.Create; sl.LoadFromFile(file1); j:=sl.Count; for i:=0 to j-1 do begin if Pos(st,sl.Strings[i])>0 then result:=1 end; sl.Free; except end; end; //查找字符並且替換 function TForm1.findStrandRep(st:string;nSt:string;file1:string):integer; var sl:TStringList; i,j:integer; begin result:=0; try sl:=TStringList.Create; sl.LoadFromFile(file1); j:=sl.Count; for i:=0 to j-1 do begin if Pos(st,sl.Strings[i])>0 then begin result:=1; replaceStr(st,nst,file1); end; end; sl.Free; except end; end; // 替換字符 function TForm1.replaceStr(sT:string;nSt:string;file1:string):integer; var a:TStringList; sNew,sOld:String; i:integer; begin try a:=TStringList.Create; a.LoadFromFile(file1); sNew:=a.text; sOld:=a.text; sNew:=StringReplace(sNew,sT,nSt,[rfReplaceAll]); a.text:=sNew; i := CompareStr(sNew,sOld); if i <> 0 then begin memo1.Lines.Add('修改了文件：'+file1); end; a.savetofile(file1); a.Free; for i:=0 to 100 do begin ProgressBar1.Position:=i; end; except result:=0; exit; end; result:=1; end; procedure TForm1.DirectoryListBox2Change(Sender: TObject); begin DirectoryListBox2.Drive:=DriveComboBox1.Drive; fileListBox1.Directory:=DirectoryListBox2.Directory; end; procedure TForm1.DriveComboBox1Change(Sender: TObject); begin DirectoryListBox2.Drive:=DriveComboBox1.Drive; end; procedure TForm1.btFindClick(Sender: TObject); var sDrive:string; begin Memo1.Lines.Clear; sDrive:= DriveComboBox1.Drive+':'; //0 不替換1替換 getdirList(sDrive,0); showmessage('查找結束！'); end; //檢查擴展名 function Tform1.CheckExt(allExt:string;file1:string):integer; var ext:string; i:integer; begin ext:=file1; i:=pos('.',ext); while i>0 do begin i:=pos('.',ext); ext:=copy(ext,i+1,length(ext)-i+1); end; if pos(ext,allExt)>0 then result:=1 else result:=0; end; //獲得目錄列表 procedure TForm1.getdirlist(dir: string;isrep:integer); var i: integer; thedir: TstringList; thefiles: TstringList; begin thedir := TstringList.Create; thefiles := TstringList.create; ReadDirectoryNames(dir, thedir, thefiles); ProgressBar1.Max:=thefiles.Count; for i := 0 to thefiles.Count - 1 do begin if checkExt(edExt.Text,thefiles[i]) = 1 then begin if findstr(edit1.Text,dir + '\' + thefiles[i])=1 then begin //0 不替換1替換 if isrep=1 then replaceStr(edit1.text,edit2.text,dir + '\' + thefiles[i]) else Memo1.Lines.Add(dir + '\' + thefiles[i]); ProgressBar1.Position:=i; end else begin ProgressBar1.Position:=i; end; end; end; if thedir.count > 0 then begin for i := 0 to thedir.Count - 1 do begin getdirlist(dir + '\' + thedir[i],isrep); //執行遞歸調用 end; end; thedir.free; end; //讀目錄 function TForm1.ReadDirectoryNames(const ParentDirectory: string; dirList: TStringList; filelist: TStringList): Integer; var Status: Integer; SearchRec: TSearchRec; function SlashSep(const Path, S: string): string; begin if AnsiLastChar(Path)^ <> '\' then Result := Path + '\' + S else Result := Path + S; end; begin Result := 0; Status := FindFirst(SlashSep(ParentDirectory, '*.*'), faDirectory, SearchRec); try while Status = 0 do begin if (SearchRec.Attr and faDirectory = faDirectory) then begin if (SearchRec.Name <> '.') and (SearchRec.Name <> '..') then begin dirlist.Add(SearchRec.Name); Memo2.Lines.Add('查找目錄：'+SearchRec.Name); Inc(Result); end; end else begin if (SearchRec.Name <> '.') and (SearchRec.Name <> '..') then begin filelist.Add(SearchRec.Name); Inc(Result); end; end; Status := FindNext(SearchRec); end; finally FindClose(SearchRec); end; end; procedure TForm1.btReplaceClick(Sender: TObject); var sDrive:string; begin if edit1.text='' then begin showmessage('沒有需要替換的字符。'); exit; end; if MessageDlg('你確定要替換所有文件中的字符:'+#13+'" '+edit1.text+'" 替換成:"'+edit2.text+'" 嗎?', mtWarning, [mbYes, mbNo], 0) = mrNo then begin exit; end; Memo1.Lines.Clear; sDrive:= DriveComboBox1.Drive+':'; //0 不替換1替換 getdirList(sDrive,1); showmessage('查找結束！'); end; procedure TForm1.Button4Click(Sender: TObject); var s,file1:string; begin edit2.text:=filtercb.Filter; end; procedure TForm1.Button1Click(Sender: TObject); begin Memo1.Lines.Clear; Edit3.Text:=DirectoryListBox2.Directory; getdirList(DirectoryListBox2.Directory,0); showmessage('查找結束！'); end; procedure TForm1.Button2Click(Sender: TObject); begin if edit1.text='' then begin showmessage('沒有需要替換的字符。'); exit; end; if MessageDlg('你確定要替換所有文件中的字符:'+#13+'" '+edit1.text+'" 替換成:"'+edit2.text+'" 嗎?', mtWarning, [mbYes, mbNo], 0) = mrNo then begin exit; end; Edit3.Text:=DirectoryListBox2.Directory; Memo1.Lines.Clear; getdirList(DirectoryListBox2.Directory,1); showmessage('查找結束！'); end; procedure TForm1.FileListBox1Click(Sender: TObject); begin Edit3.Text:=FilelistBox1.FileName; end; procedure TForm1.FileListBox1DblClick(Sender: TObject); var filename:string; begin fileName:=FileListBox1.FileName; if FileExists(FileName) then ShellExecute(handle, 'open', PChar(FileName), nil,nil, SW_SHOWNORMAL) else Showmessage(' 對不起，您打開！'); end; procedure TForm1.Button3Click(Sender: TObject); begin close; end;