WBFuncs

April 6, 2018 | Author: Anonymous | Category: Documents
Report this link


Description

unit WBFuncs; (**************************************************************) (* *) (* TWebbrowser functions by toms *) (* Version 1.9 *) (* E-Mail: [email protected] *) (* *) (* Contributors: www.swissdelphicenter.ch *) (* *) (* *) (**************************************************************) //{$I versions.inc} interface uses Windows, Messages, SysUtils, Dialogs, Variants,Forms, Classes, MSHTML, UrlMon, SHDocVw, ShellAPI, WinInet, ActiveX, ComObj, ComCtrls, // EmbeddedWB, // MOZILLACONTROLLib_TLB, Graphics; // What's your favorite Webbrowser? type // Standard TWebbrowser TMyBrowser = SHDocVw.TWebbrowser; //************************************** // TEmbeddedWB: // TMyBrowser = EmbeddedWB.TEmbeddedWB; //************************************** // TMozillaBrowser: // TMyBrowser = MOZILLACONTROLLib_TLB.TMozillaBrowser; {Experimental!! still very buggy!} TWebbrowser = TMyBrowser; const // You must also define the GUID for CGI_IWebBrowser to inform MSHTML how to process your command IDs CGID_WebBrowser: TGUID = '{ED016940-BD5B-11cf-BA4E-00C04FD70816}'; // The available commands HTMLID_FIND = 1; HTMLID_VIEWSOURCE = 2; HTMLID_OPTIONS = 3; type TWBFontSize = 0..4; type TEnumFramesProc = function(AHtmlDocument: IHtmlDocument2; Data: Integer): Boolean; { ************************************************************************* } function WB_DocumentLoaded(WB: TWebbrowser): Boolean; function WB_QueryCommandEnabled(WB: TWebbrowser; const Command: string): Boolean; function VariantIsObject(const value: OleVariant): boolean; function InvokeCMD(WB: TWebbrowser; nCmdID: DWORD): Boolean; overload; function InvokeCMD(WB: TWebbrowser; InvokeIE: Boolean; Value1, Value2: Integer; var vaIn, vaOut: OleVariant): Boolean; overload; { ************************************************************************* } procedure WaitForBrowser(WB: TWebbrowser); procedure WB_Navigate(WB: TWebbrowser; const URL: string); procedure WB_SetFocus(WB: TWebbrowser); procedure WB_GoBack(WB: TWebbrowser); procedure WB_GoForward(WB: TWebbrowser); procedure WB_Stop(WB: TWebbrowser); procedure WB_Refresh(WB: TWebbrowser); { ************************************************************************* } procedure WB_Copy(WB: TWebbrowser); procedure WB_Paste(WB: TWebbrowser); procedure WB_Cut(WB: TWebbrowser); procedure WB_SelectAll(WB: TWebbrowser); procedure WB_Save(WB: TWebbrowser); { ************************************************************************* } procedure WB_ScrollToTop(WB: TWebbrowser); procedure WB_ScrollToBottom(WB: TWebbrowser); { ************************************************************************* } procedure SetGlobalOffline(Value: Boolean); function IsGlobalOffline: Boolean; { ************************************************************************* } procedure WB_ShowPrintDialog(WB: TWebbrowser); procedure WB_ShowPrintPreview(WB: TWebbrowser); procedure WB_ShowPageSetup(WB: TWebbrowser); procedure WB_ShowFindDialog(WB: TWebbrowser); procedure WB_ShowPropertiesDialog(WB: TWebbrowser); { ************************************************************************* } function WB_SetCharSet(WB: TWebbrowser; const ACharSet: string): Boolean; procedure WB_Set3DBorderStyle(WB: TWebBrowser; bValue: Boolean); procedure WB_SearchAndHighlightText(WB: TWebbrowser; aText: string); procedure WB_ShowScrollBar(WB: TWebbrowser; Value: boolean); procedure WB_SetZoom(WB: TWebBrowser; Size: TWBFontSize); function WB_GetZoom(WB: TWebBrowser): TWBFontSize; function WB_GetCookie(WB: TWebBrowser): string; { ************************************************************************* } procedure WB_ShowSourceCode(WB: TWebbrowser); { ************************************************************************* } function GetElementAtPos(Doc: IHTMLDocument2; x, y: integer): IHTMLElement; function GetZoneIcon(IconPath: string; var Icon: TIcon): boolean; function GetZoneAttributes(const URL: string): TZoneAttributes; function GetCachedFileFromURL(strUL: string; var strLocalFile: string): boolean; { ************************************************************************* } function EnumFrames(AHtmlDocument: IHtmlDocument2; EnumFramesProc: TEnumFramesProc; Data: Integer): Boolean; procedure WB_GetObjectView(TV: TTreeView; WB: TWebBrowser); function WB_GetPlainText(WB: TWebbrowser; s: TStrings): string; function WB_GetFields(WebBrowser: TWebBrowser; SL: TStrings): Boolean; procedure WB_GetImages(AWebbrowser: TWebbrowser; sl: TStrings); procedure WB_GetLinks(WB: TWebbrowser; sl: TStrings); function WB_GetDocumentSourceToString(Document: IDispatch): string; implementation { ************************************************************************* } // Check if Webbrowser Document is loaded // Verifica se um documento Webbrowser foi carregado function WB_DocumentLoaded(WB: TWebbrowser): Boolean; var iDoc: IHtmlDocument2; begin Result := False; if Assigned(WB) then begin if WB.Document nil then begin WB.ControlInterface.Document.QueryInterface(IHtmlDocument2, iDoc); Result := Assigned(iDoc); end; end; end; { ************************************************************************* } // Returns a Boolean value that indicates whether a specified command // can be successfully executed using execCommand, // Retorna um valor booleano que indica se um determinado comando //pode ser executado com sucesso utilizando execCommand, function WB_QueryCommandEnabled(WB: TWebbrowser; const Command: string): Boolean; var Doc: IHTMLDocument2; begin Result := False; Doc := WB.Document as IHTMLDocument2; if Assigned(doc) then Result := Doc.QueryCommandEnabled(Command); end; { ************************************************************************* } function VariantIsObject(const value: OleVariant): boolean; begin result := (VarType(value) = varDispatch); end; { ************************************************************************* } // Execute a specified command or displays help for a command. // The IOleCommandTarget interface enables objects and their // containers to dispatch commands to each other. For example, // an object's toolbars may contain buttons for commands such as // Print, Print Preview, Save, New, and Zoom. //Executa um comando especificado ou exibe a ajuda para um comando. //A interface IOleCommandTarget permite que objetos e seus //recipientes para enviar comandos para o outro. Por exemplo, //barras de um objeto pode conter botões para comandos como //Imprimir, Visualizar Impressão, Salvar, em Novo e Zoom. function InvokeCMD(WB: TWebbrowser; nCmdID: DWORD): Boolean; var vaIn, vaOut: OleVariant; begin Result := InvokeCMD(WB, True, nCmdID, unassigned, vaIn, vaOut); end; function InvokeCMD(WB: TWebbrowser; InvokeIE: Boolean; Value1, Value2: Integer; var vaIn, vaOut: OleVariant): Boolean; var CmdTarget: IOleCommandTarget; PtrGUID: PGUID; begin New(PtrGUID); if InvokeIE then PtrGUID^ := CGID_WebBrowser else PtrGuid := PGUID(nil); if WB.Document nil then try WB.Document.QueryInterface(IOleCommandTarget, CmdTarget); if CmdTarget nil then try CmdTarget.Exec(PtrGuid, Value1, Value2, vaIn, vaOut); finally CmdTarget._Release; end; except end; Dispose(PtrGUID); end; { ************************************************************************* } // wait until document loaded // READYSTATE_COMPLETE: The current document is fully downloaded // esperar até documento carregado //READYSTATE_COMPLETE: O presente documento é totalmente transferido procedure WaitForBrowser(WB: TWebbrowser); begin while (WB.ReadyState READYSTATE_COMPLETE) and not (Application.Terminated) do begin Application.ProcessMessages; Sleep(0); end; end; { ************************************************************************* } // Navigate to a page // Navegue até uma página procedure WB_Navigate(WB: TWebbrowser; const URL: string); // URL: a string specifying the location of the document var BrowserFlags: OleVariant; // a value that determines under more whether a page //should be added to the history list, // be read from the cache memory or be written to //the cache; // um valor que determina se o título de mais uma //página deve ser adicionado à lista de histórico // ser lidos da memória cache ou ser gravados no //cache MyTargetFrameName: OleVariant; // a string that determines in which frame the //URL should be displayed; // uma string que determina em qual frame a URL deve //ser exibida; MyPostaData: OleVariant; // a value that specifies the HTTP POST data to send //to the server; // um valor que especifica os dados HTTP POST para //enviar para o servidor; MyHeaders: OleVariant; // a value that specifies the HTTP headers to send to //the server. // um valor que especifica os cabeçalhos HTTP para //enviar para o servidor. begin { Flags: Constant Value Meaning NavOpenInNewWindow $01 Open the resource or file in a new window. NavNoHistory $02 Do not add the resource or file to the history list. The new page replaces the current page in the list. NavNoReadFromCache $04 Do not read from the disk cache for this navigation. NavNoWriteToCache $08 Do not write the results of this navigation to the disk cache. $10 If the navigation fails, the Web browser attempts to navigate common root domains (.com, .org, and so on). If this still fails, the URL is passed to a search engine. } if Assigned(WB) then begin BrowserFlags := $02; MyTargetFrameName := null; MyPostaData := null; MyHeaders := null; WB.Navigate(URL, BrowserFlags, MyTargetFrameName, MyPostaData, MyHeaders); WaitforBrowser(WB); end; end; { ************************************************************************* } // Set Focus on Webbrowser Document // Definir o foco no documento Webbrowser procedure WB_SetFocus(WB: TWebbrowser); begin if WB_DocumentLoaded(WB) then (WB.Document as IHTMLDocument2).ParentWindow.Focus; end; { ************************************************************************* } // Navigate Back in History // Navegar: voltar no histórico procedure WB_GoBack(WB: TWebbrowser); begin try if WB_DocumentLoaded(WB) then WB.GoBack; except end; end; { ************************************************************************* } // Navigate Forward in History // Navegar: Avançar no histórico procedure WB_GoForward(WB: TWebbrowser); begin try if WB_DocumentLoaded(WB) then WB.GoForward; except end; end; { ************************************************************************* } // Stop loading Webbrowser Document // Interromper o carregamento de Webbrowser Documento procedure WB_Stop(WB: TWebbrowser); begin try if WB_DocumentLoaded(WB) then WB.Stop; except end; end; { ************************************************************************* } // Refresh Webbrowser // Atualizar Webbrowser procedure WB_Refresh(WB: TWebbrowser); const REFRESH_COMPLETELY = 3; var KeyState: TKeyBoardState; RefreshLevel: OleVariant; begin if WB_DocumentLoaded(WB) then begin GetKeyboardState(KeyState); try if not ((KeyState[vk_Control] and 128) 0) then WB.Refresh else // if control key pressed then REFRESH_COMPLETELY // RefreshLevel specifies the refresh level. RefreshLevel := REFRESH_COMPLETELY; WB.DefaultInterface.Refresh2(RefreshLevel); except end; end; end; { ************************************************************************* } // Copy selected Text // Copiar o texto selecionado procedure WB_Copy(WB: TWebbrowser); var vaIn, vaOut: Olevariant; begin InvokeCmd(WB, FALSE, OLECMDID_COPY, OLECMDEXECOPT_DODEFAULT, vaIn, vaOut); end; { ************************************************************************* } // Paste from Clipboard //Colar da Área de Transferência procedure WB_Paste(WB: TWebbrowser); var vaIn, vaOut: Olevariant; begin InvokeCmd(WB, FALSE, OLECMDID_PASTE, OLECMDEXECOPT_DODEFAULT, vaIn, vaOut); end; { ************************************************************************* } // Select All Webbrowser Document //Selecionar todo Documento Webbrowser procedure WB_SelectAll(WB: TWebbrowser); var vaIn, vaOut: Olevariant; begin InvokeCmd(WB, FALSE, OLECMDID_SELECTALL, OLECMDEXECOPT_DODEFAULT, vaIn, vaOut); end; { ************************************************************************* } // Cut selected Text // Cortar texto selecionado procedure WB_Cut(WB: TWebbrowser); var vaIn, vaOut: Olevariant; begin InvokeCmd(WB, FALSE, OLECMDID_CUT, OLECMDEXECOPT_DODEFAULT, vaIn, vaOut); end; { ************************************************************************* } // Save Webbrowser Document //Salvar documento Webbrowser procedure WB_Save(WB: TWebbrowser); var Dispatch: IDispatch; CommandTarget: IOleCommandTarget; vaIn: OleVariant; vaOut: OleVariant; begin if WB_DocumentLoaded(WB) then // ensure not busy if not (WB.Busy) then begin Dispatch := WB.Document; Dispatch.QueryInterface(IOleCommandTarget, CommandTarget); vaIn := ''; vaOut := ''; try CommandTarget.Exec(PGUID(nil), OLECMDID_SAVEAS, OLECMDEXECOPT_DONTPROMPTUSER, vaIn, vaOut); except {handle exceptions} on E: Exception do MessageDlg('ERROR: Unable to show Save As dialog. ' + #13 + E.ClassName + ': ' + E.Message + '.', mtError, [mbOk], 0); end; {try..except..} end; end; { ************************************************************************* } // Scroll To Top of Webbrowser Document // Rolar até o topo do documento Webbrowser procedure WB_ScrollToTop(WB: TWebbrowser); begin if WB_DocumentLoaded(WB) then begin try WB.OleObject.Document.ParentWindow.ScrollTo(0, 0); except end; end; end; { ************************************************************************* } // Scroll To Bottom of Webbrowser Document // Rolar até a base do documento Webbrowser procedure WB_ScrollToBottom(WB: TWebbrowser); begin if WB_DocumentLoaded(WB) then begin try WB.OleObject.Document.ParentWindow.ScrollTo(0, MaxInt); except end; end; end; { ************************************************************************* } // Set Global Offline // Definir Global Offline procedure SetGlobalOffline(Value: Boolean); const INTERNET_STATE_DISCONNECTED_BY_USER = $10; ISO_FORCE_DISCONNECTED = $1; INTERNET_STATE_CONNECTED = $1; var ci: TInternetConnectedInfo; dwSize: DWORD; begin dwSize := SizeOf(ci); if (Value) then begin ci.dwConnectedState := INTERNET_STATE_DISCONNECTED_BY_USER; ci.dwFlags := ISO_FORCE_DISCONNECTED; end else begin ci.dwFlags := 0; ci.dwConnectedState := INTERNET_STATE_CONNECTED; end; InternetSetOption(nil, INTERNET_OPTION_CONNECTED_STATE, @ci, dwSize); end; { ************************************************************************* } // Query Global Offline // Consulta Global Offline function IsGlobalOffline: Boolean; var dwState: DWORD; dwSize: DWORD; begin dwState := 0; dwSize := SizeOf(dwState); Result := False; if (InternetQueryOption(nil, INTERNET_OPTION_CONNECTED_STATE, @dwState, dwSize)) then if ((dwState and INTERNET_STATE_DISCONNECTED_BY_USER) 0) then Result := True; end; { ************************************************************************* } // Show Printer Dialog // Mostrar caixa de diálogo da Impressora procedure WB_ShowPrintDialog(WB: TWebbrowser); var OleCommandTarget: IOleCommandTarget; Command: TOleCmd; Success: HResult; begin if WB_DocumentLoaded(WB) then begin WB.Document.QueryInterface(IOleCommandTarget, OleCommandTarget); Command.cmdID := OLECMDID_PRINT; if OleCommandTarget.QueryStatus(nil, 1, @Command, nil) S_OK then begin // ShowMessage('Nothing to print'); Exit; end; if (Command.cmdf and OLECMDF_ENABLED) 0 then begin Success := OleCommandTarget.Exec(nil, OLECMDID_PRINT, OLECMDEXECOPT_PROMPTUSER, EmptyParam, EmptyParam); case Success of S_OK: ; OLECMDERR_E_CANCELED: ShowMessage('Cancelado pelo Usuário'); else ShowMessage('Error'); end; end else // ShowMessage('Printing not possible'); end; end; { ************************************************************************* } // Show Printer Preview Dialog // Mostrar caixa de diálogo visualizar impressão procedure WB_ShowPrintPreview(WB: TWebbrowser); var vaIn, vaOut: OleVariant; begin if WB_DocumentLoaded(WB) then try // Execute the print preview command. // Execute o comando de visualização de impressão. WB.ControlInterface.ExecWB(OLECMDID_PRINTPREVIEW, OLECMDEXECOPT_DONTPROMPTUSER, vaIn, vaOut); except end; end; { ************************************************************************* } // Show Page Setup Dialog // Mostra caixa de dialogo de configuração de pagina procedure WB_ShowPageSetup(WB: TWebbrowser); var vaIn, vaOut: OleVariant; begin if WB_DocumentLoaded(WB) then try // Execute the page setup command. // Execute o commando configurar pagina WB.ControlInterface.ExecWB(OLECMDID_PAGESETUP, OLECMDEXECOPT_PROMPTUSER, vaIn, vaOut); except end; end; { ************************************************************************* } // Show Find Dialog // Mostra Busca procedure WB_ShowFindDialog(WB: TWebbrowser); begin InvokeCMD(WB, HTMLID_FIND); end; { ************************************************************************* } // Show Properties Dialog (for local Files) // Mostra a Propriedades do diálogo (para arquivos locais) procedure ShowFileProperties(const FileName: string); var sei: TShellExecuteInfo; begin FillChar(sei, SizeOf(sei), 0); sei.cbSize := SizeOf(sei); sei.lpFile := PChar(FileName); sei.lpVerb := 'properties'; sei.fMask := SEE_MASK_INVOKEIDLIST; ShellExecuteEx(@sei); end; { ************************************************************************* } // Show Properties Dialog // Mostrar caixa de diálogo Propriedades procedure WB_ShowPropertiesDialog(WB: TWebbrowser); var eQuery: OLECMDF; vaIn, vaOut: OleVariant; begin if WB_DocumentLoaded(WB) then begin // if a local file if FileExists(WB.Locationname) then ShowFileProperties(WB.Locationname) else begin // if a remote file try eQuery := WB.QueryStatusWB(OLECMDID_PROPERTIES); if (eQuery and OLECMDF_ENABLED) = OLECMDF_ENABLED then WB.ExecWB(OLECMDID_PROPERTIES, OLECMDEXECOPT_PROMPTUSER, vaIn, vaOut); except end; end; end; end; { ************************************************************************* } // Show Webbrowser Source Code (in standard editor) // Mostrar Webbrowser Código Fonte (no editor padrão) procedure WB_ShowSourceCode(WB: TWebbrowser); begin InvokeCMD(WB, HTMLID_VIEWSOURCE); end; { ************************************************************************* } // Get Element under mouse cursor // Obter elemento sob o cursor do mouse function GetElementAtPos(Doc: IHTMLDocument2; x, y: integer): IHTMLElement; begin Result := nil; Result := Doc.elementFromPoint(x, y); end; { ************************************************************************* } // Retrieve the Zone Icon // Recuperar o ícone Zone function GetZoneIcon(IconPath: string; var Icon: TIcon): boolean; var FName, ImageName: string; h: hInst; begin Result := False; FName := Copy(IconPath, 1, Pos('#', IconPath) - 1); ImageName := Copy(IconPath, Pos('#', IconPath), Length(IconPath)); h := LoadLibrary(Pchar(FName)); try if h 0 then begin Icon.Handle := LoadImage(h, Pchar(ImageName), IMAGE_ICON, 16, 16, 0); Result := True; end; finally FreeLibrary(h); end; end; { ************************************************************************* } // Get Zone Attributes // Obter atributos zone function GetZoneAttributes(const URL: string): TZoneAttributes; var dwZone: Cardinal; ZoneAttr: TZoneAttributes; //Defined in Urlmon.pas var ZoneManager: IInternetZoneManager; SecManager: IInternetSecurityManager; begin ZeroMemory(@ZoneAttr, SizeOf(TZoneAttributes)); if CoInternetCreateSecuritymanager(nil, SecManager, 0) = S_OK then if CoInternetCreateZoneManager(nil, ZoneManager, 0) = S_OK then begin SecManager.MapUrlToZone(PWideChar(WideString(URL)), dwZone, 0); ZoneManager.GetZoneAttributes(dwZone, Result); end; end; { ************************************************************************* } // Set Zoom // Definir Zoom procedure WB_SetZoom(WB: TWebBrowser; Size: TWBFontSize); var V: OleVariant; begin if WB_DocumentLoaded(WB) then begin { if (WB.QueryStatusWB(OLECMDID_ZOOM) and OLECMDF_SUPPORTED) = 0 then begin Exit; end; } V := Size; WB.ExecWB(OLECMDID_ZOOM, OLECMDEXECOPT_DODEFAULT, V); end; end; { ************************************************************************* } // Get Zoom // Obter Zoom function WB_GetZoom(WB: TWebBrowser): TWBFontSize; var vaIn, vaOut: Olevariant; begin result := 0; if WB_DocumentLoaded(WB) then begin { if (WB.QueryStatusWB(OLECMDID_ZOOM) and OLECMDF_SUPPORTED) = 0 then begin Exit; end; } vaIn := null; InvokeCmd(WB, FALSE, OLECMDID_ZOOM, OLECMDEXECOPT_DONTPROMPTUSER, vaIn, vaOut); result := vaOut; end; end; { ************************************************************************* } // Display the Source Code // Mostrar Código Fonte procedure WB_GetDocumentSourceToStream(Document: IDispatch; Stream: TStream); // Save a TWebbrowser Document to a Stream // Salvar um documento TWebBrowser para uma Stream var PersistStreamInit: IPersistStreamInit; StreamAdapter: IStream; begin Assert(Assigned(Document)); Stream.Size := 0; Stream.Position := 0; if Document.QueryInterface(IPersistStreamInit, PersistStreamInit) = S_OK then begin StreamAdapter := TStreamAdapter.Create(Stream, soReference); PersistStreamInit.Save(StreamAdapter, False); StreamAdapter := nil; end; end; function WB_GetDocumentSourceToString(Document: IDispatch): string; // Save a Webbrowser Document to a string // Salvar um documento WebBrowser para uma string var Stream: TStringStream; begin Result := ''; Stream := TStringStream.Create(''); try WB_GetDocumentSourceToStream(Document, Stream); Result := StringReplace(Stream.Datastring, #$A#9, #$D#$A, [rfReplaceAll]); Result := StringReplace(Result, #$A, #$D#$A, [rfReplaceAll]); if Copy(Result, 1, 3) = 'ÿþ


Comments

Copyright © 2024 UPDOCS Inc.