ewbtools.pas

Delphi VCL Component Pack

begin
   if not DocumentLoaded(ControlInterface.Document) then
      Exit;
   if HideSetup then
      ControlInterface.ExecWB(OLECMDID_PRINTPREVIEW, OLECMDEXECOPT_DONTPROMPTUSER, vaIn, vaOut) //jerzy
   else
      ControlInterface.ExecWB(OLECMDID_PRINTPREVIEW, OLECMDEXECOPT_PROMPTUSER, vaIn, vaOut);
   Preview_HWND := 0;
   StartTime := GetTickCount;
   repeat
      App_HWND := GetForegroundWindow();
      GetClassName(App_HWND, ClassName, SizeOf(ClassName));
      if lstrcmp(@ClassName[0], @IE_PPREVIEWCLASS[1]) = 0 then
         Preview_HWND := App_HWND;
      Forms.Application.ProcessMessages;
      EndTime := GetTickCount;
   until (Preview_HWND <> 0) or (EndTime - StartTime > 6000);
   if Preview_HWND <> 0 then
      ShowWindow(Preview_HWND, nCmdShow);
end;

procedure PageSetup(Document: IDispatch; UsePrintOptions, PrintOptionsEnabled: Boolean; var InvokingPageSetup: Boolean);
var
   vaIn, vaOut: OleVariant;
begin
   if DocumentLoaded(Document) then
      begin
         if PrintOptionsEnabled and UsePrintOptions then
            InvokingPageSetup := True;
         InvokeCmd(Document, False, OLECMDID_PAGESETUP, OLECMDEXECOPT_DODEFAULT, vaIn, vaOut);
      end;
end;

procedure PrintSetup(ControlInterface: IWebBrowser2; HideSetup: Boolean);
var
   vaIn, vaOut: OleVariant;
begin
   if DocumentLoaded(ControlInterface.Document) then
      begin
         if HideSetup then
            ControlInterface.ExecWB(OLECMDID_PAGESETUP, OLECMDEXECOPT_DONTPROMPTUSER, vaIn, vaOut)
         else
            ControlInterface.ExecWB(OLECMDID_PAGESETUP, OLECMDEXECOPT_PROMPTUSER, vaIn, vaOut)
      end;
end;

procedure GetPrintValues(WebBrowser: TEmbeddedWB; PrintOptions: TPrintOptions; Measure: TMeasure);
var
   S: string;
   registry: TRegistry;

   function ReadMargin(key: string): Real;
   begin
      S := registry.ReadString(key);
      if S = '' then
         S := '0.750000'; // <-- default margin value  by takeru_tk_81
      S := StringReplace(S, ' ', '', [rfReplaceAll]);
      if DecimalSeparator <> '.' then
         S := StringReplace(S, '.', DecimalSeparator, []);
      if Measure = mMetric then
         Result := StrToFloat(S) * InchToMetric
      else
         Result := StrToFloat(S);
   end;

begin
   registry := TRegistry.Create;
   try
      with registry do
         begin
            RootKey := HKEY_CURRENT_USER;
            if OpenKey('Software\Microsoft\Internet Explorer\PageSetup', False) then
               begin
                  with PrintOptions do
                  begin
                  Header := ReadString('header');
                  Footer := ReadString('footer');
                  Margins.Left := ReadMargin('margin_left');
                  Margins.Right := ReadMargin('margin_right');
                  Margins.Top := ReadMargin('margin_top');
                  Margins.Bottom := ReadMargin('margin_bottom');
                  end;
               end;
            Registry.Free;
         end;
   except
      if WebBrowser.MessagesBoxes.InternalErrMsg then
         MessageDlg('Error while getting page print values from the registry!', mtError, [mbOK], 0);
   end;
end;

function PrintMarginStr(Measure, RuntimeMeasure: TMeasure; M: Real): PChar;
var
   s: string;
begin
   if Measure <> RuntimeMeasure then
      begin
         if RuntimeMeasure = mMetric then
            s := FloatToStr(M * InchToMetric)
         else
            s := FloatToStr(M / InchToMetric);
         Result := PChar(s);
      end
   else
      Result := PChar(FloatToStr(M));
end;

procedure OpenDialog(WebBrowser: TEmbeddedWB; AOwner: TComponent);
var
   OD: TOpenDialog;
begin
   OD := TOpenDialog.Create(AOwner);
   try
    with OD do
      begin
          Filter :='Internet Files|*.htm; *.html; *.url; *.mht; *.mhtml; *.php *.asp'
          +#10+#13+'|Image Files| *.gif;*.bmp;*.ico;*.jpg;*.png;*.wmf; *.emf; '
          +#10+#13+'|Text & Documents Files| *.txt;*.doc;*.xls;*.dot;'
          +#10+#13+'|Compressed Files| *.zip;'
          +#10+#13+'|XML Files| *.xml;'
          +#10+#13+'|Any Files|*.*';
          Options := Options + [ofShowHelp, ofEnableSizing];
          Title := 'Browser - Open Dialog';
          HelpContext := 0;
        if Execute then
           WebBrowser.Go(OD.FileName);
     end;
   finally
      OD.Free;
   end;
end;

function SaveDialog(WebBrowser: TEmbeddedWB; AOwner: TComponent): string;
var
   SD: TSaveDialog;
begin
   SD := TSaveDialog.Create(AOwner);
   try
    with SD do
      begin
          Filter :='Internet Files|*.htm; *.html;*.mht; *.mhtml; *.php *.asp'
          +#10+#13+'|Text & Documents Files| *.txt;*.doc;*.xls;*.dot;'
          +#10+#13+'|XML Files| *.xml;'
          +#10+#13+'|Any Files|*.*';
          Options := Options + [ofShowHelp, ofEnableSizing];
          Title := 'Browser - Save Dialog';
          HelpContext := 0;
        if Execute then
           Result := SD.FileName;
           if SD.FileName <> '' then            
              SaveToFile(WebBrowser.Document, SD.FileName);
     end;
   finally
      SD.Free;
   end;
end;

procedure SaveDialog(Document: IDispatch);
var
   vaIn, vaOut: OleVariant;
begin
   InvokeCmd(Document, False, OLECMDID_SAVEAS, OLECMDEXECOPT_DODEFAULT, vaIn, vaOut);
end;

procedure ShowInternetOptions(Document: IDispatch);
var
   vaIn, vaOut: OleVariant;
begin
   InvokeCmd(Document, True, HTMLID_OPTIONS, 0, vaIn, vaOut);
end;

procedure ShowPageProperties(Document: IDispatch);
var
   vaIn, vaOut: OleVariant;
begin
   InvokeCmd(Document, False, OLECMDID_PROPERTIES, OLECMDEXECOPT_DODEFAULT, vaIn, vaOut);
end;

procedure ShowOrganizeFavorites(Handle: THandle);
begin
   OrganizeFavorite(Handle, GetSpecialFolderPath(Handle, CSIDL_FAVORITES));
end;

procedure ShowImportExportFavoritesAndCookies(Handle: THandle);
begin
   SendMessage(Handle, WM_COMMAND, ID_IE_FILE_IMPORTEXPORT, 0);
end;

procedure ShowFindDialog(Document: IDispatch);
var
   vaIn, vaOut: OleVariant;
begin
   InvokeCmd(Document, True, HTMLID_FIND, 0, vaIn, vaOut);
end;

procedure SaveImagesDialog(OleObject: Variant; Document: IDispatch);
var
   k, p: Integer;
   path, Source, dest, ext: string;
begin
   if DocumentLoaded(Document) then
      begin
 //        path := TBrowse4Folder.('Web Browser - Please select a destination folder' + #10 + #13
  //          + 'for the images', 'Desktop');
         MessageDlg(Path, mtCustom, [mbYes, mbAll, mbCancel], 0);
         begin
            for k := 0 to OleObject.Document.Images.Length - 1 do
               begin
                  Source := OleObject.Document.Images.Item(k).Src;
                  p := LastDelimiter('.', Source);
                  ext := UpperCase(System.Copy(Source, p + 1, Length(Source)));
                  if (ext = 'GIF') or (ext = 'JPG') or (ext = 'BMP') or (ext = 'PNG') then
                     begin
                        p := LastDelimiter('/', Source);
                        dest := path + '/Images' + System.Copy(Source, p + 1, Length(Source));
                        DownloadFile(Source, dest);
                     end;
               end;
         end;
      end;
end;

procedure OpenOtherWBFavorites(WebBrowser: TEmbeddedWB);
begin
   if FileExists('c:\' + 'newbook.htm') then
      WebBrowser.Go('c:\newbook.htm')
   else
      if WebBrowser.MessagesBoxes.InternalErrMsg then
         MessageDlg('The file cannot be located.'
            + #10 + #13 + 'Please use "Open URL" in the toolbar to locate the file', mtCustom, [mbOK], 0);
end;

procedure ViewPageSourceHtml(Document: IDispatch);
var
   vaIn, vaOut: OleVariant;
begin
   InvokeCmd(Document, True, HTMLID_VIEWSOURCE, 0, vaIn, vaOut);
end;

procedure SavePageTextDialog(AOwner: TComponent; OleObject: Variant; Document: IDispatch);
var
   sd: TSaveDialog;
   textStr: TStringList;
begin
   textstr := TStringList.Create;
   try
      if DocumentLoaded(Document) then
         textStr.Add(VarToStr(OleObject.Document.documentElement.innerText));
      begin
         sd := TSaveDialog.Create(AOwner);
         try
            sd.Filter := 'Text file|*.txt|Word file|*.doc';
            sd.DefaultExt := 'txt';
            sd.FilterIndex := 1;
            sd.FileName := 'WebSiteText.txt';
            sd.Title := 'Web Site Text';
            if sd.Execute then
               begin
                  textStr.SaveToFile(sd.FileName);
               end;
         finally
            sd.Free;
         end;
      end;
   finally
      textStr.Free;
   end;
end;

procedure OpenOutlookMail;
begin
   ShellExecute(Application.Handle, 'open', PChar('outlook.exe'), nil, nil, SW_SHOW);
end;

procedure OpenOutlookExpressMail;
begin
   ShellExecute(Application.Handle, 'open', PChar('msimn.exe'), nil, nil, SW_SHOW);
end;

procedure OpenEudoraMail;
begin
   ShellExecute(Application.Handle, 'open', PChar('eudora.exe'), nil, nil, SW_SHOW);
end;

procedure OpenRegistryEditor;
begin
   ShellExecute(Application.Handle, 'open', PChar('regedit.exe'), nil, nil, SW_SHOW);
end;

function OpenNewsClient: Boolean;
begin
   result := OpenClient('News');
end;

procedure OpenAddressBook;
begin
   ShellExecute(Application.Handle, 'open', PChar('wab.exe'), nil, nil, SW_SHOW);
end;

function OpenCalendar: Boolean;
begin
   result := OpenClient('Calendar');
end;

function OpenNetMeeting: Boolean;
begin
   result := OpenClient('Internet Call');
end;

procedure DoExploreFolder(Handle: THandle; Path: string);
begin
   ShellExecute(handle, 'explore', PChar(path), nil, nil, SW_SHOWNORMAL);
end;

procedure OpenIEBrowserWithAddress(Handle: THandle);
begin
   SendMessage(Handle, WM_COMMAND, ID_IE_FILE_NEWWINDOW, 0);
end;

function OpenHotmailMail(WebBrowser: TEmbeddedWB): Boolean;
begin
   Result := True;
   Go(WebBrowser, 'http://lc1.law5.hotmail.passport.com/cgi-bin/login');
end;

function OpenGoogleMail(WebBrowser: TEmbeddedWB): Boolean;
begin
   Result := True;
   Go(WebBrowser, 'http://mail.google.com/mail/');
end;

function OpenYahooMail(WebBrowser: TEmbeddedWB): Boolean;
begin
   Result := True;
   Go(WebBrowser, 'http://mail.yahoo.com/');
end;

procedure GoSearchInGoogle(WebBrowser: TEmbeddedWB; SearchTerm: string);
const
   GOOGLE_QUERY = 'http://www.google.com/search?ie=ISO-8859-1&hl=de&q=';
var
   sQuery: string;
begin
   sQuery := GOOGLE_QUERY + SearchTerm;
   Go(WebBrowser, sQuery);
end;

procedure GoSearchInMSN(WebBrowser: TEmbeddedWB; SearchTerm: string);
const
   MSN_QUERY = 'http://search.msn.com/previewx.aspx?q=';
   MSN_Const = '&FORM=CBPW&first=1&noredir=1';
var
   sQuery: string;
begin
   sQuery := MSN_QUERY + SearchTerm + MSN_Const;
   Go(WebBrowser, sQuery);
end;

procedure GoSearchInYahoo(WebBrowser: TEmbeddedWB; SearchTerm: string);
const
   YAHOO_QUERY = 'http://search.yahoo.com/bin/search?p=';
var
   sQuery: string;
begin
   sQuery := YAHOO_QUERY + SearchTerm;
   WebBrowser.Go(sQuery);
end;

procedure Go(WebBrowser: TEmbeddedWB; Url: string);
var
   _URL, Flags, TargetFrameName, PostData, Headers: OleVariant;
begin
   _URL := Url;
   Flags := 0;
   TargetFrameName := 0;
   Postdata := 0;
   Headers := 0;
   if (Trim(_URL) <> '') then
      WebBrowser.Navigate2(_URL, Flags, TargetFrameName, PostData, Headers);
end;

procedure GoWithQueryDetails(WebBrowser: TEmbeddedWB; Url, Query: string);
var
   _URL, Flags, TargetFrameName, PostData, Headers: OleVariant;
begin
   _URL := Url + Query;
   TargetFrameName := 0;
   headers := StringtoVarArray('Content-Type:application/x-www-form-urlencoded'#13#10);
   Postdata := StringToVarArray('version=current&name=myname' + #13#10);
   Flags := 0;
   WebBrowser.Navigate2(_URL, Flags, TargetFrameName, PostData, Headers);
end;