searchfile.pas

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

                FBufferSearchPos := t + 1;
                If (t < FBufferDataCount - 1) And (FSearchBuffer[FBufferSearchPos] = #10) Then
                  Inc(FBufferSearchPos);
                BLine[Lpos] := #0;
                Inc(Lpos);
                Break;
              End
              Else
                If Not (FCurlyCommentActive Or FStarCommentActive) Then
                UseChar := True;
          End
          Else
            UseChar := True;
        '{':
          If FNoComments And Not FStarCommentActive Then
            FCurlyCommentActive := True
          Else
            If Not (FCurlyCommentActive Or FStarCommentActive) Then
            UseChar := True;
        '}':
          If FNoComments And Not FStarCommentActive Then
            FCurlyCommentActive := False
          Else
            If Not (FCurlyCommentActive Or FStarCommentActive) Then
            UseChar := True;
      Else
        If Not (FCurlyCommentActive Or FStarCommentActive) Then
          UseChar := True;
      End;
      If UseChar Then Begin
        If Not (soCaseSensitive In SearchOptions) Then
          BLine[Lpos] := LoCase(FSearchBuffer[i])
        Else
          BLine[Lpos] := FSearchBuffer[i];
        Inc(Lpos);
        If Lpos >= 1023 Then //! StH: 1023 somehow related to the 1024 StrAlloc of BLine? What for?
          Exit; { Binary not text file }
      End;
    End;
    If FSearchBuffer[i] <> #0 Then Inc(FLineNo);
    BLine[Lpos] := #0;
    If BLine[0] <> #0 Then PatternMatch;
    Lpos := 0;
    If FBufferSearchPos < i Then FBufferSearchPos := i;
  End;
End;

Procedure TSearcher.SetBufSize(New: Integer);
Begin
  If (FSearchBuffer = Nil) And (New <> FBufSize) Then
    FBufSize := New;
End;

(*
function TSearcher.GetLineCount: Integer;
begin
  if FMode = mmModule then
    Result := EditIntF.LinesInBuffer
  else
    Result := -1;
end;
*)

Procedure TSearcher.Setpattern(Const Source: String);
Var
  PatternCharIndex: Integer;
  SourceCharIndex: Integer;

  Procedure Store(Ch: Char);
  Begin
    Assert(PatternCharIndex < GrepPatternSize, 'Buffer overrun!');
    If Not (soCaseSensitive In SearchOptions) Then
      FPattern[PatternCharIndex] := LoCase(Ch)
    Else
      FPattern[PatternCharIndex] := Ch;
    Inc(PatternCharIndex);
  End;

  Procedure CClass;
  Resourcestring
    SClassNotTerminated = 'Class at %d did not terminate properly';
  Var
    cstart: Integer;
  Begin
    cstart := SourceCharIndex;
    Inc(SourceCharIndex);
    If Source[SourceCharIndex] = '^' Then
      Store(Char(opNCLASS))
    Else
      Store(Char(opCLASS));

    { changed: 10/22 1998 by dg, more info: see bottom }
    While (SourceCharIndex <= Length(Source)) And (Source[SourceCharIndex] <> ']') Do Begin
      If (Source[SourceCharIndex] = '-') And
        (SourceCharIndex - cstart > 1) And
        (Source[SourceCharIndex + 1] <> ']') And
        (SourceCharIndex < Length(Source)) Then Begin
        Dec(PatternCharIndex, 2);
        Store(Char(opRANGE));
        Store(Source[SourceCharIndex - 1]);
        Store(Source[SourceCharIndex + 1]);
        Inc(SourceCharIndex, 2);
      End
      Else Begin
        Store(Source[SourceCharIndex]);
        Inc(SourceCharIndex);
      End;
    End;

    If (Source[SourceCharIndex] <> ']') Or (SourceCharIndex > Length(Source)) Then
      Raise Exception.CreateFmt(SClassNotTerminated, [cstart]);

    Inc(SourceCharIndex); { To push past close bracket }
  End;

Resourcestring
  SPatternTooLong = 'Grep pattern too long. (> 500 characters)';
  SInvalidGrepSearchCriteria = 'Character immediately following: at %d is not a valid grep search criteria';
  SSenselessEscape = 'Escape character ("\") without a following character does not make sense';
Begin
  //! Warning: this does not properly protect against pattern overruns
  // A better solution needs to be found for this, possibly by sacrificing
  // a bit of performance for a test in the pattern storage code where a
  // new Assert has been introduced.
  If Length(Source) > 500 Then
    Raise Exception.Create(SPatternTooLong);

  Try
    SourceCharIndex := 1;
    PatternCharIndex := 0;
    While SourceCharIndex <= Length(Source) Do Begin
      If Not (soRegEx In SearchOptions) Then Begin
        Store(Char(opCHAR));
        Store(Source[SourceCharIndex]);
        Inc(SourceCharIndex);
      End
      Else Begin
        (*
              if (Source[SourceCharIndex]='*') or (Source[SourceCharIndex]='+') or (Source[SourceCharIndex]='-') then
              if (SourceCharIndex=1) or
                 ((PatternCharIndex>1) and (  (PBuf[lp-1]=char(opBOL)) or
                                (PBuf[PatternCharIndex-1]=char(opEOL)) or
                                (PBuf[PatternCharIndex-1]=char(opSTAR)) or
                                (PBuf[PatternCharIndex-1]=char(opPLUS)) or
                                (PBuf[PatternCharIndex-1]=char(opMINUS)))) then
                 begin
                 Store(Char(opENDPAT));
                 Raise Exception.Create('Bad pattern at character '+intToStr(SourceCharIndex));
                 end;
        *)
        Case Source[SourceCharIndex] Of
          '^': Begin
              Store(Char(opBOL));
              Inc(SourceCharIndex);
            End;

          '$': Begin
              Store(Char(opEOL));
              Inc(SourceCharIndex);
            End;

          '.': Begin
              Store(Char(opANY));
              Inc(SourceCharIndex);
            End;

          '[':
            CClass;

          ':': Begin
              If SourceCharIndex < Length(Source) Then Begin
                Case UpCase(Source[SourceCharIndex + 1]) Of
                  'A': Store(Char(opALPHA));
                  'D': Store(Char(opDIGIT));
                  'N': Store(Char(opNALPHA));
                  ' ': Store(Char(opPUNCT));
                Else
                  Store(Char(opENDPAT));
                  //! ????? Store followed by Exception?
                  Raise Exception.CreateFmt(SInvalidGrepSearchCriteria, [SourceCharIndex]);
                End;
                Inc(SourceCharIndex, 2);
              End
              Else Begin
                Store(Char(opCHAR));
                Store(Source[SourceCharIndex]);
                Inc(SourceCharIndex);
              End;
            End;

          '\': Begin { changed: 10/22 1998 by dg, more info: see bottom }
              If SourceCharIndex >= Length(Source) Then
                Raise Exception.Create(SSenselessEscape);

              Store(Char(opCHAR));
              Store(Source[SourceCharIndex + 1]);
              Inc(SourceCharIndex, 2);
            End;
        Else
          Store(Char(opCHAR));
          Store(Source[SourceCharIndex]);
          Inc(SourceCharIndex);
        End; // case
      End;
    End;
  Finally
    Store(Char(opENDPAT));
    Store(#0);
  End;
End;

Procedure TSearcher.PatternMatch;
Var
  l, p: Integer; // line and pattern pointers
  //e: Integer;     // End for STAR and PLUS match
  op: Char; // Pattern operation
  //n: Integer;     // Class Counter
  //are: String;    // Start of STAR match
  LinePos: Integer;

  Procedure IsFound;
  Var
    S: Integer;
    E: Integer;
  Begin
    { TODO -oStefan -cIssue : Note that this algorithm will identify  "GX_GExperts" as a word for "GExperts" }
    If soWholeWord In SearchOptions Then Begin
      S := LinePos - 2;
      E := l;
      If (S > 0) And IsCharAlpha(BLine[S]) Then
        Exit;
      If (BLine[E] <> #0) And IsCharAlpha(BLine[E]) Then
        Exit;
    End;
    If Assigned(FOnFound) Then
      FOnFound(Self, FLineNo, BLine, LinePos, l);
  End;

Begin
  If FPattern[0] = Char(opENDPAT) Then
    Exit;
  LinePos := 0;

  { Don't bother pattern matching if first search is opCHAR, just go to first match directly }
  { Results in about a 5% to 10% speed increase }
  If (FPattern[0] = Char(opCHAR)) And Not (soCaseSensitive In SearchOptions) Then
    While (FPattern[1] <> BLine[LinePos]) And (BLine[LinePos] <> #0) Do
      Inc(LinePos);

  While BLine[LinePos] <> #0 Do Begin
    l := LinePos;
    p := 0;
    op := FPattern[p];
    While op <> Char(opENDPAT) Do Begin
      Case Ord(op) Of
        opCHAR: Begin
            If Not (Bline[l] = FPattern[p + 1]) Then
              Break;
            Inc(p, 2);
          End;

        opBOL: Begin
            Inc(p);
          End;

        opEOL: Begin
            If BLine[l] In [#0, #10, #13] Then
              Inc(p)
            Else
              Break;
          End;

        opANY: Begin
            If BLine[l] In [#0, #10, #13] Then
              Break;
            Inc(p);
          End;

        opCLASS: Begin
            Inc(p);
            { Compare letters to find a match }
            While (FPattern[p] > LastPatternChar) And (FPattern[p] <> Bline[l]) Do
              Inc(p);
            { Was a match found? }
            If FPattern[p] <= LastPatternChar Then
              Break;
            { move pattern pointer to next opcode }
            While FPattern[p] > LastPatternChar Do
              Inc(p);
          End;

        opNCLASS: Begin
            Inc(p);
            { Compare letters to find a match }
            While (FPattern[p] > LastPatternChar) And (FPattern[p] <> Bline[l]) Do
              Inc(p);
            If FPattern[p] > LastPatternChar Then
              Break;
          End;

        opALPHA: Begin
            If Not IsCharAlpha(BLine[l]) Then
              Break;
            Inc(p);
          End;

        opDIGIT: Begin
            If Not (BLine[l] In ['0'..'9']) Then
              Break;
            Inc(p);
          End;

        opNALPHA: Begin
            //! StH: Is the second part of the clause correct?
            // This appears to be a test for alphanumerics - if it is, then
            // the clause is incorrect and should be
            //        if IsCharAlphaNumeric(BLine[l]) then
            If IsCharAlpha(BLine[l]) Or ((BLine[l] < '0') Or (BLine[l] > '9')) Then
              Inc(p)
            Else
              Break;
          End;

        opPUNCT: Begin
            If (BLine[l] = ' ') Or (BLine[l] > #64) Then
              Break;
            Inc(p);
          End;

        opRANGE: Begin
            If (BLine[l] < FPattern[p + 1]) Or (BLine[l] > FPattern[p + 2]) Then
              Break;
            Inc(p, 3);
          End;
      Else
        Inc(p);
      End; { case }

      If (op = Char(opBOL)) And Not (BLine[l] In [#9, #32]) Then
        Exit; { Means that we did not match at start }

      op := FPattern[p];
      Inc(l);
    End; { while op <> opENDPAT }
    Inc(LinePos);
    If op = Char(opENDPAT) Then
      IsFound;
  End; { while BLine[LinePos] <> #0 }
End;

{
change notes:

changed made by dg ([e-mail]) @ 22/10 1998:

1) '\'-behaviour: changed to standard grep style
new meaning: any character following '\' is treated as a normal character (= is being quoted).
Only exception: inside classes (see next remark).
examples:
 search for a '[': -> searchstring = '\[',
 search for a '\' -> searchstring = '\\',
 search for '\\' -> searchstring = '\\\\'.

2) removed '\'-treatment in classes ([...]) because it didn't work anyway and excape-functionality inside
of classes is very seldomly useful.
btw.: other grep implementations dont's treat '\' as escape-character in classes, too :-)
}

End.