atstreamsearch.pas

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

{************************************************}
{                                                }
{  ATStreamSearch Component                      }
{  Copyright (C) 2007-2008 Alexey Torgashin      }
{  http://atorg.net.ru                           }
{  [e-mail]                        }
{                                                }
{************************************************}

{$BOOLEVAL OFF} //Short boolean evaluation required.

{$I ATStreamSearchOptions.inc} //ATStreamSearch options.

unit ATStreamSearch;

interface

uses
  Windows,
  Classes,
  {$IFDEF REGEX}
  DIRegEx,
  {$ENDIF}
  {$IFDEF TNT}
  TntClasses,
  {$ENDIF}
  ATxCodepages;

type
  TATStreamSearchOption = (
    asoCaseSens,
    asoWholeWords,
    asoBackward,
    {$IFDEF REGEX} asoRegEx, {$ENDIF}
    asoFromPage //For ATViewer only, ignored in ATStreamSearch
    );

  TATStreamSearchOptions = set of TATStreamSearchOption;

  TATStreamSearchProgress = procedure(
    const ACurrentPos, AMaximalPos: Int64;
    var AContinueSearching: Boolean) of object;

type
  TATStreamSearch = class(TComponent)
  private
    FStream: TStream;
    FStreamOwner: Boolean;
    FFileName: WideString;
    FStreamStart: Int64;
    FStreamSize: Int64;
    FFoundStart: Int64;
    FFoundLength: Int64;
    {$IFDEF REGEX}
    FRegEx: TDIRegExSearchStream_Enc;
    {$ENDIF}
    FOnProgress: TATStreamSearchProgress;
    FCharSize: Integer;

    FSavedText: WideString;
    FSavedEncoding: TATEncoding;
    FSavedOptions: TATStreamSearchOptions;
    //FSearchForValidUTF16: Boolean;

    procedure FreeStream;
    procedure InitSavedOptions;
    function InitProgressFields(
      const AStartPos: Int64;
      AEncoding: TATEncoding): Boolean;
    procedure DoProgress(
      const ACurrentPos, AMaximalPos: Int64;
      var AContinueSearching: Boolean);
    procedure SetFileName(const AFileName: WideString);
    procedure SetStream(AStream: TStream);

    {$IFDEF REGEX}
    procedure FreeRegex;
    procedure InitRegex;
    procedure RegexProgress(
      const ASender: TDICustomRegExSearch;
      const AProgress: Int64;
      var AAbort: Boolean);
    function RegexFindFirst(
      const AText: WideString;
      const AStartPos: Int64;
      AEncoding: TATEncoding;
      AOptions: TATStreamSearchOptions): Boolean;
    function RegexFindNext: Boolean;
    {$ENDIF}

    function TextFind(
      const AText: WideString;
      const AStartPos: Int64;
      AEncoding: TATEncoding;
      AOptions: TATStreamSearchOptions): Int64;
    function TextFindFirst(
      const AText: WideString;
      const AStartPos: Int64;
      AEncoding: TATEncoding;
      AOptions: TATStreamSearchOptions): Boolean;
    function TextFindNext(AFindPrevious: Boolean = False): Boolean;

  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    property FileName: WideString read FFileName write SetFileName;
    property Stream: TStream read FStream write SetStream;

    function FindFirst(
      const AText: WideString;
      const AStartPos: Int64;
      AEncoding: TATEncoding;
      AOptions: TATStreamSearchOptions): Boolean;
    function FindNext(AFindPrevious: Boolean = False): Boolean;

    property FoundStart: Int64 read FFoundStart;
    property FoundLength: Int64 read FFoundLength;

  published
    //property SearchForValidUTF16: Boolean read FSearchForValidUTF16 write FSearchForValidUTF16 default False;
    property OnProgress: TATStreamSearchProgress read FOnProgress write FOnProgress;
  end;

var
  MsgATStreamSearchRegExError: string = 'Regular expression pattern error:'#13#10#13#10'%s at offset %d';
  MsgATStreamSearchReadError: string = 'Read error at offset %d';

procedure Register;

implementation

uses
  {$IFDEF REGEX}
  DIRegEx_Api, DIRegEx_SearchStream, DIUtils,
  {$ENDIF}
  SysUtils, ATxSProc;

{ Constants }

const
  cBlockSize = 64 * 1024;

{ Helper functions }

function CharSize(AEncoding: TATEncoding): Integer;
begin
  if AEncoding in cATUnicodeEncodings then
    Result := 2
  else
    Result := 1;
end;

function BoolToSign(AValue: Boolean): Integer;
begin
  if AValue then
    Result := 1
  else
    Result := -1;
end;

procedure NormalizePos(var APos: Int64; ACharSize: Integer);
begin
  if ACharSize <> 1 then
    APos := APos div ACharSize * ACharSize;
end;

function LastPos(const AFileSize: Int64; ACharSize: Integer): Int64;
begin
  Result := AFileSize;
  NormalizePos(Result, ACharSize);
  Dec(Result, ACharSize);
  I64LimitMin(Result, 0);
end;

{ TATStreamSearch }

constructor TATStreamSearch.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FStream := nil;
  FStreamOwner := False;
  FFileName := '';
  FStreamStart := -1;
  FStreamSize := 0;
  FFoundStart := -1;
  FFoundLength := 0;
  //FSearchForValidUTF16 := False;

  {$IFDEF REGEX}
  FRegEx := nil;
  {$ENDIF}

  FOnProgress := nil;
  FCharSize := 1;
  InitSavedOptions;
end;

destructor TATStreamSearch.Destroy;
begin
  FreeStream;
  {$IFDEF REGEX}
  FreeRegex;
  {$ENDIF}
  inherited;
end;

procedure TATStreamSearch.FreeStream;
begin
  if FStreamOwner then
    if Assigned(FStream) then
      FreeAndNil(FStream);
end;

procedure TATStreamSearch.InitSavedOptions;
begin
  FSavedText := '';
  FSavedEncoding := vencANSI;
  FSavedOptions := [];
end;

procedure TATStreamSearch.SetFileName(const AFileName: WideString);
begin
  FreeStream;

  if AFileName <> '' then
    begin
      InitSavedOptions;
      FFileName := AFileName;
      FStreamOwner := True;
      FStream := {$IFDEF TNT}TTntFileStream{$ELSE}TFileStream{$ENDIF}.Create(
        AFileName, fmOpenRead or fmShareDenyNone);
    end;
end;

procedure TATStreamSearch.SetStream(AStream: TStream);
begin
  FreeStream;
  InitSavedOptions;
  FFileName := '';
  FStreamOwner := False;
  FStream := AStream;
end;

function TATStreamSearch.InitProgressFields(
  const AStartPos: Int64;
  AEncoding: TATEncoding): Boolean;
begin
  FStreamStart := AStartPos;
  FStreamSize := FStream.Size;
  FCharSize := CharSize(AEncoding);
  Result := FStreamSize >= FCharSize;
end;

procedure TATStreamSearch.DoProgress(
  const ACurrentPos, AMaximalPos: Int64;
  var AContinueSearching: Boolean);
begin
  AContinueSearching := True;

  if Assigned(FOnProgress) then
    FOnProgress(ACurrentPos, AMaximalPos, AContinueSearching);
end;

//-----------------------------------------------------------------
// RegEx-related code

{$IFDEF REGEX}

procedure TATStreamSearch.FreeRegex;
begin
  if Assigned(FRegEx) then
    FreeAndNil(FRegEx);
end;

procedure TATStreamSearch.InitRegex;
begin
  if not Assigned(FRegEx) then
    begin
      FRegEx := TDIRegExSearchStream_Enc.Create(Self);
      FRegEx.MatchOptions := FRegEx.MatchOptions - [moNotEmpty];
      FRegEx.OnProgress := RegexProgress;
    end;
end;

procedure TATStreamSearch.RegexProgress(
  const ASender: TDICustomRegExSearch;
  const AProgress: Int64;
  var AAbort: Boolean);
var
  ContinueSearching: Boolean;
begin
  ContinueSearching := True;
  DoProgress(
    FStreamStart + AProgress,
    FStreamSize,
    ContinueSearching);
  if not ContinueSearching then
    AAbort := True;
end;

function TATStreamSearch.RegexFindFirst(
  const AText: WideString;
  const AStartPos: Int64;
  AEncoding: TATEncoding;
  AOptions: TATStreamSearchOptions): Boolean;
var
  RealText: AnsiString;
begin
  Result := False;

  if AText = '' then Exit;