|
:: MVP ::
|
|
|
:: RSS ::
|
|
|
Как разобрать загруженную страницу?
procedure TForm1.FormCreate(Sender: TObject);
begin
WebBrowser1.Navigate( 'http://ya.ru' );
end;
procedure TForm1.WebBrowser1DocumentComplete(ASender: TObject;
const pDisp: IDispatch; const [Ref] URL: OleVariant);
procedure Build( collection: OleVariant; Root: TTreeNode );
var
elem: OleVariant;
i: integer;
tag: WideString;
begin
for i := 0 to collection.length-1 do
begin
elem := collection.item( i, tag );
tag := elem.tagName;
TreeView1.Items.AddChild( Root, tag );
Build( elem.children, TreeView1.Items[TreeView1.Items.Count-1] );
end;
end;
var
doc: OleVariant;
begin
doc := WebBrowser1.Document;
TreeView1.Items.Clear;
Build( doc.all.item( 0, '' ).children, TreeView1.TopItem );
Build( doc.all.item( 1, '' ).children, TreeView1.TopItem );
end;
|
Как вызвать скрытые команды в TWebBrowser?
const
// Command IDs Handled by 'Shell DocObject View'
ID_IE_FILE_PAGESETUP = 259;
ID_IE_FILE_PRINT = 260;
ID_IE_FILE_NEWWINDOW = 275;
ID_IE_FILE_PRINTPREVIEW = 277;
ID_IE_FILE_NEWMAIL = 279;
ID_IE_FILE_SENDPAGE = 282;
ID_IE_FILE_SENDLINK = 283;
ID_IE_FILE_SENDDESKTOPSHORTCUT = 284;
ID_IE_HELP_VERSIONINFO = 336;
ID_IE_HELP_HELPINDEX = 337;
ID_IE_HELP_WEBTUTORIAL = 338;
ID_IE_HELP_FREESTUFF = 341;
ID_IE_HELP_PRODUCTUPDATE = 342;
ID_IE_HELP_FAQ = 343;
ID_IE_HELP_ONLINESUPPORT = 344;
ID_IE_HELP_FEEDBACK = 345;
ID_IE_HELP_BESTPAGE = 346;
ID_IE_HELP_SEARCHWEB = 347;
ID_IE_HELP_MSHOME = 348;
ID_IE_HELP_VISITINTERNET = 349;
ID_IE_HELP_STARTPAGE = 350;
ID_IE_HELP_NETSCAPEUSER = 351;
ID_IE_FILE_IMPORTEXPORT = 374;
ID_IE_HELP_ENHANCEDSECURITY = 375;
ID_IE_FILE_ADDTRUST = 376;
ID_IE_FILE_ADDLOCAL = 377;
ID_IE_FILE_NEWPUBLISHINFO = 387;
ID_IE_FILE_NEWPEOPLE = 390;
ID_IE_FILE_NEWCALL =395;
// Command IDs Handled by 'Internet Explorer_Server'
ID_IE_CONTEXTMENU_NEWWINDOW = 2137;
ID_IE_CONTEXTMENU_ADDFAV = 2261;
ID_IE_CONTEXTMENU_REFRESH = 6042;
function GetIEHandle( WebBrowser: TWebbrowser; ClassName: string ): HWND;
var
hwndChild, hwndTmp: HWND;
oleCtrl: TOleControl;
szClass: array [0..255] of Char;
begin
oleCtrl := WebBrowser;
hwndTmp := oleCtrl.Handle;
while True do
begin
hwndChild := GetWindow( hwndTmp, GW_CHILD );
GetClassName( hwndChild, szClass, SizeOf( szClass ) );
if string( szClass ) = ClassName then
begin
Result := hwndChild;
Exit;
end;
hwndTmp := hwndChild;
end;
Result := 0;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
// Вызов диалога "Add To Favorite"
SendMessage( GetIEHandle( WebBrowser1, 'Internet Explorer_Server' ),
WM_COMMAND, ID_IE_CONTEXTMENU_ADDFAV, 0 );
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
// Вызов диалога "Import/Export Wizard"
SendMessage( GetIEHandle( WebBrowser1, 'Shell DocObject View'),
WM_COMMAND, ID_IE_FILE_IMPORTEXPORT, 0 );
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
WebBrowser1.Navigate( 'http://www.decoding.dax.ru' );
end;
|
Как очистить кэш в TWebBrowser?
uses
{...,} WinInet;
procedure EmptyIECache;
var
lpEntryInfo: PInternetCacheEntryInfo;
hCacheDir: LongWord;
dwEntrySize: LongWord;
dwLastError: LongWord;
begin
dwEntrySize := 0;
FindFirstUrlCacheEntry(nil, TInternetCacheEntryInfo(nil^), dwEntrySize);
GetMem(lpEntryInfo, dwEntrySize);
try
hCacheDir := FindFirstUrlCacheEntry(nil, lpEntryInfo^, dwEntrySize);
if hCacheDir <> 0 then
DeleteUrlCacheEntry(lpEntryInfo^.lpszSourceUrlName);
finally
FreeMem(lpEntryInfo);
end;
try
repeat
dwEntrySize := 0;
FindNextUrlCacheEntry(hCacheDir, TInternetCacheEntryInfo(nil^), dwEntrySize);
dwLastError := GetLastError;
if GetLastError = ERROR_INSUFFICIENT_BUFFER then
begin
GetMem(lpEntryInfo, dwEntrySize);
if FindNextUrlCacheEntry(hCacheDir, lpEntryInfo^, dwEntrySize) then
if not DeleteUrlCacheEntry(lpEntryInfo^.lpszSourceUrlName) then
begin
UnlockUrlCacheEntryFile(lpEntryInfo^.lpszSourceUrlName, 0);
DeleteUrlCacheEntry(lpEntryInfo^.lpszSourceUrlName);
end;
FreeMem(lpEntryInfo);
end;
until (dwLastError = ERROR_NO_MORE_ITEMS) or (dwLastError = ERROR_INVALID_PARAMETER);
finally
FindCloseUrlCache(hCacheDir);
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
EmptyIECache;
end;
|
Как проверить доступность команды в TWebBrowser?
procedure TForm1.Button1Click(Sender: TObject);
var
Flags: TOleEnum; // OLECMDF
s: string;
begin
Flags := WebBrowser1.QueryStatusWB(OLECMDID_OPTICAL_ZOOM);
s := '';
if Flags and OLECMDF_SUPPORTED = OLECMDF_SUPPORTED then
s := s + 'Команда поддерживается'#13;
if Flags and OLECMDF_ENABLED = OLECMDF_ENABLED then
s := s + 'Команда поддерживается и разрешена'#13;
if Flags and OLECMDF_LATCHED = OLECMDF_LATCHED then
s := s + 'Команда – переключатель и сейчас включена'#13;
if Flags and OLECMDF_NINCHED = OLECMDF_NINCHED then
s := s + 'Зарезервировано'#13;
ShowMessage(s);
end;
|
Как изменить HTML-код в TWebBrowser?
uses
MSHTML;
// В данном примере в страницу внедряется стиль, который при выводе
// на печать поворачивает содержимое страницы на 90° (хорошо
// подходит для разворота отфтрматированных одностраничных документов)
procedure TForm1.FormCreate(Sender: TObject);
begin
WebBrowser1.Navigate('http://ya.ru');
end;
procedure TForm1.Button1Click(Sender: TObject);
var
Document: IHTMLDocument2;
Collection: IHTMLElementCollection;
Element: IHTMLElement;
begin
Document := WebBrowser1.Document as IHtmlDocument2;
Collection := Document.All.Tags('HEAD') as IHTMLElementCollection;
Element := Collection.Item(NULL, 0) as IHTMLElement;
// Первый параметр insertAdjacentHTML может быть:
// • afterBegin — вставляет строку после открывающего тега элемента
// • beforeBegin — вставляет строку перед открывающим тегом элемента
// • afterEnd — вставляет строку после закрывающего тега элемента
// • beforeEnd — вставляет строку перед закрывающим тегом элемента
Element.insertAdjacentHTML(
'afterBegin',
''
);
// В некоторых случаях при повороте могут потребоваться масштабирование и сдвиг:
//
// Кроме того можно вставлять простой текст с помощью метода insertAdjacentText
end;
|
Как распечатать страницу из TWebBrowser с ожиданием завершения печати?
uses
MSHTML;
procedure TForm1.FormCreate(Sender: TObject);
begin
WebBrowser1.Navigate('http://decoding.dax.ru');
end;
procedure WB_ShowPrintDialog(WB: TWebbrowser; ShowPrintDialog: Boolean = True);
var
vIn, vOut: OleVariant;
UserAction: Cardinal;
const
PRINT_DONTBOTHERUSER = $01; // Не беспокоить пользователя
PRINT_WAITFORCOMPLETION = $02; // Дождаться завершения
// Внимание, если указаны два значения - PRINT_DONTBOTHERUSER и OLECMDEXECOPT_PROMPTUSER,
// PRINT_DONTBOTHERUSER имеет приоритет и диалоговое окно "печать" не отображается.
begin
if ShowPrintDialog then
UserAction := OLECMDEXECOPT_PROMPTUSER
else
UserAction := OLECMDEXECOPT_DONTPROMPTUSER;
TVarData(vIn).VType := varSmallint;
TVarData(vIn).VSmallInt := PRINT_WAITFORCOMPLETION;
try
WB.ExecWB(OLECMDID_PRINT, UserAction, vIn, vOut);
ShowMessage('Печать окончена');
except
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
WB_ShowPrintDialog(WebBrowser1);
// WB_ShowPrintDialog(WebBrowser1, False);
end;
|
Как убрать header и footer при печати страницы из TWebBrowser?
// Способ первый - через OLECMDID_PRINTPREVIEW (диалог предварительного просмотра)
uses
Registry, MSHTML;
procedure TForm1.FormCreate(Sender: TObject);
begin
WebBrowser1.Navigate('http://decoding.dax.ru');
end;
procedure WB_ShowPrintDialog(WB: TWebbrowser; ShowPrintDialog: Boolean = True);
var
vIn, vOut: OleVariant;
UserAction: Cardinal;
Reg: TRegistry;
Header, Footer: string;
begin
if ShowPrintDialog then
UserAction := OLECMDEXECOPT_PROMPTUSER
else
UserAction := OLECMDEXECOPT_DONTPROMPTUSER;
Reg := TRegistry.Create;
try
Reg.RootKey := HKEY_CURRENT_USER;
if Reg.OpenKey('Software\Microsoft\Internet Explorer\PageSetup', False) then
begin
Header := Reg.ReadString('header');
Footer := Reg.ReadString('footer');
Reg.WriteString('header', '');
Reg.WriteString('footer', '');
WB.ExecWB(OLECMDID_PRINTPREVIEW, UserAction, vIn, vOut);
end;
finally
Reg.WriteString('header', Header);
Reg.WriteString('footer', Footer);
Reg.Free;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
WB_ShowPrintDialog(WebBrowser1);
// WB_ShowPrintDialog(WebBrowser1, False);
end;
// Способ второй - через OLECMDID_PRINT (диалог печати)
// Нужно дождаться окончания печати, и только после этого
// восстанавливать значения параметров реестра.
uses
Registry, MSHTML;
procedure TForm1.FormCreate(Sender: TObject);
begin
WebBrowser1.Navigate('http://decoding.dax.ru');
end;
procedure WB_ShowPrintDialog(WB: TWebbrowser; ShowPrintDialog: Boolean = True);
var
vIn, vOut: OleVariant;
UserAction: Cardinal;
Reg: TRegistry;
Header, Footer: string;
const
PRINT_DONTBOTHERUSER = $01; // Не беспокоить пользователя
PRINT_WAITFORCOMPLETION = $02; // Дождаться завершения
// Внимание, если указаны два значения - PRINT_DONTBOTHERUSER и OLECMDEXECOPT_PROMPTUSER,
// PRINT_DONTBOTHERUSER имеет приоритет и диалоговое окно "печать" не отображается.
begin
if ShowPrintDialog then
UserAction := OLECMDEXECOPT_PROMPTUSER
else
UserAction := OLECMDEXECOPT_DONTPROMPTUSER;
TVarData(vIn).VType := varSmallint;
TVarData(vIn).VSmallInt := PRINT_WAITFORCOMPLETION;
Reg := TRegistry.Create;
try
Reg.RootKey := HKEY_CURRENT_USER;
if Reg.OpenKey('Software\Microsoft\Internet Explorer\PageSetup', False) then
begin
Header := Reg.ReadString('header');
Footer := Reg.ReadString('footer');
Reg.WriteString('header', '');
Reg.WriteString('footer', '');
WB.ExecWB(OLECMDID_PRINT, UserAction, vIn, vOut);
end;
finally
Reg.WriteString('header', Header);
Reg.WriteString('footer', Footer);
Reg.Free;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
WB_ShowPrintDialog(WebBrowser1);
// WB_ShowPrintDialog(WebBrowser1, False);
end;
|
|
При использовании материала - ссылка на сайт обязательна
|
|
