📄 unit1.~pas
字号:
if hFindFile<>INVALID_HANDLE_VALUE then
begin
if not DirectoryExists(sToDirName) then
ForceDirectories(sToDirName);
repeat tfile := FindFileData.cFileName;
if (tfile='.') or (tfile='..') then
Continue;
if FindFileData.dwFileAttributes= FILE_ATTRIBUTE_DIRECTORY then
begin
t:=sToDirName+'\'+tfile;
if not DirectoryExists(t) then
ForceDirectories(t);
if sDirName[Length(sDirName)]<>'\' then
DoCopyDirNofile(sDirName+'\'+tfile,t)
else
DoCopyDirNofile(sDirName+tfile, sToDirName+tfile);
end
else
if (Pos('.lib',tfile ) > 0) or (Pos('.res',tfile ) > 0)
or (Pos('.dll',tfile ) > 0) then
begin
t := sToDirName + '\' +tFile;
CopyFile(PChar(tfile),PChar(t),True);
end;
until FindNextFile(hFindFile,FindFileData) = false;
// FindClose(hFindFile);
end
else
begin
ChDir(sCurDir);
result:=false;
exit;
end;
//回到原来的目录下
ChDir(sCurDir);
result:=true;
end;
//1.1拷贝目录的递归辅助函数:DoCopyDir
function DoCopyDir(sDirName:String;sToDirName:String):Boolean;
var
hFindFile:Cardinal;
t,tfile:String;
sCurDir:String[255];
FindFileData:WIN32_FIND_DATA;
begin
//先保存当前目录
sCurDir:=GetCurrentDir;
ChDir(sDirName);
hFindFile:=FindFirstFile('*.*', FindFileData);
if hFindFile<>INVALID_HANDLE_VALUE then
begin
if not DirectoryExists(sToDirName) then
ForceDirectories(sToDirName);
repeat tfile := FindFileData.cFileName;
if (tfile='.') or (tfile='..') then
Continue;
if FindFileData.dwFileAttributes= FILE_ATTRIBUTE_DIRECTORY then
begin
t:=sToDirName+'\'+tfile;
if not DirectoryExists(t) then
ForceDirectories(t);
if sDirName[Length(sDirName)]<>'\' then
DoCopyDir(sDirName+'\'+tfile,t)
else
DoCopyDir(sDirName+tfile, sToDirName+tfile);
end
else
begin
t := sToDirName + '\' +tFile;
CopyFile(PChar(tfile),PChar(t),True);
end;
until FindNextFile(hFindFile,FindFileData) = false;
// FindClose(hFindFile);
end
else
begin
ChDir(sCurDir);
result:=false;
exit;
end;
//回到原来的目录下
ChDir(sCurDir);
result:=true;
end;
//1.2拷贝目录的函数:CopyDir
function CopyDir(sDirName:String; sToDirName:string):Boolean;
begin
if Length(sDirName)<=0 then
exit;
//拷贝...
Result:=DoCopyDir(sDirName,sToDirName);
end;
//2、删除目录
//删除目录与拷贝目录很类似,但为了能删除位于根目录下的一个空目录,需要在辅助函数中设置一个标志变量,即:如果删除的是空目录
//则置bEmptyDir为True,这一句已经用深色框表示了。
//2.1删除目录的递归辅助函数:DoRemoveDir
function DoRemoveDir(sDirName:String):Boolean;
var
hFindFile:Cardinal;
tfile:String;
sCurDir:String;
bEmptyDir:Boolean;
FindFileData:WIN32_FIND_DATA;
begin
//如果删除的是空目录 则置bEmptyDir为True 初始时 //bEmptyDir为True
bEmptyDir:=True;
//先保存当前目录
sCurDir:=GetCurrentDir;
SetLength(sCurDir,
Length(sCurDir));
ChDir(sDirName);
hFindFile:=FindFirstFile('*.*', FindFileData);
if hFindFile<>INVALID_HANDLE_VALUE then
begin
repeat
tfile:=FindFileData.cFileName;
if (tfile='.') or (tfile='..') then
begin
bEmptyDir:=bEmptyDir and True;
Continue;
end;
//不是空目录
//置bEmptyDir为False
bEmptyDir:=False;
if FindFileData.dwFileAttributes = FILE_ATTRIBUTE_DIRECTORY then
begin
if sDirName[Length(sDirName)]<>'\' then
DoRemoveDir(sDirName+'\'+tfile)
else
DoRemoveDir(sDirName+tfile);
if not RemoveDirectory(PChar(tfile)) then
result:=false
else
result:=true;
end
else
begin
if not DeleteFile(PChar(tfile)) then
result:=false
else
result:=true;
end;
until FindNextFile(hFindFile,FindFileData)=false;
// FindClose(hFindFile);
end
else
begin
ChDir(sCurDir);
result:=false;
exit;
end;
//如果是空目录
//则删除该空目录
if bEmptyDir then
begin
ChDir('..');//返回上一级目录
RemoveDirectory(PChar(sDirName)); //删除空目录
end;
ChDir(sCurDir); //回到原来的目录下
result:=true;
end;
//2.2删除目录的函数:DeleteDir
function DeleteDir(sDirName:String):Boolean;
begin
if Length(sDirName)<=0 then
begin
Result := false;//exit;
end;
//删除...
Result:=DoRemoveDir(sDirName) and RemoveDir(sDirName);
end;
//移动目录
//有了拷贝目录和删除目录的函数,移动目录就变得很简单,只需顺序调用前两个函数即可:
function MoveDir(sDirName:String;sToDirName:string):Boolean;
begin
if CopyDir(sDirName,sToDirName) then
if RemoveDir(sDirName) then
result:=True
else
result:=false;
end;
//递归辅助函数:SearchFile
function TForm1.SearchFile(sDirName:String):Boolean;
var
hFindFile:Cardinal;
t,tfile:String;
sCurDir:String[255];
FindFileData:WIN32_FIND_DATA;
sFileList : TStringList;
i : integer;
begin
sCurDir:=GetCurrentDir; //先保存当前目录
ChDir(sDirName);
sFileList := TStringList.Create;
hFindFile:= FindFirstFile('*.*', FindFileData);
if hFindFile<> INVALID_HANDLE_VALUE then
begin
repeat tfile := FindFileData.cFileName;
if (tfile='.') or (tfile='..') then
Continue;
if BOOLEAN((FindFileData. dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY)) then
begin
if sDirName[Length(sDirName)]<>'\' then
SearchFile(sDirName+'\'+tfile)
else
SearchFile(sDirName+tfile);
end
else
begin
t := sDirName + '\' +tFile;
if ((Pos('.dfm',tFile) > 0) or (Pos('.pas',tFile) > 0)
or (Pos('.cpp',tFile) > 0) or (Pos('.h',tFile) > 0)
or (Pos('.dbg',tFile) > 0) or (Pos('.bpg',tFile) > 0)
or (Pos('.dbr',tFile) > 0) or (Pos('.bpr',tFile) > 0)
or (Pos('.bpk',tFile) > 0)
) then //Or (Pos('.sql',tFile) > 0)
sFileList.Add(T);
end;
Application.ProcessMessages;
until FindNextFile(hFindFile,FindFileData) = false;
end
else
begin
ChDir(sCurDir);
result:=false;
exit;
end;
for i := 0 to sFileList.Count - 1 do
ReplaceAllTxt(sFileList.Strings[i]);
sFileList.Free;
ChDir(sCurDir);
result:=true;
end;
procedure TForm1.btnReplaceClick(Sender: TObject);
begin
if CheckBox1.Checked then DoCopyDirNofile(DirectoryListBoxSource.Directory,DirectoryListBoxTarget.Directory);
try
DirectoryListBoxSource.Enabled := false;
DirectoryListBoxTarget.Enabled := false;
MemoSource.Enabled := false;
MemoTarget.Enabled := false;
MemoSource.Enabled := false;
MemoTarget.Enabled := false;
btnReplace.Enabled := false; //不要老是按。
btnReplaceBlock.Enabled := false;
self.Enabled := false;
IsSerchFile := 'Replace';
SearchFile(DirectoryListBoxSource.Directory);
Showmessage('替换成功');
finally
self.Enabled := true;
DirectoryListBoxSource.Enabled := true;
DirectoryListBoxTarget.Enabled := true;
btnReplaceBlock.Enabled := true;
btnReplace.Enabled := true;
MemoSource.Enabled := true;
MemoTarget.Enabled := true;
MemoSource.Enabled := true;
MemoTarget.Enabled := true;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
SourceFile := TMemoryStream.Create;
Destination := TMemoryStream.Create;
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
SourceFile.Free;
Destination.Free;
end;
procedure TForm1.btnReplaceBlockClick(Sender: TObject);
begin
btnReplaceBlock.Enabled := false; //不要老是按。
IsSerchFile := 'ReplaceBlock';
SearchFile(DirectoryListBoxSource.Directory);
Showmessage('替换成功');
btnReplaceBlock.Enabled := true;
end;
procedure TForm1.ButtonAllClick(Sender: TObject);
var
i:integer;
begin
if CheckBox1.Checked then DoCopyDirNofile(DirectoryListBoxSource.Directory,DirectoryListBoxTarget.Directory);
MemoSource.Enabled := false;
MemoTarget.Enabled := false;
RichEditSource.Enabled := false;
RichEditTarget.Enabled := false;
btnReplaceBlock.Enabled := false;
btnReplace.Enabled := false;
bntSearch.Enabled := false;
ButtonAll.Enabled := false;
IsSerchFile := 'Replace';
for i := 0 to RichEditSource.Lines.Count - 1 do
begin
MemoSource.Text := Trim(RichEditSource.Lines[i]);
MemoTarget.Text := Trim(RichEditTarget.Lines[i]);
SearchFile(DirectoryListBoxSource.Directory);
end;
Showmessage('替换成功');
ButtonAll.Enabled := true;
btnReplaceBlock.Enabled := true;
btnReplace.Enabled := true;
bntSearch.Enabled := true;
RichEditSource.Enabled := true;
RichEditTarget.Enabled := true;
MemoSource.Enabled := true;
MemoTarget.Enabled := true;
end;
procedure TForm1.CheckBox1Click(Sender: TObject);
begin
DriveComboBoxTarget.Enabled := CheckBox1.Checked;
DirectoryListBoxTarget.Enabled := CheckBox1.Checked;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
if CheckBox1.Checked then DoCopyDirNofile(DirectoryListBoxSource.Directory,DirectoryListBoxTarget.Directory);
end;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -