unit ClientUnit1;
interface
uses
SysUtils, Dialogs, Forms,OleCtrls, SHDocVw, Classes, Controls, StdCtrls, StrUtils;
type
TForm1 =
class(TForm)
Button1: TButton;
wb: TWebBrowser;
Memo1: TMemo;
Button2: TButton;
procedure Button1Click(Sender: TObject);
function WBFillForm(wb: TWebBrowser; sFieldName:
string; sValue:
string): Boolean;
procedure Button2Click(Sender: TObject);
private
{ Private-Deklarationen }
public
{ Public-Deklarationen }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
// ...HTML Formulare mit TWebBrowser automatisch ausfüllen lassen?
function TForm1.WBFillForm(wb: TWebBrowser; sFieldName:
string; sValue:
string): Boolean;
var
i, j: Integer;
FormItem: Variant;
begin
Result := False;
//no form on document
if wb.OleObject.Document.all.tags('
FORM').Length = 0
then begin
Exit;
end;
//count forms on document
for I := 0
to wb.OleObject.Document.forms.Length - 1
do begin
FormItem := wb.OleObject.Document.forms.Item(I);
for j := 0
to FormItem.Length - 1
do begin
try
// when the fieldname is found, try to fill out
if AnsiUpperCase(FormItem.Item(j).
Name) = AnsiUpperCase(sFieldName)
then begin
FormItem.Item(j).Value := sValue;
Result := True;
end;
except
Exit;
end;
end;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
Application.ProcessMessages;
while wb.Busy
do Application.ProcessMessages;
while wb.ReadyState <> READYSTATE_COMPLETE
do Application.ProcessMessages;
if not WBFillForm(wb,'
message',Memo1.Text)
then begin
ShowMessage('
Das Textfeld message wurde nicht gefunden.');
end;
Application.ProcessMessages;
while wb.Busy
do Application.ProcessMessages;
while wb.ReadyState <> READYSTATE_COMPLETE
do Application.ProcessMessages;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
wb.Navigate('
E:\Delphi\WebModule\test.html');
ShowMessage('
***');
end;
end.