| 网站首页 | 业界新闻 | 小组 | 威客 | 人才 | 下载频道 | 博客 | 代码贴 | 在线编程 | 编程论坛
欢迎加入我们,一同切磋技术
用户名:   
 
密 码:  
共有 1356 人关注过本帖
标题:idhttp问题 在线等解答
只看楼主 加入收藏
奥古斯都
Rank: 1
等 级:新手上路
帖 子:1
专家分:0
注 册:2008-3-8
收藏
 问题点数:0 回复次数:0 
idhttp问题 在线等解答
代码如下-------
unit Unit1;
interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, OleCtrls, SHDocVw, ExtCtrls, ComCtrls, IdBaseComponent,
  IdComponent, IdTCPConnection, IdTCPClient, IdHTTP, StdCtrls,ActiveX;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    StatusBar1: TStatusBar;
    IdHTTP1: TIdHTTP;
    Memo1: TMemo;
    Panel2: TPanel;
    WebBrowser1: TWebBrowser;
    Button3: TButton;
    Button4: TButton;
    Button5: TButton;
    procedure FormShow(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    function   ShowHtml(mWebBrowser:   TWebBrowser;   mStrings:   TStrings):   Boolean;
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  MyCookList:string;
  Response: TStringStream;

implementation

{$R *.dfm}

procedure TForm1.FormShow(Sender: TObject);
begin

end;

procedure TForm1.Button3Click(Sender: TObject);
var
  Fpost : Tstrings;

  i:integer;
  Cookie:string;
begin
   Response := TStringStream.Create('');
   Fpost:=TStringList.Create;
   Fpost.clear;
   Fpost.Add('strURL=http://igame.');
   Fpost.Add('Mode=Login');
   Fpost.Add('strMethod=nmmain');
   Fpost.Add('ID=2aê?μ?1ú');
   Fpost.Add('PWD=46443258');
   Fpost.Add('isagree=checked');
   IdHTTP1.Request.Referer:='http://igame.';
   IdHTTP1.Request.From :='http://igame.';
   IdHTTP1.post('http://igame.',Fpost,Response);
   for i:=0 to IdHTTP1.Response.RawHeaders.Count-1 do
   begin
      if UpperCase(Copy(IdHTTP1.Response.RawHeaders[i],1,10)) = 'SET-COOKIE' then
      begin
        Cookie:=Trim(Copy(IdHTTP1.Response.RawHeaders[i],12,MAXINT));
        Cookie:=Copy(Cookie,1,Pos(';',Cookie));
        MyCookList :=MyCookList+Cookie;
      end;
   end;

   IdHTTP1.Request.RawHeaders.Add('Cookie:'+MyCookList);
   memo1.text:=Response.DataString;
   ShowHtml(WebBrowser1,Memo1.Lines);
end;

function  TForm1.ShowHtml(mWebBrowser:   TWebBrowser;   mStrings:   TStrings):   Boolean;
  var   
      vMemoryStream:   TMemoryStream;
  begin   
      Result   :=   False;
      if   not   (Assigned(mStrings)   and   Assigned(mWebBrowser))   then   Exit;   
      mWebBrowser.Navigate('about:blank');
      if   not   Assigned(mWebBrowser.Document)   then   Exit;
      vMemoryStream   :=   TMemoryStream.Create;
      try
          mStrings.SaveToStream(vMemoryStream);
          try
              vMemoryStream.Position   :=   0;
              Application.ProcessMessages;   //   :)
              (mWebBrowser.Document   as   IPersistStreamInit).Load(
                  TStreamAdapter.Create(vMemoryStream));
          except
              Exit;
          end;
      finally
          vMemoryStream.Free;
      end;
      Result   :=   True;
end;   {   ShowHtml   }
procedure TForm1.Button4Click(Sender: TObject);
begin

   memo1.text:=Response.DataString;

end;

procedure TForm1.Button5Click(Sender: TObject);
begin
   ShowHtml(WebBrowser1,Memo1.Lines);
end;
end.

运行结果------
<SCRIPT LANGUAGE="JAVASCRIPT">
            document.domain="
            <!--
            parent.location.reload();
            //-->
        </SCRIPT>
当前脚本错误
行:3
字符:4
错误:未指明错误
代码:0
URL:about blank
----------------
在线等解答,谢谢
搜索更多相关主题的帖子: idhttp TPanel TButton 解答 uses 
2008-03-08 10:40
快速回复:idhttp问题 在线等解答
数据加载中...
 
   



关于我们 | 广告合作 | 编程中国 | 清除Cookies | TOP | 手机版

编程中国 版权所有,并保留所有权利。
Powered by Discuz, Processed in 0.012003 second(s), 7 queries.
Copyright©2004-2024, BCCN.NET, All Rights Reserved