atstreamsearch.pas

ATViewer is a component for Delphi/C++Builder, which allows to view files of various types. There is

  //1. Prepare objects and fields

  InitRegex;

  Assert(Assigned(FRegEx), 'RegEx object not initialized');
  Assert(Assigned(FStream), 'Stream object not initialized');

  if not InitProgressFields(AStartPos, AEncoding) then Exit;

  FStream.Position := AStartPos;

  //2. Prepare RegEx object

  if asoCaseSens in AOptions then
    FRegEx.CompileOptions := FRegEx.CompileOptions - [coCaseLess]
  else
    FRegEx.CompileOptions := FRegEx.CompileOptions + [coCaseLess];

  RealText := StrEncodeUtf8(AText);

  if asoWholeWords in AOptions then
    begin
      //If "Whole Words" option is used, we first need to check
      //validity of original regex:
      if not FRegEx.CompileMatchPatternStr(RealText) then
        begin
          raise Exception.Create(Format(MsgATStreamSearchRegExError,
            [FRegEx.ErrorMessage, FRegEx.ErrorOffset]));
          Exit;
        end;
      //If it's OK we append '\b...\b' and compile regex again:
      RealText := '\b' + RealText + '\b';
    end;

  if not FRegEx.CompileMatchPatternStr(RealText) then
    begin
      raise Exception.Create(Format(MsgATStreamSearchRegExError,
        [FRegEx.ErrorMessage, FRegEx.ErrorOffset]));
      Exit;
    end;

  case AEncoding of
    vencANSI:
      FRegEx.SearchInitEnc(FStream, ansi_mbtowc);
    vencOEM:
      FRegEx.SearchInitEnc(FStream, oem_mbtowc);
    vencUnicodeLE:
      begin
        {if FSearchForValidUTF16 then
          FRegex.SearchInitEnc(FStream, utf16le_mbtowc)
        else}
        FRegEx.SearchInitEnc(FStream, binary16le_mbtowc);
      end;
    vencUnicodeBE:
      begin
        {if FSearchForValidUTF16 then
          FRegex.SearchInitEnc(FStream, utf16be_mbtowc)
        else}
        FRegEx.SearchInitEnc(FStream, binary16be_mbtowc);
      end;
    else
      Assert(False, 'Unknown encoding specified');
  end;

  //3. Search

  Result := RegexFindNext;
end;

function TATStreamSearch.RegexFindNext: Boolean;
var
  DummyStart, DummyLength,
  MatchStart, MatchLength: Int64;
begin
  Assert(Assigned(FRegEx), 'RegEx object not initialized');
  Assert(Assigned(FStream), 'Stream object not initialized');

  Result := FRegEx.SearchNext(
    DummyStart, DummyLength,
    MatchStart, MatchLength) >= 0;

  if Result then
    begin
      FFoundStart := FStreamStart + MatchStart * FCharSize;
      FFoundLength := MatchLength * FCharSize;
    end
  else
    begin
      FFoundStart := -1;
      FFoundLength := 0;
    end;
end;

{$ENDIF}

//-----------------------------------------------------------------
// Plain search code

function TATStreamSearch.TextFind(
  const AText: WideString;
  const AStartPos: Int64;
  AEncoding: TATEncoding;
  AOptions: TATStreamSearchOptions): Int64;
var
  Buffer: array[0..cBlockSize - 1] of Char;
  BufPosMax, BufPos, ReadPos: Int64;
  ReadSize, BytesRead: DWORD;
  SBufferA: AnsiString;
  SBufferW: WideString;
  StringPos: Integer;
  AForward, AWholeWords, ACaseSens, AContinue: Boolean;
begin
  Result := -1;

  if AText = '' then Exit;

  //1. Init objects and fields

  Assert(Assigned(FStream), 'Stream object not initialized');

  if not InitProgressFields(AStartPos, AEncoding) then Exit;

  //2. Init variables

  AForward := not (asoBackward in AOptions);
  AWholeWords := asoWholeWords in AOptions;
  ACaseSens := asoCaseSens in AOptions;

  BufPosMax := LastPos(FStreamSize, FCharSize);
  NormalizePos(BufPosMax, FCharSize);

  BufPos := AStartPos;
  NormalizePos(BufPos, FCharSize);

  if BufPos > BufPosMax then
    begin
      if AForward then
        Exit
      else
        BufPos := BufPosMax;
    end;

  if BufPos < 0 then
    begin
      if AForward then
        BufPos := 0
      else
        Exit;
    end;

  //3. Search

  DoProgress(BufPos, FStreamSize, AContinue);
  if not AContinue then Exit;

  repeat
    ReadPos := BufPos;
    ReadSize := cBlockSize;

    if not AForward then
      begin
        Dec(ReadPos, cBlockSize - FCharSize);
        I64LimitMin(ReadPos, 0);

        ReadSize := BufPos - ReadPos + FCharSize;
        if ReadSize > cBlockSize then
          ReadSize := cBlockSize;
      end;

    try
      FillChar(Buffer, SizeOf(Buffer), 0);
      FStream.Position := ReadPos;
      BytesRead := FStream.Read(Buffer, ReadSize);
    except
      raise Exception.Create(Format(MsgATStreamSearchReadError, [ReadPos]));
      Exit;
    end;

    if FCharSize = 2 then
      begin
        SBufferW := SetStringW(Buffer, BytesRead, AEncoding = vencUnicodeBE);
        StringPos := SFindTextW(AText, SBufferW, AForward, AWholeWords, ACaseSens, BytesRead < cBlockSize);
      end
    else
      begin
        SetString(SBufferA, Buffer, BytesRead);
        SBufferA := SCodepageToUnicode(SBufferA, AEncoding);
        StringPos := SFindText(AText, SBufferA, AForward, AWholeWords, ACaseSens, BytesRead < cBlockSize);
      end;

    if StringPos > 0 then
      begin
        Result := ReadPos + (StringPos - 1) * FCharSize;
        Exit
      end;

    DoProgress(BufPos, FStreamSize, AContinue);
    if not AContinue then Exit;

    Inc(BufPos, Int64(ReadSize) * BoolToSign(AForward));
    Dec(BufPos, Int64(Length(AText) + 1) * FCharSize * BoolToSign(AForward));
    NormalizePos(BufPos, FCharSize);

    if (BufPos < 0) or (BufPos > BufPosMax) then Exit;

  until BytesRead < cBlockSize;
end;

function TATStreamSearch.TextFindFirst(
  const AText: WideString;
  const AStartPos: Int64;
  AEncoding: TATEncoding;
  AOptions: TATStreamSearchOptions): Boolean;
var
  ARealStartPos: Int64;
begin
  ARealStartPos := AStartPos;
  if (asoBackward in AOptions) and (AStartPos = 0) then
    ARealStartPos := High(Int64);

  FFoundStart := TextFind(AText, ARealStartPos, AEncoding, AOptions);
  Result := FFoundStart >= 0;

  if Result then
    FFoundLength := Length(AText) * FCharSize
  else
    FFoundLength := 0;
end;

function TATStreamSearch.TextFindNext(AFindPrevious: Boolean = False): Boolean;
var
  ACharSize: Integer;
  AStartPos,
  AForwardPos, ABackwardPos: Int64;
  ANewOptions: TATStreamSearchOptions;
begin
  ACharSize := CharSize(FSavedEncoding);

  AForwardPos := FFoundStart + ACharSize;
  ABackwardPos := FFoundStart + (Length(FSavedText) - 2) * ACharSize;

  if (asoBackward in FSavedOptions) xor (AFindPrevious) then
    AStartPos := ABackwardPos
  else
    AStartPos := AForwardPos;

  ANewOptions := FSavedOptions;
  if AFindPrevious then
    if (asoBackward in ANewOptions) then
      Exclude(ANewOptions, asoBackward)
    else
      Include(ANewOptions, asoBackward);

  FFoundStart := TextFind(FSavedText, AStartPos, FSavedEncoding, ANewOptions);
  Result := FFoundStart >= 0;

  if Result then
    FFoundLength := Length(FSavedText) * ACharSize
  else
    FFoundLength := 0;
end;

//-----------------------------------------------------------------
// Combined search code

function TATStreamSearch.FindFirst(
  const AText: WideString;
  const AStartPos: Int64;
  AEncoding: TATEncoding;
  AOptions: TATStreamSearchOptions): Boolean;
begin
  InitSavedOptions;

  FSavedText := AText;
  FSavedEncoding := AEncoding;
  FSavedOptions := AOptions;

  {$IFDEF REGEX}
  if asoRegEx in AOptions then
  begin
    Assert(not (asoBackward in AOptions), 'Backward search not supported for Regex');
    Result := RegexFindFirst(AText, AStartPos, AEncoding, AOptions);
  end
  else
  {$ENDIF}
    Result := TextFindFirst(AText, AStartPos, AEncoding, AOptions);
end;

function TATStreamSearch.FindNext(AFindPrevious: Boolean = False): Boolean;
begin
  Assert(FSavedText <> '', 'Search text is empty');

  {$IFDEF REGEX}
  if asoRegEx in FSavedOptions then
  begin
    Assert(AFindPrevious = False, 'FindPrevious not supported for Regex');
    Result := RegexFindNext;
  end
  else
  {$ENDIF}
    Result := TextFindNext(AFindPrevious);
end;


{ Registration }

procedure Register;
begin
  RegisterComponents('Samples', [TATStreamSearch]);
end;

end.