delphi 文件的操作：重命名、复制、移动、删除 | 文件

帆帆资源网

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, {this is the trick!}, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, ); 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=; FILE_RENAME=; 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 [..MAX_PATH + ] of Char; lpDirSrc,lpDirDes: array [..MAX_PATH + ] 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 + ); filename:=WindowsDirs; if filename[length(filename)]<>'\' then filename:=filename+'\'; filename:=filename+'wininit.ini'; if FileExists(filename) then StrLstDelte.LoadFromFile(filename); if StrLstDelte.IndexOf('[rename]') = - then StrLstDelte.Add('[rename]'); GetShortPathName(lpFileNameToSrc, lpDirSrc, MAX_PATH + ); if fileexists(lpFileNameToDes) then GetShortPathName(lpFileNameToDes, lpDirDes, MAX_PATH + ) else begin s:=extractfilename(lpFileNameToDes); i:=pos('.',s); if (i=) then begin if length(s)> then raise exception.create('不是有效的短文件名(8+3格式)!'); end else begin if (i->)or(length(s)-i>) then raise exception.create('不是有效的短文件名(8+3格式)!'); end; strcopy(lpDirDes,lpFileNameToDes); end; if (flag=FILE_DELETE) then {删除} StrLstDelte.Insert(StrLstDelte.IndexOf('[rename]') + , 'NUL='+string(lpDirSrc)) else if (flag=FILE_RENAME) then {改名} StrLstDelte.Insert(StrLstDelte.IndexOf('[rename]') + , 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= 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 [..MAX_PATH + ] 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 + ); edit2.text:=buf; end; end; procedure TForm1.RadioGroup1Click(Sender: TObject); begin edit2.Enabled:=RadioGroup1.ItemIndex=; button2.Enabled:=RadioGroup1.ItemIndex=; end; end. 复制代码 其实就是利用Windows重启的瞬间来删除或移动文件。 文件，文件夹删除移动和拷贝 function WinErasefile(Owner: Integer; WichFiles: string; SendToRecycleBin, Confirm: Boolean): Boolean; //用于将文件直接删除或移动到回收站 var Struct : TSHFileOpStructA; begin FillChar(Struct, SizeOf(Struct), ); While pos(';', WichFiles)> do WichFiles[pos(';', WichFiles)] := #; WichFiles := WichFiles + ##; 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  or FOF_FILESONLY; hNameMappings := nil; lpszProgressTitle := nil; end; result := (SHFileOperationA(Struct)=) and (not Struct.fAnyOperationsAborted); end; function WinErasepath(Owner: Integer; WichFiles: string; SendToRecycleBin, Confirm: Boolean): Boolean; //用于将目录直接删除或移动到回收站 var Struct : TSHFileOpStructA; begin FillChar(Struct, SizeOf(Struct), ); While pos(';', WichFiles)> do WichFiles[pos(';', WichFiles)] := #; WichFiles := WichFiles + ##; 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  or FOF_FILESONLY; hNameMappings := nil; lpszProgressTitle := nil; end; result := (SHFileOperationA(Struct)=) 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), ); MultDest := pos(';', ToFile)>; While pos(';', FromFile)> do FromFile[pos(';', FromFile)] := #; While pos(';', ToFile)> do ToFile[pos(';', ToFile)] := #; FromFile := FromFile + ##; ToFile := ToFile + ##; 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)=) 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), ); MultDest := pos(';', ToFile)>; While pos(';', FromFile)> do FromFile[pos(';', FromFile)] := #; While pos(';', ToFile)> do ToFile[pos(';', ToFile)] := #; FromFile := FromFile + ##; ToFile := ToFile + ##; 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)=) 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), ); MultDest := pos(';', ToFile)>; While pos(';', FromFile)> do FromFile[pos(';', FromFile)] := #; While pos(';', ToFile)> do ToFile[pos(';', ToFile)] := #; FromFile := FromFile + ##; ToFile := ToFile + ##; 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)=) 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), ); MultDest := pos(';', ToFile)>; While pos(';', FromFile)> do FromFile[pos(';', FromFile)] := #; While pos(';', ToFile)> do ToFile[pos(';', ToFile)] := #; FromFile := FromFile + ##; ToFile := ToFile + ##; 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)=) 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('你确定要替换所有文件中的字符:'+#+'" '+edit1.text+'" 替换成:"'+edit2.text+'" 吗?', mtWarning, [mbYes, mbNo], ) = mrNo then begin exit; end; memo1.Lines.Clear; file1:=FileListBox1.FileName; if file1='' then exit; if checkExt(edExt.Text,file1) =  then if findstr(edit1.Text,file1)= 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:=; try sl:=TStringList.Create; sl.LoadFromFile(file1); j:=sl.Count; for i:= to j- do begin if Pos(st,sl.Strings[i])> then result:= end; sl.Free; except end; end; //查找字符并且替换 function TForm1.findStrandRep(st:string;nSt:string;file1:string):integer; var sl:TStringList; i,j:integer; begin result:=; try sl:=TStringList.Create; sl.LoadFromFile(file1); j:=sl.Count; for i:= to j- do begin if Pos(st,sl.Strings[i])> then begin result:=; 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 <>  then begin memo1.Lines.Add('修改了文件：'+file1); end; a.savetofile(file1); a.Free; for i:= to  do begin ProgressBar1.Position:=i; end; except result:=; exit; end; result:=; 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,); showmessage('查找结束！'); end; //检查扩展名 function Tform1.CheckExt(allExt:string;file1:string):integer; var ext:string; i:integer; begin ext:=file1; i:=pos('.',ext); while i> do begin i:=pos('.',ext); ext:=copy(ext,i+,length(ext)-i+); end; if pos(ext,allExt)> then result:= else result:=; 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 :=  to thefiles.Count -  do begin if checkExt(edExt.Text,thefiles[i]) =  then begin if findstr(edit1.Text,dir + '\' + thefiles[i])= then begin //0 不替换1替换 if isrep= 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 >  then begin for i :=  to thedir.Count -  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 := ; Status := FindFirst(SlashSep(ParentDirectory, '*.*'), faDirectory, SearchRec); try while Status =  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('你确定要替换所有文件中的字符:'+#+'" '+edit1.text+'" 替换成:"'+edit2.text+'" 吗?', mtWarning, [mbYes, mbNo], ) = mrNo then begin exit; end; Memo1.Lines.Clear; sDrive:= DriveComboBox1.Drive+':'; //0 不替换1替换 getdirList(sDrive,); 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,); showmessage('查找结束！'); end; procedure TForm1.Button2Click(Sender: TObject); begin if edit1.text='' then begin showmessage('没有需要替换的字符。'); exit; end; if MessageDlg('你确定要替换所有文件中的字符:'+#+'" '+edit1.text+'" 替换成:"'+edit2.text+'" 吗?', mtWarning, [mbYes, mbNo], ) = mrNo then begin exit; end; Edit3.Text:=DirectoryListBox2.Directory; Memo1.Lines.Clear; getdirList(DirectoryListBox2.Directory,); 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; 复制代码