ewbtools.pas

Delphi VCL Component Pack

                  UNum := ElementCo.item(i);
                  s := UNum.href;
                  if j = 0 then
                     s := 'No Links found in the page body';
                  LinksList.Add(s);
               end;
         end;
      HTMLFrames := htmlDoc.Frames;
      j := HTMLFrames.Length - 1;
      for i := 0 to j do
         begin
            HTMLWnd := HTMLFrames.Item(i);
            try
               doc := HTMLWnd.Document;
               RecurseLinks(doc);
            except
               Continue;
            end;
         end;
   end;
begin
   LinksList.Clear;
   if not DocumentLoaded(OleObject.Document) then
      Exit;
   RecurseLinks(OleObject.Document);
end;

procedure ViewPageFieldsToStrings(OleObject: Variant; FieldList: TStrings);
var //by smot
   i, j: Integer;
   FormItem: Variant;
begin
   if not DocumentLoaded(OleObject.Document) then
      Exit;
   FieldList.Clear;
   for I := 0 to OleObject.Document.Forms.Length - 1 do
      begin
         FormItem := OleObject.Document.Forms.Item(I);
         for j := 0 to FormItem.Length - 1 do
            begin
               try
                  FieldList.Add('Name :' + FormItem.Item(j).Name + ' ; ' +
                     'ID :' + FormItem.Item(j).ID + ' ; ' +
                     'TagName :' + FormItem.Item(j).TagName + ' ; ' +
                     'toString :' + FormItem.Item(j).toString + ' ; ' +
                     'innerText :' + FormItem.Item(j).innerText + ' ; ' +
                     'innerHTML :' + FormItem.Item(j).innerHTML);
               except
                  Exit;
               end;
            end;
      end;
end;

procedure ViewPageImagesToStrings(OleObject: Variant; ImagesList: TStrings);
var //by smot
   i, Num: Integer;
   sImageURL: string;
   strLocalFile: string;
begin
   if not DocumentLoaded(OleObject.Document) then
      Exit;
   i := 0;
   ImagesList.Clear;
   for Num := 0 to OleObject.Document.Images.Length - 1 do
      begin
         sImageURL := OleObject.Document.Images.Item(Num).Src;
         ImagesList.Add('--Url  :' + sImageURL);
         GetCachedFileFromURL(sImageURL, strLocalFile);
         ImagesList.Add('--Local:' + strLocalFile);
         i := Num;
      end;
   if i = 0 then
      ImagesList.Add('No images found.');
end;

procedure ViewPageSourceHTMLToStrings(OleObject: Variant; Document: IDispatch; HtmlList: TStrings);
begin
   HtmlList.Clear;
   if DocumentLoaded(Document) then
      HtmlList.Add(VarToStr(OleObject.Document.documentElement.innerHTML));
end;

procedure ViewPageSourceTextToStrings(OleObject: Variant; Document: IDispatch; TextList: TStrings);
begin
   TextList.Clear;
   if DocumentLoaded(Document) then
      TextList.Add(VarToStr(OleObject.Document.documentElement.innerText));
end;

procedure ViewPagePropertiesToStrings(OleObject: Variant; Document: IDispatch; PropertiesList: TStrings);
begin
   PropertiesList.Clear;
   if DocumentLoaded(Document) then
      begin
         try
            with PropertiesList do
               begin
                  Add('Current Url: ' + OleObject.Document.Url);
                  Add('Current Title: ' + OleObject.Document.Title);
                  Add('Scroll Height: ' + IntToStr(OleObject.Document.Body.ScrollHeight));
                  Add('Scroll Width: ' + IntToStr(OleObject.Document.Body.ScrollWidth));
                  Add('Scroll Top: ' + IntToStr(OleObject.Document.Body.ScrollTop));
                  Add('Scroll Left: ' + IntToStr(OleObject.Document.Body.ScrollLeft));
                  Add('Client Height: ' + IntToStr(OleObject.Document.Body.ClientHeight));
                  Add('Client Width: ' + IntToStr(OleObject.Document.Body.ClientWidth));
                  Add('Referrer: ' + OleObject.Document.Referrer);
                  Add('Cookie: ' + OleObject.Document.Cookie);
                  Add('Last Modified: ' + OleObject.Document.LastModified);
                  Add('Protocol: ' + OleObject.Document.Location.Protocol);
                  Add('Default Charset: ' + OleObject.Document.DefaultCharset);
                  Add('Unique ID: ' + OleObject.Document.UniqueID);
                  Add('File Size: ' + OleObject.Document.FileSize);
                  Add('File Created Date: ' + OleObject.Document.FileCreatedDate);
               end;
         except
            PropertiesList.Add('It looks like there are errors on the page HTML code!');
         end;
      end;
end;

procedure ViewPageSourceText(OleObject: Variant; Document: IDispatch);
var
   TextLst: TStringList;
begin
   TextLst := TStringList.Create;
   try
      if DocumentLoaded(Document) then
         begin
            TextLst.Add(VarToStr(OleObject.Document.documentElement.innerText));
            MessageDlg(TextLst.Text, mtCustom, [mbOK], 0);
         end;
   finally
      TextLst.Free;
   end;
end;

function SaveToFile(Document: IDispatch; const Fname: string): HRESULT;
begin
   if DocumentLoaded(Document) then
      begin
         Result := SaveDocToFile(Document, FName);
      end
   else
      Result := S_FALSE;
end;

function SaveToStream(Document: IDispatch; var AStream: TStream): HRESULT;
begin
   if DocumentLoaded(Document) then
      Result := SaveDocToStream(Document, AStream)
   else
      Result := S_FALSE;
end;

function SaveToStrings(Document: IDispatch; AStrings: TStrings): HRESULT;
begin
   if DocumentLoaded(Document) then
      Result := SaveDocToStrings(Document, AStrings)
   else
      Result := S_FALSE;
end;

function SaveDocToStrings(Document: IDispatch; var AStrings: TStrings): HResult;
var
   IpStream: IPersistStreamInit;
   AStream: TMemoryStream;
begin
   Result := S_FALSE;
   if not DocumentLoaded(Document) then
      Exit;
   AStream := TMemoryStream.Create;
   try
      IpStream := Document as IPersistStreamInit;
      if not Assigned(IpStream) then
         Result := S_FALSE
      else
         if Succeeded(IpStream.save(TStreamadapter.Create(AStream), True))
            then
            begin
               AStream.Seek(0, 0);
               AStrings.LoadFromStream(AStream);
               Result := S_OK;
            end;
   except
   end;
   AStream.Free;
end;

function SaveDocToStream(Document: IDispatch; var AStream: TStream): HResult;
var
   IpStream: IPersistStreamInit;
begin
   if DocumentLoaded(Document) then
      begin
         IpStream := Document as IPersistStreamInit;
         Result := IpStream.Save(TStreamAdapter.Create(AStream), True);
      end
   else
      Result := S_FALSE;
end;

function SaveDocToFile(Document: IDispatch; const Fname: string): HResult;
var
   PFile: IPersistFile;
begin
   Result := S_FALSE;
   if DocumentLoaded(Document) then
      begin
         PFile := Document as IPersistFile;
         Result := PFile.Save(StringToOleStr(FName), False);
      end;
end;

function SaveFrameToFile(Document: IDispatch; FrameNo: Integer; const Fname: string): HRESULT;
var
   IWeb: IWebBrowser2;
   PFile: IPersistFile;
begin
   IWeb := GetFrame(Document, FrameNo);
   if (IWeb <> nil) and DocumentLoaded(IWeb.Document) then
      begin
         PFile := IWeb.Document as IPersistFile;
         Result := PFile.Save(StringToOleStr(FName), False);
      end
   else
      Result := S_FALSE;
end;

function SaveFrameToStream(Document: IDispatch; FrameNo: Integer; AStream: TStream): HRESULT;
var
   IWeb: IWebBrowser2;
begin
   Result := S_FALSE;
   IWeb := GetFrame(Document, FrameNo);
   if (IWeb <> nil) and DocumentLoaded(IWeb.Document) then
      Result := SaveDocToStream(IWeb.Document, AStream)
end;

function SaveFrameToStrings(Document: IDispatch; FrameNo: Integer; AStrings: TStrings): HRESULT;
var
   IWeb: IWebBrowser2;
begin
   Result := S_FALSE;
   IWeb := GetFrame(Document, FrameNo);
   if (IWeb <> nil) and DocumentLoaded(IWeb.Document) then
      Result := SaveDocToStrings(IWeb.Document, AStrings);
end;

function LoadFromStrings(WebBrowser: TEmbeddedWB; Document: IDispatch; const AStrings: TStrings): HResult;
var
   Ms: TMemoryStream;
begin
   Ms := TMemoryStream.Create;
   try
      try
         if not DocumentLoaded(Document) then
            AssignEmptyDocument(WebBrowser);
         AStrings.SaveToStream(Ms);
         Result := WebBrowser.LoadFromStream(Ms);
      except
         Result := S_FALSE;
      end;
   finally
      Ms.free;
   end;
end;

function LoadFromStream(WebBrowser: TEmbeddedWB; Document: IDispatch; const AStream: TStream): HRESULT;
begin
   if not DocumentLoaded(Document) then
      AssignEmptyDocument(WebBrowser);
   AStream.Seek(0, 0);
   Result := (Document as IPersistStreamInit).Load(TStreamadapter.Create(AStream));
end;

procedure LoadFromImage(WebBrowser: TEmbeddedWB; Image: TImage);
var
   Stm: TMemoryStream;
begin
   Stm := TMemoryStream.Create;
   try
      Image.Picture.Bitmap.SaveToStream(Stm);
      WebBrowser.LoadFromStream(Stm);
   finally
      Stm.Free;
   end;
end;

function LoadFrameFromStrings(Document: IDispatch; FrameNo: Integer; const AStrings: TStrings): HResult;
var
   IWeb: IWebBrowser2;
   M: TMemoryStream;
begin
   Result := S_FALSE;
   IWeb := GetFrame(Document, FrameNo);
   if (IWeb <> nil) and DocumentLoaded(IWeb.Document) then
      begin
         M := TMemoryStream.Create;
         try
            AStrings.SaveToStream(M);
            M.Seek(0, 0);
            Result := (IWeb.Document as IPersistStreamInit).Load(TStreamadapter.Create(M));
         except
            Result := S_FALSE;
         end;
         M.free;
      end;
end;

function LoadFrameFromStream(Document: IDispatch; FrameNo: Integer; AStream: TStream): HRESULT;
var
   IWeb: IWebBrowser2;
begin
   Result := S_FALSE;
   IWeb := GetFrame(Document, FrameNo);
   if (IWeb <> nil) then
      if DocumentLoaded(IWeb.Document) then
         begin
            AStream.Seek(0, 0);
            Result := (IWeb.Document as IPersistStreamInit).Load(TStreamadapter.Create(AStream));
         end;
end;

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

procedure PrintWithOptions(ControlInterface: IWebBrowser2; Document: IDispatch; UsePrintOptions, PrintOptionsEnabled, HideSetup: Boolean; var InvokingPageSetup: Boolean);
begin
   PrintingWithOptions := True;
   PageSetup(Document, UsePrintOptions, PrintOptionsEnabled, InvokingPagesetup);
   Print(ControlInterface, HideSetup);
end;

procedure PrintPreview(Webbrowser: IWebBrowser2);
// IE 5.5 only
var
   vaIn, vaOut: Olevariant;
begin
   if DocumentLoaded(Webbrowser.Document) then
      Webbrowser.ExecWB(OLECMDID_PRINTPREVIEW, OLECMDEXECOPT_DONTPROMPTUSER, vaIn, vaOut);
end;

function OpenClient(Client: string): Boolean;
var
   s, params, Exec: string;
begin
   Result := False;
   with TRegistry.Create do
      try
         RootKey := HKEY_LOCAL_MACHINE;
         OpenKey('Software\Clients\' + Client, False);
         S := ReadString('');
         CloseKey;
         OpenKey('Software\Clients\' + Client + '\' + S + '\shell\open\command', False);
         S := ReadString('');
         CloseKey;
         if S <> '' then
            begin
               if Pos('/', S) > 0 then
                  begin
                     Exec := system.Copy(S, 1, Pos('/', S) - 2);
                     Params := system.Copy(s, Length(exec) + 1, length(S));
                  end
               else
                  begin
                     Exec := S;
                     Params := '';
                  end;
               Result := True;
               shellExecute(Application.handle, 'open', PChar(Exec), pChar(Params), '', SW_SHOW);
            end;
      finally
         Free;
      end;
end;

procedure PrintPreviewExtended(ControlInterface: IWebBrowser2; nCMDShow: Integer; HideSetup: Boolean);
var
   Preview_HWND, App_HWND: THandle;
   ClassName: array[0..255] of Char;
   StartTime, EndTime: DWORD; //Smot
   vaIn, vaOut: OleVariant;