search.pas

MiniHex 1.1 源程序说明 “MiniHex11SrcSource”目录中的所有文件是MiniHex 1.1的主程序； “MiniHex11SrcControls”目录中的是该软件

{**********************************************************}
{                                                          }
{  功能：实现查找和替换.                                   }
{                                                          }
{**********************************************************}

unit Search;

interface

uses
  Windows, Messages, SysUtils, Classes,
  Controls, Forms, Dialogs, HexChFrm;

type
  TIntegerType = (itShortInt, itSmallInt, itLongInt, itInt64, itByte, itWord, itLongWord);
  TFloatType = (ftSingle, ftDouble, ftReal48, ftExtended);

  TSearchTextPara = record
    Text: string;
    MatchCase: Boolean;
    WholeWord: Boolean;
    Unicode: Boolean;
    OnlyBlock: Boolean;
    AllDoc: Boolean;
    UseWild: Boolean;
    WildChar: Char;
    WildCount: Integer;
  end;

  TSearchHexPara = record
    Text: string;
    OnlyBlock: Boolean;
    AllDoc: Boolean;
    UseWild: Boolean;
    WildChar: Char;
    WildCount: Integer;
  end;

  TSearchIntPara = record
    Value: Int64;
    OnlyBlock: Boolean;
    AllDoc: Boolean;
  end;

  TSearchFloatPara = record
    Value: Extended;
    FloatType: TFloatType;
    Blur: Boolean;
    BlurValue: Extended;
    OnlyBlock: Boolean;
    AllDoc: Boolean;
  end;

  TReplaceTextPara = record
    FromText: string;
    ToText: string;
    MatchCase: Boolean;
    WholeWord: Boolean;
    Unicode: Boolean;
    OnlyBlock: Boolean;
    AllDoc: Boolean;
    AskRep: Boolean;
    UseWild: Boolean;
    WildChar: Char;
    WildCount: Integer;
  end;

  TReplaceHexPara = record
    FromText: string;
    ToText: string;
    OnlyBlock: Boolean;
    AllDoc: Boolean;
    AskRep: Boolean;
    UseWild: Boolean;
    WildChar: Char;
    WildCount: Integer;
  end;

  { TSearchBaseMgr }

  TSearchBaseMgr = class
  private
    FResultForm: THexChForm;
    FResultOffset: Integer;

    function Search(FromCur: Boolean): Boolean; virtual; abstract;
    function GetNotFoundMsg: string; virtual;
  protected
    procedure GetFormIdxRange(var FromIdx, ToIdx: Integer; AllDoc: Boolean);
    procedure GetOffsetRange(var FromOffset, ToOffset: Integer; Frm: THexChForm; OnlyBlock, FromCur: Boolean);
  public
    property ResultForm: THexChForm read FResultForm;
    property ResultOffset: Integer read FResultOffset;

    function SearchFirst: Boolean;
    function SearchNext: Boolean;
  end;

  { TSearchTextMgr }

  TSearchTextMgr = class(TSearchBaseMgr)
  private
    FPara: TSearchTextPara;

    function Search(FromCur: Boolean): Boolean; override;
    function GetNotFoundMsg: string; override;
  public
    property Para: TSearchTextPara read FPara write FPara;
  end;

  { TSearchHexMgr }

  TSearchHexMgr = class(TSearchBaseMgr)
  private
    FPara: TSearchHexPara;

    function Search(FromCur: Boolean): Boolean; override;
    function GetNotFoundMsg: string; override;
  protected
    function HexStrToValStr(HexStr: string): string;
  public
    property Para: TSearchHexPara read FPara write FPara;
  end;

  { TSearchIntMgr }

  TSearchIntMgr = class(TSearchBaseMgr)
  private
    FPara: TSearchIntPara;

    function GetIntType(Value: Int64): TIntegerType;
    function GetIntLen(IntType: TIntegerType): Integer;
    function Search(FromCur: Boolean): Boolean; override;
    function GetNotFoundMsg: string; override;
  public
    property Para: TSearchIntPara read FPara write FPara;
  end;

  { TSearchFloatMgr }

  TSearchFloatMgr = class(TSearchBaseMgr)
  private
    FPara: TSearchFloatPara;

    function GetFloatLen(FloatType: TFloatType): Integer;
    function GetFloatHexStr(Value: Extended; FloatType: TFloatType): string;
    function Search(FromCur: Boolean): Boolean; override;
    function GetNotFoundMsg: string; override;
  public
    property Para: TSearchFloatPara read FPara write FPara;
  end;

  { TReplaceTextMgr }

  TReplaceTextMgr = class(TSearchTextMgr)
  private
    FPara: TReplaceTextPara;
    procedure SetPara(Value: TReplaceTextPara);
    function CanReplace: Boolean;
  public
    property Para: TReplaceTextPara read FPara write SetPara;
    function ReplaceFirst: Boolean;
    function ReplaceNext: Boolean;
    function ReplaceAll: Boolean;
  end;

  { TReplaceHexMgr }

  TReplaceHexMgr = class(TSearchHexMgr)
  private
    FPara: TReplaceHexPara;
    procedure SetPara(Value: TReplaceHexPara);
    function CanReplace: Boolean;
  public
    property Para: TReplaceHexPara read FPara write SetPara;
    function ReplaceFirst: Boolean;
    function ReplaceNext: Boolean;
    function ReplaceAll: Boolean;
  end;

implementation

uses
  MainFrm, Radix;

function CharUpperCase(Ch: Char): Char;
begin
  if (Ch >= 'a') and (Ch <= 'z') then Dec(Ch, 32);
  Result := Ch;
end;

function IsAlphaChar(Ch: Char): Boolean;
begin
  Result := (Ch >= 'a') and (Ch <= 'z') or (Ch >= 'A') and (Ch <= 'Z');
end;

function IsDigitChar(Ch: Char): Boolean;
begin
  Result := (Ch >= '0') and (Ch <= '9');
end;

function IsBorderChar(Ch: Char): Boolean;
begin
  Result := not IsAlphaChar(Ch) and not IsDigitChar(Ch);
end;

{ TSearchBaseMgr }

function TSearchBaseMgr.GetNotFoundMsg: string;
begin
  Result :=  '搜索完毕。';
end;

procedure TSearchBaseMgr.GetFormIdxRange(var FromIdx, ToIdx: Integer; AllDoc: Boolean);
begin
  if AllDoc then
  begin
    FromIdx := 0;
    ToIdx := MHMainForm.MDIChildCount - 1;
  end else
  begin
    FromIdx := 0;
    ToIdx := 0;
  end;
end;

procedure TSearchBaseMgr.GetOffsetRange(var FromOffset, ToOffset: Integer; Frm: THexChForm; OnlyBlock, FromCur: Boolean);
var
  CurOffset: Integer;
begin
  CurOffset := Frm.Offset + 1;
  if MHMainForm.ActiveMDIChild <> Frm then FromCur := False;
  if OnlyBlock then
  begin
    if Frm.Block.Active then
    begin
      if FromCur then
      begin
        if (CurOffset >= Frm.Block.StartOffset) and (CurOffset <= Frm.Block.EndOffset) then
        begin
          FromOffset := CurOffset;
          ToOffset := Frm.Block.EndOffset;
        end else
        begin
          FromOffset := 0;
          ToOffset := -1;
        end;
      end else
      begin
        FromOffset := Frm.Block.StartOffset;
        ToOffset := Frm.Block.EndOffset;
      end;
    end else
    begin
      FromOffset := 0;
      ToOffset := -1;
    end;
  end else
  begin
    if FromCur then
      FromOffset := CurOffset
    else
      FromOffset := 0;
    ToOffset := Frm.BufSize - 1;
  end;
end;

function TSearchBaseMgr.SearchFirst: Boolean;
begin
  MHMainForm.ShowStatusMsg('正在搜索...');
  Result := Search(False);
  MHMainForm.ShowStatusMsg('');
  if Result then
  begin
    FResultForm.BringToFront;
    FResultForm.Offset := FResultOffset;
  end else
  begin
    MessageBox(Application.Handle, PChar(GetNotFoundMsg), '提示', 48);
  end;
end;

function TSearchBaseMgr.SearchNext: Boolean;
begin
  MHMainForm.ShowStatusMsg('正在搜索...');
  Result := Search(True);
  MHMainForm.ShowStatusMsg('');
  if Result then
  begin
    FResultForm.BringToFront;
    FResultForm.Offset := FResultOffset;
  end else
  begin
    MessageBox(Application.Handle, PChar(GetNotFoundMsg), '提示', 48);
  end;
end;

{ TSearchTextMgr }

function TSearchTextMgr.Search(FromCur: Boolean): Boolean;
var
  i, j, k, Len, FrmIdx: Integer;
  FromFrmIdx, ToFrmIdx, FromOffset, ToOffset: Integer;
  FindStr, S: string;
  FindStrW: WideString;
  Frm: THexChForm;
  Same: Boolean;
  Ch: Char;
begin
  GetFormIdxRange(FromFrmIdx, ToFrmIdx, FPara.AllDoc);
  if FPara.MatchCase then
    FindStr := FPara.Text
  else
    FindStr := UpperCase(FPara.Text);
  if FPara.UseWild then
  begin
    i := 1;
    while i <= Length(FindStr) do
    begin
      if FindStr[i] = FPara.WildChar then
      begin
        for j := 1 to FPara.WildCount - 1 do
          Insert(FPara.WildChar, FindStr, i);
        Inc(i, FPara.WildCount - 1);
      end;
      Inc(i, 1);
    end;
  end;
  if FPara.Unicode then
  begin
    S := FindStr;
    FindStrW := WideString(S);
    Len := (Length(FindStrW)+1)*2;
    SetLength(FindStr, Len);
    StringToWideChar(S, @FindStr[1], Len);
    SetLength(FindStr, Length(FindStrW)*2);
    if FPara.UseWild then
    begin
      i := 1;
      while i < Length(FindStr) do
      begin
        if (FindStr[i] = FPara.WildChar) and (FindStr[i+1] = #0) then
          Delete(FindStr, i+1, 1)
        else
          Inc(i);
      end;
    end;
  end;

  for FrmIdx := FromFrmIdx to ToFrmIdx do
  begin
    if not (MHMainForm.MDIChildren[FrmIdx] is THexChForm) then Continue;
    Frm := MHMainForm.MDIChildren[FrmIdx] as THexChForm;

    GetOffsetRange(FromOffset, ToOffset, Frm, FPara.OnlyBlock, FromCur);
    Len := Length(FindStr);
    for i := FromOffset to ToOffset - Len + 1 do
    begin
      Same := True;

      if FPara.WholeWord then
      begin
        k := i - 1;
        if k >= 0 then
          if not IsBorderChar(Frm.BufPointer[k]) then
            Same := False;
        k := i + Len;
        if k < Frm.BufSize then
          if not IsBorderChar(Frm.BufPointer[k]) then
            Same := False;
      end;
      if not Same then Continue;

      for j := 0 to Len - 1 do
      begin
        if FPara.UseWild then
        begin
          if FindStr[j+1] = FPara.WildChar then Break;
        end;
        Ch := Frm.BufPointer[i+j];
        if not FPara.MatchCase then Ch := CharUpperCase(Ch);

        if FindStr[j+1] <> Ch then
        begin
          Same := False;
          Break;
        end;
      end;

      if Same then
      begin
        FResultOffset := i;
        FResultForm := Frm;
        Result := True;
        Exit;
      end;
    end; //for i
  end;
  FResultOffset := -1;
  FResultForm := nil;
  Result := False;
end;

function TSearchTextMgr.GetNotFoundMsg: string;
begin
  Result := '没找到文本“' + FPara.Text + '”，搜索完毕。';
end;

{ TSearchHexMgr }

function TSearchHexMgr.Search(FromCur: Boolean): Boolean;
var
  i, j, Len, FrmIdx: Integer;
  FromFrmIdx, ToFrmIdx, FromOffset, ToOffset: Integer;
  FindStr: string;
  Frm: THexChForm;
  Same: Boolean;