Idhttp ,cookie相关

━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
 
主  题:  indy的TIdHTTP控件的使用
作  者:  hardtoreg (柱子) 
等  级:   
信 誉 值:  98
所属论坛:  C++ Builder 网络及通讯开发
问题点数:  100
回复次数:  26
发表时间:  2003-03-31 00:35:54Z
  
 
  

TIdHTTP控件中的post方法如何使用啊?
我想用post方法把参数传给一个web登陆页,从而得到登陆后页面的html,可却无法办到。
具体代码:
void __fastcall TForm1::postClick(TObject *Sender)
{
  TStrings *Source=new TStringList();
  TStream *stream=new TStringStream("");
  Source->Add(Edit2->Text);
  IdHTTP1->Post(Edit1->Text,Source,stream);
  Memo1->Text=((TStringStream *)stream)->ReadString(1024*1024);
}
用sniffer观察发现甚至连http交互都没有。郁闷
 

 
 
 
 
 
 回复人: ronshen(大音) ( ) 信誉:105  2003-04-03 13:18:25Z  得分:0
 
 
 
代码如下:

头文件httpdatastream.h-------->
定义了一个tHttpDataStream类,继承的tmemorystream,主要是两个函数,一个addfield,在HTTP消息体中加一个字段;一个addfile,在HTTP消息体中加一个附加文件;
//---------------------------------------------------------------------------

#ifndef HttpDataStreamH
#define HttpDataStreamH

const AnsiString CONTENT_TYPE="multipart/form-data; boundary=";
const AnsiString CRLF = "/r/n";
const AnsiString CONTENT_DISPOSITION = "Content-Disposition: form-data; name=/"%s/"";
const AnsiString FILENAME_PLACE_HOLDER = "; filename=/"%s/"";
const AnsiString CONTENTTYPE_PLACE_HOLDER = "Content-Type: %s" + CRLF + CRLF;
const AnsiString CONTENT_LENGTH = "Content-Length: %s" + CRLF;

class THttpDataStream : public TMemoryStream
{
public:
    __fastcall THttpDataStream();
private:
    AnsiString m_Boundary;
    AnsiString m_RequestContentType;
    AnsiString GenerateUniqueBoundary();
    void AddFile(const AnsiString FieldName,const AnsiString FileName,const AnsiString ContentType,TFileStream* FileData);

public:
    void AddField(const AnsiString FieldName,const AnsiString FieldValue);
    void AddFile(const AnsiString FieldName,const AnsiString FileName,const AnsiString ContentType);
    void PrepareStreamForDispatch(); 

    AnsiString GetBoundary();
    AnsiString GetRequestContentType();
};
//---------------------------------------------------------------------------
#endif


//*httpdatastream.cpp-------------------------------------------------------
#include <vcl.h>
#pragma hdrstop

#include "HttpDataStream.h"

//---------------------------------------------------------------------------

#pragma package(smart_init)
__fastcall THttpDataStream::THttpDataStream()
                 : TMemoryStream()
{
  m_Boundary = GenerateUniqueBoundary();
  m_RequestContentType = CONTENT_TYPE + m_Boundary;
}

//产生HTTP消息中唯一的分隔字符串
AnsiString THttpDataStream::GenerateUniqueBoundary()
{
  AnsiString result = "--------------ronshen" + FormatDateTime("yyyymmddhhnnsszzz", Now());
  return result;
}

//在HTTP消息中增加一个变量
void THttpDataStream::AddField(const AnsiString FieldName,const AnsiString FieldValue)
{
  AnsiString sFormFieldInfo;
  AnsiString strTemp = m_Boundary + CRLF + CONTENT_DISPOSITION + CRLF + CRLF +
                        FieldValue + CRLF;

  TVarRec v[] = { FieldName };
  sFormFieldInfo = Format(strTemp, v , ARRAYSIZE(v) - 1);
  Write((const void *) sFormFieldInfo.c_str(), sFormFieldInfo.Length());
}

//在HTTP消息中增加一个文件
void THttpDataStream::AddFile(const AnsiString FieldName, const AnsiString FileName,
                const AnsiString ContentType, TFileStream* FileData)
{
        AnsiString sFormFieldInfo;
        __int64 iSize;

        iSize = FileData->Size;
        AnsiString strSize = AnsiString(iSize);
        sFormFieldInfo = Format(m_Boundary + CRLF + CONTENT_DISPOSITION +
                FILENAME_PLACE_HOLDER + CRLF + CONTENT_LENGTH +
                CONTENTTYPE_PLACE_HOLDER, OPENARRAY(TVarRec,(FieldName, FileName, strSize, ContentType)));
       
        Write((const void *) sFormFieldInfo.c_str(), sFormFieldInfo.Length());

        FileData->Position = 0;

        try{
                CopyFrom(FileData,0);
        }
        catch(...)
        {
        }

        Write((const void*) CRLF.c_str(),CRLF.Length());
}

//在HTTP消息中增加一个文件
void THttpDataStream::AddFile(const AnsiString FieldName, const AnsiString FileName,
                const AnsiString ContentType)
{
        TFileStream* FileStream;
        FileStream = new TFileStream(FileName, fmOpenRead | fmShareDenyWrite);
        try {
                AddFile(FieldName, FileName, ContentType, FileStream);
        }
        catch(...)
        {
        }
        FileStream->Free();
}

//在发送消息之前,加一个结束字符串,并将指针位置归0
void THttpDataStream::PrepareStreamForDispatch()
{
  AnsiString strEnd;
  strEnd = CRLF + m_Boundary + "--" + CRLF;
  Write((const void *) strEnd.c_str(), strEnd.Length());
  Position = 0;
}

AnsiString THttpDataStream::GetBoundary()
{
        return m_Boundary;
}

AnsiString THttpDataStream::GetRequestContentType()
{
        return m_RequestContentType;
}

在调用这个类时,比如在一个有两个显示用的memo的form中吧,这样写:

        AnsiString strFieldName = "fileno";
        TMemoryStream* responseStream = new TMemoryStream();
        THttpDataStream* httpStream = new THttpDataStream();

        IdHTTP1->Request->ContentType = httpStream->GetRequestContentType();

        httpStream->AddField("action","1");
        httpStream->AddField("docunid","046080F7D74BFF1348256CE9002DA29A");
        
       
        httpStream->PrepareStreamForDispatch();
        httpStream->Position = 0;
        /
        //显示POST消息流中的所有信息
        Memo1->Lines->Clear();
        char buffer[1024];
        int readChars=1024;
        AnsiString strDisp;
        while(readChars >= 1024){
                readChars = httpStream->Read(buffer,1024);
                strDisp = AnsiString(buffer);
                Memo1->Lines->Add(strDisp);
        }

        httpStream->Position = 0;
        IdHTTP1->Post(Edit1->Text,httpStream,responseStream);

        /
        //显示回来的消息流中的所有信息
        Memo2->Lines->Clear();
        responseStream->Position = 0;
        readChars = 1024;
        while(readChars >= 1024){
                readChars = responseStream->Read(buffer,1024);
                strDisp = AnsiString(buffer);
                Memo2->Lines->Add(strDisp);
        }

        delete httpStream;
        delete responseStream;

这个是目前在实际使用的东东,应该是没有问题的。

当然,如果你只需要提交几个字段的话,或许不需要这么复杂,因为URL里边就可以带了,直接发个GET命令过去都应该可以。POST主要还是适用于需要大量数据传输的场合,比如需要提交一个文件等等。
 
 
Top
 
 回复人: hardtoreg(柱子) ( ) 信誉:98  2003-04-03 14:25:42Z  得分:0
 
 
 
非常感谢ronshen(大音)!
我只是想将一个form中填好的信息提交上去。真的很感谢你!
有一事不明白,idHTTP控件应该已经对http协议进行了封装,应用层以下都应是透明的。可为什么
以你的方式提交数据,对数据的格式有着如此严格的要求?真的象Lo(水滴)所说是通过TCP来提交数据?我真的有些糊涂。
 
 
Top
 
 回复人: ronshen(大音) ( ) 信誉:105  2003-04-03 15:44:50Z  得分:0
 
 
 
如果是在URL中直接写参数,这个格式很简单,URL中跟"&..."就可以,就象Lo(水滴)给的格式一样。这种其实没必要用POST命令,用个GET就可以了。
但如果是用POST命令的话,它后边跟的是一个HTTP消息体,这个消息体需要自己来填,就必须按照一定的格式来了。

不是用TCP提交数据的问题,而是POST命令的问题(你有SNIFFER,可以做个HTML FORM,用浏览器来提交,然后截获下来看一下噻!),谁让你是用C来做这种事呢?肯定要麻烦一些呐,如果是直接写一个HTML FORM,那多简单啊!:=)
 
 
Top
 
 回复人: ronshen(大音) ( ) 信誉:105  2003-04-03 16:44:00Z  得分:0
 
 
 
另,
提交Form中的数据,确实是用的POST方法,浏览器的实现也是用POST方法,然后用和我类似的方法来填POST消息体。
当然,在我们访问很多网站的时候,URL栏上都会出现一些参数,就比如这个:
http://expert.csdn.net/Expert/topic/1596/1596850.xml?temp=.796673
象这个的参数不是放在消息体,而是放在URL里边的。如果后台用JAVA处理,URL上带的参数可以从REQUEST消息中获取到。
但一般接收浏览器上Form数据的后台程序,是自己分析POST消息体,然后解析出参数来的。如果你给的不是标准格式,别人当然不会正确处理哪。
 
 
Top
 
 回复人: Lo(水滴) ( ) 信誉:105  2003-04-04 00:23:14Z  得分:0
 
 
 
你不会是把IdHTTP的ProtocolVersion设成pv1_0了吧,IdHTTP绝对是支持Http 1.1的,连1.1都不支持的话,那组件还有什么用,现在网络上用的Http协议基本都是1.1版本的。

你还是把你的全部代码贴出来吧,省得老出问题,或者你把代码发到我的邮箱里,我帮你调试。

net2m@21cn.com
 
 
Top
 
 回复人: Kylix_XP(上帝咬过的苹果) ( ) 信誉:99  2003-04-04 20:05:07Z  得分:0
 
 
 
<<TCP-IP详解卷1:协议>> 下载:
http://jiurl.cosoft.org.cn/download/TCPIP_Illustracted_1.zip
 
 
Top
 
 回复人: hardtoreg(柱子) ( ) 信誉:98  2003-04-06 16:36:58Z  得分:0
 
 
 
还有,我用post方法提交的过程用sniffer抓下,看不到http交互。仔细一看才发现。它们都包含在tcp包中,但并未作为http交互显示出来。这是什么原因?

 


 
 
Top
 
 回复人: hardtoreg(柱子) ( ) 信誉:98  2003-04-06 17:59:53Z  得分:0
 
 
 
不会是indy90没有安装好吧?
 
 
Top
 
 回复人: Lo(水滴) ( ) 信誉:105  2003-04-06 20:37:01Z  得分:0
 
 
 
你的例子我看了,估计是和你登录的网站有关系,你里面有串数字是从哪来的,我估计那数字是每次登录是都会变化的,有点类似PHPSession这样的东西。
你换个网站登录试试看,找个简单点的。
 
 
Top
 
 回复人: hardtoreg(柱子) ( ) 信誉:98  2003-04-06 21:30:23Z  得分:0
 
 
 
还是结了吧。非常感谢各位。特别是Lo(水滴)和ronshen(大音)

 
 
Top
 
 

该问题已经结贴 ,得分记录: Lo (50)、 ronshen (50)、 
 
 


━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
回复人: Lo(水滴) ( ) 信誉:105  2002-05-12 03:19:08Z  得分:0
 
 
 
TStream * a=new TMemoryStream();
TStream * b=new TMemoryStream();

AnsiString url="http://xxx/login.cgi";
String  data="user=9999";
b->Write(data.c_str(),data.Length());
IdHTTP1->Post(url,b,a);
a->Position=0;
Memo1->Lines->LoadFromStream(a);
delete a;
delete b;
这下准没错了。刚才把Write写成Read了;
 
━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

如何在DELPHI中读取指定的Cookie文件中的内容
作  者:  skyit () 
等  级:   
信 誉 值:  100
所属论坛:  Delphi 网络编程/分布式开发
问题点数:  100
回复次数:  3
发表时间:  2003-12-18 16:27:43Z
  
 
  

各位老大,江湖救急啊!

如何在DELPHI中读取指定的Cookie文件中的内容。
偶好象记得有这个对象的啊,可是找不到了。
注意,非Websnape。最好有注释和源代码!

 
 
 
 回复人: sandian(毛毛) ( ) 信誉:100  2003-12-19 09:46:54Z  得分:40
 
 
 
顶~
 
 
Top
 
 回复人: VeryOldMan(老者) ( ) 信誉:100  2003-12-19 09:52:03Z  得分:10
 
 
 
以下链接有一篇十几页的英文文章,也许能救救你:
http://delphi.about.com/library/bluc/text/uc060901i.htm
 
 
Top
 
 回复人: yannqi(燕祺) ( ) 信誉:100  2003-12-22 15:28:46Z  得分:50
 
 
 
搞了几天,终于有了点眉目,以下是我登录一个asp站点的delphi程序,使用了IDHttp控件和IDCookieManager控件,在delphi7(带indy9)+win2k pro调试通过。

有不当之处请指正,如转载请注明作者:yannqi。

1、网站asp程序:
判断如果有cookie显示用户名和邮件;如果没有将获得的用户名和邮件写入cookie。
<%
if (request.Cookies("name")="" or request.Cookies("email")="") then

  Response.Cookies("name") = request("name")
        Response.Cookies("email") = request("email")
  Response.write(request("name")+","+request("email")+",写入cookie")
else
Response.write("Name:"+request.Cookies("name"))
Response.write("<br>email:"+request.Cookies("email"))
end if
%>

2、delphi form
object Form1: TForm1
  Left = 258
  Top = 154
  Width = 650
  Height = 388
  Caption = 'Form1'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  PixelsPerInch = 96
  TextHeight = 13
  object btnLogin: TButton
    Left = 256
    Top = 24
    Width = 75
    Height = 25
    Caption = '提交'
    TabOrder = 0
    OnClick = btnLoginClick
  end
  object edtUserName: TLabeledEdit
    Left = 0
    Top = 24
    Width = 121
    Height = 21
    EditLabel.Width = 50
    EditLabel.Height = 13
    EditLabel.Caption = 'UserName'
    TabOrder = 1
    Text = 'yannqi'
  end
  object edtPassword: TLabeledEdit
    Left = 128
    Top = 24
    Width = 121
    Height = 21
    EditLabel.Width = 25
    EditLabel.Height = 13
    EditLabel.Caption = 'Email'
    TabOrder = 2
    Text = 'xayahe@163.com'
  end
  object Memo1: TMemo
    Left = 312
    Top = 64
    Width = 321
    Height = 281
    Lines.Strings = (
      'Memo1')
    TabOrder = 3
  end
  object Cookies: TMemo
    Left = 8
    Top = 64
    Width = 297
    Height = 281
    Lines.Strings = (
      'Cookies')
    TabOrder = 4
  end
  object btnInfor: TButton
    Left = 336
    Top = 24
    Width = 75
    Height = 25
    Caption = '测试'
    TabOrder = 5
    OnClick = btnInforClick
  end
  object Button3: TButton
    Left = 416
    Top = 24
    Width = 43
    Height = 25
    Caption = '清空'
    TabOrder = 6
    OnClick = Button3Click
  end
  object http: TIdHTTP
    MaxLineAction = maException
    ReadTimeout = 0
    AllowCookies = False
    ProxyParams.BasicAuthentication = False
    ProxyParams.ProxyPort = 0
    Request.ContentLength = -1
    Request.ContentRangeEnd = 0
    Request.ContentRangeStart = 0
    Request.ContentType = 'text/html'
    Request.Accept = 'text/html, */*'
    Request.BasicAuthentication = False
    Request.UserAgent = 'Mozilla/3.0 (compatible; Indy Library)'
    HTTPOptions = [hoForceEncodeParams]
    CookieManager = CookieMngr
    Left = 120
    Top = 96
  end
  object CookieMngr: TIdCookieManager
    Left = 152
    Top = 96
  end
end

3、unit1。pas
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, IdCookieManager, IdBaseComponent,
  IdComponent, IdTCPConnection, IdTCPClient, IdHTTP;

type
  TForm1 = class(TForm)
    http: TIdHTTP;
    CookieMngr: TIdCookieManager;
    edtUserName: TLabeledEdit;
    edtPassword: TLabeledEdit;
    btnLogin: TButton;
    Cookies: TMemo;
    Memo1: TMemo;
    btnInfor: TButton;
    Button3: TButton;
    procedure btnLoginClick(Sender: TObject);
    procedure btnInforClick(Sender: TObject);
    procedure Button3Click(Sender: TObject);
   private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}


procedure TForm1.btnLoginClick(Sender: TObject);
var
  s, s1: TStringStream;
  i: Integer;
begin
  s := TStringStream.Create('');
  s1 := TStringStream.Create('');
  try
    s.WriteString('name=' + edtUserName.Text + '&');
    s.WriteString('email=' + edtPassword.Text);
    http.Request.ContentType := 'application/x-www-form-urlencoded';

    try
      http.Post('http://localhost/cookietest.asp', s, s1)
    except
      http.Get(http.Response.Location, s1);
    end;
  //}
    Memo1.Lines.Text := s1.DataString;
//下面的是显示cookies信息的代码
    Cookies.Clear;
    Cookies.Lines.Add(inttostr(CookieMngr.CookieCollection.Count));
    for i := 0 to CookieMngr.CookieCollection.Count - 1 do
      Cookies.Lines.Add(CookieMngr.CookieCollection.Items[i].CookieText);
  finally
    s.Free;
    s1.Free;
  end;

end;

procedure TForm1.btnInforClick(Sender: TObject);
var
  s, s1: TStringStream;
  i: Integer;
begin
  s := TStringStream.Create('');
  s1 := TStringStream.Create('');
  try
    http.Request.ContentType := 'application/x-www';
    http.AllowCookies:=true;
    try
      http.Post('http://localhost/cookietest.asp', s, s1)
    except
      http.Get(http.Response.Location, s1);
    end;
    Memo1.Lines.Text := s1.DataString;
    Cookies.Clear;
    for i := 0 to CookieMngr.CookieCollection.Count - 1 do
      Cookies.Lines.Add(CookieMngr.CookieCollection.Items[i].CookieText);
  finally
    s.Free;
    s1.Free;
  end;

end;

procedure TForm1.Button3Click(Sender: TObject);
begin
cookies.Clear;
Memo1.Clear;
end;

end.

 
 
━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

主  题:  请问:在程序中自动访问网页、自动登录的问题(详细请入)。
作  者:  rocsoar (&天,真的痛&) 
等  级:   
信 誉 值:  97
所属论坛:  C++ Builder 网络及通讯开发
问题点数:  100
回复次数:  11
发表时间:  2003-01-17 11:17:53Z
  
 
  

详细说明:
首先用NMHTTP控件访问首页,取得了COOKIE,然后要带入相同的COOKIE,并且输入用户名、密码,我用该控件的POST方法,失败。

请问应该怎么做????IDHTTP控件好使不?怎么使?可有详细代码可供参考?
 
 
 
 
 回复人: rocsoar(&天,真的痛&) ( ) 信誉:97  2003-01-17 11:59:13Z  得分:0
 
 
 
我见过一个使用INDY的IdHTTP控件的登录代码,但是它在取得COOKIE处不能成功。
代码如下,谨供参考。。。。。

    String strBody;
    String urlBase = "http://www.cjol.com/company/";
    //取得cookie
    memoMain->Lines->Add( FormatDateTime("hh:nn:ss", Now()) + ":正在获取Cookie。。。");
    IdHttp->Get(urlBase);
    IdHttp->Request->ExtraHeaders->Add("Cookie: "+IdHttp->Response->ExtraHeaders->Values[IdHttp->Response->ExtraHeaders->Names[2]]);//这一句中本意是使用IdHttp->Response->ExtraHeaders->Names[2]来取得COOKIE的值,但现在试验证明不行,关键也就是在这里,如何取得COOKIE
    IdHTTP1->Request->Connection="Keep-Alive";
    IdHTTP1->Request->Server="www.cjol.com";
    IdHTTP1->Request->AcceptEncoding="gzip, deflate";
    IdHttp->Request->ContentType="application/x-www-form-urlencoded";

    //登录网站
    memoMain->Lines->Add( FormatDateTime("hh:nn:ss", Now()) + ":正在登录。。。");
    TStringStream *rep=new TStringStream("");
    TStream *src=new TStringStream("comId=YOUID&password=YOURPASSWORD&goback=comLogin.asp&Submit2=");
    IdHttp->Post(urlBase + "check.asp",src,rep);

    strBody = rep->DataString;
    String strFrom = "location.href=/"";
    String strTo = "/";";
    String url = urlBase + getHtmlItem( strBody, strFrom, strTo );

    IdHttp->Get( url );//进入登录成功页面

 
 
 
 回复人: warton(管理困惑) ( ) 信誉:161  2003-01-17 14:32:55Z  得分:0
 
 
 
菜哥是indy的高手,等他来看看!!
 
 
 
 回复人: Lo(水滴) ( ) 信誉:105  2003-01-17 14:57:05Z  得分:0
 
 
 
Indy组件里有个专门保存Cookie的组件,我现在用是的Indy9.0,如果你现在的版本里没有的话,你可以到网上去下载升级,不过我也还没用到那Cookie组件,相信不难
 
 
 
 回复人: Lo(水滴) ( ) 信誉:105  2003-01-17 15:05:05Z  得分:0
 
 
 
用NMHttp也可以保存Cookie,但比较麻烦,我是自己通过分析返回的NMHTTP1->Header里自己把那Cookie值提取出来,这样做的缺点就是你必需先知道那Cookie的格式。不过也许经过改进一下,也可以变成通用的,你自己去试试吧。

如,先访问首页,然后把Cookie保存到cookies变量里,然后再登录时加上
NMHTTP1->HeaderInfo->Cookie=cookies;
如果你那Cookie提取的没错的话,这样就可以登录了,因为我曾经就是这样用的。

至于那NMHTTP1->CookieIn属性,好像不太好使,所以我都是自己找Cookie的值
 
 
 
Top
 
 回复人: rocsoar(&天,真的痛&) ( ) 信誉:97  2003-01-17 16:27:11Z  得分:0
 
 
 
哦,明白。十分感谢Lo(水滴)的帮助。
 
 
Top
 
 

该问题已经结贴 ,得分记录: warton (30)、 Lo (70)、 

 
 

该问题已经结贴 ,得分记录: sandian (40)、 VeryOldMan (10)、 yannqi (50)、 
 

━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
 http://search.csdn.net/Expert/topic/1487/1487497.xml?temp=.540127
主  题:  关于idhttp的一个简单问题
作  者:  popeyepower (popeyepower) 
等  级:   
信 誉 值:  93
所属论坛:  Delphi 网络编程/分布式开发
问题点数:  50
回复次数:  3
发表时间:  2003-03-03 22:07:13Z
  
 
  

连接某些页面的时候,总是出现'http/1.1 302 Found'的提示,为什么?

Project Project1.exe raised exception class EIdHTTPProtocolException with message'HTTP/1.1 302 Found'.Process stopped.Use Step or Run to continue.
 
 
 
 
 回复人: westfly(西翔) ( ) 信誉:115  2003-03-04 12:44:03Z  得分:50
 
 
 
某些网址可能用了重定向,
你将HandleRedirects设为true试试。

 
 
Top
 
 

该问题已经结贴 ,得分记录: westfly (50)、 
 
━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

IdHTTP的问题
作  者:  zcx2001 (zcx) 
等  级:   
信 誉 值:  99
所属论坛:  Delphi 网络编程/分布式开发
问题点数:  50
回复次数:  7
发表时间:  2003-10-26 09:31:09Z
  
 
  

怎么获得cookie 值啊?

还有 比如 我在 post 一个网页的时候,还有一些cookie怎么设置啊? 
 谢谢了, 最好能带一些带码 :)
 
 
 
 
 回复人: nyxi(南野秀一) ( ) 信誉:97  2003-10-27 10:48:21Z  得分:10
 
 
 
Indy Misc选项上有IdCookieManager控件用它和IdHttp组合来管理HTTP的Cookies
用IdCookieManager1.AddCookie的方法就能添加Cookie
 
  
 回复人: skimeister(网寻欢╃) ( ) 信誉:92  2003-11-18 19:05:27Z  得分:20
 
 
 
HTTP.Get(cbURL.Text);
          for J := 0 to http.Response.ExtraHeaders.Count - 1 do
          begin
            if (UpperCase(Copy(http.Response.ExtraHeaders[J], 1, 10)) = 'SET-COOKIE') and (edt1.text = '') then
            begin
              Cookie := Trim(Copy(http.Response.ExtraHeaders[J], 12, MAXINT));
              Cookie := Copy(Cookie, 1, Pos(';', Cookie) - 1);
              http.Request.Extraheaders.Add('Cookie: ' + Cookie);
              edt1.text := 'Cookie: ' + Cookie;
            end;
          end;
 
 
Top
 
 回复人: WQmeng(我曾经忍耐,我如此等待,也许在等你到来) ( ) 信誉:99  2003-11-18 19:56:45Z  得分:20
 
 
 
使用idhttp里的cookiemanager ,在cookiemanager 的onNewCookie 事件里获得cookie。

var
  cookie :String;

procedure TForm1.IdCookieManager1NewCookie(ASender: TObject;
  ACookie: TIdCookieRFC2109; var VAccept: Boolean);
begin
  cookie:= Acookie.ClientCookie;
end;

━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━  
  关于IdHTTP1,IdCookieManager1,IdSSLIOHandlerSocket1三者控件使用的问题
作  者:  suigui (衰鬼) 
等  级:   
信 誉 值:  99
所属论坛:  C++ Builder 网络及通讯开发
问题点数:  100
回复次数:  7
发表时间:  2003-04-02 14:14:47Z
  
 
  

第一次登陆没问题,但是后来的就是不行,说还没有登陆。IdCookieManager的目的就是方便以后其他网页的访问。如第一次https://172.16.100.96:8887/cgi-bin/login.cgi?username=aaaa&password=aaaa登陆成功了。但是再访问其他的网页就不行了如https://172.16.100.96:8887/cgi-bin/login.cgi。说没有登陆,非法访问。是不是那里设置有错?有谁有过这方面的使用经历.
 
 
 
 
 
 回复人: litqqs(QS) ( ) 信誉:99  2003-09-14 02:11:00Z  得分:0
 
 
 
上面的问题我解决了,这一会是要来拿你的分啦.
 
 
 
 回复人: litqqs(QS) ( ) 信誉:99  2003-09-14 21:36:53Z  得分:0
 
 
 
方法如下:(我用Post,用Get差不多)
TStrings *ps = new TStringList();
TMemoryStream *ms = new TMemoryStream();
ps->Text = "username=aaaa$password=aaaa";
IdHTTP1->Post(URL,ps);
IdHTTP->Trace(URL);
delete ps,ms;
//以后的网页就是正常登录后的页面啦.

//我是BCB6,WinXP,Indy9下通过.
 
 
Top
 
 回复人: suigui(衰鬼) ( ) 信誉:99  2003-09-15 11:58:53Z  得分:0
 
 
 
感谢litqqs(QS) ,其实我早已解决,只是很久没时间上来看了,我是在IdCookieManager的CookieManagerNewCookie事件中保存他的cookie来实现的。如下。
void __fastcall TFrmMain::CookieManagerNewCookie(TObject *ASender,
          TIdCookieRFC2109 *ACookie, bool &VAccept)
{
    int pos = ACookie->CookieText.Pos(";");

    if ( pos > 0 )
        Session_ID = ACookie->CookieText.SubString( 1, pos -1 );
    else
        Session_ID = ACookie->CookieText;

}
然后以后传送时,先执行语句HTTP->Request->CustomHeaders->Add("Cookie:"+Session_ID);
就可以了

 

━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
我想写自动访问web页面的
作  者:  brucely () 
等  级:   
信 誉 值:  94
所属论坛:  Delphi 网络编程/分布式开发
问题点数:  0
回复次数:  6
发表时间:  2003-06-04 13:27:47Z
  
 
  

添一个手机号程序访问http://www.abkk.com/cn/mobile/index.asp

把手机所在地返回

我现在就是不知道怎么把这个手机号提交出去,我用的是nmhttp控件,他下面有用的代码
<form  method="POST" action="http://www.abkk.com/cn/mobile/index.asp">
<input type="text" name="tel" >
<input type="submit">
</form>

可是我直接post号码不可以,请问谁可以帮忙阿。
 
 
 
 回复人: lion_lh(xmanx) ( ) 信誉:115  2003-06-04 15:39:09Z  得分:0
 
 
 
BP 短讯
很多人一定用过 OICQ,想必也用过了它的 BP 机短讯、手机短讯 ,编程的朋友一定想实现这种功能 ,

如果你的程序能发到手机、发到 BP 机一定很酷。

      现在我就介绍一种可行的方法。

     一、原理

               它不同于 OICQ 的双方都在网上才能进行交流的寻呼功能 ,它可以将文字信息发送到真正的寻呼机上。只要你能够上网 ,就可以自己动手 ,随时随地将信息发送出去 ,即使你在国外 ,也可以利用它来向国内的友人发送信息了 ,而且不用交纳国际长途费用 ,是不是方便又省事呢!

    二、分析

               现在网上各寻呼台都有网上服务 ,网页寻呼 (Web Paging) 就是常用的一种。它是通过在互联网上访问寻呼台的主页 ,然后由寻呼台的信息寻呼系统打传呼。所以我们只要利用 HTTP 协议就可以实现网络寻呼了。以下就简单介绍一下 HTTP 协议 :

   HTTP 中完成一个会话通常要完成 :1) 客户端程序与服务器建立连接 2) 发送请求 3) 服务器响应客户端 4) 关闭连接

   HTTP 常用到的请求有 :1)GET( 请求一万维网页 ) 2)HEAD( 读取一万维网页的头部 ) 3)PUT( 请求一存储万维网页 ) 4)POST( 附加一个命名的资源 ) 5)DELETE( 删除万维网页 ) 6)LINK( 连接两个已有的资源 ) 7)UNLINK( 断开两个已有资源的连接 )

   HTTP 中常用到的应答状态代码有 :(* 号代表 0-9 间的一个数 ) 1. 1** ( 信息 ) 2. 2**( 成功 ) 3.4**( 客户端错误 ) 4.5**( 服务器错误 )

    其实我们要实现的程序 ,只用 POST 、 GET 请求 ,收到正常应答就可以了。 POST 可以用于把用户输入的数据以数据流的方式传给 CGI 程序 ,CGI 通过 Contect-Length 环境变量来取相应长度的数据流信息。

POST 请求格式如下 :

POST http://www2.scuta.edu.cn/stu/chatroom/check.asp HTTP/1.0

Accept: image/gif, image/x-xbitmap, image/jpeg, image/pjpeg, application/vnd.ms-powerpoint, application/vnd.ms-excel, application/msword, */*

Referer: http://www2.scuta.edu.cn/stu/

Accept-Language: zh-cn

Content-Type: application/x-www-form-urlencoded

Proxy-Connection: Keep-Alive

User-Agent: Mozilla/4.0 (compatible; MSIE 5.5; Windows 98)

Host: www2.scuta.edu.cn

Content-Length: 87

Pragma: no-cache

Cookie: ASPSESSIONIDQGGGQHHE=ABGNNOJCIGOFCDLBIOLHKAFK

服务器正常应答的头部结构为 :

  200 OK HTTP/1.0   说明提交数据成功

     三、程序的实现

             Delphi 中 NMHTTP 已经可以很容易的实现上面的所说的数据提交 ,而且它还支持 Proxy 、这样对于通过代理服务器上网一样可以适用 ,并且它不是 OICQ 中发送讯信所用到 SOCKET5 代理。

    新建一个窗体 ,加入组件一个 ComboBox,命名为 callto,用于存放寻呼对象 ,如国信寻呼就有 95908 、 94908 、 94909 、 98062 、 98063 、 98019 、 98035 、 98052 、 98038 、 99055 、 98060 、 98061 、 98051 、 98003 、 99062 、 99016 、 99017 、 99018 、 99019 、 99046 、 99076; 加入组件 Edit,命名为 tonumber,表示寻呼号码 ; 加入组件 RadioGroup,命名为 RadioGroup1,Caption 设为呼机类型 ,items 中加入两项 ,分别为中文机、数字机 ; 加入组件 Edit,命名为 firstName,用于表示发寻呼人的姓 ; 加入组件 RadioGroup,命名为 RadioGroup2,Caption 设为寻呼人性别 ,items 中加入两项 ,分别为先生、小姐 ; 加入组件 Memo,命名为 callmsg,用于输入发送的信息 ( 注 : 对于数字机只能是数字信息 ); 加入组件 NMHTTP,命名为 NMHTTP1; 加入 Checkbox,命名为 ifuseproxy,用于确定是否使用代理服务器 ; 加入两个 Edit 组件 ,分别用于软件代理服务器地址、代理服务器端口 ; 最后加入命令按钮 ,Caption 设为“发送”。

现在以国信寻呼为例 ,它用 GET 请求就可以实现了 ,“发送”按钮的程序代码如下 :

procedure TForm1.Button1Click(Sender: TObject);

  var callstr:string;

begin            callstr:='http://tips.gxspace.com/cgi-bin/tips/webpaging?stn_id='+callto.Text+'&page_no='+tonumber.Text;

     case RadioGroup1.ItemIndex of

       0:callstr:=callstr+'&pager_type=C';

       1:callstr:=callstr+'&pager_type=N';

     end;

     callstr:=callstr+'&firstname='+firstname.text;

     case RadioGroup2.ItemIndex of

       0:callstr:=callstr+'&title=0';

       1:callstr:=callstr+'&title=1';

     end;

     callstr:=callstr+'&msg='+callmsg.Text+'&answer=null&B1= 发送寻呼 ';

  NMHTTP1.InputFileMode := FALSE;

  NMHTTP1.OutputFileMode := FALSE;

  NMHTTP1.ReportLevel := Status_Basic;

  If ifuseproxy.Checked then

  Begin

    NMHTTP1.Proxy := Edit1.Text;

    NMHTTP1.ProxyPort := StrToInt(Edit2.Text);

  End;

  NMHTTP1.Get(callstr);

end;

有些寻呼 ( 如润迅寻呼就不能用上面的 GET 请求实现 ,它要用 POST 请求 ),使用与上面相差不大 ,如下面是 NMHTTP 的 POST 用法 :

  NMHTTP1.InputFileMode:=False;

  NMHTTP1.OutputFileMode:=True;

  NMHTTP1.ReportLevel:=Status_Basic;

  If ifuseproxy.Checked then

  Begin

    NMHTTP1.Proxy := Edit1.Text;

    NMHTTP1.ProxyPort := StrToInt(Edit2.Text);

  End;

  With NMHTTP1.HeaderInfo do

  Begin

    Cookie := Edit5.Text;

    LocalMailAddress := Edit6.Text;

    LocalProgram := Edit7.Text;

    Referer := Edit8.Text;

    UserID := Edit9.Text;

    Password := Edit10.Text;

  End;

//   把要提交的数据先放在 test.txt 文件中 : 格式为 stnid=A&pageno=123456...

  NMHTTP1.Post('http://www.wocall.com/script/zbwebcall.asp','test.txt');

//NMHTTP 的具体用法在 Delphi 安装目前 /Borland/Delphi5/Demos/FastNet/Http 下有个 NMHTTP 使用的例子。

以上都是用 NMHTTP 实现的 ,其实用 Delphi 中的 WebBrowser 组件同样可以完成数据的提交 ,使用是这样的  Webbrowser1.OleObject.Document.FrontPage_Form1.submit();

说明 :WebBrowser1 是 WebBrowser 组件的名 ,Frontpage_Form1 是用 WebBrowser 打开的网页中的表单名

网页中的表单是这机样的 :

<FORM name=FrontPage_Form1  action=http://message.com.cn/cgi-bin/ips/webpaging  method=post>

......

</Form>

这样的实现方法就是用程序生成一个已经按用户输入信息生成一个网页 ,然后通过 WebBrowser1.Navigate( 生成的网页 ),最后提交到服务器 Webbrowser1.OleObject.Document.FrontPage_Form1.submit(); 这样就完成了一次寻呼

 

 
 
Top
 
 回复人: langzixin(浪子心) ( ) 信誉:100  2003-09-23 10:27:51Z  得分:0
 
 
 
procedure TForm1.Button4Click(Sender: TObject);
const
 BURL ='http://www.abkk.com/cn/mobile/index.asp';
 TXT ='13978896926';
var
 H:TStrings;
 H1:String;
begin
 H:=TStringList.Create;
 H.Add('tel='+TXT);
 H1:=idhttp.Post(BURL,H);
 memo1.Text:=H1;
end;
我试过了。用这个可以,但是如果有些网站要读取cookie或者你提交的网页有一个中转的处理页面,我没有办法做到,那个有好的方法贴出来。
 
 
Top
 
 

该问题已经结贴 
 
 
━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
为什么idhttp不支持cookie啊 ( 积分:0, 回复:12, 阅读:169 )
分类:Internet/TCPIP ( 版主:luyear, robertcool ) 
来自:kocus, 时间:2003-4-20 14:21:00, ID:1785135 [显示:小字体 | 大字体] 

有些网站他要登陆一次,然后记录cookie

才能进行一些操作

我用idhttp登陆成功后,操作的时候他又要我输入密码。怎么好象不支持cookie一样啊

idhttp的allow cookie我已经设置为true了

还是不可以。谁知道原因? 

 


来自:AI_Player, 时间:2003-4-23 22:27:00, ID:1796833
我在Delphi6里遇到过同样的问题,到delphi7里就解决了 


来自:沈浪, 时间:2003-4-24 10:17:00, ID:1797566
支持的,你查一下有这个控件,好像是在indy m什么中记不清了。  


来自:freekim, 时间:2004-7-2 0:21:18, ID:2691708
添加Indy Misc 页中的CookieManager, 在IdHTTP1的CookieManager属性里选它,然后
代码中 IdHTTP1.CookieManager.AddCookie('uid=aaa', 'www.aaa.com');
形参不太明白, 原定义是
procedure TIdCookieManager.AddCookie(ACookie, AHost: String);
自己试试吧.... 


来自:fengtianyun, 时间:2004-7-2 7:42:45, ID:2691772
用应用程序登陆后,怎么可以获得本次登陆的session的编号? 


来自:freekim, 时间:2004-7-2 17:41:46, ID:2693242
CookieManager有onNewCookie事件,双击产生事件处理代码段,如下:
procedure TForm1.IdCookieManager1NewCookie(ASender: TObject;
  ACookie: TIdCookieRFC2109; var VAccept: Boolean);
通过ACookie可以获取关于Cookie的各种信息,注意要在uses 中加 IdCookie,
然后,例如:
memo1.lines.add(Format('Cookie的最大生存期为:%d', [ACookie.MaxAge]));
memo1.lines.add(Format('CookieName为:%s', [ACookie.MaCookieName]));
memo1.lines.add(Format('Value为:%s', [ACookie.Value]));
可以一个一个都试试,就会知道是什么意思了。
这个回答有没有分啊? 呵呵....
 


来自:lilor, 时间:2004-7-4 23:32:07, ID:2695684
  s := 'http://aaa.net/bbs/index.php';
  if CanGetIECookie(s, str) then
  begin
    CookieStr := 'Cookie: ' + str;
    idHttp1.Request.CustomHeaders.Text := CookieStr;
  end else
  begin
    ShowMessage('没有发现本地Cookie,请从Web页面登陆一次。');
    Exit;
  end;
  s := 'http://aaa.net/bbs/forumdisplay.php';
  PostData := TStringList.Create;
  PostData.Add('fid=1');
  Memo1.Lines.Text := idHTTP1.Post(s, PostData);
  PostData.Free; 


来自:fengtianyun, 时间:2004-7-5 13:09:23, ID:2696497
CanGetIECookie 是什么函数,请赐教
是自己写的吧
必须登陆的才可以有Cookie的
用的是session  怎么取的session 的id? 


来自:yuelinniao, 时间:2004-7-9 23:58:23, ID:2705359
session id在服务器端的。

用IdHTTP的cookie要拖一个cookiemanager过去 

 

来自:old.BB, 时间:2004-7-25 16:56:09, ID:2729800
很简单, 先用 GET 方法 URL 为打开的登录页面网址, 跟住直接再用 POST 方法, URL 为提交的网址. 
 
━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━  
http://gikonavi.xrea.jp/imgboard/img-box/img20040627211240.txt
 
unit Editor;

interface

uses
 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
 Dialogs, StdCtrls, ComCtrls, ExtCtrls, ToolWin, Menus, OleCtrls, Registry,
{$IF Defined(DELPRO) }
 SHDocVw,
{$ELSE}
 SHDocVw_TLB,
{$IFEND}
 ActiveX, {HTTPApp,} YofUtils, Trip, IniFiles, StrUtils,
 GikoSystem, GikoUtil, ImgList, Clipbrd, BoardGroup,
 IdAntiFreezeBase, IdAntiFreeze, IdBaseComponent, IdComponent,
 IdTCPConnection, IdTCPClient, IdHTTP, ActnList, StdActns, IdIntercept,
 IdLogBase, IdLogDebug, IdException, DateUtils, MojuUtils, bmRegExp;

type
// TSetLayeredWindowAttributes = function(wnd: HWND; crKey: DWORD; bAlpha: BYTE; dwFlag: DWORD): Boolean; stdcall;
 //書き込み戻り値タイプ
 TGikoResultType = (grtOK, grtCookie, grtCheck, grtError);

 TEditorForm = class(TForm)
  MainMenu: TMainMenu;
  FileMenu: TMenuItem;
  PostMessage: TMenuItem;
  SaveMessage: TMenuItem;
  CloseMenu: TMenuItem;
  N01: TMenuItem;
  StatusBar: TStatusBar;
  EditorPage: TPageControl;
  EditorTab: TTabSheet;
  PreviewTab: TTabSheet;
  Browser: TWebBrowser;
  EditMenu: TMenuItem;
  UndoMenu: TMenuItem;
  CutMenu: TMenuItem;
  CopyMenu: TMenuItem;
  PasteMenu: TMenuItem;
  N02: TMenuItem;
  ToolBarImageList: TImageList;
  HotToobarImageList: TImageList;
  BodyEdit: TMemo;
  NameBasePanel: TPanel;
  NameLabel: TLabel;
  MailLabel: TLabel;
  NameComboBox: TComboBox;
  MailComboBox: TComboBox;
  ToolBar: TToolBar;
  SendToolButton: TToolButton;
  OutBoxToolButton: TToolButton;
  ToolButton5: TToolButton;
  UndoToolButton: TToolButton;
  CutToolButton: TToolButton;
  CopyToolButton: TToolButton;
  PasteToolButton: TToolButton;
  ToolButton3: TToolButton;
  TransToolButton: TToolButton;
  TopToolButton: TToolButton;
  Indy: TIdHTTP;
  IdAntiFreeze: TIdAntiFreeze;
  ToolButton1: TToolButton;
  ToolButton2: TToolButton;
  ActionList: TActionList;
  SendAction: TAction;
  SaveAction: TAction;
  CloseAction: TAction;
  UndoAction: TAction;
  CutAction: TAction;
  CopyAction: TAction;
  PasteAction: TAction;
  AbortAction: TAction;
  TopAction: TAction;
  Show1: TMenuItem;
  T1: TMenuItem;
  N1: TMenuItem;
  S1: TMenuItem;
  SageCheckBox: TCheckBox;
  IdLogDebug: TIdLogDebug;
  TransAction: TAction;
  A1: TMenuItem;
  KotehanCheckBox: TCheckBox;
  TitlePanel: TPanel;
  Label1: TLabel;
  TitleEdit: TEdit;
  SelectAllAction: TAction;
  N2: TMenuItem;
  SelectAll1: TMenuItem;
    Timer1: TTimer;
    QuotePasteAction: TAction;
    QuotePasteMenuItem: TMenuItem;
    C1: TMenuItem;
    SpaceToNBSPAction: TAction;
    AmpToCharRefAction: TAction;
    SpaceTabnbsp1: TMenuItem;
    amp1: TMenuItem;
  procedure EditorPageChange(Sender: TObject);
  procedure FormCreate(Sender: TObject);
  procedure BrowserStatusTextChange(Sender: TObject;
   const Text: WideString);
  procedure FormClose(Sender: TObject; var Action: TCloseAction);
  procedure FormDestroy(Sender: TObject);
  procedure SendActionExecute(Sender: TObject);
  procedure SaveActionExecute(Sender: TObject);
  procedure AbortActionExecute(Sender: TObject);
  procedure CloseActionExecute(Sender: TObject);
  procedure UndoActionExecute(Sender: TObject);
  procedure CutActionExecute(Sender: TObject);
  procedure CopyActionExecute(Sender: TObject);
  procedure PasteActionExecute(Sender: TObject);
  procedure SendActionUpdate(Sender: TObject);
  procedure SaveActionUpdate(Sender: TObject);
  procedure CloseActionUpdate(Sender: TObject);
  procedure UndoActionUpdate(Sender: TObject);
  procedure CutActionUpdate(Sender: TObject);
  procedure CopyActionUpdate(Sender: TObject);
  procedure PasteActionUpdate(Sender: TObject);
  procedure TopActionExecute(Sender: TObject);
  procedure TopActionUpdate(Sender: TObject);
  procedure SageCheckBoxClick(Sender: TObject);
  procedure MailComboBoxChange(Sender: TObject);
  procedure TransActionExecute(Sender: TObject);
  procedure TransActionUpdate(Sender: TObject);
  procedure IdLogDebugReceive(ASender: TIdConnectionIntercept;
   AStream: TStream);
  procedure IdLogDebugSend(ASender: TIdConnectionIntercept;
   AStream: TStream);
  procedure SelectAllActionExecute(Sender: TObject);
    procedure StatusBarResize(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  procedure QuotePasteActionExecute(Sender: TObject);
    procedure SpaceToNBSPActionExecute(Sender: TObject);
    procedure AmpToCharRefActionExecute(Sender: TObject);
 private
  FThreadItem: TThreadItem;
  FBoard: TBoard;
  FNameComboEdit: THandle;
  FMailComboEdit: THandle;
  FAbort: Boolean;
  FWork: Boolean;
  FStatusCode: Integer;
  FDebugStrReceive: string;
  FDebugStrSend: string;
        FSambaTime: TDateTime;
        FHost: string;
  FNow: TDateTime;
  procedure Preview;
  function RepHtml(s: string): string;
  function Check: Boolean;
  procedure SetNameList(sName, sMail: string);
//  procedure Send(SendType: TGikoSendType; SPID: string; PON: string; FirstWriting: Boolean);
  procedure Send(SPID: string; PON: string; FirstWriting: Boolean);

  function GetActiveControlHandle: THandle;
//  function GetSendData: string;
//  procedure GetSendData(Source: TStringStream);
  procedure GetSendData(Source: TStringStream);
  procedure SaveSendFile;
  procedure SetContent(Content: string);
  function GetSPID(CookieLine: string): string;
  function GetPON(CookieLine: string): string;
  function GetResultType(ResponseText: string): TGikoResultType;
        procedure ReadSambaTime(const AHost: string);
        procedure WriteSambaTime(const AHost: string; ATime: TDateTime);
        function ReadSettingTime(const AHost: string): Integer;
        function CheckSambaTime(const AHost: string; ATime: TDateTime): Boolean;
    procedure SetSamba24(AURL: string);
  /// 引用符の取得
  function GetOEIndentChar : string;
  /// 本文の取得
  function GetBody : string;
 protected
  procedure CreateParams(var Params: TCreateParams); override;
 public
  procedure SetFont;
  procedure SetThreadItem(Item: TThreadItem);
  procedure SetBoard(Item: TBoard);
 end;

implementation

uses
 Giko, ItemDownload;
const
 CAPTION_NAME_NEW: string = 'ギコナビ スレ立てエディタ';
 CAPTION_NAME_RES: string = 'ギコナビ レスエディタ';

    // エディットウィンドウを右下にずらして開く移動量
    WINDOWMOVE_H = 30;
    WINDOWMOVE_V = 30;

 //DAXさん?????!(′▽`)
 READCGI_ERR    = '-ERR';
 READCGI_INCR  = '-INCR';
 READCGI_OK   = '+OK';
 READCGI_PARTIAL = '+PARTIAL';
 READCGI_ERR_FOUND_KAKO = '-ERR 過去ログ倉庫で発見';
 READCGI_ERR_NOT_HTML  = '-ERR html化待ち';
 READCGI_ERR_NOT_FOUND   = '-ERR そんな板orスレッドないです。';
 READCGI_ERR_ABONE     = '-ERR どこかであぼーんがあったみたいです。';
 READCGI_ERR_TIMEOUT    = '-ERR 指定時間が過ぎました。';
 READCGI_ERR_CANTUSE    = '-ERR もう つかえません';
 RES2CH_TRUE     = '<!-- 2ch_X:true -->';
 RES2CH_FALSE   = '<!-- 2ch_X:false -->';
 RES2CH_ERROR   = '<!-- 2ch_X:error -->';
 RES2CH_CHECK   = '<!-- 2ch_X:check -->';
 RES2CH_COOKIE    = '<!-- 2ch_X:cookie -->';


type
 TSelection = record
  StartPos, EndPos: Integer;
 end;

{$R *.DFM}

{constructor TEditorForm.Create(AOwner: TComponent; Item: TBoard);
begin
 inherited Create(AOwner);
end;}

procedure TEditorForm.CreateParams(var Params: TCreateParams);
begin
 inherited;
 if FormStyle in [fsNormal, fsStayOnTop] then
  if BorderStyle in [bsSingle, bsSizeable] then begin
   Params.ExStyle := Params.ExStyle or WS_EX_APPWINDOW;
   Params.WndParent := 0;
  end;
end;

{procedure TEditorForm.CreateParams(var Params: TCreateParams);
begin
 inherited CreateParams(Params);
 Params.ExStyle := Params.ExStyle or WS_EX_APPWINDOW;
end;}

procedure TEditorForm.FormCreate(Sender: TObject);
var
 wp: TWindowPlacement;
  hUser32 : HINST;
begin
 FWork := False;
 Browser.Navigate('about:blank');

 FBoard := nil;
 FThreadItem := nil;

 //ウィンドウの位置設定
 wp.length := sizeof(wp);
 wp.rcNormalPosition.Top := GikoSys.Setting.EditWindowTop;
 wp.rcNormalPosition.Left := GikoSys.Setting.EditWindowLeft;

 wp.rcNormalPosition.Bottom := GikoSys.Setting.EditWindowTop + GikoSys.Setting.EditWindowHeight;
 wp.rcNormalPosition.Right := GikoSys.Setting.EditWindowLeft + GikoSys.Setting.EditWindowWidth;
 wp.showCmd := SW_HIDE;
 SetWindowPlacement(Handle, @wp);

 if GikoSys.Setting.EditWindowMax then
  WindowState := wsMaximized;

 //ウィンドウが画面外なら画面内に移動する
 if (Left + Width) > Screen.Width then
//  Left := Screen.Width - Width;
  Left := 0;
 if (Top + Height) > Screen.Height then
//  Top := Screen.Height - Height;
  Top := 0;
 if Left < 0 then
  Left := 0;
 if Top < 0 then
  Top := 0;

    //現在のウィンドウの位置を保存
    GikoSys.Setting.EditWindowTop := Top  + WINDOWMOVE_V;   // 次に開くウィンドウは
    GikoSys.Setting.EditWindowLeft := Left + WINDOWMOVE_H;  //    右斜め下にずらす
    //ウィンドウの幅と高さが小さすぎいれば元に戻す
 if GikoSys.Setting.EditWindowHeight < 144 then
  Height := 400;
 if GikoSys.Setting.EditWindowWidth < 144 then
  Width := 640;

 EditorPage.ActivePage := EditorTab;
 FNameComboEdit := GetWindow(NameComboBox.Handle, GW_CHILD);
 FMailComboEdit := GetWindow(MailComboBox.Handle, GW_CHILD);
 NameComboBox.Items.Assign(GikoSys.Setting.NameList);
 MailComboBox.Items.Assign(GikoSys.Setting.MailList);
 SetFont;
 hUser32 := 0;
 try
  try
   hUser32 := LoadLibrary('User32.dll');
   if hUser32 <> 0 then
    TransAction.Enabled := true
   else
    TransAction.Enabled := false;
  except
         TransAction.Enabled := false;
  end;
 finally
  FreeLibrary(hUser32);
 end;

    // ウィンドウのステイ状態
 if GikoSys.Setting.EditWindowStay then begin    // ステイ状態
  SetWindowPos(Handle, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE + SWP_NOSIZE);
  TopAction.Checked := true;
  TopToolButton.Down := true;
 end else begin                                  // ステイしない
  SetWindowPos(Handle, HWND_NOTOPMOST, 0, 0, 0, 0, SWP_NOMOVE + SWP_NOSIZE);
  TopAction.Checked := false;
  TopToolButton.Down := false;
 end;

    // ウィンドウの半透明状態
 if(GikoSys.Setting.EditWindowTranslucent) and (TransAction.Enabled) then begin // 半透明(トランスルーセント)状態
        AlphaBlend := true;
        TransAction.Checked := true;
        TransToolButton.Down := true;
    end else begin                                      // 不透明
        AlphaBlend := false;
        TransAction.Checked := false;
        TransToolButton.Down := false;
    end;
        // 半透明状態の保存
 GikoSys.Setting.EditWindowTranslucent := TransAction.Checked;

 SpaceToNBSPAction.Checked  := GikoSys.Setting.SpaceToNBSP;
 AmpToCharRefAction.Checked := GikoSys.Setting.AmpToCharRef;
end;

procedure TEditorForm.SetBoard(Item: TBoard);
begin
 FBoard := Item;
 Caption := CAPTION_NAME_NEW + ' - [' + Item.Title + ']';
 NameComboBox.Text := FBoard.KotehanName;
 MailComboBox.Text := FBoard.KotehanMail;
 SageCheckBox.Checked := AnsiPos('sage', MailComboBox.Text) <> 0;
 TitlePanel.Visible := True;
    SetSamba24('');
end;

procedure TEditorForm.SetThreadItem(Item: TThreadItem);
begin
 FThreadItem := Item;
 Caption := CAPTION_NAME_RES + ' - [' + FThreadItem.Title + ']';
 NameComboBox.Text := FThreadItem.ParentBoard.KotehanName;
 MailComboBox.Text := FThreadItem.ParentBoard.KotehanMail;
 SageCheckBox.Checked := AnsiPos('sage', MailComboBox.Text) <> 0;
 TitlePanel.Visible := False;
    SetSamba24(FThreadItem.ParentBoard.URL);
end;

function TEditorForm.GetBody : string;
var
 body  : string;
 regexp : TAWKStr;
begin

 body := BodyEdit.Text;
 if AmpToCharRefAction.Checked then
  // & の置換は一番最初にやること
  body := CustomStringReplace( body, '&', '&amp;' );
 if SpaceToNBSPAction.Checked then begin
  body := CustomStringReplace( body, #09, '&nbsp;&nbsp;&nbsp;&nbsp;' );
  body := CustomStringReplace( body, '  ', '&nbsp;&nbsp;' );
  body := CustomStringReplace( body, '&nbsp; ', '&nbsp;&nbsp;' );
  regexp := TAWKStr.Create( nil );
  try
   regexp.RegExp := '^ ';
   regexp.GSub( '/&nbsp;', body );
  finally
   regexp.Free;
  end;
 end;

 Result := body;

end;

procedure TEditorForm.SetFont;
begin
 BodyEdit.Font.Name := GikoSys.Setting.EditorFontName;
 BodyEdit.Font.Size := GikoSys.Setting.EditorFontSize;
 BodyEdit.Font.Color := GikoSys.Setting.EditorFontColor;
 BodyEdit.Color := GikoSys.Setting.EditorBackColor;
end;

procedure TEditorForm.Preview;
var
 Title: string;
 No: string;
 Mail: string;
 Namae: string;
 DateTime: string;
 Body: string;
 s: string;

    posTrip : Integer;
    tripOrigin : string;
begin
 if FThreadItem = nil then begin
  No := '1';
  Title := RepHtml(TitleEdit.Text);
 end else begin
  No := IntToStr(FThreadItem.Count + 1);
  Title := RepHtml(FThreadItem.Title);
 end;

 body := GetBody;

 Namae := RepHtml(NameComboBox.Text);
 Mail := RepHtml(MailComboBox.Text);
 Body := RepHtml(body);
 Body := StringReplace(Body, #13#10, '<br>', [rfReplaceAll]);
 DateTime := FormatDateTime('yyyy/mm/dd(aaa) hh:nn', now);

 if Trim(Namae) = '' then
  Namae := '名無しさん';

 s := '<HTML><HEAD>' + #13#10
   + '<META http-equiv="Content-Type" content="text/html; charset=Shift_JIS">' + #13#10
   + '<TITLE>' + title + '</TITLE>' + #13#10
//   + '<STYLE><!--BODY{font-size : 9pt;font-family : "MS Pゴシック";}--></STYLE>' + #13#10
   + '</HEAD>' + #13#10
   + '<BODY text="#000000" bgcolor="#EFEFEF" link="#0000FF" alink="#FF0000" vlink="#660099">' + #13#10
   + '<FONT COLOR="#FF0000">' + title + '</FONT>' + #13#10
   + '<DL>' + #13#10;
    posTrip := AnsiPos( '#', Namae );
    if posTrip > 0 then
    begin
        tripOrigin := Copy( Namae, posTrip + 1, Length( Namae ) );
        Namae :=
            Copy( Namae, 1, posTrip - 1 ) + '</B> ◆' +
            get_2ch_trip( PChar( tripOrigin ) ) + '<B>';
    end;
 if Mail = '' then
  s := s + '<DT>' + No + ' : <FONT color="forestgreen"><B>' + Namae + '</B></FONT> : ' + DateTime+ '<BR><DD>' + Body + '<BR><BR><BR>' + #13#10
 else
  s := s + '<DT>' + No + ' : <A href="mailto:' + Mail + '"><B>' + Namae + '</B></A> [' + Mail + ']: ' + DateTime+ '<BR><DD>' + Body + '<BR><BR><BR>' + #13#10;
 s := s + '</BODY></HTML>';
 SetContent(s);
end;

function TEditorForm.RepHtml(s: string): string;
begin
// s := StringReplace(s, '&', '&amp;', [rfReplaceAll]);
 s := StringReplace(s, '<', '&lt;', [rfReplaceAll]);
 s := StringReplace(s, '>', '&gt;', [rfReplaceAll]);
// s := StringReplace(s, ' ', '&nbsp;', [rfReplaceAll]); //仕様変更により&nbsp;使用不可
 s := StringReplace(s, '"', '&quot;', [rfReplaceAll]);
 Result := s;
end;

procedure TEditorForm.EditorPageChange(Sender: TObject);
begin
 if EditorPage.ActivePage = PreviewTab then begin
  Preview;
 end else begin
  Browser.Navigate('about:blank');
 end;
end;

procedure TEditorForm.BrowserStatusTextChange(Sender: TObject;
 const Text: WideString);
begin
 if EditorPage.ActivePage = PreviewTab then begin
  StatusBar.Panels[0].Text := Text;
 end else begin
  StatusBar.Panels[0].Text := '';
 end;
end;

function TEditorForm.Check: Boolean;
var
 Msg: string;
 rc: Integer;
 Board: TBoard;
begin
 Result := True;
 if FThreadItem = nil then
  Board := FBoard
 else
  Board := FThreadItem.ParentBoard;

 if (not GikoSys.Setting.UseMachineTime) and
   ((Board.LastGetTime = 0) or
   (Board.LastGetTime = ZERO_DATE)) then begin
  Msg := 'サーバの時刻が分からないため、送信出来ません'#13#10
     + 'スレッドを更新(取得)後、15秒待ってから送信してください';
  MsgBox(Handle, Msg, 'エラー', MB_OK or MB_ICONSTOP);
  Result := False;
 end else if BodyEdit.Text = '' then begin
  Msg := '本文が入力されていません。';
  MsgBox(Handle, Msg, 'エラー', MB_OK or MB_ICONSTOP);
  Result := False;
 end else if (FBoard <> nil) and (Trim(TitleEdit.Text) = '') then begin
  Msg := 'タイトルが入力されていません。';
  MsgBox(Handle, Msg, 'エラー', MB_OK or MB_ICONSTOP);
  Result := False;
 end else begin
  if (not GikoSys.Dolib.Connected) and (AnsiPos('●', NameComboBox.Text) <> 0) then begin
   Msg := 'ログインしていないので●の機能は利用出来ません。'#13#10
      + 'このまま送信してもよろしいですか?';
   rc := MsgBox(Handle, Msg, '確認', MB_YESNO or MB_ICONQUESTION);
   Result := (rc = IDYES);
  end;
 end;
end;

procedure TEditorForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
 Action := caFree;
end;

procedure TEditorForm.FormDestroy(Sender: TObject);
var
 wp: TWindowPlacement;
begin
 //最大化?ウィンドウ位置保存
 wp.length := sizeof(wp);
 GetWindowPlacement(Handle, @wp);

 GikoSys.Setting.EditWindowTop := wp.rcNormalPosition.Top;
 GikoSys.Setting.EditWindowLeft := wp.rcNormalPosition.Left;
 GikoSys.Setting.EditWindowHeight := wp.rcNormalPosition.Bottom - wp.rcNormalPosition.Top;
 GikoSys.Setting.EditWindowWidth := wp.rcNormalPosition.Right - wp.rcNormalPosition.Left;
 GikoSys.Setting.EditWindowMax := WindowState = wsMaximized;
 //GikoSys.Setting.EditWindowStay := FormStyle = fsStayOnTop;      // ステイ状態の保存
 GikoSys.Setting.EditWindowTranslucent := TransAction.Checked;   // 半透明状態の保存

end;

procedure TEditorForm.SetNameList(sName, sMail: string);
begin
 if Trim(sName) <> '' then begin
  if GikoSys.Setting.NameList.IndexOf(sName) = -1 then
   GikoSys.Setting.NameList.Insert(0, sName);
 end;
 if Trim(sMail) <> '' then begin
  if GikoSys.Setting.MailList.IndexOf(sMail) = -1 then
   GikoSys.Setting.MailList.Insert(0, sMail);
 end;
end;

function TEditorForm.GetActiveControlHandle: THandle;
begin
 if EditorPage.ActivePage = EditorTab then begin
  if ActiveControl = NameComboBox then
   Result := FNameComboEdit
  else if ActiveControl = MailComboBox then
   Result := FMailComboEdit
  else if ActiveControl = BodyEdit then
   Result := BodyEdit.Handle
  else if ActiveControl = TitleEdit then
   Result := TitleEdit.Handle
  else
   Result := 0;
 end else
  Result := 0;
end;

procedure TEditorForm.SetContent(Content: string);
var
 doc : Variant;
begin
 if Browser.Document <> nil then begin
  doc := Browser.Document;
  doc.Clear;
  doc.open;
  doc.charset := 'Shift_JIS';
  doc.Write(Content);
  doc.Close;
 end;
end;

procedure TEditorForm.Send(SPID: string; PON: string; FirstWriting: Boolean);
var
 TextStream: TStringStream;
 Source: TStringStream;
 ResponseText: string;
 URL: string;
 RefURL: string;
 State: TGikoDownloadState;
 ResultType: TGikoResultType;
 MsgResult: Integer;
 Cookie: string;
 Board: TBoard;
 sysMenu : HMENU;
 //fusianasanトラップ by定期便
 Namae: String;
 SettingTxt: String;
        RefeURL: string;
begin
 FAbort := False;
 State := gdsError;
 Namae := RepHtml(NameComboBox.Text);
 if FThreadItem = nil then
  Board := FBoard
 else
  Board := FThreadItem.ParentBoard;

 Indy.Request.Clear;
 Indy.ProxyParams.BasicAuthentication := False;
 if GikoSys.Setting.WriteProxy then begin
  Indy.ProxyParams.ProxyServer := GikoSys.Setting.WriteProxyAddress;
  Indy.ProxyParams.ProxyPort := GikoSys.Setting.WriteProxyPort;
  Indy.ProxyParams.ProxyUsername := GikoSys.Setting.WriteProxyUserID;
  Indy.ProxyParams.ProxyPassword := GikoSys.Setting.WriteProxyPassword;
  if GikoSys.Setting.ReadProxyUserID <> '' then
   Indy.ProxyParams.BasicAuthentication := True;
 end else begin
  Indy.ProxyParams.ProxyServer := '';
  Indy.ProxyParams.ProxyPort := 80;
  Indy.ProxyParams.ProxyUsername := '';
  Indy.ProxyParams.ProxyPassword := '';
 end;
 if FThreadItem = nil then begin
  URL := FBoard.GetSendURL;
  RefURL := GikoSys.UrlToServer(FBoard.URL) + 'test/bbs.cgi';
 end else begin
  URL := FThreadItem.GetSendURL;
  RefURL := FThreadItem.URL;
 end;
 Indy.Request.UserAgent := GikoSys.GetUserAgent;
 Indy.Request.Referer := RefURL;
 Indy.Request.AcceptEncoding := '';

 Cookie := '';
 if SPID <> '' then
  Cookie := Cookie + 'SPID=' + SPID + '; ';
 if PON <> '' then
  Cookie := Cookie + 'PON=' + PON + '; ';
 Cookie := 'Cookie: ' + Cookie + 'NAME=' + NameComboBox.Text + '; MAIL=' + MailComboBox.Text;

 sysMenu := GetSystemMenu( Handle, false );
 EnableMenuItem( sysMenu, SC_CLOSE, MF_GRAYED );
{
  EnableMenuItem(SysMenu, SC_CLOSE, MF_BYCOMMAND or MF_ENABLED);
  DrawMenuBar(Handle);
}
 Indy.Request.CustomHeaders.Clear;
// Indy.Request.CacheControl := 'no-cache';
 Indy.Request.CustomHeaders.Add('Pragma: no-cache');
 Indy.Request.AcceptLanguage := 'ja';
 Indy.Request.Accept := 'image/gif, image/x-xbitmap, image/jpeg, image/pjpeg, */*';
 Indy.Request.ContentType := 'application/x-www-form-urlencoded';
 Indy.Request.CustomHeaders.Add(Cookie);
 TextStream := TStringStream.Create('');
 Source := TStringStream.Create('');
 try
  try
   FDebugStrReceive := '';
   FDebugStrSend := '';
   GetSendData(Source);
   Indy.Post(URL, Source, TextStream);
   ResponseText := TextStream.DataString;

   ResultType := GetResultType(ResponseText);

   //フシアナトラップ警告(LocalMode) by 定期便
                        if Namae = '山崎渉' then begin
    MsgResult := MsgBox(
      Handle,
     'リモートホストを表示する機能が使われています' + #13#10 +
     'もしも間違ってこの方法でホストが表示されたとしても、自己責任なので削除依頼には応じません。' + #13#10#13#10 +
     '責任を負うことを承諾して書き込みますか?',
     '情報',
     MB_YESNO or MB_ICONQUESTION);
    if MsgResult = IDYES then begin
                                end
                        end else
   if MsgResult = IDNO  then begin
    Exit;
    Close;
   end else
   if Namae = 'fusianasan' then begin
    MsgResult := MsgBox(
      Handle,
     'リモートホストを表示する機能が使われています' + #13#10 +
     'もしも間違ってこの方法でホストが表示されたとしても、自己責任なので削除依頼には応じません。' + #13#10#13#10 +
     '責任を負うことを承諾して書き込みますか?',
     '情報',
     MB_YESNO or MB_ICONQUESTION);
    if MsgResult = IDYES then begin
                                end
                        end else
   if MsgResult = IDNO  then begin
    Exit;
    Close;
   end;
   //フシアナトラップ警告(SETTING.TXT Mode) by 定期便
   RefURL := GikoSys.UrlToServer(FBoard.URL)
    + GikoSys.UrlToID(FBoard.URL)
    + '/';
   //RefURLを元にSETTING.TXTアドレス指定
   RefeURL := RefURL
    + 'SETTING.TXT';

   Settingtxt := Indy.Get(RefeURL);

                        //DebugOnly
                        if Settingtxt = '' then begin
                                ShowMessage(Settingtxt);
                                Exit;
                        end else begin
                                ShowMessage(Settingtxt);
                                Exit;
                        end;

   if ResultType = grtOK then begin
                WriteSambaTime(FHost, Now());
    State := gdsComplete;
   end else if ResultType = grtCookie then begin
    //ループ防止
    if not FirstWriting then
     raise Exception.Create('');
    MsgResult := MsgBox(
     Handle,
     '?投稿された内容はコピー、保存、引用、転載等される場合があります。' + #13#10 +
     '?投稿に関して発生する責任は全て投稿者に帰します。' + #13#10#13#10 +
     '全責任を負うことを承諾して書き込みますか?',
     '情報',
     MB_YESNO or MB_ICONQUESTION);
    if MsgResult = IDYES then begin
     Board.SPID := GetSPID(Indy.Response.RawHeaders.Values['Set-Cookie']);
     Board.PON := GetPON(Indy.Response.RawHeaders.Values['Set-Cookie']);
     if (Board.SPID = '') and (Board.PON = '') then
      raise Exception.Create('');
     //もう一回このメソッド
     Send(Board.SPID, Board.PON, False);
     Exit;
    end else begin
     Board.SPID := '';
     Board.PON := '';
     FWork := false;
     EnableMenuItem(SysMenu, SC_CLOSE, MF_BYCOMMAND or MF_ENABLED);
     DrawMenuBar(Handle);
     Exit;
    end;
   end else if ResultType = grtCheck then begin
    //
    //ループ防止
    if not FirstWriting then
     raise Exception.Create('');

    MsgResult := MsgBox(
     Handle,
     '書き込みに関しては様々なログ情報が記録されています。' + #13#10 +
     '投稿に関して発生する責任は全て投稿者に帰します。' + #13#10 +
     '公序良俗に反したり、他人に迷惑をかける書き込みは控えて下さい。' + #13#10 +
     '投稿された内容はコピー?保存?引用?転載等される場合があります。' + #13#10 +
     #13#10 +
     '全責任を負うことを承諾して書き込みますか?',
     '確認',
     MB_YESNO or MB_ICONQUESTION);

    if MsgResult = IDYES then begin
     Board.SPID := GetSPID(Indy.Response.RawHeaders.Values['Set-Cookie']);
     Board.PON := GetPON(Indy.Response.RawHeaders.Values['Set-Cookie']);
     if (Board.SPID = '') and (Board.PON = '') then
      raise Exception.Create('');
     Send(Board.SPID, Board.PON, False);
     Exit;
    end else begin
     EnableMenuItem(SysMenu, SC_CLOSE, MF_BYCOMMAND or MF_ENABLED);
     DrawMenuBar(Handle);
     Board.SPID := '';
     Board.PON := '';
     FWork := false;
     Exit;
            end;
   end else begin
                WriteSambaTime(FHost, Now());
    State := gdsError;
    raise Exception.Create('');
   end;

  except
   on E: EIdConnectException do begin
    State := gdsError;
    ResponseText := '<html><body>'
           + '<div>接続が失敗しました<br>'
           + '回線やプロキシの状態を調べてください<br></div>'
           + '<br><br><div>' + E.Message + '</div>'
           + '</body></html>';
   end;
   on E: Exception do begin
    State := gdsError;

    FDebugStrReceive := AnsiReplaceText(FDebugStrReceive, '<', '&lt;');
    FDebugStrReceive := AnsiReplaceText(FDebugStrReceive, '>', '&gt;');
    FDebugStrSend := AnsiReplaceText(FDebugStrSend, '<', '&lt;');
    FDebugStrSend := AnsiReplaceText(FDebugStrSend, '>', '&gt;');

    ResponseText := '<html><body>' + TextStream.DataString;
    ResponseText := AnsiReplaceText(ResponseText, '</body>', '');
    ResponseText := AnsiReplaceText(ResponseText, '</html>', '');
    ResponseText := ResponseText + '<hr><div align="left"><pre>';
    ResponseText := ResponseText + '<b>ここからギコナビの情報</b>'#13#10;
    ResponseText := ResponseText + #13#10'●送信'#13#10;
    ResponseText := ResponseText + FDebugStrSend;
    ResponseText := ResponseText + #13#10'●受信'#13#10;
    ResponseText := ResponseText + FDebugStrReceive;
    ResponseText := ResponseText + '</pre></div></body></html>';
   end;
  end;
  FStatusCode := Indy.ResponseCode;
  if FAbort then
   State := gdsAbort;
 finally
  Source.Free;
  TextStream.Free;
  //sysMenu := GetSystemMenu( Handle, true );
  EnableMenuItem(SysMenu, SC_CLOSE, MF_BYCOMMAND or MF_ENABLED);
  DrawMenuBar(Handle);
 end;
 FWork := false;
        //非公式ギコナビ板などのスクリプト用
        //ResponceCodeが302Foundで書き込み完了
        if FStatusCode = 302 then begin
  GikoForm.PlaySound('ResEnd');
  SaveSendFile;
  if FThreadItem = nil then
   GikoForm.AddMessageList(FBoard.Title + ' [新スレ送信終了]', nil, gmiOK)
  else
   GikoForm.AddMessageList(FThreadItem.Title + ' [レス送信終了]', nil, gmiOK);
  Close;
        end;
 if State = gdsComplete then begin
  GikoForm.PlaySound('ResEnd');
  SaveSendFile;
  if FThreadItem = nil then
   GikoForm.AddMessageList(FBoard.Title + ' [新スレ送信終了]', nil, gmiOK)
  else
   GikoForm.AddMessageList(FThreadItem.Title + ' [レス送信終了]', nil, gmiOK);
  Close;
 end else if State = gdsError then begin
  if FThreadItem = nil then
   GikoForm.AddMessageList(FBoard.Title + ' [新スレ送信失敗]', nil, gmiNG)
  else
   GikoForm.AddMessageList(FThreadItem.Title + ' [レス送信失敗]', nil, gmiNG);
  EditorPage.ActivePage := PreviewTab;
  SetContent(ResponseText);
 end else if State = gdsAbort then begin
  GikoForm.AddMessageList(FThreadItem.Title + ' [中断]', nil, gmiSAD);
 end;
end;

function TEditorForm.GetResultType(ResponseText: string): TGikoResultType;
begin
 if AnsiPos('書きこみが終わりました', ResponseText) <> 0 then
  Result := grtOK
 else if (AnsiPos('クッキーがないか期限切れです', ResponseText) > 0) or
     (AnsiPos('<title>クッキー確認!</title>', ResponseText) > 0) or
     (AnsiPos('<title>■クッキー確認!■</title>', ResponseText) > 0) or
     //(AnsiPos('クッキー確認', ResponseText) > 0) or
     (AnsiPos(RES2CH_COOKIE, ResponseText) > 0) then
  Result := grtCookie
 else if (AnsiPos('<font size=+2 color=#FF0000>書き込みチェック! </font>', ResponseText) > 0) or
     (AnsiPos('<title>■ 書き込み確認します ■</title>', ResponseText) > 0) or
     (AnsiPos('<title>投稿確認</title>', ResponseText) > 0) or
     (AnsiPos('<b>書きこみ確認</b>', ResponseText) > 0) or
     (AnsiPos('="../test/subbbs.cgi">', ResponseText) > 0) or
     (AnsiPos(RES2CH_FALSE, ResponseText) > 0) then
  Result := grtCheck
 else
  Result := grtError;
end;


procedure TEditorForm.GetSendData(Source: TStringStream);
var
 SessionID: string;
 s: string;
 SendTime: Integer;
 Adjust: Integer;
 Board: TBoard;
 body  : string;
begin
 if FThreadItem = nil then
  Board := FBoard
 else
  Board := FThreadItem.ParentBoard;

 if GikoSys.Setting.UseMachineTime then begin
  if GikoSys.Setting.TimeAdjust then
   Adjust := Gikosys.Setting.TimeAdjustSec
  else
   Adjust := GikoSys.Setting.TimeAdjustSec * -1;
  SendTime := GikoSys.DateTimeToInt(Now) - (9 * 60 * 60) + Adjust
 end else begin
  if (Board.LastGetTime = 0) or (Board.LastGetTime = ZERO_DATE) then
   SendTime := GikoSys.DateTimeToInt(Now)
  else
   SendTime := GikoSys.DateTimeToInt(Board.LastGetTime);
 end;

 body := GetBody;

 SessionID := GikoSys.Dolib.SessionID;
 if SessionID <> '' then
  s := 'sid=' + HttpEncode(SessionID) + '&'
 else
  s := '';
 s := s + 'subject=&'
     + 'FROM=' + HttpEncode(NameComboBox.Text) + '&'
     + 'mail=' + HttpEncode(MailComboBox.Text) + '&'
     + 'MESSAGE=' + HttpEncode(body) + '&'
     + 'bbs=' + Board.BBSID + '&'
     + 'time=' + IntToStr(SendTime) + '&';
 if FThreadItem = nil then begin
  s := s + 'subject=' + HttpEncode(TitleEdit.Text) + '&';
  s := s + 'submit=' + HttpEncode('全責任を負うことを承諾して書き込む') + #13#10;
 end else begin
  s := s + 'key=' + ChangeFileExt(FThreadItem.FileName, '') + '&';
  s := s + 'submit=' + HttpEncode('書き込む') + #13#10;
 end;
 Source.WriteString(s);
end;

procedure TEditorForm.SaveSendFile;
var
 sDate: string;
 ini: TMemIniFile;
begin
 ini := TMemIniFile.Create(GikoSys.GetSentFileName);
 try
  sDate := IntToStr(GikoSys.DateTimeToInt(Now));

  ini.WriteString(sDate, 'Name', NameComboBox.Text);
  ini.WriteString(sDate, 'EMail', MailComboBox.Text);
  ini.WriteString(sDate, 'Body', HttpEncode(BodyEdit.Text));
  ini.WriteInteger(sDate, 'Status', FStatusCode);
  ini.WriteDateTime(sDate, 'Date', Now);
  if FThreadItem = nil then begin
   ini.WriteString(sDate, 'Title', TitleEdit.Text);
   ini.WriteString(sDate, 'BBS', FBoard.BBSID);
   ini.WriteInteger(sDate, 'NewThread', 1);
  end else begin
   ini.WriteString(sDate, 'Title', FThreadItem.Title);
   ini.WriteString(sDate, 'BBS', FThreadItem.ParentBoard.BBSID);
   ini.WriteString(sDate, 'Key', ChangeFileExt(FThreadItem.FileName, ''));
  end;

  ini.UpdateFile;
 finally
  ini.Free;
 end;
end;

procedure TEditorForm.SendActionExecute(Sender: TObject);
var
 Board: TBoard;
 rc: Integer;
 state : TGikoDownloadState;
 body  : string;
begin
 if FWork then
  Exit;
 try
  FWork := True;
  SendAction.Enabled := False;
  Application.ProcessMessages;
  if not Check then Exit;

  if FThreadItem = nil then
   Board := FBoard
  else
   Board := FThreadItem.ParentBoard;

  if FThreadItem = nil then begin
   rc := GikoUtil.MsgBox(Handle,
             '「' + Board.Title + '」板に新しいスレッド立てます'#13#10#13#10
             + '?板のルールを守った書き込みであることを確認しましたか?'#13#10
             + '?他に同じようなスレッドが無かったことを確認しましたか?'#13#10#13#10
             + '「はい」を押すと送信します',
             '確認',
             MB_ICONQUESTION or MB_YESNO);
   if rc <> ID_YES then
    Exit;
  end;

  SetNameList(NameComboBox.Text, MailComboBox.Text);
  if KotehanCheckBox.Checked then begin
   Board.KotehanName := NameComboBox.Text;
   Board.KotehanMail := MailComboBox.Text;
  end;

  if Board.IsBoardPlugInAvailable then begin
   body := GetBody;

   if FThreadItem = nil then begin
    // スレ立て
    state := TGikoDownloadState( Board.BoardPlugIn.CreateThread(
     DWORD( Board ), TitleEdit.Text, NameComboBox.Text, MailComboBox.Text, body ) );

    if state = gdsComplete then begin
     GikoForm.PlaySound('ResEnd');
     SaveSendFile;
     GikoForm.AddMessageList(FBoard.Title + ' [新スレ送信終了]', nil, gmiOK);
     FWork := False;
     Close;
    end else if State = gdsError then begin
     GikoForm.AddMessageList(FBoard.Title + ' [新スレ送信失敗]', nil, gmiNG);
    end else if State = gdsAbort then begin
     GikoForm.AddMessageList(FThreadItem.Title + ' [中断]', nil, gmiSAD);
    end;
   end else begin
    // レス
    state := TGikoDownloadState( FThreadItem.BoardPlugIn.WriteThread(
     DWORD( FThreadItem ), NameComboBox.Text, MailComboBox.Text, body ) );

    if state = gdsComplete then begin
     GikoForm.PlaySound('ResEnd');
     SaveSendFile;
     GikoForm.AddMessageList(FThreadItem.Title + ' [レス送信終了]', nil, gmiOK);
                    FWork := False;
     Close;
    end else if State = gdsError then begin
     GikoForm.AddMessageList(FThreadItem.Title + ' [レス送信失敗]', nil, gmiNG);
    end else if State = gdsAbort then begin
     GikoForm.AddMessageList(FThreadItem.Title + ' [中断]', nil, gmiSAD);
    end;
   end;
  end else begin
   if not Timer1.Enabled then
    Send(Board.SPID, Board.PON, True)
   else begin
    if not CheckSambaTime(FHost, Now()) then begin
     rc := GikoUtil.MsgBox(Handle,
        'Samba24の規定値未満の秒数しか経過していません。'#13#10
        + '送信を中止しますか?' + #13#10
        + '(「いいえ」だと送信します)', 'Samba24警告',
        MB_YESNO or MB_ICONQUESTION);
     if rc = IDYES then begin
      FWork := false;
      Exit;
     end;
    end;
    Send(Board.SPID, Board.PON, True);
   end;
  end;
 finally
  FWork := False;
  if Timer1.Enabled then
   ReadSambaTime(FHost);
 end;
end;

procedure TEditorForm.SaveActionExecute(Sender: TObject);
begin
//
end;

procedure TEditorForm.CloseActionExecute(Sender: TObject);
begin
 Close;
end;

procedure TEditorForm.UndoActionExecute(Sender: TObject);
begin
 SendMessage(GetActiveControlHandle, WM_UNDO, 0, 0);
end;

procedure TEditorForm.CutActionExecute(Sender: TObject);
begin
 SendMessage(GetActiveControlHandle, WM_CUT, 0, 0);
end;

procedure TEditorForm.CopyActionExecute(Sender: TObject);
begin
 SendMessage(GetActiveControlHandle, WM_COPY, 0, 0);
end;

procedure TEditorForm.PasteActionExecute(Sender: TObject);
begin
 SendMessage(GetActiveControlHandle, WM_PASTE, 0, 0);
end;

procedure TEditorForm.SelectAllActionExecute(Sender: TObject);
begin
 SendMessage(GetActiveControlHandle, EM_SETSEL, 0, GetWindowTextLength(GetActiveControlHandle));
end;

procedure TEditorForm.TopActionExecute(Sender: TObject);     // ウィンドウ最前面(Stay)ボタンの処理
begin
 if not (fsShowing in Self.FormState) then begin
  if TopAction.Checked then begin // ステイ状態に設定
   SetWindowPos(Handle, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE + SWP_NOSIZE);
   GikoSys.Setting.EditWindowStay := true;
  end else begin   // ステイ状態解除
   SetWindowPos(Handle, HWND_NOTOPMOST, 0, 0, 0, 0, SWP_NOMOVE + SWP_NOSIZE);
   GikoSys.Setting.EditWindowStay := false;
  end;
  // ステイ状態の保存
  //GikoSys.Setting.EditWindowStay := FormStyle = fsStayOnTop;
 end;
end;

procedure TEditorForm.AbortActionExecute(Sender: TObject);
begin
 FAbort := True;
end;

procedure TEditorForm.SendActionUpdate(Sender: TObject);
begin
 SendAction.Enabled := not FWork;
end;

procedure TEditorForm.SaveActionUpdate(Sender: TObject);
begin
 SaveAction.Enabled := False;
end;

procedure TEditorForm.CloseActionUpdate(Sender: TObject);
begin
 CloseAction.Enabled := not FWork;
end;

procedure TEditorForm.UndoActionUpdate(Sender: TObject);
begin
 UndoAction.Enabled := (GetActiveControlHandle <> 0)
            and (SendMessage(GetActiveControlHandle, EM_CANUNDO, 0, 0) <> 0)
            and (not FWork);
end;

procedure TEditorForm.CutActionUpdate(Sender: TObject);
var
 Selection: TSelection;
 AHandle: THandle;
begin
 AHandle := GetActiveControlHandle;
 SendMessage(AHandle, EM_GETSEL, Longint(@Selection.StartPos), Longint(@Selection.EndPos));
 CutAction.Enabled := (AHandle <> 0)
          and ((Selection.EndPos - Selection.StartPos) <> 0)
          and (not FWork);
end;

procedure TEditorForm.CopyActionUpdate(Sender: TObject);
var
 Selection: TSelection;
 AHandle: THandle;
begin
 AHandle := GetActiveControlHandle;
 SendMessage(AHandle, EM_GETSEL, Longint(@Selection.StartPos), Longint(@Selection.EndPos));
 CopyAction.Enabled := (AHandle <> 0)
          and ((Selection.EndPos - Selection.StartPos) <> 0)
          and (not FWork);
end;

procedure TEditorForm.PasteActionUpdate(Sender: TObject);
begin
 PasteAction.Enabled := (GetActiveControlHandle <> 0)
           and (Clipboard.HasFormat(CF_TEXT))
           and (not FWork);
end;

procedure TEditorForm.TopActionUpdate(Sender: TObject);
begin
  TopAction.Enabled := not FWork;
end;

procedure TEditorForm.SageCheckBoxClick(Sender: TObject);
begin
 if SageCheckBox.Checked then begin
  if AnsiPos('sage', MailComboBox.Text) = 0 then
   MailComboBox.Text := 'sage' + MailComboBox.Text;
 end else begin
  if AnsiPos('sage', MailComboBox.Text) <> 0 then
   MailComboBox.Text := StringReplace(MailComboBox.Text, 'sage', '', [rfReplaceAll]);
 end;
end;

procedure TEditorForm.MailComboBoxChange(Sender: TObject);
begin
 if AnsiPos('sage', MailComboBox.Text) = 0 then
  SageCheckBox.Checked := False
 else
  SageCheckBox.Checked := True;
end;


function TEditorForm.GetSPID(CookieLine: string): string;
var
 s: string;
 i: Integer;
begin
 Result := '';
 i := 0;
 while True do begin
  s := Trim(GikoSys.GetTokenIndex(CookieLine, ';', i));
  if s = '' then
   Break
  else begin
   if Pos('SPID=', s) = 1 then begin
    Result := Trim(Copy(s, 6, Length(s)));
    Break;
   end;
  end;
  inc(i);
 end;
end;

function TEditorForm.GetPON(CookieLine: string): string;
var
 s: string;
 i: Integer;
begin
 Result := '';
 i := 0;
 while True do begin
  s := Trim(GikoSys.GetTokenIndex(CookieLine, ';', i));
  if s = '' then
   Break
  else begin
   if Pos('PON=', s) = 1 then begin
    Result := Trim(Copy(s, 5, Length(s)));
    Break;
   end;
  end;
  inc(i);
 end;
end;

procedure TEditorForm.IdLogDebugReceive(ASender: TIdConnectionIntercept;
 AStream: TStream);
var
 StringStream: TStringStream;
begin
 StringStream := TStringStream.Create('');
 try
  StringStream.CopyFrom(AStream, AStream.Size);
  FDebugStrReceive := FDebugStrReceive + StringStream.DataString;
 finally
  StringStream.Free;
 end;
end;

procedure TEditorForm.IdLogDebugSend(ASender: TIdConnectionIntercept;
 AStream: TStream);
var
 StringStream: TStringStream;
begin
 StringStream := TStringStream.Create('');
 try
  StringStream.CopyFrom(AStream, AStream.Size);
  FDebugStrSend := FDebugStrSend + StringStream.DataString;
 finally
  StringStream.Free;
 end;
end;

procedure TEditorForm.TransActionExecute(Sender: TObject);
begin
 AlphaBlend := TransAction.Checked;
 // 半透明状態の保存
 GikoSys.Setting.EditWindowTranslucent := TransAction.Checked;
end;

procedure TEditorForm.TransActionUpdate(Sender: TObject);
begin
 TransAction.Enabled := not FWork;
end;
//StatusBarのPanels[0]の幅を可変。残りを固定にする
procedure TEditorForm.StatusBarResize(Sender: TObject);
begin
 StatusBar.Panels[0].Width := StatusBar.Width
         - StatusBar.Panels[1].Width - StatusBar.Panels[2].Width;

end;

procedure TEditorForm.Timer1Timer(Sender: TObject);
begin
 if FSambaTime = ZERO_DATE then
  StatusBar.Panels[1].Text := '初書'
 else begin
  FNow := IncMilliSecond(FNow, 500);
  StatusBar.Panels[1].Text := Format('%8.0f秒経過', [SecondSpan(FNow, FSambaTime)]);
 end;

end;
//Samba.iniの書き込み時間を読み込む
procedure TEditorForm.ReadSambaTime(const AHost: string);
var
 ini :TMemIniFile;
 tmp: string;
begin
 Timer1.Enabled := false; //経過秒数表示TimerをOffにする(これがONのときSamba24対策On)
 FNow := Now();   //現在時間を取得(Timer表示用で、Checkするときは再びNow()を呼ぶ)
 Timer1.Enabled := true; //経過秒数表示TimerをOnにする(これがONのときSamba24対策On)
 ini := TMemIniFile.Create(GikoSys.GetSambaFileName);
 try
   //文字列で読み取って、変換関数でTDateTimeへ
   tmp := ini.ReadString('Send', AHost, DateTimeToStr(ZERO_DATE));
   FSambaTime := ConvertDateTimeString(tmp);
 finally
  ini.Free;
 end;
end;
//Samba.iniに最終書き込み時間を書き込む
procedure TEditorForm.WriteSambaTime(const AHost: string; ATime: TDateTime);
var
 ini :TMemIniFile;
begin
 ini := TMemIniFile.Create(GikoSys.GetSambaFileName);
 try
  ini.WriteDateTime('Send', AHost, ATime);
  ini.UpdateFile;
 finally
  ini.Free;
 end;
end;
//最終書き込み時間と現在時を比較する(真:規定値以上 偽:規定値未満)
function TEditorForm.CheckSambaTime(const AHost: string; ATime: TDateTime): Boolean;
var
 pastsec: double;
 SettingTime: Integer;
begin
 SettingTime := ReadSettingTime(AHost);
 ReadSambaTime(AHost);
 pastsec := SecondSpan(ATime, FSambaTime);
 if pastsec > SettingTime then
  Result := true
 else
  Result := false;
end;
//AHost(鯖名)のSambaの規定値を読み込む
function TEditorForm.ReadSettingTime(const AHost: string): Integer;
var
 ini :TMemIniFile;
begin
 ini := TMemIniFile.Create(GikoSys.GetSambaFileName);
 try
  Result := ini.ReadInteger('Setting', AHost, 0);
  //規定値が0のとき、もしくは設定されていないときは、ファイルに書きたす。
  if Result = 0 then begin
   ini.WriteInteger('Setting', AHost, 0);
   ini.UpdateFile;
  end;
 finally
  ini.Free;
 end;
end;
//FormがActiveになったら最終書き込み時間を読み込む
procedure TEditorForm.FormActivate(Sender: TObject);
begin
 if ( Timer1.Enabled ) and ( FThreadItem <> nil )then
  ReadSambaTime(FHost);
end;
//Samba24対策を使うかどうか決める関数
//ReadSambaTime を呼び出すとTimerがOnになる
procedure TEditorForm.SetSamba24(AURL: string);
var
 Protocol, Host, Path, Document, Port, Bookmark : string;
begin
 //Samba24対策をしないなら終了
 if not GikoSys.Setting.UseSamba then
  Exit;
 //HostのURLに'.2ch.'か'.bbspink.'が含まれていたらSamba24対策をする
 GikoSys.ParseURI( AURL, Protocol,Host, Path, Document, Port, Bookmark );
 if GikoSys.Is2chHost(Host) then begin
  Host := Copy(Host, 1, AnsiPos('.', Host) - 1);
  FHost := Host;   //FHost=鯖名
  ReadSambaTime(FHost); //以前の書き込み時間を読み込む
  //StatusBarにこの鯖の規定値を表示する
  StatusBar.Panels[2].Text := 'Samba24規定値' + IntToStr(ReadSettingTime(FHost));
 end;
end;
procedure TEditorForm.FormCloseQuery(Sender: TObject;
  var CanClose: Boolean);
begin
 CanClose := not FWork;
end;

function TEditorForm.GetOEIndentChar : string;
var
 regKey   : TRegistry;
 Identities : string;
 IndentChar : DWORD;
const
 DEFAULT_CHAR = '> ';
 OE_MAIL_PATH = '/Software/Microsoft/Outlook Express/5.0/Mail';
 INDENT_CHAR  = 'Indent Char';
begin

 Result := DEFAULT_CHAR;
 regKey := TRegistry.Create;
 try
  try
   regKey.RootKey := HKEY_CURRENT_USER;
   if not regKey.OpenKey( 'Identities', False ) then
    Exit;
   Identities   := regKey.ReadString( 'Default User ID' );
   if Identities = '' then
    Exit;
   if not regKey.OpenKey( Identities + OE_MAIL_PATH, False ) then
    Exit;
   IndentChar := regKey.ReadInteger( INDENT_CHAR );
   Result := Char( IndentChar ) + ' ';
  except
  end;
 finally
  regKey.Free;
 end;

end;

procedure TEditorForm.QuotePasteActionExecute(Sender: TObject);
var
 s   : TStringList;
 i   : Integer;
 quote : string;
begin

 quote := GetOEIndentChar;
 s   := TStringList.Create;
 try
  s.Text := Clipboard.AsText;

  for i := s.Count - 1 downto 0 do
   s[ i ] := quote + s[ i ];

  BodyEdit.SelText := s.Text;
 finally
  s.Free;
 end;

end;

procedure TEditorForm.SpaceToNBSPActionExecute(Sender: TObject);
begin
 GikoSys.Setting.SpaceToNBSP := SpaceToNBSPAction.Checked;
 if EditorPage.ActivePage = PreviewTab then
  Preview;
end;

procedure TEditorForm.AmpToCharRefActionExecute(Sender: TObject);
begin
 GikoSys.Setting.AmpToCharRef := AmpToCharRefAction.Checked;
 if EditorPage.ActivePage = PreviewTab then
  Preview;
end;

end.

━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

 TidHttp和Cookie
关键字:
分类: 个人专区
密级: 公开
(评分: , 回复: 1, 阅读: 59) ??
我们知道,用IE注册网页(象论坛)时,它能够自动找出相应的Cookie并提交给服务器,从而使用户不用重新登录就能够看到与他自己帐号有关的内容.这是怎么实现的呢?

如果我用用IE的ACTIVEX控件TWebBrowser,这个问题是不用考虑的,它自己处理了.但是有些场合TWebBrowser并不是上佳的选择,比如我们要从网页上取点内容下来,但是不用显示,这样也用WebBrowser的话程序就显得笨拙了.

我今天用的是idHttp,据说拿它和IdCookieManager连起来用很好用,但是我没有弄懂.我用的是别的办法,整理如下:

*取得与网址有关的Cookie
用InternetGetCookie这个API,它在WinInet单元中
有4个参数,第一个是URL,第二个设为nil,第二个指到一个变量BUFFER,存放Cookie的内容,第四个是Cookie的长度
InternetGetCookie(PChar(Edit1.Text), nil, buf, Size)

*给idHttp设置Cookie
idHttp1.Request.CustomHeaders.Text := 'Cookie: ' + Memo1.Lines.Text;

*取网页内容
Memo1.Lines.Text := idHttp1.Get(Url);

比较完整的代码如下:
procedure TForm1.Button1Click(Sender: TObject);
var
  buf: array[0..1023] of char;
  Size: DWord;
begin
  if InternetGetCookie(PChar(Edit1.Text), PChar(Edit2.Text), buf, Size) then
    begin
    Memo1.Lines.Text := Buf;
    idHttp1.Request.CustomHeaders.Text := 'Cookie: ' + Memo1.Lines.Text;
    end
  else
    Memo1.Lines.Text := 'error!';
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  Memo2.Lines.Text := IdHTTP1.Get(Edit1.Text);
end;
 

━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
http://usenet.best-buy-online.com/Dir6/File611.html

From: Rob Kennedy
Subject: Re: Setting cookies?


Jonathan wrote:
> Well, I'm not actually gonna set the cookies, because, I suppose the
> website automatically sets them like it does when you're just
> browsing using Internet Explorer?

 

I see. I misunderstood your request. I though you were writing a program
that would run on the server -- that it would *be* the online forum. You
want a program that will run on the clients' computers and help them
manage their online accounts. Well, gee, why didn't you say so? ;)

Normally, the user fills in a form with a user name and password and
presses "Submit," and the browser sends that form data to the server. In
its response, the server will send one or more Set-Cookie headers, which
the browser stores. When the user issues the next request to that
server, the browser will include any applicable cookies with one or more
Cookie headers, and that's how the server knows the request is coming
from someone who's already logged in.

The way I picture your program is like this: You'll present the user
with a list of know sites and accounts. The user will choose one, and
your program will perform the necessary conversation with the server to
log in automatically. Then the user can visit the site, and it will
already recognize the user as being logged in.

Your program will need to recognize Set-Cookie headers from the server,
which should be pretty easy with Indy. The tricky part will be getting
Internet Explorer (or some other Web browser) to send those cookies in
its subsequent requests. To my knowledge, Internet Explorer stores all
its cookies in separate files. It might be enough for you to create
cookie files there for the browser to use, but you might find that IE
only reads those files once at start-up, and then keeps its relevant
cookies in RAM, so it might not notice when you create new files.

--
Rob

━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

ziluobu
0.8 分總積分 發表於 - 2004/07/06 :  19:49:47    
--------------------------------------------------------------------------------
我想編個能夠獲取網頁內容的軟體,可是髮現如果對方頁靣需要驗證cookie那麼用idhttp的get就不能直接獲取,請問高手我需要怎樣做?最好有例子,謝謝!

 
Chance36
版主
 
男42
Taiwan
768 篇發表文章
282 分答題得分
1628.6 分總積分 發表於 - 2004/07/06 :  21:24:33    
--------------------------------------------------------------------------------
ziluobu 你好

1.Cookies的取得,一般是經過帳號密碼登入並驗證過後由WebServer產生並隨網頁自動傳到Client端的,而由瀏覽器依設定存放在固定的位置(一般為使用者資料夾下的Cookies目錄)。

2.當有Get及Post的動作時,瀏覽器會自動到該位置檢查是否有目標伺服器產生的Cookies,若有的話(且未過期),則自動隨Get或Post一同傳到目標伺服器。

因此略過第一個產生Cookies的步驟,從第二步來看,Get時如何將Cookies傳給伺服器

1.若有現成的Cookies 且未過期,其實我們也不用額外處理,瀏覽器會自動一起傳過去。
2.若沒有現成的Cookies,就須要在Get或post之前,自己產生並放在正確的位置,
但是要自己產生Cookies,除非你知道該伺服器所產生的Cookies的內容及結構如何,否則就等於駭客的行為了。

3.另一個比較可行的辦法,是由程式代為登入該伺服器,讓該伺服器自動生成Cookies後,在執行Get或Post的動作(一切也都順理成章)。

4.至於由程式代為登錄伺服器,本站之前有人討論過,搜尋一下應該可以找到。

以下連結,參考看看
http://delphi.ktop.com.tw/topic.asp?topic_id=18695
http://delphi.ktop.com.tw/topic.asp?topic_id=47086
http://delphi.ktop.com.tw/topic.asp?topic_id=31987
http://delphi.ktop.com.tw/topic.asp?topic_id=48118

 
ziluobu
0.8 分總積分 發表於 - 2004/07/16 :  16:03:11    
--------------------------------------------------------------------------------
1、這個問題我已經試齣來勒,可以在idhttp的程序裏加一個idcookiemanager控件,試idhttp的idcookiemanager指嚮idcookiemanager控件,用post方式先到網站上獲取cookie然后就能用idhttp.get方式訪問有COOKIE限製的網站勒!

2、如果妳知道cookie的格式可以直接用add的方法直接將cookie賦值給idcookiemanager,然后直接用idhttp.get獲取頁麵就行勒!
procedure TForm2.BitBtn1Click(Sender: TObject);
var
temp:tstringlist;
b:string;
begin
form1.Memo1.Text:='';
temp:=tstringlist.Create;
temp.add('url=http://localhost/bbs/main.asp');
temp.Add('username=ziluobu');
temp.Add('userpass=******);
temp.add('xuansave=1');
temp.Add('Submit1= 登录 ');
b:=form1.idhttp1.Post('http://localhost/bbs/login.asp',temp);
form1.memo1.Text:=b;
form2.Hide;
end;
 

 

 

已标记关键词 清除标记
©️2020 CSDN 皮肤主题: 大白 设计师:CSDN官方博客 返回首页