delphi 文件的操作:重命名复制移动删除

Posted blogpro

tags:

篇首语:本文由小常识网(cha138.com)小编为大家整理,主要介绍了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;
View Code

例如:

技术图片
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;
View Code

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;
View Code

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.
View Code

其实就是利用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; 
View Code

 遍历目录查找文件中的字符并替换

技术图片
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;
View Code

 

 

 

以上是关于delphi 文件的操作:重命名复制移动删除的主要内容,如果未能解决你的问题,请参考以下文章

文件和文件夹的移动复制删除重命名

文件和文件夹的移动复制删除重命名

python文件文件夹的移动复制删除重命名

文件工具类——文件删除复制移动重命名

Linux下对文件夹和文件重命名、移动和删除

如何在 Linux 中批量移动复制追加和重命名文件