みなさん、こんにちは。十兵衛です。



DFMファイルの内容から指定された文字列を検索します。

 //ストリーム中の文字列を検索し、ヒット文字列の行と
 //ファイル名をTStringsに追加します
procedure MyWordFind(AFileName:string;AFile:TStream;
                     AWord:string;List:TStrings);
const
 BSIZE = 8192*2;
 TURNPOINT = BSIZE - 512;
var
 Key:string;
 Buf:array [0..BSIZE] of Char;
 LineBuf: array [0..255] of Char;
 IDX,PT,Len,Line,KeyLen: Integer;
 C:Char;
begin
  KeyLen := Length(AWord);
  Key := LowerCase(AWord);
  AFile.Position := 0;
  Len := AFile.Read(Buf,BSIZE);
  IDX := 0;
  PT := 0;
  Line := 1;
  repeat
   if Buf[IDX] = #10 then begin
      PT := 0;
      Inc(Line);
      if (IDX > TURNPOINT) and (Len = BSIZE) then begin
          CopyMemory(@Buf[0], @Buf[TURNPOINT], 512);
          Len := Len - TURNPOINT + AFile.Read(Buf[512], TURNPOINT);
          IDX := IDX - TURNPOINT;
      end;
   end else
    if Buf[IDX] <> #13 then begin
       if PT < 255 then begin
          LineBuf[PT] := Buf[IDX];
          Inc(PT);
       end;
       c := Buf[IDX];
       if c in ['A'..'Z'] then Inc(C,32);
       if (Key[1] = C) and ((PT = 1) or 
                  (LineBuf[PT-2] in [' ', '.', '('])) then
       begin
        if StrLIComp(PChar(Key),@Buf[IDX],KeyLen) = 0 then
        begin
         repeat
          Inc(IDX);
          LineBuf[PT] := Buf[IDX];
          Inc(PT);
         until Buf[IDX] in [#0,#10,#13,#26];
         LineBuf[PT-1] := #0;
         List.Add(Format('%s(%.6d):%-s',[
          ExtractFileName(AFileName),Line,StrPas(LineBuf)]));
        end;
       end;
    end;
    Inc(IDX);
    Application.ProcessMessages;
  until IDX >= Len;
end;

 //指定されたディレクトリ中からDFMファイルを検索しStream展開を行ない
 //指定された文字列を探す関数に渡します（再帰処理を行なっています）
procedure MyFileFind(ADir:TFileName;AWord:string;List:TStrings);
var
 FS:TSearchRec;
 FRes:Integer;
 FPath:TFileName;
 FAttr:Integer;
 FInput,FOutput:TMemoryStream;
begin
 FPath := ADir;
 if FPath[Length(FPath)] <> '\' then FPath := FPath + '\';
 FAttr := faReadOnly or faHidden or faSysFile
        or faDirectory or faArchive or faAnyFile;
 FRes := SysUtils.FindFirst(FPath+'*.DFM',FAttr,FS);
 if FRes = 0 then begin
    repeat
      if (FS.Attr and faDirectory) > 0 then begin
        if FS.Name[1] <> '.' then begin
           MyFileFind(FPath+FS.Name,AWord,List);
        end;
      end else begin
        FInput := TMemoryStream.Create;
        FOutput := TMemoryStream.Create;
        try
         FInput.LoadFromFile(FPath+FS.Name);
         ObjectResourceToText(FInput,FOutput);
         MyWordFind(FPath+FS.Name,FOutput,AWord,List);
        finally
         FInput.Free;
         FOutput.Free;
        end;
      end;
      Application.ProcessMessages;
      FRes := FindNext(FS);
    until  FRes <> 0;
    SysUtils.FindClose(FS);
 end;
end;

使い方例

FormにTButtonを二つ、TEditを二つ、TListBoxを一つ置きます。

procedure TForm1.FormCreate(Sender: TObject);
begin
 Edit1.Text := ExtractFilePath(Application.ExeName);
 Edit2.Text := '';
end;

procedure TForm1.Button1Click(Sender: TObject);
var
 FDir:string;
begin
 if DirectoryExists(Edit1.Text) then FDir := Edit1.Text;
 if SelectDirectory(FDir,[],-1) then Edit1.Text := FDir;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
 Screen.Cursor := crHourGlass;
 try
  MyFileFind(Edit1.Text,Edit2.Text,ListBox1.Items);
 finally
  Screen.Cursor := crDefault;
 end;
end;

検索実行を行なえばListBoxに一覧が表示されます。

                                     98/09/06(日) 11:26 十兵衛(BZT01311)

Original document by 十兵衛          氏 ID:(BZT01311)

ここにあるドキュメントは NIFTY SERVEの Delphi Users' Forum の16番会議室「玉石混淆みんなで作るSample蔵」に投稿されたサンプルです。これらのサンプルはボーランド株式会社がサポートする公式のものではありません。また、必ずしも動作が検証されているものではありません。これらのサンプルを使用したことに起因するいかなる損害も投稿者、およびフォーラムスタッフはその責めを負いません。使用者のリスクの範疇でご使用下さい。