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;

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;

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.

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;