main.pas

Delphi编写 IE搜索工具条 应用bho技术

unit Main;

interface

uses
  Windows, Messages, SysUtils, Classes, Controls, Forms, StdCtrls, Buttons, ExtCtrls,
  SHDocVw, OleCtrls, Menus, IniFiles, ComCtrls, { Shellapi,}
  Setting, DMU,
  RzButton, RzCommon, RzCmboBx;

type
  TFrmMain = class(TForm)
    PanelRight: TPanel;
    PanelLeft: TPanel;
    CbKey: TRzComboBox;
    MenuController: TRzMenuController;
    MenuBtn: TRzToolButton;
    CmdSearch: TRzToolButton;
    CmdSet: TRzToolButton;
    PopupMenu: TPopupMenu;
    procedure FormResize(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure CmdSetClick(Sender: TObject);
    procedure CmdSearchClick(Sender: TObject);
    procedure CbKeyKeyUp(Sender: TObject; var Key: Word;
      Shift: TShiftState);
  private
    SH: Boolean; //是否保存搜索历史记录
    Ini: TIniFile;
    procedure GoUrl(const Url: string);
    procedure GetSearchEngine;
    procedure SearchHistoryData(Format: Boolean);
    procedure PopupClick(Sender: TObject);
  public
    IEThis: IWebbrowser2;
  end;

var
  FrmMain: TFrmMain;

implementation

{$R *.dfm}
function Replace(const S, OldPattern, NewPattern: string): string;
begin
  result := stringreplace(Trim(S), OldPattern, NewPattern, [rfReplaceAll, rfIgnoreCase]);
end;

function GetDllPath(): string;
var ModuleName: string;
begin
  SetLength(ModuleName, 260);
  GetModuleFileName(HInstance, PChar(ModuleName), Length(ModuleName));
  result := ModuleName;
end;

procedure TFrmMain.GoUrl(const Url: string);
begin
  //ShellExecute(Handle,'Open',PChar(Url),Nil,Nil,Nil,0);
  IEThis.Navigate(WideString(Url), EmptyParam, EmptyParam, EmptyParam, EmptyParam);
end;

//获取搜索引擎列表
procedure TFrmMain.GetSearchEngine;
var SearchEngine: TStringList;
  i: Integer;
  MenuItem: TMenuItem;
begin
  SearchEngine := TStringList.Create;
  try
    Ini.ReadSectionValues('SearchEngine', SearchEngine);
    PopupMenu.Items.Clear;
    for i := 0 to SearchEngine.Count - 1 do
    begin
      MenuItem := TMenuItem.Create(self);
      MenuItem.Caption := Copy(SearchEngine.Strings[i], 1, Pos('=', SearchEngine.Strings[i]) - 1);
      MenuItem.Hint := Ini.ReadString('SearchEngine', MenuItem.Caption, '');
      MenuItem.RadioItem := true;
      MenuItem.OnClick := self.PopupClick;
      PopupMenu.Items.Add(MenuItem);
    end;
  finally
    SearchEngine.Free;
  end;
  PopupClick(TObject(PopupMenu.Items[Ini.ReadInteger('Config', 'DefaultSE', 0)]));
end;

procedure TFrmMain.SearchHistoryData(Format: Boolean);
var i: Integer;
  MS: TStrings;
begin
  MS := TStringList.Create;
  try
    if SH then
    begin
      Ini.ReadSection('SearchHistory', MS);
      for i := 0 to MS.Count - 1 do
        CbKey.Items.Add(MS[i]);
    end else
    begin

    end;
  finally
    MS.Free;
  end;
end;

procedure TFrmMain.PopupClick(Sender: TObject);
begin
  CmdSearch.Hint := TMenuItem(Sender).Hint;
  TMenuItem(Sender).Checked := true;
end;

procedure TFrmMain.FormResize(Sender: TObject);
begin
  CbKey.Left := 5;
  CbKey.top := (self.ClientHeight - CbKey.height) div 2;
  CbKey.Width := PanelLeft.Width - 10;
  CmdSearch.Left := 5;
  CmdSearch.top := (self.ClientHeight - CmdSearch.height) div 2;
  MenuBtn.Left := CmdSearch.Left + CmdSearch.Width;
  MenuBtn.top := (self.ClientHeight - MenuBtn.height) div 2;
  CmdSet.Left := MenuBtn.Left + MenuBtn.Width + 5;
  CmdSet.top := (self.ClientHeight - CmdSet.height) div 2;
end;

procedure TFrmMain.FormCreate(Sender: TObject);
begin
  application.CreateForm(TDM, DM);
  Ini := TIniFile.Create(ExtractFilePath(GetDllPath) + 'Config.ini');
  SH := Ini.ReadBool('Config', 'IsSaveSearchHistory', false);
  SearchHistoryData(SH);
  GetSearchEngine;
end;

procedure TFrmMain.FormDestroy(Sender: TObject);
begin
  if Assigned(Ini) then Ini.Free;
  if Assigned(DM) then DM.Free;
end;

procedure TFrmMain.CmdSetClick(Sender: TObject);
var F: TFrmSet;
  i: Integer;
  ListItem: TListItem;
begin
  F := TFrmSet.Create(self);
  try
    F.ChkSeHistory.Checked := SH;
    for i := 0 to PopupMenu.Items.Count - 1 do
    begin
      ListItem := F.LVSE.Items.Add;
      ListItem.Caption := PopupMenu.Items[i].Caption;
      ListItem.SubItems.Add(PopupMenu.Items[i].Hint);
    end;
    F.LVSE.Tag := Ini.ReadInteger('Config', 'DefaultSE', 0);
    if F.ShowModal = mrok then
    begin
      SH := F.ChkSeHistory.Checked;
      Ini.WriteBool('Config', 'IsSaveSearchHistory', SH);
      if not SH then CbKey.Items.Clear;
      for i := 0 to PopupMenu.Items.Count - 1 do
        Ini.DeleteKey('SearchEngine', PopupMenu.Items[i].Caption);
      for i := 0 to F.LVSE.Items.Count - 1 do
        Ini.WriteString('SearchEngine', F.LVSE.Items[i].Caption, F.LVSE.Items[i].SubItems.Strings[0]);
      Ini.WriteInteger('Config', 'DefaultSE', F.LVSE.Tag);
      GetSearchEngine;
    end;
  finally
    F.Free;
  end;
end;

procedure TFrmMain.CmdSearchClick(Sender: TObject);
var Url: string;
begin
  Url := Trim(CbKey.Text);
  //if Url = '' then Exit;
  if SH then
    CbKey.Items.Add(Url);
  Url := Replace(Url, '''', '');
  Url := Replace(CmdSearch.Hint, '[%]', Url);
  GoUrl(Url);
end;

procedure TFrmMain.CbKeyKeyUp(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if Key = 13 then CmdSearch.Click;
end;

end.