unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, OleCtrls, SHDocVw,MSHTML, StdCtrls, IdBaseComponent, IdComponent,
IdTCPConnection, IdTCPClient, IdHTTP;
type
TForm1 = class(TForm)
WebBrowser1: TWebBrowser;
Button1: TButton;
Label1: TLabel;
Memo1: TMemo;
Memo2: TMemo;
Button2: TButton;
IdHTTP1: TIdHTTP;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
function NumberOfForms(document: IHTMLDocument2): integer;
function GetFormByNumber(document: IHTMLDocument2;formNumber: integer): IHTMLFormElement;
function GetFormFieldNames(fromForm: IHTMLFormElement): TStringList;
function GetFieldValue(fromForm: IHTMLFormElement;const fieldName: string): string;
function GetElementById(const Doc: IDispatch; const Id: string): IDispatch;
procedure SetFieldValue(theForm: IHTMLFormElement;const fieldName: string; const newValue: string;const instance: integer=0);
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
{ TForm1 }
procedure TForm1.Button1Click(Sender: TObject);
var
stringlist: tstringlist;
firstForm: IHTMLFormElement;
document: IHTMLDocument2;
i:integer;
a:variant;
begin
firstForm:=GetFormByNumber(webbrowser1.Document as IHTMLDocument2,0);
stringlist:=GetFormFieldNames(firstForm);
memo1.Lines.Assign(stringlist);
memo2.Clear;
for i := 0 to memo1.Lines.Count - 1 do
memo2.Lines.Add(inttostr(i)+'. '+GetFieldValue(firstForm,memo1.Lines[i]));
memo2.Lines.Add(GetFieldValue(firstForm,memo1.Lines[0]));
memo2.Lines.Add(GetFieldValue(firstForm,memo1.Lines[1]));
memo2.Lines.Add(GetFieldValue(firstForm,memo1.Lines[2]));
memo2.Lines.Add(GetFieldValue(firstForm,memo1.Lines[3]));
end;
procedure TForm1.Button2Click(Sender: TObject);
var
PostData,PageData:TStringList;
begin
end;
procedure TForm1.FormCreate(Sender: TObject);
var Flags, TargetFrameName, PostData, Headers: OleVariant;
begin
//WebBrowser1.Navigate('http://www.google.com', 4, TargetFrameName, PostData, Headers);
WebBrowser1.Navigate('https://esk.sbrf.ru', 4, TargetFrameName, PostData, Headers);
//WebBrowser1.Navigate('file:///' + ExtractFilePath(ParamStr(0)) + '2.html', 4, TargetFrameName, PostData, Headers);
end;
function TForm1.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('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
memo2.Lines.Add(Tag.innerHTML);
if AnsiSameText(Tag.id, Id) then
begin
Result := Tag;
Break;
end;
end;
end;
function TForm1.GetFieldValue(fromForm: IHTMLFormElement;
const fieldName: string): string;
var
field: IHTMLElement;
inputField: IHTMLInputElement;
selectField: IHTMLSelectElement;
textField: IHTMLTextAreaElement;
begin
field := fromForm.Item(fieldName,'') as IHTMLElement;
if not Assigned(field) then
result := ''
else if field.tagName = 'INPUT' then
begin
inputField := field as IHTMLInputElement;
if (inputField.type_ <> 'radio') and
(inputField.type_ <> 'checkbox')
then
result := inputField.value
else if inputField.checked then
result := 'checked'
else
result := 'unchecked';
end
else if field.tagName = 'SELECT' then
begin
selectField := field as IHTMLSelectElement;
result := selectField.value
end
else if field.tagName = 'TEXTAREA' then
begin
textField := field as IHTMLTextAreaElement;
result := textField.value;
end;
end;
function TForm1.GetFormByNumber(document: IHTMLDocument2;
formNumber: integer): IHTMLFormElement;
var
forms: IHTMLElementCollection;
begin
forms := document.Forms as IHTMLElementCollection;
if formNumber < forms.Length then
result := forms.Item(formNumber,'') as IHTMLFormElement
else
result := nil;
end;
function TForm1.GetFormFieldNames(fromForm: IHTMLFormElement): TStringList;
var
index: integer;
field: IHTMLElement;
input: IHTMLInputElement;
select: IHTMLSelectElement;
text: IHTMLTextAreaElement;
begin
result := TStringList.Create;
for index := 0 to fromForm.length do
begin
field := fromForm.Item(index,'') as IHTMLElement;
if Assigned(field) then
begin
if field.tagName = 'INPUT' then
begin
// поля Input
input := field as IHTMLInputElement;
result.Add(input.name);
end
else if field.tagName = 'SELECT' then
begin
// поля Select
select := field as IHTMLSelectElement;
result.Add(select.name);
end
else if field.tagName = 'TEXTAREA' then
begin
// поля TextArea
text := field as IHTMLTextAreaElement;
result.Add(text.name);
end;
end;
end;
end;
function TForm1.NumberOfForms(document: IHTMLDocument2): integer;
var
forms: IHTMLElementCollection;
begin
forms := document.Forms as IHTMLElementCollection;
result := forms.Length;
end;
procedure TForm1.SetFieldValue(theForm: IHTMLFormElement; const fieldName,
newValue: string; const instance: integer);
var
field: IHTMLElement;
inputField: IHTMLInputElement;
selectField: IHTMLSelectElement;
textField: IHTMLTextAreaElement;
begin
field := theForm.Item(fieldName,instance) as IHTMLElement;
if Assigned(field) then
begin
if field.tagName = 'INPUT' then
begin
inputField := field as IHTMLInputElement;
if (inputField.type_ <> 'radio') and
(inputField.type_ <> 'checkbox')
then
inputField.value := newValue
else
inputField.checked := (newValue = 'checked');
end
else if field.tagName = 'SELECT' then
begin
selectField := field as IHTMLSelectElement;
selectField.value := newValue;
end
else if field.tagName = 'TEXTAREA' then
begin
textField := field as IHTMLTextAreaElement;
textField.value := newValue;
end;
end;
end;
end.