|
Delphi 文件的操作：重命名、復(fù)制、移動、刪除 RenameFile('Oldname', 'Newname');
CopyFile(PChar('Oldname'), PChar('Newname'), False);
MoveFile(PChar('Oldname'), PChar('Newname'));
DeleteFile(文件名);第二種方法： SHFileOperation函數(shù)可以實現(xiàn)各種文件操作，只需將文件操作命令(拷貝、剪切、刪除、重命名)發(fā)送給 它，它就會實現(xiàn)Windows資源管理器那樣的文件操作功能。該函數(shù)的聲明如下： function SHFileOperation(constract lpFileOp : LPSHFILEOPSTRUCT): Integer;stdcall;
LPSHFILEOPSTRUCT的結(jié)構(gòu)類型：
typedef struct _SHFILEOPSTRUCT{
HWND hwnd; // 顯示對話框的句柄
UINT wFunc; // 指明操作類型,支持4種操作：FO_COPY拷貝、FO_MOVE剪切、
FO_DELETE刪除、FO_RENAME重命名。
LPCSTR pFrom; // 源文件路徑，可以是多個文件
LPCSTR pTo; // 目標(biāo)路徑，可以是路徑或文件名，F(xiàn)O_DELETE時，該參數(shù)不起作用
FILEOP_FLAGS fFlags; // 標(biāo)志，附加的風(fēng)格選項
BOOL fAnyOperationsAborted; // 是否可被中斷
LPVOID hNameMappings; // 文件映射名字，可在其它 Shell 函數(shù)中使用
LPCSTR lpszProgressTitle; // 只在 FOF_SIMPLEPROGRESS 時，指定對話框的標(biāo)題。
}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類型轉(zhuǎn)換到PAnsiChar類型，需要經(jīng)過AnsiString類型 FileOp.pFrom := PAnsiChar( AnsiString(aFromFile)); FileOp.pTo := PAnsiChar( AnsiString(aToFile)); case aCommand of fcCopy: FileOp.wFunc := FO_COPY; // 復(fù)制文件 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;
調(diào)用
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('目標(biāo)文件為空！');
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('查找結(jié)束！');
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);
//執(zhí)行遞歸調(diào)用
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('查找結(jié)束！');
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('查找結(jié)束！');
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('查找結(jié)束！');
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; |
|
|
