Witam
Dzięki wskazówkom od Olesio i Madmike napisałem sobie klasę do obsługi formularzy na stronach www. Używam WebBrowsera, który pozwala na ściągnięcie strony, podstawienie wartości, naciśnięcie klawisza i wykonanie scryptu Java. Zamieszczam - może się komuś przyda:
// klasa obsługująca interakcyjne formularze na stronach www
// 03.03.2011
unit www_obs;
interface
uses Forms, MSHTML, OleCtrls, SHDocVw, StrUtils, Dialogs, SysUtils;
type
Twww_obsluga=class
private
procedure WWWczekajNaWWW;
public
informacja:string; //do wyświetlania info (nr pozycji itp)
strona_sciagnieta: boolean; //=true zdarzenie kompletne
adresURL: string; //co ma pobierać, do porównania czy nie przekierowano do logowania
adresSciagniety: string; //co się udało ściągnąć
lAdresOK: boolean; //ustawia true, gdy pasują adresy (porónuje do długości zadanego, żeby ID sesji gubić
procedure www_ustaw_wartosc(sPole, sWartosc: string; WebBrowserX:TObject); //wpisuje w kontrolkę wartość
function www_kliknij_klawisz(sNazwaKlawisza:string; WebBrowserX:TObject):boolean;
function www_wykonaj_skrypt(sNazwaSkryptu:string; WebBrowserX:TObject): boolean;
procedure www_sciagnij_strone(sAdresWWW:string; WebBrowserX:TObject); //pobiera kompletną stronę
constructor www_creator(WebBrowserX:Tobject); //przechwyci obsługę po załadowaniu strony
procedure www_zaladowano; //wywołana po kompletnym wczytaniu strony, zapala flagę
end;
implementation
{ Twww_obsluga }
// function to execute a script function
function ExecuteScript(doc: IHTMLDocument2; script: string; language: string): Boolean;
var
win: IHTMLWindow2;
Olelanguage: Olevariant;
begin
result:=true; //ustawić właściwe wartości
if doc <> nil then
begin
try
win := doc.parentWindow;
if win <> nil then
begin
try
Olelanguage := language;
win.ExecScript(script, Olelanguage);
finally
win := nil;
end;
end;
finally
doc := nil;
end;
end;
end;
// czeka, aż strona zostanie całkowicie pobrana
procedure Twww_obsluga.WWWczekajNaWWW;
begin
while not(strona_sciagnieta) do
Application.ProcessMessages; //zwalnianie kolejki
end;
constructor Twww_obsluga.www_creator; //(WebBrowserX: Tobject);
begin
// TWebBrowser(WebBrowserX).OnDocumentComplete:='www_obsluga.www_zaladowano';
strona_sciagnieta:=false;
lAdresOK:=false;
adresURL:='';
adresSciagniety:='';
showmessage('zainicjowano');
end;
function Twww_obsluga.www_kliknij_klawisz(sNazwaKlawisza:string; WebBrowserX:TObject):boolean;
//symuluje kliknięcie podanego klawisza na formularzu
var
doc: IHtmlDocument2;
i: integer;
ov: OleVariant;
disp: IDispatch;
collection: IHTMLElementCollection;
inputelement: HTMLInputImage;
begin
result:=false;
TWebBrowser(WebBrowserX).ControlInterface.Document.QueryInterface(IHtmlDocument2, doc);
ov := 'INPUT';
disp := doc.all.tags(ov);
if Assigned(disp) then
begin
disp.QueryInterface(IHTMLElementCollection, collection);
if Assigned(collection) then
begin
for i := 1 to collection.Get_length do
begin
disp := collection.item(pred(i), 0);
disp.QueryInterface(HTMLInputImage, inputelement);
if Assigned(inputelement) then
begin
if inputelement.Name = sNazwaKlawisza then
begin
inputelement.Click;
result:=true;
EXIT
end;
end;
end;
end;
end;
end;
procedure Twww_obsluga.www_sciagnij_strone(sAdresWWW: string; WebBrowserX:TObject);
//pobiera kompletną stronę, błąd/sukces lAdresOK
var
Url, Flags, TargetFrameName, PostData, Headers: OleVariant;
begin
// Url := ExtractFilePath(Application.ExeName) + 'Test.htm';
strona_sciagnieta:=false; //flaga
adresURL:=sAdresWWW;
Url:=sAdresWWW;
TWebBrowser(WebBrowserX).Navigate2(Url, Flags, TargetFrameName, PostData, Headers);
WWWczekajNaWWW; //wyjdzie po ściągnięciu całości
//porównanie adresu
adresSciagniety:=TWebBrowser(WebBrowserX).LocationURL;
if LeftStr(AnsiUpperCase(adresSciagniety),Length(adresURL))<>AnsiUpperCase(adresURL) then
begin
lAdresOK:=false;
ShowMessage('Pobrano niewłaściwą stronę!'#10'wymagana: '+adresURL+#10'ściągnięty: '+adresSciagniety);
EXIT;
end
else
lAdresOK:=true;
end;
/////////////////////////////////////////////////////
procedure Twww_obsluga.www_ustaw_wartosc(sPole, sWartosc: string; WebBrowserX:TObject);
//wstawia wartości w zadane pola
var
doc: IHtmlDocument2;
begin
TWebBrowser(WebBrowserX).ControlInterface.Document.QueryInterface(IHtmlDocument2, doc);
TWebBrowser(WebBrowserX).OleObject.document.GetElementById(sPole).value:=sWartosc;
end;
function Twww_obsluga.www_wykonaj_skrypt(sNazwaSkryptu:string; WebBrowserX:TObject): boolean;
var
doc: IHtmlDocument2;
begin
strona_sciagnieta:=false; //flaga
TWebBrowser(WebBrowserX).ControlInterface.Document.QueryInterface(IHtmlDocument2, doc);
result:=ExecuteScript(doc, sNazwaSkryptu, 'JavaScript');
WWWczekajNaWWW;
end;
procedure Twww_obsluga.www_zaladowano;
begin
strona_sciagnieta:=true;
end;
end.
przykładowe wykorzystanie:
nowy.www_sciagnij_strone('http://jakas_strona/privmsg.php?mode=post',WebBrowser1);
nowy.www_ustaw_wartosc('username','zefir',WebBrowser1);
nowy.www_ustaw_wartosc('subject','Zmiana hasła z okazji',WebBrowser1);
nowy.www_ustaw_wartosc('message','test zmiany2',WebBrowser1);
nowy.www_kliknij_klawisz('post',WebBrowser1);
nowy.www_sciagnij_strone('http://www.inna_strona/main.asp',WebBrowser1);
nowy.www_ustaw_wartosc('id','zefir',WebBrowser1);
nowy.www_ustaw_wartosc('pwd','******',WebBrowser1);
nowy.www_wykonaj_skrypt('document.LForm.submit()',WebBrowser1);
Oczywiście w źródłach strony trzeba wyłapać odpowiednie pola do uzupełnienia, nazwy klawiszy i procedur Java. Chodzi nie za szybko, ale pewnie.
Niestety - do czasu :(
Problem pojawia się, gy dostaję "Komunikat ze strony web" że np. dane zostały zmienione z sukcesem. I tu prośba o pomoc - JAK ZGASIĆ TAKI KOMUNIKAT?
Program zatrzymuje się i muszę ręcznie nacisnąć OK. Można oczywiście zasymulować kliknięcie myszy, ale to rozwiązanie zawsze niesie pewne ryzyko (np. reklama na stronie przesunie współrzędne).
Z góry dziękuję za wskazówki