searchfile.pas

大家是不是为不知道如何在VB学到绝地程序

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);