unit1.pas

来自「全文检索 快速搜寻一般文字档」· PAS 代码 · 共 417 行

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, ExtCtrls, Buttons,  Menus,
  MyRegistryRead, MyRegistryWriter,  Grids, DBGrids, DB, ADODB,
  DBCtrls, Mask;
type
TTextFormat=(tfAnsi,tfUnicode,tfUnicodeBigEndian,tfUtf8);
const
TextFormatFlag:array[tfAnsi..tfUtf8] of word=($0000,$FFFE,$FEFF,$EFBB);　

type
  TMain = class(TForm)
    StatusBar1: TStatusBar;
    SaveDialog1: TSaveDialog;
    Panel1: TPanel;
    Label4: TLabel;
    Label3: TLabel;
    Label2: TLabel;
    Label8: TLabel;
    ComboBox1: TComboBox;
    ComboBox2: TComboBox;
    ComboBox3: TComboBox;
    Button1: TButton;
    CheckBox1: TCheckBox;
    ProgressBar1: TProgressBar;
    Button2: TButton;
    BitBtn1: TBitBtn;
    BitBtn2: TBitBtn;
    BitBtn3: TBitBtn;
    Edit1: TEdit;
    Panel2: TPanel;
    Splitter1: TSplitter;
    ListBox1: TListBox;
    RichEdit1: TRichEdit;
    procedure Button1Click(Sender: TObject);
    procedure BitBtn2Click(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    procedure CheckBox1Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure ComboBox1KeyPress(Sender: TObject; var Key: Char);
    procedure N1Click(Sender: TObject);
    procedure N2Click(Sender: TObject);
    procedure BitBtn3Click(Sender: TObject);
    procedure ListBox1DblClick(Sender: TObject);
//    procedure ReadTextFile(var FileName: string;var TextFormat: TTextFormat; var sText:string);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Main: TMain;
  endloop: boolean;
  subcheck: string;
  vq:string;
  pc,fis: integer;
  alist, blist, clist, dlist: array[0..9] of string;
implementation
uses unit2,unit3, Unit4;

{$R *.dfm}

{  首先，不同編碼的文本，是根據文本的前兩個字節來定義其編碼格式的。定義如下：

  ANSI：　　　　　　　　無格式定義；
  Unicode： 　　　　　　前兩個字節為FFFE；
  Unicode big endian：　前兩字節為FEFF；　
  UTF-8：　 　　　　　　前兩字節為EFBB；　

}
procedure WordLoHiExchange(var w:Word);
var
b:Byte;
begin
  b:=WordRec(w).Lo;
  WordRec(w).Lo:=WordRec(w).Hi;
  WordRec(w).Hi:=b;
end;

{ TextFormat返回文本編碼類型，sText未經處理的文本 }
procedure ReadTextFile( FileName: string;
var TextFormat: TTextFormat; var sText:string);
var
w:Word;
b:Byte;
begin
  with TFileStream.Create(FileName,fmOpenRead or fmShareDenyNone) do
    try
      Read(w,2);
      WordLoHiExchange(w);//因為是以Word數據類型讀取，故高低字節互換
    if w = TextFormatFlag[tfUnicode] then
      TextFormat:= tfUnicode
      else if w = TextFormatFlag[tfUnicodeBigEndian] then
      TextFormat:= tfUnicodeBigEndian
      else if w = TextFormatFlag[tfUtf8] then
      begin
        Read(b,1);//這裡要注意一下，UFT-8必須要跳過三個字節。
      TextFormat:=tfUtf8;
      end else
      begin
        TextFormat:=tfANSI;
        Position:=0;
      end;
      SetLength(sText,Size-Position);
      ReadBuffer(sText[1],Size-Position);
      finally
        Free;
      end;
end;



//搜尋引擎開始

procedure Dirs(path: string; subdir: boolean);
var
  pathdir, temp: string;
  f: tSearchrec;
  i, count, check, posre: integer;
  stlist: tstringlist;
  xx: TTextFormat;
  temp2: string;
begin
  stlist := tstringlist.Create;
  application.ProcessMessages;
  if endloop = true then exit;
  if copy(path, length(path), 1) <> '\' then path := path + '\';
  if findfirst(path + Main.ComboBox3.Text, faanyfile, f) = 0 then
  begin
    case pc of
      0: Main.ProgressBar1.Position := 10;
      1: Main.ProgressBar1.Position := 20;
      2: Main.ProgressBar1.Position := 30;
      3: Main.ProgressBar1.Position := 70;
      4: Main.ProgressBar1.Position := 75;
      5: Main.ProgressBar1.Position := 80;
      6: Main.ProgressBar1.Position := 85;
      7: Main.ProgressBar1.Position := 90;
      8: Main.ProgressBar1.Position := 93;
    end;
    repeat
      if (trim(f.name) <> '.') and (trim(f.name) <> '..') and ((f.Attr and faDirectory) <> faDirectory) then
      begin
        Main.richedit1.SelAttributes.Color := clBlack;
        stlist.LoadFromFile(path + f.Name);       // 讀取檔案

//        ReadTextFile(path + f.Name, xx, temp2);
//        stlist.Text:=temp2;

        COUNT := 0;
        check := 0;
        Main.StatusBar1.Panels[2].Text := '搜尋檔案：' + path + f.Name + '..中';
        if POS(Main.ComboBox1.Text, stlist.Text) > 0 then
        begin
          for I := 0 to stlist.Count - 1 do
          begin
            application.ProcessMessages;

            TEMP := stlist.Strings[i];
            while (TRUE) do begin
              POSRE := POS(Main.ComboBox1.Text, TEMP);
              if POSRE <> 0 then begin
                if check = 0 then
                begin
                  // 紀錄完整路徑
                  Main.ListBox1.Items.Add(path+extractfilename(f.Name));
                  fis:=fis+1;   // 搜尋到符合檔案數 +1
                  unit1.Main.Edit1.Text:=inttostr(fis);
                  // 摘要
                  Main.RichEdit1.Lines.Add('');                                     // extractfilename(
                  Main.richedit1.SelAttributes.Color := clFuchsia;
                  Main.RichEdit1.SelAttributes.Style := [fsbold];
                  Main.RichEdit1.SelAttributes.Size := Main.RichEdit1.SelAttributes.Size + 2;
                  Main.RichEdit1.Lines.Add('--在[' + path + ']資料夾中的--[' + f.Name + ']--檔案發現目標--');
                  Main.RichEdit1.SelStart := Main.RichEdit1.Perform(EM_LINEINDEX, Main.RichEdit1.Lines.Count - 1, 0) + 4;
                  Main.RichEdit1.SelLength := LENGTH(path);
                  Main.RichEdit1.SelAttributes.Color := CLBlue;
                  Main.RichEdit1.SelAttributes.Style := [fsbold];
                  Main.RichEdit1.SelStart := Main.RichEdit1.Perform(EM_LINEINDEX, Main.RichEdit1.Lines.Count - 1, 0) + 13 + LENGTH(path);
                  Main.RichEdit1.SelLength := LENGTH(f.Name);
                  //Main.RichEdit1.SelAttributes.Color := CLGreen;
                  //Main.RichEdit1.SelAttributes.Style := [fsbold];
                  check := 1;
                end;
                //找到的字串換色
                //Main.RichEdit1.SelAttributes.Color := CLRed;

                Main.Richedit1.Lines.Add(inttostr(check)+'.'+temp);
//                Main.RichEdit1.SelAttributes.Style := [fsbold];
                Main.RichEdit1.SelStart := Main.RichEdit1.Perform(EM_LINEINDEX, Main.RichEdit1.Lines.Count , 0) + POSRE ;
                Main.RichEdit1.SelLength := LENGTH(Main.ComboBox1.Text);
                //
                COUNT := COUNT + 1;
                check := check + 1;
                // 同一個檔繼續找下一句
                //略過ComboBox1.Text後的剩餘文字
                TEMP := COPY(TEMP, POSRE + LENGTH(Main.ComboBox1.Text), LENGTH(stlist.Strings[I]) - POSRE);
              end else BREAK;
            end;
          end;
        end;
      end;
    until findnext(f) <> 0;
  end;
  if subdir = true then
  begin
    if findfirst(path + '*.*', $0000001F, f) = 0 then
    begin
      if pc < 7 then pc := pc + 1;
      repeat
        application.ProcessMessages;
        if (trim(f.name) <> '.') and (trim(f.name) <> '..') then
          if f.attr = faDirectory then
            Dirs(path + f.name + '\', subdir);
      until findnext(f) <> 0;
      findclose(f);
    end;
  end;
  stlist.Free;
end;


procedure TMain.Button1Click(Sender: TObject);
begin
  with TForm2.Create(self) do
  try
    ShowModal;
  finally
    free;
  end;
end;

procedure TMain.BitBtn2Click(Sender: TObject);
begin
  endloop := TRUE;
end;

procedure TMain.BitBtn1Click(Sender: TObject);
var
   i, check1, check2: integer;
  FoundAt: LongInt;
  StartPos, ToEnd: Integer;
begin



  if (ComboBox1.Text <> '') and (ComboBox2.Text <> '') then
  begin
    check1 := -1;
    check2 := -1;
    ListBox1.Clear;
    ComboBox1.Items.Clear;
    ComboBox2.Items.Clear;
    blist[0] := ComboBox2.Text;
    dlist[0] := ComboBox1.Text;
    for i := 0 to 9 do
    begin
      if alist[i] = ComboBox2.Text then
        check1 := i;
      if clist[i] = ComboBox1.Text then
        check2 := i;
    end;
    for i := 1 to 9 do
    begin
      if (i <= check1) or (check1 = -1) then
        blist[i] := alist[i - 1];
      if (i > check1) and (check1 <> -1) then
        blist[i] := alist[i];
      if (i <= check2) or (check2 = -1) then
        dlist[i] := clist[i - 1];
      if (i > check2) and (check2 <> -1) then
        dlist[i] := clist[i];
    end;
    for i := 0 to 9 do
    begin
      alist[i] := blist[i];
      clist[i] := dlist[i];
      if alist[i] <> '' then
        ComboBox2.Items.Add(alist[i]);
      if clist[i] <> '' then
        ComboBox1.Items.Add(clist[i]);
    end;
    pc := 0;
    fis:=0;//符合檔案數

    endloop := FALSE;
    richedit1.Lines.Clear;
    ProgressBar1.Visible := true;
    RICHEDIT1.SelAttributes.Color := CLBLUE;
    RICHEDIT1.Lines.Add('=========================================全 文  檢 索============================================');
    RICHEDIT1.SelAttributes.Color := CLBLUE;
    RICHEDIT1.Lines.Add('搜尋字串：' + ComboBox1.Text);
    RICHEDIT1.SelAttributes.Color := CLBLUE;
    RICHEDIT1.Lines.Add('檔案目錄：' + ComboBox2.Text);
    RICHEDIT1.SelAttributes.Color := CLBLUE;
    RICHEDIT1.Lines.Add('副檔名格式：' + ComboBox3.Text);
    RICHEDIT1.SelAttributes.Color := CLBLUE;
    RICHEDIT1.Lines.Add('子目錄搜尋：' + subcheck);
    RICHEDIT1.SelAttributes.Color := CLBLUE;
    RICHEDIT1.Lines.Add('=========================================檢索摘要完畢============================================');


  RichEdit1.Visible:=False;
    dirs(ComboBox2.Text, CheckBox1.Checked);
    Main.ProgressBar1.Position := 95;
    StatusBar1.Panels[1].Text := ('已完成搜尋');
    StatusBar1.Panels[2].Text := ('');
    ProgressBar1.Visible := false;

//      將關鍵字全部標出來
  RichEdit1.SelLength:=0;
        while true do
        begin
          with RichEdit1 do
          begin
            if SelLength=0
            then StartPos :=0
            else StartPos := SelStart + SelLength;

            ToEnd := Length(Text) - StartPos;                //[stWholeWord]
            FoundAt := FindText(Trim(Combobox1.Text), StartPos, ToEnd, [stMatchCase]);
            if FoundAt <> -1 then
            begin
                //找到的字串換色
//              SetFocus;
              SelStart := FoundAt;
              SelLength := Length(Trim(Combobox1.Text));
              SelAttributes.Color := CLRed;
            end
            else
            begin
//               SetFocus;
               SelStart := 0;
               SelLength := 0;
               break; // ShowMessage('找不到相符的文字');
            end;
          end;
        end;

    RichEdit1.Visible:=True;
    RichEdit1.SetFocus;




  end
  else
    showmessage('搜尋字串或搜尋路徑不得為空值');
end;

procedure TMain.CheckBox1Click(Sender: TObject);
begin
  if CheckBox1.Checked = true then
    subcheck := 'Yes';
  if CheckBox1.Checked = false then
    subcheck := 'No';
end;

procedure TMain.FormShow(Sender: TObject);
var i: integer;
  str: string;
begin
  if CheckBox1.Checked = true then
    subcheck := 'Yes';
  if CheckBox1.Checked = false then
    subcheck := 'No';
  ComboBox1.SetFocus;
end;



procedure TMain.ComboBox1KeyPress(Sender: TObject; var Key: Char);
begin
  if key = #13 then
    bitbtn1.Click;
end;

procedure TMain.N1Click(Sender: TObject);
begin
  close;
end;

procedure TMain.N2Click(Sender: TObject);
begin
  ShowMessage('[這是免費軟體，有任何問題可以回報，以利改進。!!]'+#13+#10+#13+#10+'[e-mail]');
end;

procedure TMain.BitBtn3Click(Sender: TObject);
var fs1:string;
begin
  SaveDialog1.InitialDir:='.\';
  SaveDialog1.FileName:=trim(ComboBox1.Text)+'.rtf';
  SaveDialog1.Execute;

  fs1:=Extractfilename(SaveDialog1.FileName);
  if (Trim(fs1)='')
  then ShowMessage('檔 名 空 白 無 法 儲 存!!!')
  else begin
      RichEdit1.Lines.SaveToFile(fs1);
  end;

end;

procedure TMain.ListBox1DblClick(Sender: TObject);
begin
  Form4.hide;
  Form4.Show;
end;

end.