Ir para conteúdo
Fórum Script Brasil
  • 0

webbrowser + cookies

Gabriel10101

Perguntado por Gabriel10101,

 Share

Pergunta

Gabriel10101

Gabriel10101

Postado
Postado

Olá estou usando webbrowser,e quero limprar os cookies do navegador em certa parte do código,mas não estou conseguindo,depois de muita procura achei um código mais não consegui usa-lo:

procedure DeleteCache(ACache, ACookies, AHistory:boolean);
var
 lpEntryInfo: PInternetCacheEntryInfo;
 hCacheDir: LongWord;
 dwEntrySize: LongWord;
begin
 if (not ACache) and (not ACookies) and (not AHistory) then// nothing to delete
  exit;
 dwEntrySize := 0;
 FindFirstUrlCacheEntry(nil, TInternetCacheEntryInfo(nil^), dwEntrySize);
 GetMem(lpEntryInfo, dwEntrySize);
 if dwEntrySize > 0 then lpEntryInfo^.dwStructSize := dwEntrySize;
 hCacheDir := FindFirstUrlCacheEntry(nil, lpEntryInfo^, dwEntrySize); 
 if hCacheDir <> 0 then begin
   repeat
     // delete cookies
     if (ACookies and ((lpEntryInfo^.CacheEntryType and COOKIE_CACHE_ENTRY) = COOKIE_CACHE_ENTRY))
     // delete history
     or (AHistory and ((lpEntryInfo^.CacheEntryType and URLHISTORY_CACHE_ENTRY) = URLHISTORY_CACHE_ENTRY))
     // delete "normal" cache
     or (ACache and ((lpEntryInfo^.CacheEntryType and NORMAL_CACHE_ENTRY) = NORMAL_CACHE_ENTRY))
     then DeleteUrlCacheEntry(lpEntryInfo^.lpszSourceUrlName);
     FreeMem(lpEntryInfo, dwEntrySize);
     dwEntrySize := 0;
     FindNextUrlCacheEntry(hCacheDir, TInternetCacheEntryInfo(nil^), dwEntrySize);
     GetMem(lpEntryInfo, dwEntrySize);
     if dwEntrySize > 0 then lpEntryInfo^.dwStructSize := dwEntrySize;
   until not FindNextUrlCacheEntry(hCacheDir, lpEntryInfo^, dwEntrySize);
 end;
 FreeMem(lpEntryInfo, dwEntrySize);
 FindCloseUrlCache(hCacheDir);
end;
Tentei:
DeleteCache(ACookies);
DeleteCache;
Se alguém poder me ajudar,fico grato. (Uso delphi 7)
Link para o comentário
Compartilhar em outros sites

50 respostass a esta questão

Posts Recomendados

  • 0
Jhonas

Jhonas

Postado
Postado

dessa maneira funciona

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;

type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

uses
WinInet;

procedure DeleteCache(ACache, ACookies, AHistory:boolean);
var
lpEntryInfo: PInternetCacheEntryInfo;
hCacheDir: LongWord;
dwEntrySize: LongWord;
begin
if (not ACache) and (not ACookies) and (not AHistory) then// nothing to delete
exit;
dwEntrySize := 0;
FindFirstUrlCacheEntry(nil, TInternetCacheEntryInfo(nil^), dwEntrySize);
GetMem(lpEntryInfo, dwEntrySize);
if dwEntrySize > 0 then lpEntryInfo^.dwStructSize := dwEntrySize;
hCacheDir := FindFirstUrlCacheEntry(nil, lpEntryInfo^, dwEntrySize);
if hCacheDir <> 0 then begin
repeat
// delete cookies
if (ACookies and ((lpEntryInfo^.CacheEntryType and COOKIE_CACHE_ENTRY) = COOKIE_CACHE_ENTRY))
// delete history
or (AHistory and ((lpEntryInfo^.CacheEntryType and URLHISTORY_CACHE_ENTRY) = URLHISTORY_CACHE_ENTRY))
// delete "normal" cache
or (ACache and ((lpEntryInfo^.CacheEntryType and NORMAL_CACHE_ENTRY) = NORMAL_CACHE_ENTRY))
then DeleteUrlCacheEntry(lpEntryInfo^.lpszSourceUrlName);
FreeMem(lpEntryInfo, dwEntrySize);
dwEntrySize := 0;
FindNextUrlCacheEntry(hCacheDir, TInternetCacheEntryInfo(nil^), dwEntrySize);
GetMem(lpEntryInfo, dwEntrySize);
if dwEntrySize > 0 then lpEntryInfo^.dwStructSize := dwEntrySize;
until not FindNextUrlCacheEntry(hCacheDir, lpEntryInfo^, dwEntrySize);
end;
FreeMem(lpEntryInfo, dwEntrySize);
FindCloseUrlCache(hCacheDir);
end;

procedure DeleteIECache;
var
lpEntryInfo: PInternetCacheEntryInfo;
hCacheDir: LongWord;
dwEntrySize: LongWord;
begin { DeleteIECache }
dwEntrySize := 0;

FindFirstUrlCacheEntry(nil, TInternetCacheEntryInfo(nil^), dwEntrySize);

GetMem(lpEntryInfo, dwEntrySize);

if dwEntrySize>0 then
lpEntryInfo^.dwStructSize := dwEntrySize;

hCacheDir := FindFirstUrlCacheEntry(nil, lpEntryInfo^, dwEntrySize);

if hCacheDir<>0 then
begin
repeat
DeleteUrlCacheEntry(lpEntryInfo^.lpszSourceUrlName);
FreeMem(lpEntryInfo, dwEntrySize);
dwEntrySize := 0;
FindNextUrlCacheEntry(hCacheDir, TInternetCacheEntryInfo(nil^), dwEntrySize);
GetMem(lpEntryInfo, dwEntrySize);
if dwEntrySize>0 then
lpEntryInfo^.dwStructSize := dwEntrySize;
until not FindNextUrlCacheEntry(hCacheDir, lpEntryInfo^, dwEntrySize)
end; { hCacheDir<>0 }
FreeMem(lpEntryInfo, dwEntrySize);

FindCloseUrlCache(hCacheDir)
end; { DeleteIECache }


procedure TForm1.Button1Click(Sender: TObject);
begin
DeleteIECache;

DeleteCache(true,true,true);
end;

end.

abraço

Link para o comentário
Compartilhar em outros sites
  • 0
Jhonas

Jhonas

Postado
Postado

veja tambem nesse link

http://www.cryer.co.uk/brian/delphi/twebbrowser/clear_history.htm

unit InternetExplorerHistory;


interface


uses

Windows, ComObj, ActiveX;


procedure ClearInternetExplorerHistory;


const

CLSID_CUrlHistory: TGUID = '{3C374A40-BAE4-11CF-BF7D-00AA006946EE}';


type

TSTATURL = record

cbSize: DWORD;

pwcsUrl: DWORD;

pwcsTitle: DWORD;

ftLastVisited: FILETIME;

ftLastUpdated: FILETIME;

ftExpires: FILETIME;

dwFlags: DWORD;

end;


IEnumSTATURL = interface(IUnknown)

['{3C374A42-BAE4-11CF-BF7D-00AA006946EE}']

function Next(celt: Integer; out elt; pceltFetched: PLongint): HRESULT; stdcall;

function Skip(celt: Longint): HRESULT; stdcall;

function Reset: HResult; stdcall;

function Clone(out ppenum: IEnumSTATURL): HResult; stdcall;

function SetFilter(poszFilter: PWideChar; dwFlags: DWORD): HResult; stdcall;

end;


IUrlHistoryStg = interface(IUnknown)

['{3C374A41-BAE4-11CF-BF7D-00AA006946EE}']

function AddUrl(pocsUrl: PWideChar; pocsTitle: PWideChar; dwFlags: Integer): HResult; stdcall;

function DeleteUrl(pocsUrl: PWideChar; dwFlags: Integer): HResult; stdcall;

function QueryUrl(pocsUrl: PWideChar; dwFlags: Integer; var lpSTATURL: TSTATURL): HResult; stdcall;

function BindToObject(pocsUrl: PWideChar; var riid: TIID; out ppvOut: Pointer): HResult; stdcall;

function EnumUrls(out ppenum: IEnumSTATURL): HResult; stdcall;

end;


IUrlHistoryStg2 = interface(IUrlHistoryStg)

['{AFA0DC11-C313-11D0-831A-00C04FD5AE38}']

function AddUrlAndNotify(pocsUrl: PWideChar; pocsTitle: PWideChar; dwFlags: Integer;

fWriteHistory: Integer; var poctNotify: Pointer;

const punkISFolder: IUnknown): HResult; stdcall;

function ClearHistory: HResult; stdcall;

end;


implementation


procedure ClearInternetExplorerHistory;

var

stg: IUrlHistoryStg2;

begin

stg := CreateComObject(CLSID_CUrlHistory) as IUrlHistoryStg2;

stg.ClearHistory;

end;


end.

Link para o comentário
Compartilhar em outros sites
  • 0
Gabriel10101

Gabriel10101

Postado
  • Autor
Postado (editado)

Esse codigo que você me mandou da os seguintes erros:

[Error] Unit1.pas(64): Local class, interface or object types not allowed
[Error] Unit1.pas(73): Local class, interface or object types not allowed
[Error] Unit1.pas(78): Undeclared identifier: 'TIID'
[Error] Unit1.pas(82): Local class, interface or object types not allowed
[Error] Unit1.pas(90): ';' expected but 'IMPLEMENTATION' found
[Error] Unit1.pas(25): Unsatisfied forward or external declaration: 'TForm1.FormCreate'
[Error] Unit1.pas(26): Unsatisfied forward or external declaration: 'TForm1.OnDocumentComplete'
[Error] Unit1.pas(27): Unsatisfied forward or external declaration: 'TForm1.Button5Click'
[Error] Unit1.pas(28): Unsatisfied forward or external declaration: 'TForm1.Button2Click'
[Error] Unit1.pas(29): Unsatisfied forward or external declaration: 'TForm1.btnAbrirClick'
[Fatal Error] Project1.dpr(5): Could not compile used unit 'Unit1.pas'

Linha:

IEnumSTATURL = interface(IUnknown)

Parte maior do code

unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, OleCtrls, SHDocVw, StdCtrls, ExtCtrls, Menus, Buttons, StrUtils, ShellApi,
  XPMan, WinInet, ComObj, ActiveX;
 
type
    TForm1 = class(TForm)
    Panel1: TPanel;
    Button5: TButton;
    WebBrowser1: TWebBrowser;
    Memo1: TMemo;
 
    Memo2: TMemo;
    Button2: TButton;
    Memo3: TMemo;
    btnAbrir: TButton;
    dialogAbrir: TOpenDialog;
    XPManifest1: TXPManifest;
    edtAbrir: TEdit;
    
    procedure FormCreate(Sender: TObject);
    procedure OnDocumentComplete(Sender: TObject;const pDisp: IDispatch;var URL: OleVariant);
    procedure Button5Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure btnAbrirClick(Sender: TObject);
 
  private
    { Private declarations }
  public
    { Public declarations }
    Continuar: Boolean;
    logo: Boolean;
    end;
 
var
  Form1: TForm1;
  N, P, Q, tel, Mes, Erro: String;
  D,A,total,k, Res: Integer;
 
implementation
 
{$R *.dfm}
 
procedure ClearInternetExplorerHistory;
 
const
  CLSID_CUrlHistory: TGUID = '{3C374A40-BAE4-11CF-BF7D-00AA006946EE}';
 
type
  TSTATURL = record
    cbSize: DWORD;
    pwcsUrl: DWORD;
    pwcsTitle: DWORD;
    ftLastVisited: FILETIME;
    ftLastUpdated: FILETIME;
    ftExpires: FILETIME;
    dwFlags: DWORD;
  end;
 
  IEnumSTATURL = interface(IUnknown)
    ['{3C374A42-BAE4-11CF-BF7D-00AA006946EE}']
    function Next(celt: Integer; out elt; pceltFetched: PLongint): HRESULT; stdcall;
    function Skip(celt: Longint): HRESULT; stdcall;
    function Reset: HResult; stdcall;
    function Clone(out ppenum: IEnumSTATURL): HResult; stdcall;
    function SetFilter(poszFilter: PWideChar; dwFlags: DWORD): HResult; stdcall;
  end;

Atualmente para burlar o captcha tenho que fechar e abrir o programa.

Editado por Gabriel10101
Link para o comentário
Compartilhar em outros sites
  • 0
Jhonas

Jhonas

Postado
Postado

Atualmente para burlar o captcha tenho que fechar e abrir o programa.

fechar e abrir o programa indica que voce tem que atualizar algum comando ou rotina ( tipo dar um refresh )

Para não dar erros o código deve ser assim

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ComObj, ActiveX;

procedure ClearInternetExplorerHistory;

const
CLSID_CUrlHistory: TGUID = '{3C374A40-BAE4-11CF-BF7D-00AA006946EE}';

type
TSTATURL = record
cbSize: DWORD;
pwcsUrl: DWORD;
pwcsTitle: DWORD;
ftLastVisited: FILETIME;
ftLastUpdated: FILETIME;
ftExpires: FILETIME;
dwFlags: DWORD;
end;

IEnumSTATURL = interface(IUnknown)
['{3C374A42-BAE4-11CF-BF7D-00AA006946EE}']
function Next(celt: Integer; out elt; pceltFetched: PLongint): HRESULT; stdcall;
function Skip(celt: Longint): HRESULT; stdcall;
function Reset: HResult; stdcall;
function Clone(out ppenum: IEnumSTATURL): HResult; stdcall;
function SetFilter(poszFilter: PWideChar; dwFlags: DWORD): HResult; stdcall;
end;

IUrlHistoryStg = interface(IUnknown)
['{3C374A41-BAE4-11CF-BF7D-00AA006946EE}']
function AddUrl(pocsUrl: PWideChar; pocsTitle: PWideChar; dwFlags: Integer): HResult; stdcall;
function DeleteUrl(pocsUrl: PWideChar; dwFlags: Integer): HResult; stdcall;
function QueryUrl(pocsUrl: PWideChar; dwFlags: Integer; var lpSTATURL: TSTATURL): HResult; stdcall;
function BindToObject(pocsUrl: PWideChar; var riid: TIID; out ppvOut: Pointer): HResult; stdcall;
function EnumUrls(out ppenum: IEnumSTATURL): HResult; stdcall;
end;

IUrlHistoryStg2 = interface(IUrlHistoryStg)
['{AFA0DC11-C313-11D0-831A-00C04FD5AE38}']
function AddUrlAndNotify(pocsUrl: PWideChar; pocsTitle: PWideChar; dwFlags: Integer;
fWriteHistory: Integer; var poctNotify: Pointer;
const punkISFolder: IUnknown): HResult; stdcall;
function ClearHistory: HResult; stdcall;
end;

type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure ClearInternetExplorerHistory;
var
stg: IUrlHistoryStg2;
begin
stg := CreateComObject(CLSID_CUrlHistory) as IUrlHistoryStg2;
stg.ClearHistory;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
ClearInternetExplorerHistory;
end;

end.

obs: tente adaptar o seu código a este

abraço

Link para o comentário
Compartilhar em outros sites
  • 0
Jhonas

Jhonas

Postado
Postado

veja se esse post do forum resolve

https://www.scriptbrasil.com.br/forum/topic/114777-resolvidowebbrowser-cookies/?p=472341

tente esse tambem

procedure TForm1.Button2Click(Sender: TObject);
begin
// uses Wininet
InternetSetOption(0, INTERNET_OPTION_END_BROWSER_SESSION, nil, 0);

end;

OBS: me passa o diretório ( caminho ) onde fica os cookies em sua maquina ... acho que é possivel apagar o conteudo da pasta

abraço

Link para o comentário
Compartilhar em outros sites
  • 0
Gabriel10101

Gabriel10101

Postado
  • Autor
Postado (editado)

Jhonas,muito obrigado cara,não sei como te agradecer,esse último deu certo,você é demais cara !!!

@Aproveitando o tópico,como pesso pegar o total de "gold":

	
		
			
				<div class="moduleBox MainForm" style="margin-top: 15px;">
				 
				<div class="moduleBox">
				 
				<fieldset>
				 
				<legend>
				Resumo da Conta </legend>
				 
				<div class="content">
				<div
				style='padding: 10px 5px; font-size: 16px; color: #444;'>
				Saldo Atual: <strong>Gold: 0</strong>
				</div>
				</div>
				 
				</fieldset>
				 
				</div>
				 
				</div>

Eu queria pegar o "0" depois do "GOLD:"

Tentei assim:

showmessage(WebBrowser1.OleObject.Document.All.Tags('div').InnerHTML);

Pode me ajudar com isso também? Obrigado novamente.

Editado por Gabriel10101
Link para o comentário
Compartilhar em outros sites
  • 0
Jhonas

Jhonas

Postado
Postado

nesse link tem um exemplo que voce pode modificar para o seu uso

http://delphidabbler.com/tips/56

http://www.devmedia.com.br/dicas-extraindo-tags-html/982

nesse link tem outro exemplo ... voce pode jogar o conteudo do html para um memo, e depois procurar dentro dele e extrair a informação que precisa

http://www.dicasdelphi.com.br/dica-vizualizando-html-no-componente-memo/

abraço

Link para o comentário
Compartilhar em outros sites
  • 0
Gabriel10101

Gabriel10101

Postado
  • Autor
Postado

A ok vou tentar aqui,outra dúvida como posso fazer para preencher um campo que sempre gera um id diferente?

<input id="66c52590-5f06-4e30-9fdd-ed0b28ee7187.loginForm.username" maxlength="50" name="66c52590-5f06-4e30-9fdd-ed0b28ee7187:username" value="" tabindex="1" class="mail required email" type="text" crmwa_forminfo="e-mail|">
Link para o comentário
Compartilhar em outros sites
  • 0
Gabriel10101

Gabriel10101

Postado
  • Autor
Postado (editado)

Então Jhonas,eu to usando a fuction para procurar pela class,porém não estou conseguindo usar ela,pode me ajudar?

function GetElementById(const Doc: IDispatch; const Id: string): IDispatch;
var
Document: IHTMLDocument2; // IHTMLDocument2 interface of Doc
Body: IHTMLElement2; // document body element
Tags: IHTMLElementCollection; // all tags in document body
Tag: IHTMLElement; // a tag in document body
I: Integer; // loops thru tags in document body 
begin
Result := nil; // Check for valid document: require IHTMLDocument2 interface to it
if not Supports(Doc, IHTMLDocument2, Document) then
raise Exception.Create('Invalid HTML document'); // Check for valid body element: require IHTMLElement2 interface to it
if not Supports(Document.body, IHTMLElement2, Body) then
raise Exception.Create('Can''t find <body> element'); // Get all tags in body element ('*' => any tag name)
Tags := Body.getElementsByTagName('*'); // Scan through all tags in body
for I := 0 to Pred(Tags.length) do
begin // Get reference to a tag
Tag := Tags.item(I, EmptyParam) as IHTMLElement; // Check tag's id and return it if id matches
if AnsiSameText(Tag.ClassName, Id) then
begin
Result := Tag;
Break;
end;
end;
end;

Não consigo fazer o programa procurar pela class: "mail required email" e colocar um value nela.

Editado por Gabriel10101
Link para o comentário
Compartilhar em outros sites
  • 0
Jhonas

Jhonas

Postado
Postado

como esta no exemplo

function GetElementById(const Doc: IDispatch; const Id: string): IDispatch;
var
Document: IHTMLDocument2; // IHTMLDocument2 interface of Doc
Body: IHTMLElement2; // document body element
Tags: IHTMLElementCollection; // all tags in document body
Tag: IHTMLElement; // a tag in document body
I: Integer; // loops thru tags in document body
begin
Result := nil; // Check for valid document: require IHTMLDocument2 interface to it
if not Supports(Doc, IHTMLDocument2, Document) then
raise Exception.Create('Invalid HTML document'); // Check for valid body element: require IHTMLElement2 interface to it
if not Supports(Document.body, IHTMLElement2, Body) then
raise Exception.Create('Can''t find <body> element'); // Get all tags in body element ('*' => any tag name)
Tags := Body.getElementsByTagName('*'); // Scan through all tags in body
for I := 0 to Pred(Tags.length) do
begin // Get reference to a tag
Tag := Tags.item(I, EmptyParam) as IHTMLElement; // Check tag's id and return it if id matches
if AnsiSameText(Tag.ClassName, Id) then
begin
Result := Tag;
Break;
end;
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
Elem: IHTMLElement;
begin
Elem := GetElementById(WebBrowser1.Document, 'mail required email') as IHTMLElement;
if Assigned(Elem) then
Elem.Click;
end;

abraço

Link para o comentário
Compartilhar em outros sites
  • 0
Jhonas

Jhonas

Postado
Postado

veja se não esqueceu de declarar a uses :

uses
  MSHTML;

mas o comando é permitido sim

exemplo

procedure SetData;
var
  doc: IHTMLdocument2;
  elem: IHTMLElement;
begin
    doc := IE.document as IHTMLdocument2;
    elem := doc.all.item('mycontrol',0) as IHTMLElement;
    elem.value := 'SomeValue';
end;

abraço

Link para o comentário
Compartilhar em outros sites
  • 0
Jhonas

Jhonas

Postado
Postado

nesse exemplo voce quer substituir

Paragraph with id = myid

pelo seu texto, então vai ficar

My new text

OBS: voce deve fazer as alterações necessarias para o seu uso

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, OleCtrls, SHDocVw;

type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
WebBrowser1: TWebBrowser;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure FormShow(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}


uses
MSHTML;

function GetElementById(const Doc: IDispatch; const Id: string): IDispatch;
var
Document: IHTMLDocument2; // IHTMLDocument2 interface of Doc
Body: IHTMLElement2; // document body element
Tags: IHTMLElementCollection; // all tags in document body
Tag: IHTMLElement; // a tag in document body
I: Integer; // loops thru tags in document body
begin
Result := nil;
// IHTMLDocument2

if not Supports(Doc, IHTMLDocument2, Document) then
raise Exception.Create('Invalid HTML document');

// Check for valid body element: require IHTMLElement2 interface to it

if not Supports(Document.body, IHTMLElement2, Body) then
raise Exception.Create('Invalid HTML document');

Tags := Body.getElementsByTagName('*');

for I := 0 to Pred(Tags.length) do
begin

Tag := Tags.item(I, EmptyParam) as IHTMLElement;

// Check tag's id and return it if id matches

if AnsiSameText(Tag.id, Id) then
begin
Result := Tag;
Break;
end;
end;
end;

// CRIAR ARQUIVO TESTE.HTML PARA TESTE

{<?xml version="1.0"?>
<!DOCTYPE html
PUBLIC "//W3C//DTD XHTML 1.0 Strict//EN"
"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
<head>
<title>Tip#36 Test</title>
</head>
<body>
<p>Paragraph with no id</p>
<p id="myid">Paragraph with id = myid</p>
</body>
</html> }


procedure TForm1.FormShow(Sender: TObject);
begin
// WebBrowser1.Navigate(
// 'file:///' + ExtractFilePath(ParamStr(0)) + 'c:\test.html');

WebBrowser1.Navigate('c:\teste.html');
end;


procedure TForm1.Button1Click(Sender: TObject);
var
Elem: IHTMLElement;
begin
Elem := GetElementById(WebBrowser1.Document,
'myid') as IHTMLElement;
if Assigned(Elem) then
ShowMessage(
'Tag name = <' + Elem.tagName + '>'#10 +
'Tag id = ' + Elem.id + #10 +
'Tag innerHTML = "' + Elem.innerHTML + '"'
);
end;


procedure TForm1.Button2Click(Sender: TObject);
var
Elem: IHTMLElement;
begin
Elem := GetElementById(WebBrowser1.Document,'myid') as IHTMLElement;
if Assigned(Elem) then
Elem.innerHTML := 'My new text';
end;


end.

abraço

Link para o comentário
Compartilhar em outros sites
  • 0
Gabriel10101

Gabriel10101

Postado
  • Autor
Postado

<script type='text/javascript'>window.mod_pagespeed_start = Number(new Date());</script>

veja se não esqueceu de declarar a uses :

uses
  MSHTML;

mas o comando é permitido sim

exemplo

procedure SetData;
var
  doc: IHTMLdocument2;
  elem: IHTMLElement;
begin
    doc := IE.document as IHTMLdocument2;
    elem := doc.all.item('mycontrol',0) as IHTMLElement;
    elem.value := 'SomeValue';
end;

abraço

Declarei tudo e ainda da o erro:

[Error] Unit1.pas(193): Undeclared identifier: 'value'

Tentei adaptar para:

    doc := WebBrowser1.document as IHTMLdocument2;
    elem := doc.all.item('mail required email',0) as IHTMLElement;
    elem.innerHTML := 'my text';
Link para o comentário
Compartilhar em outros sites
  • 0
Gabriel10101

Gabriel10101

Postado
  • Autor
Postado (editado)

Tentei todas e não consegui,no exemplo o cara usa:

elem.setAttribute('value','meulogin',0)

Com base no exemplo pensei algo tipo:

     doc := WebBrowser1.document as IHTMLdocument2;
    elem := doc.all.item('mail required email',0) as IHTMLElement;
    elem.setAttribute('value','loginnnn',0);

Porém não deu certo,não completou :/

Editado por Gabriel10101
Link para o comentário
Compartilhar em outros sites
  • 0
Jhonas

Jhonas

Postado
Postado

Ok amigo... vamos a um exemplo pratico ... Preencher os campos E-mail e Senha do BOL

entrar-email-bol.jpg

vamos preencher os campos E-mail e Senha e depois clicar no botão ENTRAR

primeiro precisamos reconhecer no código da pagina os identificadores dos campos e do botão

para isso veja o código fonte da pagina

<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1//EN" "http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd"> <html xmlns="http://www.w3.org/1999/xhtml"> <head> <meta content="text/html; charset=ISO-8859-1" http-equiv="Content-Type"/> <title>BOL Mail</title> <link rel="shortcut icon" href="http://img.bol.com.br/favicon.ico" type="image/x-icon"/> <link href="http://email.bol.uol.com.br/c/bol-mail-20130108.css" media="screen" rel="stylesheet" type="text/css"/> <script src="http://barra.bol.com.br/scripts/functions.js" type="text/javascript"></script> <script type="text/javascript" src="http://me.jsuol.com/rm/clicklogger_namespace.js"></script> <script type="text/javascript">UOLRM.check(58);</script> </head> <body class="section-ajuda area26"> <div id="all"> <script type="text/javascript" src="http://barra.bol.com.br/scripts/barra-v3.js"></script> <div id="home-content"> <h1>BOL Mail</h1> <form action="https://visitante.acesso.uol.com.br/login.html" method="post" id="fWM" class="login-form"> <input type="hidden" value="bol-default" name="skin"/> <input type="hidden" value="WEBMAIL" name="dest"/> <fieldset> <p class="fields clearfix"> <label for="user"> E-mail: </label> <input class="text-field" id="username" name="user" type="text"/> <input type="hidden" value="" name="userconcat"/> <span class="extra"> @bol.com.br </span> </p> <p class="fields clearfix"> <label for="pass"> Senha: </label> <input class="text-field" id="pass" name="pass" type="password"/> <button class="entrar" type="submit">Entrar</button> </p> </fieldset> <div id="options" class="clearfix"> <a class="linksLogin" href="https://sac.uol.com.br/usuario/esqueci-senha.html?skin=bol"><span>Esqueceu a senha?</span></a> <a class="linksLogin" href="https://sac.uol.com.br/usuario/senha.html?skin=bol"><span>Alterar senha</span></a> <a class="linksLogin" href="http://email.bol.com.br/ajuda/"><span>Ajuda</span></a> </div> </form> <div id="features"> <a href="/ajuda/" class="homepacote"> <h2>O BOL tem o melhor pacote de e-mail gr&#225;tis pra voc&#234;</h2> </a> <ul class="clearfix"> <li><a href="http://email.bol.uol.com.br/gigamail">E-mail com 6GB</a></li> <li><a href="http://email.bol.uol.com.br/ajuda/calendario/">Calend&#225;rio com agenda</a></li> <li><a href="http://blog.bol.uol.com.br/">Blog e fotoblog</a></li> <li><a href="http://email.bol.uol.com.br/ajuda/bandalarga/">Banda larga *</a></li> <li><a href="http://email.bol.uol.com.br/ajuda/bate-papo-camera.jhtm">Bate-papo com c&#226;mera</a></li> <li><a href="http://email.bol.uol.com.br/ajuda/antispam/">Antispam</a></li> <li class="obs">* Exclusivo para quem tem Speedy</li> </ul> </div> <a class="signup" href="https://cadastro.uol.com.br/indexb.html?skin=bol/pf"> <span>Inscreva-se grátis!</span> </a> </div> <div id="home-links" class="flt_b"> <dl> <dt><img src="http://em.i.bol.com.br/2013/banner_bol_gigamail.png"></dt> <dd><h2>BOL Gigamail</h2> <p>Dobre o espaço do seu BOL Mail de 6GB para 12GB e guarde mais fotos vídeos e músicas</p> <a href="http://clicklogger.rm.uol.com.br/?prd=72&grp=src:10;chn:65;creative:banner_pagina_email_bol&msr=Cliques%20de%20Origem:1&oper=11&redir=http://email.bol.uol.com.br/gigamail ">Saiba mais</a> </dd> </dl> <span class="sep-v"></span> <dl> <dt><img src="http://em.i.bol.com.br/2013/banner_bol_suporte_tel.png"></dt> <dd><h2>BOL Suporte Telefônico</h2> <p>Seu canal de atendimento para tirar dúvidas sobre instalação, configuração de e-mail e modem.</p> <a href="http://clicklogger.rm.uol.com.br/?prd=71&grp=src:10;chn:65;creative:banner_pagina_email_bol&msr=Cliques%20de%20Origem:1&oper=11&redir=http://suportetelefonico.bol.uol.com.br ">Saiba mais</a> </dd> </dl> </div> <script type="text/javascript">WriteCopyBol();</script> <div class="uolhost"><a href="http://www.uolhost.com.br/hospedagem-de-sites.html" target="_blank">Hospedagem</a>: <a href="http://www.uolhost.com.br/" target="_blank">UOL Host</a></div> <script type="text/javascript" src="http://jsuol.com/c/jquery/jquery.js"></script> <script language="JavaScript" type="text/javascript" src="http://me.jsuol.com/omtr/bolemail.js"></script> <script language="JavaScript" type="text/javascript">var s_code=uol_sc.t();if(s_code){document.write(s_code);}</script> <script type="text/javascript" src="http://jsuol.com/b/ie6/ie6alert.js" charset="iso-8859-1"></script> <script type="text/javascript" src="https://simg.uol.com.br/nocache/sac/menusac.min.js"></script> </body> </html>

Campo E-mail

<input class="text-field" id="username" name="user" type="text"/>

Campo Senha

<input class="text-field" id="pass" name="pass" type="password"/>

Botão ENTRAR

<button class="entrar" type="submit">Entrar</button>

para os campos E-mail e Senha temos um identificador id="username" e id="pass"

para o botão class="entrar"

OBS: tem muitas formas de montar o código, vou passar uma delas

uma forma bem simples de preencher os campos seria:

WebBrowser1.OleObject.Document.all.Item('username', 0).value := 'treinamento@bol.com.br';

WebBrowser1.OleObject.Document.all.Item('pass', 0).value := 'senhaxyz';

já para clicar no botão, poderiamos optar pela classe ou pelo nome do elemento botão que seria BUTTON

mas como pode haver varios outros elementos na pagina, então devemos procurar o elemento que queremos

if (Elements.item(i).tagName = 'BUTTON') then

agora vamos ao código .... em um Form coloque um componente WebBrowser e 3 botões

o botão 1 sera para iniciar a navegação no Webbrowser

o botão 2 será para preencher os campos E-mail e Senha

o botão 3 será para clicar no botão ENTRAR

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, OleCtrls, SHDocVw;

type
TForm1 = class(TForm)
WebBrowser1: TWebBrowser;
Button1: TButton;
Button2: TButton;
Button3: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
// Entrar na pagina
WebBrowser1.Navigate('http://email.bol.uol.com.br/#rmcl');
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
// Preencher os campos E-mail e Senha
WebBrowser1.OleObject.Document.all.Item('username', 0).value := 'meuemail@bol.com.br';
WebBrowser1.OleObject.Document.all.Item('pass', 0).value := 'minhasenha';
end;

procedure TForm1.Button3Click(Sender: TObject);
var Elements: OleVariant;
i: Integer;
begin
// Evitar erros de Scripts
WebBrowser1.Silent := true;

// Procurar pelo botão e clicar nele
Elements := WebBrowser1.OleObject.Document.forms.item(0).elements;
for i := 0 to (Elements.Length - 1) do
if (Elements.item(i).tagName = 'BUTTON') then
Elements.item(i).Click;
end;


end.

=============================================================================

agora vamos fazer de modo que eu apenas clique no botão 1 para chamar a pagina e o resto ele faça sozinho

para isso vamos usar a propriedade OnDocumentComplete do Webbrowser

onde após o carregamento da pagina, o código será automaticamente executado

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, OleCtrls, SHDocVw;

type
TForm1 = class(TForm)
WebBrowser1: TWebBrowser;
Button1: TButton;
procedure Button1Click(Sender: TObject);
procedure WebBrowser1DocumentComplete(Sender: TObject;
const pDisp: IDispatch; var URL: OleVariant);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

uses MSHtml, ActiveX;

procedure TForm1.Button1Click(Sender: TObject);
begin
// Entrar na pagina
WebBrowser1.Navigate('http://email.bol.uol.com.br/#rmcl');
end;

procedure TForm1.WebBrowser1DocumentComplete(Sender: TObject;
const pDisp: IDispatch; var URL: OleVariant);
var
CurrentBrowser: IWebBrowser2;
TopBrowser: IWebBrowser2;
Document: OleVariant;
Doc3 : IHTMLDocument3;
Frm : IHtmlFormElement;

Elements: OleVariant;
i: Integer;
begin
CurrentBrowser := pDisp as IWebBrowser2;
TopBrowser := (Sender as TWebbrowser).DefaultInterface;
if Assigned(CurrentBrowser) and Assigned(TopBrowser) then
begin
if CurrentBrowser = TopBrowser then
begin
Doc3 := CurrentBrowser.Document as IHTMLDocument3;
Webbrowser1.OnDocumentComplete := nil;
Doc3.getElementById('username').setAttribute('value', 'meuemail@bol.com.br', 0);
Doc3.getElementById('pass').setAttribute('value', 'minhasenha', 0);
WebBrowser1.Silent;
Elements := WebBrowser1.OleObject.Document.forms.item(0).elements;
for i := 0 to (Elements.Length - 1) do
if (Elements.item(i).tagName = 'BUTTON') then
begin
WebBrowser1.Silent := true;
Elements.item(i).Click;
end;

end;
end;

end;

end.

===========================================================================

Espero que isso ajude a esclarecer as suas idéias ...

OBS: como eu disse, existem outras maneiras de se fazer isso

abraço

Link para o comentário
Compartilhar em outros sites
  • 0
Gabriel10101

Gabriel10101

Postado
  • Autor
Postado

Desculpa a demora pra responder...Meu problema é que no id vem numeros e letras random:

id=c2f2ea0e-7e33-403d-b1d1-a31770577ece.loginForm.username

Todo

<input id="c2f2ea0e-7e33-403d-b1d1-a31770577ece.loginForm.username" maxlength="50" name="c2f2ea0e-7e33-403d-b1d1-a31770577ece:username" value="" tabindex="1" class="mail required email" type="text" crmwa_forminfo="e-mail|">

Por isso eu precisava pegar a class que é fixo,e fazer ele preencher.

Link para o comentário
Compartilhar em outros sites

Participe da discussão

Você pode postar agora e se registrar depois. Se você já tem uma conta, acesse agora para postar com sua conta.

Visitante
Responder esta pergunta...

×   Você colou conteúdo com formatação.   Remover formatação

  Apenas 75 emoticons são permitidos.

×   Seu link foi incorporado automaticamente.   Exibir como um link em vez disso

×   Seu conteúdo anterior foi restaurado.   Limpar Editor

×   Você não pode colar imagens diretamente. Carregar ou inserir imagens do URL.

×
 Share
Ir para lista de Perguntas


  • Estatísticas dos Fóruns

    • Tópicos
      152,3k
    • Posts
      652,5k
×
×
  • Criar Novo...