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

📄 unit1.pas

📁 提供Delphi和C++builder整个目录的字符或类名的替换工具
💻 PAS
📖 第 1 页 / 共 2 页
字号:
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ComCtrls, Grids,  Buttons, FileCtrl;

type
  TForm1 = class(TForm)
    Label1: TLabel;
    DirectoryListBoxSource: TDirectoryListBox;
    DriveComboBox1: TDriveComboBox;
    btnReplace: TButton;
    Label3: TLabel;
    MemoTarget: TRichEdit;
    MemoSource: TRichEdit;
    MemoResult: TMemo;
    bntSearch: TButton;
    Label2: TLabel;
    Label4: TLabel;
    edtEnd: TEdit;
    Label6: TLabel;
    btnReplaceBlock: TButton;
    Memo1: TMemo;
    Label5: TLabel;
    RichEditSource: TRichEdit;
    Label7: TLabel;
    RichEditTarget: TRichEdit;
    ButtonAll: TButton;
    CheckBox1: TCheckBox;
    DriveComboBoxTarget: TDriveComboBox;
    DirectoryListBoxTarget: TDirectoryListBox;
    Button1: TButton;
    CheckBoxUppercase: TCheckBox;
    procedure bntSearchClick(Sender: TObject);
    procedure btnReplaceClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure btnReplaceBlockClick(Sender: TObject);
    procedure ButtonAllClick(Sender: TObject);
    procedure CheckBox1Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    procedure ReplaceAllTxt(SourceFileName: string);
    function SearchFile(sDirName:String):Boolean;
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  sSource,sTarget : String;
  IsSerchFile : String = 'Search';

implementation
var
  SourceFile,Destination : TMemoryStream;

{$R *.DFM}


procedure TForm1.ReplaceAllTxt(SourceFileName: string);
var
  OriginalFormat: TStreamOriginalFormat;
  OutputStream: TFileStream;
  StrStream: TStringStream;
  iSite,iStrLen,iSLength : integer;
  S,TmpSourceFileName,TmpCaption:string;
  i,iTargetName, iSourceLength , iFileName : integer;
  IsChange : Boolean;
  RichEditTxt : TRichEdit;
  procedure Replace();
  var
    J : integer;
  begin
    iSourceLength := Length(sSource);
    iSLength := Length(s);
    if IsSerchFile = 'Search' then
    begin
      for J := iSLength downto 1  do
        if Copy(s,J,iSourceLength) = sSource then
          MemoResult.Lines.Add(SourceFileName)
    end
    else
       if IsSerchFile = 'Replace' then
       begin
          for J := iSLength Downto 1 do
            if (CheckBoxUppercase.Checked) and (Copy(s,J,iSourceLength) = UpperCase(sSource)) then //大写换大写小写换小写;
            begin
              Delete(S,J,iSourceLength); //要删除的字符的长度;
              if sTarget <> '' then
                Insert(UpperCase(sTarget),S,J);
              IsChange := true;
            end
            else
              if (UpperCase(Copy(s,J,iSourceLength)) = UpperCase(sSource)) then
              begin
                Delete(S,J,iSourceLength); //要删除的字符的长度;
                if sTarget <> '' then
                  Insert(sTarget,S,J);
                IsChange := true;
              end;
       end
       else
       begin
         RichEditTxt := TRichEdit.Create(Self);
         RichEditTxt.Visible := false;
         RichEditTxt.Parent := self;
         Application.ProcessMessages;
         RichEditTxt.Text := S;
         if (iSite > 0) then IsChange := true;
         while (iSite > 0) do
         begin  //取块的长度;
           iStrLen := RichEditTxt.FindText(edtEnd.Text,iSite,Length(S),[stMatchCase])
             - iSite  + Length(edtEnd.Text) + 1; //相减少了一个字符;
           Delete(S,iSite,iStrLen);
           if sTarget <> '' then
             Insert(sTarget,S,iSite);
           iSite  := Pos(sSource,S);
         end;
         RichEditTxt.Free;
       end;
  end;

begin
  OriginalFormat := sofText;
  StrStream := TStringStream.Create(s);
  try
    //start
    if (RichEditSource.Text <> '') and (RichEditTarget.Text <> '') then
    begin
      IsSerchFile := 'Replace';
      if CheckBox1.Checked then
        IsChange := true
      else
        IsChange := false;  
      SourceFile.Clear;
      Destination.Clear;
      SourceFile.LoadFromFile(SourceFileName);
      ObjectResourceToText(SourceFile, Destination, OriginalFormat);
      ObjectBinaryToText(Destination, StrStream,OriginalFormat);
      S := StrStream.DataString;
      StrStream.Seek(0,soFromBeginning);
      TmpSourceFileName := SourceFileName;
      TmpCaption := SourceFileName;
      for i := 0 to RichEditSource.Lines.Count - 1 do
      begin
        MemoSource.Text := Trim(RichEditSource.Lines[i]);
        MemoTarget.Text := Trim(RichEditTarget.Lines[i]);
        Destination.Seek(0, soFromBeginning);
        sSource := Trim(MemoSource.Text);
        sTarget := Trim(MemoTarget.Text);
        self.Caption := TmpCaption + ' -- ' + sSource + ' --  '  +  sTarget;
        Replace();
        iFileName := 1;
        iSLength := Length(SourceFileName);
        for iTargetName := iSLength downto 1 do  //插入目标在串的后面,
        begin
          if Copy(SourceFileName,i,1) = '\' then
          begin
            iFileName := i;
            break;
          end;
        end;
        for iTargetName := iSLength downto iFileName do  //更改文件名;
        begin
          //大写换大写小写换小写;
          if (CheckBoxUppercase.Checked) and (Copy(SourceFileName,iTargetName,iSourceLength) = UpperCase(sSource)) then
          begin
            Delete(SourceFileName,iTargetName,iSourceLength); //要删除的字符的长度;
            if sTarget <> '' then
               Insert(UpperCase(sTarget),SourceFileName,iTargetName);
            IsChange := true;
          end
          else
            if (UpperCase(Copy(SourceFileName,iTargetName,iSourceLength)) = UpperCase(sSource)) then
            begin
              Delete(SourceFileName,iTargetName,iSourceLength); //要删除的字符的长度;
              if sTarget <> '' then
                 Insert(sTarget,SourceFileName,iTargetName);
              IsChange := true;
            end;
        end;
      end;
    end
    else
    begin
      SourceFile.Clear;
      Destination.Clear;
      IsChange := false;
      SourceFile.LoadFromFile(SourceFileName);
      ObjectResourceToText(SourceFile, Destination, OriginalFormat);
      Destination.Seek(0, soFromBeginning);
      ObjectBinaryToText(Destination, StrStream,OriginalFormat);
      S := StrStream.DataString;
      StrStream.Seek(0,soFromBeginning);
      sSource := Trim(MemoSource.Text);
      sTarget := Trim(MemoTarget.Text);
      Replace();
    end;
    if ((IsSerchFile = 'Replace') or (IsSerchFile = 'ReplaceBlock')) then //更改文件名称;
    begin
      if IsSerchFile = 'Replace' then
      begin
        if (CheckBox1.Checked) then //输出到目标目录.
          for i := iSLength downto 1 do   //更改原文件的目录;
            if UpperCase(Copy(SourceFileName,i,Length(DirectoryListBoxSource.Directory)))
               = UpperCase(DirectoryListBoxSource.Directory) then
            begin
              Delete(SourceFileName,i,Length(DirectoryListBoxSource.Directory)); //要删除的字符的长度;
              if sTarget <> '' then
                 Insert(DirectoryListBoxTarget.Directory,SourceFileName,i);
              IsChange := true;
            end;
        if (IsChange) and (not CheckBox1.Checked)then
          deletefile(TmpSourceFileName);
      end
      else
      begin
         RichEditTxt := TRichEdit.Create(Self);
         RichEditTxt.Visible := false;
         RichEditTxt.Parent := self;
         Application.ProcessMessages;
         RichEditTxt.Text := SourceFileName;
         if (iSite > 0) then
         begin
           IsChange := true;
           deletefile(SourceFileName);
         end;
         while (iSite > 0) do
         begin  //取块的长度;
           iStrLen := RichEditTxt.FindText(edtEnd.Text,iSite,Length(SourceFileName),[stMatchCase])
             - iSite  + Length(edtEnd.Text) + 1; //相减少了一个字符;
           Delete(SourceFileName,iSite,iStrLen);
           if sTarget <> '' then
             Insert(sTarget,SourceFileName,iSite);
           iSite  := Pos(sSource,SourceFileName);
         end;
         RichEditTxt.Free;
      end;
      if (IsChange) or (CheckBox1.Checked) then
      begin
        StrStream.WriteString(s);
        OutputStream := TFileStream.Create(SourceFileName, fmOpenWrite  or fmCreate);
        ObjectTextToResource(StrStream, OutputStream,OriginalFormat);
        OutputStream.Free;
      end;
    end;
  finally
    StrStream.free;
  end;
end;

function ConvertFormToText(SourceFileName: string): boolean;
var
  InputStream, OutputStream: TFileStream;
  DestFileName: string;
  OriginalFormat: TStreamOriginalFormat;
begin
  OriginalFormat := sofText;
  result := true;
  { change the file extension to .txt }
  DestFileName := ChangeFileExt(SourceFileName, '.txt');
  { Create a file stream for the specified file }
  InputStream  := TFileStream.Create(SourceFileName, fmOpenRead);
  OutputStream := TFileStream.Create(DestFileName, fmOpenWrite  or fmCreate);
  { convert }
  try
    try
      ObjectResourceToText(InputStream, OutputStream,OriginalFormat);
    except
      On EStreamError do Result := False;
    end
  finally
    { free memory }
    InputStream.Free;
    OutputStream.Free;
  end;
end;


function ConvertTextToForm(SourceFileName: string): boolean;
var
  InputStream, OutputStream: TFileStream;
  DestFileName: string;
  OriginalFormat: TStreamOriginalFormat;
begin
  OriginalFormat := sofText;
  result := true;
  DestFileName := ChangeFileExt(SourceFileName, '.dfm');
  InputStream  := TFileStream.Create(SourceFileName, fmOpenRead);
  OutputStream := TFileStream.Create(DestFileName, fmCreate);
  try
    try
      ObjectTextToResource(InputStream, OutputStream , OriginalFormat);
    except
      on EStreamError do result := false;
    end
  finally
    InputStream.Free;
    OutputStream.Free;
  end;
end;

function IsValidDir(SearchRec:TSearchRec):Boolean;
begin
  if (SearchRec.Attr=16) and
    (SearchRec.Name<>'.') and
    (SearchRec.Name<>'..')
  then
    Result:=True
  else
    Result:=False;
end;

procedure TForm1.bntSearchClick(Sender: TObject);
begin
  bntSearch.Enabled := false; //不要老是按。
  MemoResult.Lines.Clear;
  IsSerchFile := 'Search';
  SearchFile(DirectoryListBoxSource.Directory);
  Showmessage('查找完毕!');
  bntSearch.Enabled := true;
end;

//1.1拷贝目录的递归辅助函数:DoCopyDir
function DoCopyDirNofile(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);

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -