Witam
Próbuje zrobić program łączący się z formularzem na stronie i wysyła treści metodą POST. Wzoruje się na jednym artykule z 4programmers i chcialem to przetestowac na forum 4programmers czy to dziala i okazalo sie, ze program wypelnia mi wszystkie pola w formularzu ale juz go nie wysyla. Może mi ktoś pomóc? Na docelowym formularzu mam taki sam objaw
Moj kod porgramu:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
IdBaseComponent, IdHTTP,
StdCtrls, ComCtrls, IdTCPClient, IdTCPConnection, IdComponent, OleCtrls,
SHDocVw;
type
TForm1 = class(TForm)
WebBrowser1: TWebBrowser;
Button1: TButton;
Edit1: TEdit;
memBody: TMemo;
btnSend: TButton;
StatusBar: TStatusBar;
edtTitle: TEdit;
edtNick: TEdit;
edtmail: TEdit;
procedure Button1Click(Sender: TObject);
procedure WebBrowser1DocumentComplete(ASender: TObject;
const pDisp: IDispatch; var URL: OleVariant);
procedure FormCreate(Sender: TObject);
procedure ForumConnected(Sender: TObject);
procedure ForumWork(Sender: TObject; AWorkMode: TWorkMode; const AWorkCount: Integer);
procedure ForumWorkEnd(Sender: TObject; AWorkMode: TWorkMode);
procedure btnSendClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
Forum: TIdHttp;
implementation
{$R *.dfm}
procedure TForm1.btnSendClick(Sender: TObject);
var
Input, OutPut : TStringStream;
ErrCode : String;
BeginPos : Integer;
begin
Input := TStringStream.Create('');
Output := TStringStream.Create('');
try
btnSend.Enabled := False; // zablokowanie przycisku
Input.WriteString(Format('subject=%s&content=%s&tag=%s&username=%s', [edtTitle.Text, edtNick.Text, edtmail.Text, edtmail.Text{, memBody.Lines.Text}]));
Forum.Post('http://4programmers.net/Forum/Delphi_Pascal?mode=submit', Input, Output);
memBody.Text := Output.DataString;
if Pos('<title>Bł±d</title>', Output.DataString) <> 0 then // jezeli wystapi taka linia
begin
BeginPos := Pos('</p>', Output.DataString)+4;
ErrCode := Copy(Output.DataString, BeginPos, Pos('</center>', Output.DataString) - BeginPos);
MessageBox(Handle, PChar(Errcode), 'Wystąpił błąd podczas próbie wysłania postu...', MB_OK + MB_ICONWARNING);
end else Messagebox(Handle, 'Dziękuje za wysłanie posta na forum dyskusjne 4programmers.net! Wejdź na stronę www.4programmers.net, aby zobaczyć swój post!', 'Dziękujemy...', MB_OK + MB_ICONINFORMATION);
finally
{ zwolnienie zasobow }
Input.Free;
Output.Free;
btnSend.Enabled := True;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
WebBrowser1.Navigate(Edit1.Text);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
Forum := TIdHttp.Create(self);
Forum.Host := 'http://4programmers.net';
Forum.Request.ContentType := 'application/x-www-form-urlencoded';
Forum.Request.UserAgent := 'Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1)';
end;
procedure TForm1.WebBrowser1DocumentComplete(ASender: TObject;
const pDisp: IDispatch; var URL: OleVariant);
begin
memBody.Clear;
memBody.Text := WebBrowser1.OleObject.Document.documentElement.innerHTML;
{ WebBrowser1.OleObject.Document.getElementByID('subject').value := 'TESTEEEEEE'; }
end;
procedure TForm1.ForumConnected(Sender: TObject);
begin
StatusBar.SimpleText := 'Połączony...';
end;
procedure TForm1.ForumWork(Sender: TObject; AWorkMode: TWorkMode;
const AWorkCount: Integer);
begin
// pokazanie procesu przesylania danych
StatusBar.SimpleText := 'Pracuje... ' + IntToStr(AWorkCount) + '%';
end;
procedure TForm1.ForumWorkEnd(Sender: TObject; AWorkMode: TWorkMode);
begin
StatusBar.SimpleText := 'Zakończono i rozłączono. Przesłanie danych do skryptu... ' +
(Forum.ResponseText)
end;
end.