寻找小程序

用DELPHI的IDE专家‘GEXPERT’
www.51delphi.com有下载，能进行批量处理

dfm也可以打开后,form上点右键,view as text来处理,然后查找替换用ultraedit可以做到

我做了一个搜索文件中的单词的程序，不过代码比较多，只能发一部分给你，至于替换，你自己加工吧：
procedure TMainForm.FindInfoInfiles(FName,FindString:String);
var
  MemMapFile:TMemMapFile;
  FoundStr:PChar;
  WordCount:Integer;
  FileCount:Integer;
begin
  FileCount := 0;
  MemMapFile := TMemMapFile.Create(FName,fmOpenRead,0,true);
  try
    WordCount := 0;
    FoundStr := StrPos(PChar(MemMapFile.Data),PChar(FindString));
    if FoundStr <> nil then
    begin
      ListBox1.Items.Add(FName+' - '+IntToStr(WordCount));
    end;
  finally
    MemMapFile.Free;
  end;
end;function TMainForm.GetDirectoryName(Dir: String): String;
begin
  if Dir[Length(Dir)]<> '\' then
    Result := Dir+'\'
  else
    Result := Dir;
end;procedure TMainForm.FindFiles(APath: String);
var
  FSearchRec,
  DSearchRec: TSearchRec;
  FindResult: integer;
//  fData:WIN32_FIND_DATA;
  function IsDirNotation(ADirName: String): Boolean;
  begin
    Result := (ADirName = '.') or (ADirName = '..');
  end;begin
  APath := GetDirectoryName(APath);
  FindResult := FindFirst(APath+FFileName,faAnyFile+faHidden+
                          faSysFile+faReadOnly,FSearchRec);
  try
    while FindResult = 0 do
    begin
      ExtractFileExt(StrPas(FSearchRec.FindData.cFileName));
      lbFiles.Items.Add(LowerCase(APath+FSearchRec.Name));
      FindInfoInfiles(APath+FSearchRec.Name,edtFileInfo.Text);
      FindResult := FindNext(FSearchRec);
    end;    FindResult := FindFirst(APath+'*.*', faDirectory, DSearchRec);
    while FindResult = 0 do
    begin
      if ((DSearchRec.Attr and faDirectory) = faDirectory)
         and not IsDirNotation(DSearchRec.Name) then
      begin
        FindFiles(APath+DSearchRec.Name); // Recursion here
      end;
      FindResult := FindNext(DSearchRec);
    end;
  finally
    FindClose(FSearchRec);
  end;
end;//映射文件
unit MemMap;interfaceuses Windows, SysUtils, Classes;type
  EMMFError = class(Exception);  TMemMapFile = class
  private
    FFileName: String;    // File name of the mapped file.
    FSize: Longint;       // Size of the mapped view
    FFileSize: Longint;   // Actual File Size
    FFileMode: Integer;   // File access mode
    FFileHandle: Integer; // File handle
    FMapHandle: Integer;  // Handle to the file mapping object.
    FData: PByte;         // Pointer to the file's data
    FMapNow: Boolean;     // Determines whether or
                          //   not to map view of immediately.
    procedure AllocFileHandle;
    { Retrieves a handle to the disk file. }
    procedure AllocFileMapping;
    { Retrieves a file-mapping object handle }
    procedure AllocFileView;
    { Maps a view to the file }
    function GetSize: Longint;
    { Returns the size of the mapped view }
  public
    constructor Create(FileName: String; FileMode: integer;
                       Size: integer; MapNow: Boolean); virtual;
    destructor Destroy; override;
    procedure FreeMapping;
    property Data: PByte read FData;
    property Size: Longint read GetSize;
    property FileName: String read FFileName;
    property FileHandle: Integer read FFileHandle;
    property MapHandle: Integer read FMapHandle;
  end;implementationconstructor TMemMapFile.Create(FileName: String; FileMode: integer;
                               Size: integer; MapNow: Boolean);
{ Creates Memory Mapped view of FileName file.
  FileName: Full pathname of file.
  FileMode: Use fmXXX constants.
  Size: size of memory map.  Pass zero as the size to use the
        file's own size.
}
begin  { Initialize private fields }
  FMapNow := MapNow;
  FFileName := FileName;
  FFileMode := FileMode;  AllocFileHandle;  // Obtain a file handle of the disk file.
  { Assume file is < 2 gig  }  FFileSize := GetFileSize(FFileHandle, Nil);
  FSize := Size;  try
    AllocFileMapping; // Get the file mapping object handle.
  except
    on EMMFError do
    begin
      CloseHandle(FFileHandle);
      FFileHandle := 0;
      raise;
    end;
  end;
  if FMapNow then
    AllocFileView;
end;destructor TMemMapFile.Destroy;
begin  if FFileHandle <> 0 then
    CloseHandle(FFileHandle);
  if FMapHandle <> 0 then
    CloseHandle(FMapHandle);  FreeMapping;
  inherited Destroy;
end;procedure TMemMapFile.FreeMapping;
{ This method unmaps the view of the file from this process's address
  space. }
begin
  if FData <> Nil then
  begin
    UnmapViewOfFile(FData);
    FData := Nil;
  end;
end;function TMemMapFile.GetSize: Longint;
begin
  if FSize <> 0 then
    Result := FSize
  else
    Result := FFileSize;
end;procedure TMemMapFile.AllocFileHandle;
{ creates or opens disk file before creating memory mapped file }
begin
  if FFileMode = fmCreate then
    FFileHandle := FileCreate(FFileName)
  else
    FFileHandle := FileOpen(FFileName, FFileMode);  if FFileHandle < 0 then
    raise EMMFError.Create('Failed to open or create file');
end;procedure TMemMapFile.AllocFileMapping;
var
  ProtAttr: DWORD;
begin
  if FFileMode = fmOpenRead then
    ProtAttr := Page_ReadOnly
  else
    ProtAttr := Page_ReadWrite;
  FMapHandle := CreateFileMapping(FFileHandle, Nil, ProtAttr,
      0, FSize, Nil);
  if FMapHandle = 0 then
    raise EMMFError.Create('Failed to create file mapping');
end;procedure TMemMapFile.AllocFileView;
var
  Access: Longint;
begin
  if FFileMode = fmOpenRead then
    Access := File_Map_Read
  else
    Access := File_Map_All_Access;
  FData := MapViewOfFile(FMapHandle, Access, 0, 0, FSize);
  if FData = Nil then
    raise EMMFError.Create('Failed to map view of file');
end;end.

{*******************************************************}
{                                                       }
{       Copyright (c) 1995,96 Borland International     }
{                                                       }
{*******************************************************}unit Search;interfaceuses WinProcs, SysUtils, StdCtrls, Dialogs;const
  { Default word delimiters are any character except the core alphanumerics. }
  WordDelimiters: set of Char = [#0..#255] - ['a'..'z','A'..'Z','1'..'9','0'];{ SearchMemo scans the text of a TEdit, TMemo, or other TCustomEdit-derived
  component for a given search string.  The search starts at the current
  caret position in the control.  The Options parameter determines whether the
  search runs forward (frDown) or backward from the caret position, whether
  or not the text comparison is case sensitive, and whether the matching
  string must be a whole word.  If text is already selected in the control,
  the search starts at the 'far end' of the selection (SelStart if searching
  backwards, SelEnd if searching forwards).  If a match is found, the
  control's text selection is changed to select the found text and the
  function returns True.  If no match is found, the function returns False. }
function SearchMemo(Memo: TCustomEdit;
                    const SearchString: String;
                    Options: TFindOptions): Boolean;{ SearchBuf is a lower-level search routine for arbitrary text buffers.  Same
  rules as SearchMemo above.  If a match is found, the function returns a
  pointer to the start of the matching string in the buffer.  If no match,
  the function returns nil. }
function SearchBuf(Buf: PChar; BufLen: Integer;
                   SelStart, SelLength: Integer;
                   SearchString: String;
                   Options: TFindOptions): PChar;implementation
uses Messages;  // Messages added by Xavier Pacheco
function SearchMemo(Memo: TCustomEdit;
                    const SearchString: String;
                    Options: TFindOptions): Boolean;
var
  Buffer, P: PChar;
  Size: Word;
begin
  Result := False;
  if (Length(SearchString) = 0) then Exit;
  Size := Memo.GetTextLen;
  if (Size = 0) then Exit;
  Buffer := StrAlloc(Size + 1);
  try
    Memo.GetTextBuf(Buffer, Size + 1);
    P := SearchBuf(Buffer, Size, Memo.SelStart, Memo.SelLength,
                   SearchString, Options);
    if P <> nil then
    begin
      Memo.SelStart := P - Buffer;
      Memo.SelLength := Length(SearchString);
      { In Delphi 1.0 setting the SelStart property automatically
        brought the memo's caret into view. This is not the case in
        Win32 apps. You must use the EM_SCROLLCARET message to
        scroll to the caret position. -- Xavier Pacheco}
      Memo.Perform(EM_SCROLLCARET, 0, 0); // Added by Xavier Pacheco
      Result := True;
    end;
  finally
    StrDispose(Buffer);
  end;
end;
function SearchBuf(Buf: PChar; BufLen: Integer;
                   SelStart, SelLength: Integer;
                   SearchString: String;
                   Options: TFindOptions): PChar;
var
  SearchCount, I: Integer;
  C: Char;
  Direction: Shortint;
  CharMap: array [Char] of Char;  function FindNextWordStart(var BufPtr: PChar): Boolean;
  begin                   { (True XOR N) is equivalent to (not N) }
    Result := False;      { (False XOR N) is equivalent to (N)    }
     { When Direction is forward (1), skip non delimiters, then skip delimiters. }
     { When Direction is backward (-1), skip delims, then skip non delims }
    while (SearchCount > 0) and
          ((Direction = 1) xor (BufPtr^ in WordDelimiters)) do
    begin
      Inc(BufPtr, Direction);
      Dec(SearchCount);
    end;
    while (SearchCount > 0) and
          ((Direction = -1) xor (BufPtr^ in WordDelimiters)) do
    begin
      Inc(BufPtr, Direction);
      Dec(SearchCount);
    end;
    Result := SearchCount >= 0;
    if (Direction = -1) and (BufPtr^ in WordDelimiters) then
    begin   { back up one char, to leave ptr on first non delim }
      Dec(BufPtr, Direction);
      Inc(SearchCount);
    end;
  end;begin
  Result := nil;
  if BufLen <= 0 then Exit;
  if frDown in Options then
  begin
    Direction := 1;
    Inc(SelStart, SelLength);  { start search past end of selection }
    SearchCount := BufLen - SelStart - Length(SearchString);
{    SearchCount := BufLen - SelStart - Length(SearchString) + 1;}
    if SearchCount < 0 then Exit;
    if Longint(SelStart) + SearchCount > BufLen then Exit;
  end
  else
  begin
    Direction := -1;
    Dec(SelStart, Length(SearchString));
    SearchCount := SelStart;
{    SearchCount := SelStart + 1;}
  end;
  if (SelStart < 0) or (SelStart > BufLen) then Exit;
  Result := @Buf[SelStart];  { Using a Char map array is faster than calling AnsiUpper on every character }
  for C := Low(CharMap) to High(CharMap) do
    CharMap[C] := C;  if not (frMatchCase in Options) then
  begin
    AnsiUpperBuff(PChar(@CharMap), sizeof(CharMap));
    AnsiUpperBuff(@SearchString[1], Length(SearchString));
  end;  while SearchCount >= 0 do
  begin
    if frWholeWord in Options then
      if not FindNextWordStart(Result) then Break;
    I := 0;
    while (CharMap[Result[I]] = SearchString[I+1]) do
    begin
      Inc(I);
      if I >= Length(SearchString) then
      begin
        if (not (frWholeWord in Options)) or
           (SearchCount = 0) or
           (Result[I] in WordDelimiters) then
          Exit;
        Break;
      end;
    end;
    Inc(Result, Direction);
    Dec(SearchCount);
  end;
  Result := nil;
end;end.

解决方案 »