通过IdHTTP自动提交网页信息

unit StartPostUnit;
interface
uses
  Classes,IdBaseComponent,stdctrls,Sysutils,IdComponent, IdTCPConnection,
  IdTCPClient, IdHTTP;
type
  TPostMsgThread = class(TThread)
  private
    FContentType:string;
    FUserName:string;
    FPassWord:string;
    FPostUrl:string;
    FPostBody:string;
    FHTTPBody:string;
    FPostState:integer;
    HTTP: TIdHTTP;
    function PostMsg(ContentType:string;UserName:string;PassWord:string;PostUrl:string;PostBody:string):integer;
    function GetMsg(UserName:string;PassWord:string;PostUrl:string):String;
  protected
    procedure Execute; override;
  public
    constructor Create(ContentType:string;UserName:string;PassWord:string;PostUrl:string;PostBody:string);
    destructor Destroy; override;
  end;
type
  TPostMsg = class(TComponent)
  private
    { Private declarations }
    FContentType:string;
    FUserName:string;
    FPassWord:string;
    FBBSName:string;
    FBBSUrl:string;
    FPostUrl:string;
    FPostBody:string;
    FHTTPBody:string;
    FPostState:integer;
    FStartPost:boolean;
    FStartGet:boolean;
    FStartPostThread:TPostMsgThread;
    procedure ThreadDone(Sender: TObject);
    procedure setStartPost(Value:boolean);
    procedure setStartGet(Value:boolean);
  public
    { Public declarations }
    procedure Abort;
    constructor Create(AOwner: TComponent); override;
    destructor  Destroy; override;
  published
    property ContentType:string read FContentType write FContentType;
    property UserName:string read FUserName write FUserName;
    property PassWord:string read FPassWord write FPassWord;
    property BBSName:string read FBBSName write FBBSName;
    property BBSUrl:string read FBBSUrl write FBBSUrl;
    property PostUrl:string read FPostUrl write FPostUrl;
    property PostBody:string read FPostBody write FPostBody;
    property HTTPBody:string read FHTTPBody;
    property PostState:integer read FPostState;
    property StartPost:boolean read FStartPost write setStartPost;
    property StartGet:boolean read FStartGet write setStartGet;
  end;
implementation
{ Important: Methods and properties of objects in VCL can only be used in a
  method called using Synchronize, for example,
      Synchronize(UpdateCaption);
  and UpdateCaption could look like,
    procedure SendmailThread.UpdateCaption;
    begin
      Form1.Caption := 'Updated in a thread';
    end; }
{ TSendmailThread }
constructor TPostMsgThread.Create(ContentType:string;UserName:string;PassWord:string;PostUrl:string;PostBody:string);
begin
  {code here}
  FContentType:=ContentType;
  FUserName:=UserName;
  FPassWord:=PassWord;
  FPostUrl:=PostUrl;
  FPostBody:=PostBody;
  FHTTPBody:='';
  FPostState:=-1;
  HTTP:=TIdHTTP.Create(nil) ;
  HTTP.Port:=80;
  HTTP.ProtocolVersion:=pv1_0;
  HTTP.RecvBufferSize:=1024;
  HTTP.RedirectMaximum:=15;
  HTTP.HandleRedirects:=true;
  inherited Create(False);
end;
destructor TPostMsgThread.Destroy;
begin
  {code here}
  HTTP.Free;
  inherited Destroy;
end;
procedure TPostMsgThread.Execute;
begin
  FreeOnTerminate:=true;
  try
    if FContentType='Get' then FHTTPBody:=GetMsg(FUserName,FPassWord,FPostUrl)
    else FPostState:=postmsg(FContentType,FUserName,FPassWord,FPostUrl,FPostBody)
  except
    FPostState:=-11;
  end;
end;
function TPostMsgThread.GetMsg(UserName:string;PassWord:string;PostUrl:string):String;
begin
  try
    // Set the properties for HTTP
    HTTP.Request.Username := UserName;
    HTTP.Request.Password := PassWord;
    //HTTP.Request.ProxyServer := '';
    //HTTP.Request.ProxyPort := StrToIntDef('', 80);
    //HTTP.Request.ContentType := ContentType;
    result:=HTTP.Get(PostUrl);
  except
    result:='';
  end;
end;
function TPostMsgThread.postmsg(ContentType:string;UserName:string;PassWord:string;PostUrl:string;PostBody:string):integer;
var
  Response: TStringStream;
  stra:TStrings;
begin
  try
    // Set the properties for HTTP
    HTTP.Request.Username := UserName;
    HTTP.Request.Password := PassWord;
    //HTTP.Request.ProxyServer := '';
    //HTTP.Request.ProxyPort := StrToIntDef('', 80);
    HTTP.Request.ContentType := ContentType;
    http.Request.Referer:=PostUrl;
    // post bbs msg
    Response := TStringStream.Create('');
    try
      stra:=TStringList.Create;
      try
        stra.Text:=PostBody;
        HTTP.Post(PostUrl, stra, Response);
      finally
        stra.Free;
      end;
    finally
      Response.Free;
    end;
    result:=HTTP.ResponseCode;
  except
    result:=HTTP.ResponseCode;
  end;
end;
//============================================================================//
constructor TPostMsg.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  {code here}
end;
destructor TPostMsg.Destroy;
begin
  {code here}
  inherited Destroy;
end;
procedure TPostMsg.ThreadDone(Sender: TObject);
begin
  FPostState:=FStartPostThread.FPostState;
  FHTTPBody:=FStartPostThread.FHTTPBody;
  FStartPost:=false;
  FStartGet:=false;
  FStartPostThread:=nil;
end;
procedure TPostMsg.setStartPost(Value:boolean);
begin
  if Value<>FStartPost then
  begin
    FStartPost:=Value;
    if FStartPost then
      if not Assigned(FStartPostThread) then
      begin
        FPostState:=-1;
        FStartPostThread := TPostMsgThread.Create(FContentType,FUserName,FPassWord,FPostUrl,FPostBody);
        FStartPostThread.OnTerminate := ThreadDone;
      end;
  end;
end;
procedure TPostMsg.setStartGet(Value:boolean);
begin
  if Value<>FStartGet then
  begin
    FStartGet:=Value;
    if FStartGet then
      if not Assigned(FStartPostThread) then
      begin
        FPostState:=-1;
        FStartPostThread := TPostMsgThread.Create(FContentType,FUserName,FPassWord,FPostUrl,FPostBody);
        FStartPostThread.OnTerminate := ThreadDone;
      end;
  end;
end;
procedure TPostMsg.Abort;
begin
  if Assigned(FStartPostThread) then
  begin
    try      
      FStartPostThread.http.DisconnectSocket;
      FStartPostThread.Terminate;
    except
    end;
  end;
end;
end.