⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 unit1.~pas

📁 提供Delphi和C++builder整个目录的字符或类名的替换工具
💻 ~PAS
📖 第 1 页 / 共 2 页
字号:
  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 + -