unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, OleCtrls, SHDocVw, mshtml, StdCtrls;
type
TForm1 = class(TForm)
WebBrowser1: TWebBrowser;
ButtonLogin: TButton;
ButtonRefresh: TButton;
procedure ButtonRefreshClick(Sender: TObject);
procedure ButtonLoginClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
function GetBodyAll(XDoc: IDispatch): IHTMLElementCollection;
var
LDoc: HTMLDocument;
LBody: HTMLBody;
begin
Result := nil;
LDoc := XDoc as HTMLDocument;
if LDoc = nil then
Exit;
LBody := LDoc.body as HTMLBody;
if LBody = nil then
Exit;
Result := LBody.all as IHTMLElementCollection;
end;
function GetBodyElement(const ABodyAll: IHTMLElementCollection; const AnElementName: string): IHTMLElement;
var
LName: OleVariant;
LIndex: OleVariant;
begin
Result := nil;
LName := AnElementName;
Result := ABodyAll.item(LName, LIndex) as IHTMLElement;
end;
function GetBodyElementStrValue(XBodyAll: IHTMLElementCollection; const AnItemName: string; var RetStr: string): Boolean;
var
LElem: IHTMLElement;
begin
Result := False;
LElem := GetBodyElement(XBodyAll, AnItemName);
if LElem <> nil then
begin
try
RetStr := Trim(LElem.getAttribute('value', 0));
Result := True;
except
end;
end;
end;
function GetIFrameBodyAll(XDoc: IDispatch; XFrameIndex: Integer): IHTMLElementCollection;
var
LIframeCollection:IHTMLElementCollection;
L1Iframe:IWebBrowser;
LLen: Integer;
LDoc: HTMLDocument;
LBody: HTMLBody;
begin
Result := nil;
LIframeCollection:=GetBodyAll(XDoc).tags('iframe') as IHTMLElementCollection;
LLen := LIframeCollection.length;
if (LLen > 0) and (XFrameIndex >= 0) and (XFrameIndex < LLen) then
begin
L1Iframe:= LIframeCollection.item(XFrameIndex, varEmpty) as IWebBrowser;
LDoc := L1Iframe.document as HTMLDocument;
if LDoc = nil then
Exit;
LBody := LDoc.body as HTMLBody;
if LBody = nil then
Exit;
Result := LBody.all as IHTMLElementCollection;
end;
end;
function SetBodyElementStrValue(XBodyAll: IHTMLElementCollection; const AnItemName: string; const XValueStr: string): Boolean;
var
LElem: IHTMLElement;
LValue: OleVariant;
begin
Result := False;
LElem := GetBodyElement(XBodyAll, AnItemName);
if LElem <> nil then
begin
try
LValue := XValueStr;
LElem.setAttribute('value', LValue, 0);
Result := True;
except
end;
end;
end;
procedure TForm1.ButtonLoginClick(Sender: TObject);
const
CNameUserName = 'miniLogin_username';
CNamePwd = 'miniLogin_pwd';
CMyUserName = '[email protected]';
CMyPwd = '11';
var
LOldValue: string;
LBodyAll: IHTMLElementCollection;
LBtn: IHTMLElement;
begin
inherited;
LBodyAll := GetIFrameBodyAll(WebBrowser1.Document, 0);
if LBodyAll = nil then
Exit;
if not GetBodyElementStrValue(LBodyAll, CNameUserName, LOldValue) then
begin
Exit;
end;
if LOldValue <> CMyUserName then
begin
if not SetBodyElementStrValue(LBodyAll, CNameUserName, CMyUserName) then
Exit;
end;
if not GetBodyElementStrValue(LBodyAll, CNamePwd, LOldValue) then
begin
Exit;
end;
if LOldValue <> CMyPwd then
begin
if not SetBodyElementStrValue(LBodyAll, CNamePwd, CMyPwd) then
Exit;
end;
LBtn := GetBodyElement(LBodyAll, 'message_LOGIN_IMMEDIATELY');
if LBtn = nil then
Exit;
LBtn.click;
end;
procedure TForm1.ButtonRefreshClick(Sender: TObject);
begin
WebBrowser1.Navigate('url');
end;
end.