Komponenta treba da se uloguje na sajt, da "isparsuje" html kod, t.e. da nadje odredjeni deo.
evo koda:
unit Account;
interface
uses
SysUtils, Classes, Controls, ExtCtrls, SHDocVw,
FastStringFuncs, StdCtrls;
type
TAccount = class(TPanel)
private
{ Private declarations }
Timer: TTimer;
Browser: TWebBrowser;
Code: TMemo;
function FillForm(WebBrowser: TWebBrowser; FieldName: string; Value: string):boolean;
function SubmitForm(WebBrowser: TWebBrowser): Boolean;
function stratpos(FindWhat, FindWhere: string): integer;
function CutStr(Tekst, StartString, EndString: string):string;
function FindLineNo(FindWhat: string; FindWhere: TStrings):integer;
procedure FillLogin();
procedure DocComplete(Sender: TObject;const pDisp: IDispatch; var URL: OleVariant);
procedure ParseBalance();
protected
{ Protected declarations }
public
{ Public declarations }
Account : string;
Pin : string;
Rate : real;
CheckAfter : integer;
RealBalance : real;
Balance : real;
Test : string;
URL : String;
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure Navigate(URL: string);
function GetHTML: String;
published
{ Published declarations }
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Moi', [TAccount]);
end;
function TAccount.FillForm(WebBrowser: TWebBrowser; FieldName: string; Value: string): Boolean;
var
i, j: Integer;
FormItem: Variant;
begin
Result := False;
if WebBrowser.OleObject.Document.all.tags('FORM').Length = 0 then Exit;
for I := 0 to WebBrowser.OleObject.Document.forms.Length - 1 do
begin
FormItem := WebBrowser.OleObject.Document.forms.Item(I);
for j := 0 to FormItem.Length - 1 do
begin
if (UpperCase(FormItem.Item(j).Type) = 'TEXT') or (UpperCase(FormItem.Item(j).Type) = 'TEXTAREA') or (UpperCase(FormItem.Item(j).Type) = 'PASSWORD') then
if (FormItem.Item(j).Name = FieldName) then
begin
FormItem.Item(j).Value := Value;
Result := True;
end;
end;
end;
end;
function TAccount.SubmitForm(WebBrowser: TWebBrowser): Boolean;
var
i, j: Integer;
FormItem: Variant;
begin
Result := False;
if WebBrowser.OleObject.Document.all.tags('FORM').Length = 0 then Exit;
for I := 0 to WebBrowser.OleObject.Document.forms.Length - 1 do
begin
FormItem := WebBrowser.OleObject.Document.forms.Item(I);
for j := 0 to FormItem.Length - 1 do
begin
if (UpperCase(FormItem.Item(j).Type) = 'SUBMIT') then
begin
FormItem.Item(j).click;
Result := True;
end;
end;
end;
end;
function TAccount.stratpos(FindWhat, FindWhere: string): integer;
var Rezultat: integer;
i: integer;
begin
Rezultat := -1;
for i:=1 to length(FindWhere)-length(FindWhat) do
if copy(FindWhere, i, length(FindWhat)) = FindWhat then
Rezultat := i;
Result:=Rezultat;
end;
function TAccount.CutStr(Tekst, StartString, EndString: string):string;
var
StartPos, EndPos: integer;
begin
StartPos:=stratpos(StartString, Tekst)+length(StartString);
EndPos:=stratpos(EndString, Tekst);
Result:=copy(Tekst, StartPos, EndPos-StartPos);
end;
function TAccount.FindLineNo(FindWhat: string; FindWhere: TStrings):integer;
var i:integer;
finded:boolean;
begin
finded:=false;
i:=1;
while (not finded) and (i<=FindWhere.Count) do
begin
if stratpos(FindWhat, FindWhere[i])>-1 then
finded:=true
else
i:=i+1;
end;
if Finded then
Result:=i
else
Result:=-1;
end;
procedure TAccount.FillLogin();
begin
FillForm(Browser, 'p_sa', Account);
FillForm(Browser, 'p_pin', Pin);
SubmitForm(Browser);
end;
procedure TAccount.DocComplete(Sender: TObject;const pDisp: IDispatch; var URL: OleVariant);
begin
Test:=TWebBrowser(Sender).LocationURL;
if stratpos('login', TWebBrowser(Sender).LocationURL)>0 then
FillLogin;
if stratpos('account',TWebBrowser(Sender).LocationURL)>0 then
ParseBalance;
end;
procedure TAccount.ParseBalance();
var
LineNo: integer;
Linija, TempBalance: string;
begin
Code.Text:=Browser.OleObject.document.Body.innerHTML;
LineNo:=FindLineNo('<P>Account Balance: <B>US$',Code.Lines);
if LineNo>=0 then
begin
Linija:=Code.Lines.Strings[LineNo];
TempBalance:=CutStr(Linija, '<B>US$', '</B>');
TempBalance := StringReplace(TempBalance, '.', ',',[rfReplaceAll, rfIgnoreCase]);
RealBalance:=StrToFloat(TempBalance);
Balance:=RealBalance*Rate;
end;
end;
constructor TAccount.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Timer := TTimer.Create(Self);
Code:=TMemo.Create(Self);
Browser:=TWebBrowser.Create(Self);
Browser.OnDocumentComplete:=DocComplete;
end;
destructor TAccount.Destroy;
begin
Timer.Free;
Browser.Free;
Code.Free;
inherited;
end;
procedure TAccount.Navigate(URL: string);
begin
Browser.Navigate(URL);
end;
function TAccount.GetHTML: string;
begin
Result:=Browser.OleObject.document.Body.innerHTML;
end;
end.
Nesto mi ne radi OnDocumentComplete. Kako da napravim svoje properties i svoje evente?
Recimo, kad "nadje" balance, da ima event OnBalance (recimo).