Webbrowser OleObject - Felder füllen

[gee21]

Zitat von nahpets:

Hallo,

die Fehlermeldung muss nicht zwingend in der Zeile auftreten, die Du uns gezeigt hast. Zeig doch bitte mal etwas mehr Quellcode.

Oder hilft Dir diese Funktion?

Delphi-Quellcode:

// ...HTML Formulare mit TWebBrowser automatisch ausfüllen lassen?
function  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;

Der Aufruf müsste dann in etwa so aussehen:

Delphi-Quellcode:

  Application.ProcessMessages;
  while WebBrowser1.Busy do Application.ProcessMessages;
  while WebBrowser1.ReadyState <> READYSTATE_COMPLETE do Application.ProcessMessages;
  if not WBFillForm(WebBrowser1,'message', Memo1.Text) then begin
    ShowMessage('Das Feld Message konnte nicht gefüllt werden.');
  end;
  Application.ProcessMessages;
  while WebBrowser1.Busy do Application.ProcessMessages;
  while WebBrowser1.ReadyState <> READYSTATE_COMPLETE do Application.ProcessMessages;

Ok hier mal mein Quellcode, Dein Code habe ich übrigens getestet. Leider kommt die Meldung dass das Feld nicht ausgefüllt werden konnte.

Delphi-Quellcode:

var
  Form1: TForm1;

implementation

{$R *.dfm}

function WB_GetHTMLCode(WebBrowser: tembeddedwb; ACode: TStrings): Boolean;
var
   ps: IPersistStreamInit;
   ss: TStringStream;
   sa: IStream;
   s: string;
begin
   ps := WebBrowser.Document as IPersistStreamInit;
   s := '';
   ss := TStringStream.Create(s);
   try
     sa := TStreamAdapter.Create(ss, soReference) as IStream;
     Result := Succeeded(ps.Save(sa, True));
     if Result then ACode.Add(ss.Datastring);
   finally
     ss.Free;
   end;
end;



 function FillForm(WebBrowser: tembeddedwb; FieldName: string; Value: string): Boolean;
var
  i, j: Integer;
  FormItem: Variant;
begin
  Result := False;
  //no form on document
  if WebBrowser.OleObject.Document.all.tags('FORM').Length = 0 then
  begin
    Exit;
  showmessage('Exit');
  end;
  //count forms on document
  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
      try
        //when the fieldname is found, try to fill out
        if FormItem.Item(j).Name = FieldName then
        begin
          FormItem.Item(j).Value := Value;
          Result := True;
        end;
      except
        Exit;
      end;
    end;
  end;
end;





procedure TForm1.Button1Click(Sender: TObject);
begin

if Assigned(WebBrowser1)=true then showmessage('Vor');

WebBrowser1.OleObject.Document.getElementById('recipient').value :=  combobox1.Items[combobox1.ItemIndex]+edit3.Text;
WebBrowser1.OleObject.Document.getElementById('message').value :=  memo1.Text;

end;

procedure TForm1.Button2Click(Sender: TObject);
begin
if combobox2.ItemIndex=2 then webbrowser1.Navigate('http://www.bern-web.ch/');

if combobox2.ItemIndex=1 then webbrowser1.Navigate('http://www1.sunrise.ch/SMS-Sender-cbBpfAqFI.RUoAAAEwinJTNyCu-Sunrise-Residential-Site-WFS-de_CH-CHF.html');
progressbar1.Position:=25;

end;

procedure TForm1.Button5Click(Sender: TObject);
begin
if form1.Height=322=false then form1.Height:=322 else form1.Height:=590;
end;

procedure TForm1.Edit4MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
ReleaseCapture;
 Perform(WM_SYSCOMMAND, $F012, 0);
end;

procedure TForm1.FormCreate(Sender: TObject);

begin
Set8087CW($133F);
memo2.Lines.LoadFromFile(ExtractFilePath(Application.Exename)+'\config.txt');
end;

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
ReleaseCapture;
 Perform(WM_SYSCOMMAND, $F012, 0);
end;



procedure TForm1.Memo1Change(Sender: TObject);
var
i: integer;
i2: integer;
begin
i:=memo1.MaxLength;
i2 := Length(Memo1.Text);

i:=i-i2;
edit4.Text:=inttostr(i);
if i<160 then edit1.Text:='3/3';
if i>160 then edit1.Text:='2/3';
if i>320 then edit1.Text:='1/3';
if i>479 then edit1.Text:='0/3';
end;

procedure TForm1.Memo1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
ReleaseCapture;
 Perform(WM_SYSCOMMAND, $F012, 0);
end;

procedure TForm1.ProgressBar1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
ReleaseCapture;
 Perform(WM_SYSCOMMAND, $F012, 0);
end;


procedure TForm1.WebBrowser1DocumentComplete(ASender: TObject;
const pDisp: IDispatch; var URL: OleVariant);
var
i:integer;
begin

progressbar1.Position:=35;

if combobox2.ItemIndex=2 then begin
WB_GetHTMLCode(Webbrowser1, Memo2.Lines);
if FillForm(WebBrowser1, 'smsMessage', memo1.Text)=true then begin
 progressbar1.Position:=50;
  webbrowser1.Stop;
  FillForm(WebBrowser1, 'smsMessage', memo1.Text) ;
  FillForm(WebBrowser1, 'SMSEingabe', edit3.Text) ;
  if combobox1.ItemIndex=1 then  FillForm(WebBrowser1, 'intlPrefix', '004176');
   if combobox1.ItemIndex=2 then  FillForm(WebBrowser1, 'intlPrefix', '004177');
  if combobox1.ItemIndex=3 then  FillForm(WebBrowser1, 'intlPrefix', '004178');
    if combobox1.ItemIndex=4 then  FillForm(WebBrowser1, 'intlPrefix', '004179');

  webbrowser1.oleobject.document.forms.item(4).submit;
progressbar1.Position:=75;
  end else begin
      if progressbar1.Position=35 then begin
if edit7.Text='http://www.bern-web.ch/' then begin
if pos('Heute wurden von Ihrer IP-Adresse',Memo2.Text) > 0 then  label1.Caption:='Fehler: Limit erreicht! (IP oder Service wechseln)' else label1.Caption:='Fehler: Service Down?';
label1.Visible:=true;
end;
end;
  end;
if edit7.Text='http://www.bern-web.ch/Bern/sms_ok/' then  begin
  Progressbar1.Position:=100;
webbrowser1.Navigate('www.google.com');
end;
  end;


///////////////// //////////////////////

if combobox2.ItemIndex=1 then begin

repeat;
Application.ProcessMessages;
Sleep(1);
until WebBrowser1.ReadyState=4;

try
webbrowser1.oleobject.document.forms.item(1).elements.item('LoginForm_Login').value := memo2.Lines[2];
except
end;

if webbrowser1.oleobject.document.forms.item(1).elements.item('LoginForm_Login').value =memo2.Lines[2] then begin
webbrowser1.oleobject.document.forms.item(1).elements.item('LoginForm_Password').value :=  memo2.Lines[3] ;
webbrowser1.oleobject.document.forms.item(1).submit;
end;

//Server1 ENDE
end;

end;



procedure TForm1.Webbrowser1DownloadComplete(Sender: TObject);
begin
edit7.Text:=webbrowser1.LocationURL;
end;

end.