demo.pas

delphi老牌的浏览器控件

      procedure SetDesignModeClick(Sender: TObject);
      procedure EmbeddedWB2CommandStateChange(ASender: TObject; Command: Integer;
         Enable: WordBool);
      procedure sbConnectClick(Sender: TObject);
      procedure sbUpClick(Sender: TObject);
      procedure sbRefreshClick(Sender: TObject);
      procedure EmbeddedWB1SetSecureLockIcon(ASender: TObject;
         SecureLockIcon: Integer);
      procedure CheckURLsFromALinkList1Click(Sender: TObject);
      procedure CheckTheLinksClick(Sender: TObject);
      procedure RadioButton2Click(Sender: TObject);
      procedure RadioButton1Click(Sender: TObject);
      procedure IEDownload1Complete(Sender: TBSCB; Stream: TStream;
         Result: HRESULT);
      function IEDownload1Response(Sender: TBSCB; dwResponseCode: Cardinal;
         szResponseHeaders, szRequestHeaders: PWideChar;
         out szAdditionalRequestHeaders: PWideChar): HRESULT;
      procedure Button1Click(Sender: TObject);
      procedure FavoritesTree1NodeAdded(Sender: TObject; const aNode: TTreeNode;
         aNodeType: TNodeType);
      procedure FavoritesTree1Expanded(Sender: TObject; Node: TTreeNode);
      procedure CheckPageSecurityEncryption1Click(Sender: TObject);
      procedure CheckSiteSecurityZone1Click(Sender: TObject);
      procedure CheckSiteSecurityLevel1Click(Sender: TObject);
      procedure CheckIfInTrustedZoneList1Click(Sender: TObject);
      procedure AddToTrustedListZoneList1Click(Sender: TObject);
      procedure CheckIfInResrictedZoneList1Click(Sender: TObject);
      procedure AddToRestrictedZoneListClick(Sender: TObject);
      procedure AddTheSiteToTheList1Click(Sender: TObject);
      procedure AddToFavorites1Click(Sender: TObject);
      procedure btnGoClick(Sender: TObject);
      procedure CharSetAutomatic1Click(Sender: TObject);
      procedure checkOnlineStatus2Click(Sender: TObject);
      procedure ClearAddressBarTypedURLs1Click(Sender: TObject);
      procedure ClearCache1Click(Sender: TObject);
      procedure ClearTheLinkList1Click(Sender: TObject);
      procedure CookiesCheck1Click(Sender: TObject);
      procedure CopyClick(Sender: TObject);
      procedure CreateAShortCutOnYourDeskTop1Click(Sender: TObject);
      procedure CreateNewMail1Click(Sender: TObject);
      procedure Cut1Click(Sender: TObject);
      procedure DeleteHistory1Click(Sender: TObject);
      procedure EmbeddedWB1BeforeNavigate2(ASender: TObject; const pDisp: IDispatch;
         var URL, Flags, TargetFrameName, PostData, Headers: OleVariant; var Cancel: WordBool);
      procedure EmbeddedWB1CommandStateChange(ASender: TObject; Command: Integer;
         Enable: WordBool);
      procedure EmbeddedWB1DocumentComplete(ASender: TObject; const pDisp: IDispatch;
         var URL: OleVariant);
      procedure EmbeddedWB1DownloadBegin(Sender: TObject);
      procedure EmbeddedWB1DownloadComplete(Sender: TObject);
      procedure EmbeddedWB1FullScreen(ASender: TObject; FullScreen: WordBool);
      procedure EmbeddedWB1NavigateComplete2(ASender: TObject; const pDisp: IDispatch;
         var URL: OleVariant);
      procedure EmbeddedWB1NewWindow2(ASender: TObject; var ppDisp: IDispatch;
         var Cancel: WordBool);
      procedure EmbeddedWB1ProgressChange(ASender: TObject; Progress, ProgressMax: Integer);
      procedure EmbeddedWB1PropertyChange(ASender: TObject; const szProperty: WideString);
      procedure EmbeddedWB1StatusTextChange(ASender: TObject; const Text: WideString);
      procedure EmbeddedWB1TitleChange(ASender: TObject; const Text: WideString);
      procedure EmbeddedWB1Unload(Sender: TObject);
      procedure EmbeddedWB1Visible(ASender: TObject; Visible: WordBool);
      procedure Exit1Click(Sender: TObject);
      procedure ExportFavorites1Click(Sender: TObject);
      procedure FillFormWithPersonalDetails1Click(Sender: TObject);
      procedure FindDialogClick(Sender: TObject);
      procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
      procedure FormCreate(Sender: TObject);
      procedure FormDestroy(Sender: TObject);
      procedure FormShow(Sender: TObject);
      procedure GetAScreanCapture1Click(Sender: TObject);
      procedure GetCachedPathClick(Sender: TObject);
      procedure GetCookiesPath1Click(Sender: TObject);
      procedure GetDefaultWebBrowserFromResistry1Click(Sender: TObject);
      procedure GetFavoritesPath1Click(Sender: TObject);
      procedure GetHistoryPath1Click(Sender: TObject);
      procedure GetHostAndIP1Click(Sender: TObject);
      procedure GetIEHomePageClick(Sender: TObject);
      procedure GetJpegPageCapture1Click(Sender: TObject);
      procedure GetSpecialFolderPath1Click(Sender: TObject);
      procedure GetThumbnailClick(Sender: TObject);
      procedure GoAboutBlank1Click(Sender: TObject);
      procedure GoDowloadMasked1Click(Sender: TObject);
      procedure Godownloadafile1Click(Sender: TObject);
      procedure GoWithQueryDetails1Click(Sender: TObject);
      procedure IEAddress1KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
      procedure ImportExportWizard1Click(Sender: TObject);
      procedure ImportFavorites1Click(Sender: TObject);
      procedure InternetOptions1Click(Sender: TObject);
      procedure LoadFromStreamClick(Sender: TObject);
      procedure LoadFromStringsClick(Sender: TObject);
      procedure NavigateToLinkItem1Click(Sender: TObject);
      procedure OfflineMode1Click(Sender: TObject);
      procedure OpenAddressBook1Click(Sender: TObject);
      procedure OpenCalender1Click(Sender: TObject);
      procedure OpenClick(Sender: TObject);
      procedure OpenFoldersExplore1Click(Sender: TObject);
      procedure OpenGoogleMail1Click(Sender: TObject);
      procedure OpenHotmailMail1Click(Sender: TObject);
      procedure OpenMailClient1Click(Sender: TObject);
      procedure OpenNetMeetingClick(Sender: TObject);
      procedure OpenNewsClient1Click(Sender: TObject);
      procedure OpenOtherBrowsersFavorites1Click(Sender: TObject);
      procedure OpenOutlook1Click(Sender: TObject);
      procedure OpenOutlookExpress1Click(Sender: TObject);
      procedure OpenRegistryEditor1Click(Sender: TObject);
      procedure OpenYahooMail1Click(Sender: TObject);
      procedure PageCtrlChange(Sender: TObject);
      procedure PageSetup1Click(Sender: TObject);
      procedure PageSourceHtmlasstrings1Click(Sender: TObject);
      procedure PageSourceTextasstrings1Click(Sender: TObject);
      procedure PageSourceTextClick(Sender: TObject);
      procedure Pastefromclipboard1Click(Sender: TObject);
      procedure PrintClick(Sender: TObject);
      procedure PrintPreview1Click(Sender: TObject);
      procedure PrintWithOptionsClick(Sender: TObject);
      procedure PropertiesClick(Sender: TObject);
      procedure RemoveTheSiteFromTheList1Click(Sender: TObject);
      procedure SaveAllImagesClick(Sender: TObject);
      procedure SaveAs1Click(Sender: TObject);
      procedure SavepagetextClick(Sender: TObject);
      procedure SavePageToStreamClick(Sender: TObject);
      procedure SavePageToStrings1Click(Sender: TObject);
      procedure SaveThePageTofile1Click(Sender: TObject);
      procedure sbRebuildViewClick(Sender: TObject);
      procedure Scrolltothebottom1Click(Sender: TObject);
      procedure ScrollToTheTop1Click(Sender: TObject);
      procedure ScrolToPosition1Click(Sender: TObject);
      procedure SearchImMsn1Click(Sender: TObject);
      procedure SearchInGoogle1Click(Sender: TObject);
      procedure SearchInYahoo1Click(Sender: TObject);
      procedure SelectAllClick(Sender: TObject);
      procedure SendThePageInMail1Click(Sender: TObject);
      procedure SendTheURLClick(Sender: TObject);
      procedure SetIENewHomePageClick(Sender: TObject);
      procedure ShowInternetExplorerVersion1Click(Sender: TObject);
      procedure ShowOrganizeFavorites1Click(Sender: TObject);
      procedure ShowTheList1Click(Sender: TObject);
      procedure Smallest1Click(Sender: TObject);
      procedure spdBtnGoogleSearchClick(Sender: TObject);
      procedure ToolBtnAccesoriesClick(Sender: TObject);
      procedure ToolbtnBackClick(Sender: TObject);
      procedure ToolBtnForwardClick(Sender: TObject);
      procedure ToolBtnHomeClick(Sender: TObject);
      procedure ToolBtnRefreshClick(Sender: TObject);
      procedure ToolBtnSearchClick(Sender: TObject);
      procedure ToolBtnStopClick(Sender: TObject);
      procedure ViewHidethelinksbar1Click(Sender: TObject);
      procedure ViewHideTheLinksToolbar1Click(Sender: TObject);
      procedure ViewPageFieldsAsAList1Click(Sender: TObject);
      procedure ViewPageImagesAsAList1Click(Sender: TObject);
      procedure ViewPageLinksAsAList1Click(Sender: TObject);
      procedure ViewPagePropertiesAsAList1Click(Sender: TObject);
      procedure ViewSourceHtmlClick(Sender: TObject);
      procedure Zoom1Click(Sender: TObject);
    procedure edtSearchDblClick(Sender: TObject);
   private
      Links: TStringlist;
      EncryptionSt: string;
      InitialURL: WideString;
      procedure AddEventLog(s: string);
      procedure UpdateSecurityZone;
      procedure UpdateSSLStatus;
      procedure UpdateStopButton;
      procedure UpdateControls;
      procedure UpdateEditor;
      procedure UpdateImage;
      procedure UpdateView;
      procedure ClearResultsGrid;
      procedure ClearAllGrid;
      procedure UpdateLinksChecker;
      procedure UpdateProgressBars;
   end;

var
   frmMain: TfrmMain;

implementation

{$R *.dfm}

//////////////////{ Private Section } //////////////////

procedure TfrmMain.UpdateProgressBars;
begin
   ProgressBar2.Max := RichEditWB1.GetLineCount;
   ProgressBar2.Position := RichEditWB1.CursorPositionY;
   ProgressBar3.Max := RichEditWB1.GetLineLength(RichEditWB1.CursorPositionY);
   ProgressBar3.Position := RichEditWB1.CursorPositionX;
end;

procedure TfrmMain.UpdateSecurityZone;
var
   Name, Description: string;
   Icon: TIcon;
begin
   Icon := TIcon.Create;
   EmbeddedWB1.GetURLSecurityZone(Name, Description, Icon);
   stBar.Panels[1].Text := Name;
   stBar.Hint := Description;
   lblZone.Caption := Name;
   lblZone.Hint := Description;
   imgZone.Picture.Icon := Icon;
   imgZone.Hint := 'The Web SIte Security Zone Is ' + Name;
   Forms.Application.Icon := Icon;
   Icon.Free;
end;

procedure TfrmMain.UpdateSSLStatus;
var
   SSLName, SSLDescription: string;
begin
   if EmbeddedWB1.GetSSLStatus(SSLName, SSLDescription) then
      begin
         ImgUn.Visible := false;
         imgSSl.Visible := true;
         stBar.Panels[2].Text := SSLName;
         stBar.Hint := SSLDescription;
         lblSSL.Caption := SSLName;
         lblSSL.Hint := SSLDescription;
         imgSSL.Hint := 'The Page SSL Security Status Is ' + SSLName;
      end
   else
      begin
         ImgUn.Visible := true;
         stBar.Panels[2].Text := '';
         stBar.Hint := '';
         lblSSL.Caption := '';
         lblSSL.Hint := '';
         imgSSl.Visible := false;
         imgSSL.Hint := '';
      end;
end;

procedure TfrmMain.AddEventLog(s: string);
begin
   lvEventLog.ItemIndex := lvEventLog.Items.Add(s);
end;

procedure TfrmMain.UpdateView;
begin
   case pagectrl.ActivePageIndex of
      0: FavoritesListView1.Loaded;
      1: FavoritesTree1.Refresh;
      2: HistoryListView1.Loaded;
      4: EmbeddedWB2.Navigate('c:\');
   end
end;

procedure TfrmMain.UpdateEditor;
begin
   pctrlWB.Pages[1].TabVisible := true;
   pctrlWB.ActivePage := TabEditor;
end;

procedure TfrmMain.UpdateLinksChecker;
begin
   pctrlWB.Pages[3].TabVisible := true;
   pctrlWB.ActivePage := TabLinks;
end;

procedure TfrmMain.UpdateImage;
begin
   pctrlWB.Pages[2].TabVisible := true;
   pctrlWB.ActivePage := TabImage;
end;

procedure TfrmMain.UpdateStopButton;
begin
   if EmbeddedWB1.Busy then
      begin
         ToolBtnStop.Enabled := true;
         Stop1.Enabled := true;
      end
   else
      begin
         ToolBtnStop.Enabled := false;
         Stop1.Enabled := false;
      end;
end;

procedure TfrmMain.UpdateControls;
begin
{while EmbeddedWB1.ReadyState <> READYSTATE_COMPLETE do
  begin
    Application.ProcessMessages;
    Sleep(0);
  end; }
   if EmbeddedWB1.Busy then
      EmbeddedWB1.Stop;
end;

procedure TfrmMain.ClearResultsGrid;
var
   X, y: Integer;
begin
   for x := 1 to Links.Count do
      for y := 1 to 2 do
         Stringgrid1.Cells[y, x] := '';
end;

procedure TfrmMain.ClearAllGrid;
var
   X, y: Integer;
begin
   for x := 1 to Links.Count do
      for y := 0 to 2 do
         Stringgrid1.Cells[y, x] := '';
end;

////////////{ End of private section } ///////////

//////////////////{ Form procedures section} //////////////////

procedure TfrmMain.FormDestroy(Sender: TObject);
begin
   Links.Free;
   HistoryMenu.Free;
end;

procedure TfrmMain.FormCreate(Sender: TObject);
var
   UrlList: TStringList;
begin
// RichEditWB1.RTFText := '{\rtf1\ansi\deff0{\fonttbl{\f0\fnil Tahoma;}}{\colortbl ;\red0\green0\blue0;}\viewkind4\uc1\pard\cf1\lang2055\f0\fs16\par}';

{$IFDEF DELPHI_7_UP}
   TxpManifest.Create(FrmMain);
{$ENDIF}
   HistoryMenu.CreateMenu;
   FavoritesMenu1.CreateMenu;
   UrlList := TStringList.Create;
   Links := TStringlist.create;
   try
      if FileExists('links.txt') then
         Links.LoadFromFile('links.txt');
      LinksBar1.GetTheLinksURLs(UrlList);
      Links.Add('');
      Links.AddStrings(UrlList);
   finally
   end;
   UrlList.Free;
end;

procedure TfrmMain.FormShow(Sender: TObject);
var
   LastVisitedPage: string;
   i: Integer;
begin
{$IFDEF DELPHI_9_UP}
   EmbeddedWB1.OnSetSecureLockIcon := EmbeddedWB1SetSecureLockIcon;
{$ENDIF}
   EmbeddedWB2.Navigate('c:\');
   Stringgrid1.Cells[0, 0] := 'Url';
   Stringgrid1.Cells[1, 0] := 'Status';
   Stringgrid1.Cells[2, 0] := 'Result';
   for i := 0 to links.count - 1 do
      begin
         Stringgrid1.RowCount := i + 2;
         Stringgrid1.Cells[0, i + 1] := links[i];
      end;
   pctrlWB.ActivePage := TabBrowser;
   EmbeddedWB1.RestoreApplicationFormSize;
   if EmbeddedWB1.GetLastVisitedPage(LastVisitedPage) and
      (Pos('http', LastVisitedPage) > 0) then
      EmbeddedWB1.Navigate(LastVisitedPage)
   else
      EmbeddedWB1.GoHome;
end;

procedure TfrmMain.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
   EmbeddedWB1.SaveLastVisitedPage;
   EmbeddedWB1.SaveApplicationFormSize;
   UpdateControls;
   if FileExists(ExtractFilePath(ParamStr(0)) + 'Site.html') then
      DeleteFile('Site.html');
   CanClose := not EmbeddedWB1.Busy;
end;
//////////////////{End of Form procedures section } //////////////////

procedure TfrmMain.sbRebuildViewClick(Sender: TObject);
begin
   UpdateView();
end;

procedure TfrmMain.OpenClick(Sender: TObject);
begin
   EmbeddedWB1.OpenDialog;
end;

procedure TfrmMain.PrintClick(Sender: TObject);
begin
   EmbeddedWB1.Print;
end;

procedure TfrmMain.PrintPreview1Click(Sender: TObject);
begin
   EmbeddedWB1.PrintPreView;
end;

procedure TfrmMain.PageSetup1Click(Sender: TObject);
begin
   EmbeddedWB1.PrintSetup;
end;

procedure TfrmMain.PropertiesClick(Sender: TObject);
begin
   EmbeddedWB1.ShowPageProperties;
end;

procedure TfrmMain.OfflineMode1Click(Sender: TObject);
begin
   if OfflineMode1.Checked then
      EmbeddedWB1.WorkOffline
   else
      EmbeddedWB1.WorkOnline;
end;

procedure TfrmMain.Exit1Click(Sender: TObject);
begin