searchfile.pas

Delphi编写的一个支持语法高亮显示和很多语言的文本编辑器

{***************************************************************
 *
 * Unit Name   : GrepResultsDlg
 * Purpose     : Grep Search Result Dialog
 * Copyright   : This Source Code is taken from GExperts, the excellent
 * 			     Delphi/C++Builder add-on available from GExperts.org.
 *				 Please see the file gexpertslicense.html for the license.
 *				 Any modifications from the original are copyright Echo
 *				 Software.
 ****************************************************************}

unit SearchFile;

//! StH: This unit has been completely prepared for localization
//! StH: This unit is fully compatible with C++Builder

interface

{$IFDEF VER125}
  {$D-}  //! StH: This works around a bug in C++Builder 4.0
{$ENDIF VER125}

{$IFDEF VER110}
  {$D-} //! StH: Work around a compiler bug in C++Builder 3.0
{$ENDIF VER110}

uses
  Windows, SysUtils, Classes, Dialogs;

type

  TSearchOption = (soCaseSensitive, soWholeWord, soRegEx);

  TSearchOptions = set of TSearchOption;

  TFoundEvent = procedure(Sender: TObject; LineNo: Integer; Line: string; SPos, FEditReaderPos: Integer) of object;

  TSearcher = class(TObject)
  private
    FSearchStream: TStream;
    FEof: Boolean;
    FSearchBuffer: PChar;
    BLine: PChar; //? What is that
    FBufferSearchPos: Integer;
    FBufferDataCount: Integer;
    FLineNo: Integer;
    FBufSize: Integer;
    FFileName: string;
    FNoComments: Boolean;
    FCurlyCommentActive: Boolean;
    FStarCommentActive: Boolean;
    FOnFound: TFoundEvent;
    FOnStartSearch: TNotifyEvent;
    FPattern: PChar;
    FSearchOptions: TSearchOptions;
    LoCase: function(const Ch: Char): Char;
    procedure Reset;
    procedure FillBuffer;
    //function GetLineCount: Integer;
    procedure SetBufSize(New: Integer);
    procedure PatternMatch;
    function GetANSICompatible: Boolean;
    procedure SetANSICompatible(const Value: Boolean);
  protected
    procedure SetFileName(const Value: string);
    procedure SearchForm;
    procedure FreeObjects;
    procedure DoSearch;
  public
    constructor Create(const SearchFileName: string);
    destructor Destroy; override;
    procedure Execute;
    procedure SetPattern(const Source: string);
    property Pattern: PChar read FPattern;
  published
    property BufSize: Integer read FBufSize write SetBufSize;
    property SearchOptions: TSearchOptions read FSearchOptions write FSearchOptions;
    property FileName: string read FFileName write SetFileName;
    property NoComments: Boolean read FNoComments write FNoComments;
    property ANSICompatible: Boolean read GetANSICompatible write SetANSICompatible;
    property OnFound: TFoundEvent read FOnFound write FOnFound;
    property OnStartSearch: TNotifyEvent read FOnStartSearch write FOnStartSearch;
  end;

const
  opCHAR = 1;
  opBOL = 2;
  opEOL = 3;
  opANY = 4;
  opCLASS = 5;
  opNCLASS = 6;
  opSTAR = 7;
  opPLUS = 8;
  opMINUS = 9;
  opALPHA = 10;
  opDIGIT = 11;
  opNALPHA = 12;
  opPUNCT = 13;
  opRANGE = 14;
  opENDPAT = 15;

  LastPatternChar = Char(opENDPAT);

implementation


const
  GrepPatternSize = 512;

//! StH: Optimize this, perhaps some BASM
(*
function ANSILoCase(const Ch: Char): Char;
var
  ConversionChar: PChar;
begin
  ConversionChar := PChar(MakeLong(Ord(Ch), 0));
  CharLower(ConversionChar);
  Result := Chr(LoWord(ConversionChar));
end;
*)

function ANSILoCase(const Ch: Char): Char;
var
  w: Word;
begin
  w := MakeWord(Ord(Ch), 0);
  CharLower(PChar(@w));
  Result := Char(Lo(w));
end;

function ASCIILoCase(const Ch: Char): Char;
begin
  if Ch in ['A'..'Z'] then
    Result := Char(Ord(Ch) + 32)
  else
    Result := Ch;
end;

constructor TSearcher.Create(const SearchFileName: string);
begin
  inherited Create;

  FBufSize := 2048;
  FSearchStream := TMemoryStream.Create;
{
  // everything is automatically initialized to
  // these values
  FEof := False;
  FLineNo := 0;
  FNoComments := False;
  FCurlyCommentActive := False;
  FStarCommentActive := False;
  FBufferSearchPos := 0;
  FBufferDataCount := 0;
  FSearchBuffer := nil;
  FName := '';
}
  BLine := StrAlloc(1024);
  FPattern := StrAlloc(GrepPatternSize);
  if SearchFileName <> '' then
    SetFileName(SearchFileName);
  LoCase := ASCIILoCase;
end;

destructor TSearcher.Destroy;
begin
  FSearchStream.Free;
  FSearchStream := nil;

  StrDispose(FSearchBuffer);
  FSearchBuffer := nil;

  StrDispose(BLine);
  BLine := nil;

  StrDispose(FPattern);
  FPattern := nil;

  inherited Destroy;
end;

procedure TSearcher.SearchForm;
var
  FormStream: TStream;
  origFormat: TStreamOriginalFormat;
begin
    FreeObjects;
    if FileExists(FFileName) then
    begin
      FormStream := TFileStream.Create(FFileName, fmOpenRead or fmShareDenyWrite);
      try
        FSearchStream := TMemoryStream.Create;
        ObjectResourceToText(FormStream, FSearchStream, origFormat);
      finally
        FormStream.Free;
      end;
    end;

    if FSearchStream <> nil then
    begin
      Reset;
      DoSearch;
    end;
end;

procedure TSearcher.FreeObjects;
begin
  if FFileName <> '' then
  begin
    FSearchStream.Free;
    FSearchStream := nil;
  end;
end;

procedure TSearcher.SetFileName(const Value: string);
begin
//  FreeObjects;
  FFileName := Value;
  if FFileName <> '' then
    Reset;
  TMemoryStream(FSearchStream).LoadFromFile(FFileName);
end;

function TSearcher.GetANSICompatible: Boolean;
begin
  if @LoCase = @ANSILoCase then
    Result := True
  else
    Result := False;
end;

procedure TSearcher.SetANSICompatible(const Value: Boolean);
begin
  if Value then
    LoCase := ANSILoCase
  else
    LoCase := ASCIILoCase;
end;

procedure TSearcher.Reset;
resourcestring
  SSearcherReset = 'Reset exception:'#13#10;
begin
    if FFileName = '' then
      Exit;

    FBufferSearchPos := 0;
    FBufferDataCount := 0;
    FLineNo := 0;
    FEof := False;
    FCurlyCommentActive := False;
    FStarCommentActive := False;
    FSearchStream.Position := 0;
end;

procedure TSearcher.FillBuffer;
var
  AmountOfBytesToRead: Integer;
  SkippedCharactersCount: Integer;
  LineEndScanner: PChar;
begin
  if FSearchBuffer = nil then
    FSearchBuffer := StrAlloc(FBufSize);
  FSearchBuffer[0] := #0;

  // Read at most (FBufSize - 1) bytes
  AmountOfBytesToRead := FBufSize - 1;

  FBufferDataCount := FSearchStream.Read(FSearchBuffer^, AmountOfBytesToRead);

  FEof := (FBufferDataCount = 0);

  // Reset buffer position to zero
  FBufferSearchPos := 0;

  // If we filled our buffer completely, there is a chance that
  // the last line was read only partially.
  // Since our search algorithm is line-based,
  // skip back to the end of the last completely read line.
  if FBufferDataCount = AmountOfBytesToRead then
  begin
    // Get pointer on last character of read data
    LineEndScanner := FSearchBuffer + FBufferDataCount - 1;
    // We have not skipped any characters yet
    SkippedCharactersCount := 0;
    // While we still have data in the buffer,
    // do scan for a line break as characterised
    // by a #13#10 or #10#13 or a single #10.
    // Which sequence exactly we hit is not important,
    // we just need to find and line terminating
    // sequence.
    while FBufferDataCount > 0 do
    begin
      if LineEndScanner^ = #10 then
      begin
        FSearchStream.Seek(-SkippedCharactersCount, soFromCurrent);

        // Done with finding last complete line
        Break;
      end;

      Inc(SkippedCharactersCount);
      Dec(FBufferDataCount);
      Dec(LineEndScanner);
    end;

    // With FBufferPos = 0 we have scanned back in our
    // buffer and not found any line break; this means
    // that we cannot employ our pattern matcher on a
    // complete line -> Internal Error.
    if FBufferDataCount = 0 then
    begin
      { TODO -oStefan -cIssue: Complete error handling for the case where
                               a single line exceeds FBufSize-1 characters }
      raise Exception.Create('Grep: Internal line length error.  Binary file?'); //! FIXME
    end;
  end;


  // Cut off everything beyond the line break
  // Assert(FBufferDataCount >= 0);
  FSearchBuffer[FBufferDataCount] := #0;
end;

procedure TSearcher.Execute;
var
  UpperFileExt: string;
begin
  UpperFileExt := UpperCase(ExtractFileExt(FFileName));

  if UpperFileExt = '.DFM' then
  begin
    SearchForm;
  end
  else DoSearch;
end;

procedure TSearcher.DoSearch;
var
  i: Integer;
  t: Integer;
  LPos: Integer;
  UseChar: Boolean;
begin
  if FFileName = '' then
    Exit;
  if Assigned(FOnStartSearch) then
    FOnStartSearch(Self);
  LPos := 0;
  while not FEof do
  begin
    { read new data in }
    if (FBufferSearchPos >= FBufferDataCount) or (FBufferDataCount = 0) then
      FillBuffer;
    if FEof then Exit;
    for i := FBufferSearchPos to FBufferDataCount - 1 do
    begin
      UseChar := False;
      case FSearchBuffer[i] of
        #0:
          begin
            FBufferSearchPos := FBufferDataCount + 1;
            Break;
          end;
        #10:
          begin
            FBufferSearchPos := i + 1;
            Break;
          end;
        #13:
          begin
            FBufferSearchPos := i + 1;
            if FSearchBuffer[FBufferSearchPos] = #10 then Inc(FBufferSearchPos);
            Break;
          end;
        // TODO -oStefan -cC++Builder: C(++) comments are a major problem here;
        '(':
          if FNoComments and not FCurlyCommentActive and (FSearchBuffer[i + 1] = '*') then
            FStarCommentActive := True
          else
            if not (FCurlyCommentActive or FStarCommentActive) then
              UseChar := True;
        ')':
          if (i > 1) and (FNoComments) and not FCurlyCommentActive and (FSearchBuffer[i - 1] = '*') then
            FStarCommentActive := False
          else
            if not (FCurlyCommentActive or FStarCommentActive) then
              UseChar := True;
        '/':
          if FNoComments then
          begin
            if not (FCurlyCommentActive or FStarCommentActive) then
              if FSearchBuffer[i + 1] = '/' then
              begin
                t := i;
                while (t <= FBufferDataCount - 1) and not (FSearchBuffer[t] in [#0, #13]) do
                  Inc(t);
                FBufferSearchPos := t + 1;
                if (t < FBufferDataCount - 1) and (FSearchBuffer[FBufferSearchPos] = #10) then