unthttpheaderobj.pas

用于模拟GETPOST方法发送HTTP请求并取得数据.rar

unit untHttpHeaderObj;

interface

uses
  Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TMyHttpHeaderObj = class
  private
  public
    HttpStat:String;
    HttpStatDesc:String;
    HttpServer:String;
    Location:String;
    ContentType:String;
    CookieVal:String;
    CookieValue:TStringList;
    procedure ParseHeaderData(Data:String);
    procedure ParseCookieData(CookieData:String);
    procedure SetCooikeData(CookieString:String);
  public
    constructor Create;
    destructor destory;
  end;

implementation

constructor TMyHttpHeaderObj.Create;
begin
  CookieValue := TStringList.Create;
end;

destructor TMyHttpHeaderObj.destory;
begin
  CookieValue.Free;
end;

procedure TMyHttpHeaderObj.ParseCookieData(CookieData: String);
var
  i,j:integer;
  tmpData:String;
begin
  i:=pos(';',CookieData);
  j:=0;
  while i>0 do
  begin
    tmpData := Copy(CookieData,j+1,i-j);
    //ShowMessage(tmpData);
    SetCooikeData(tmpData);
    delete(CookieData,1,i);
    i:=pos(';',CookieData);
  end;
end;


procedure TMyHttpHeaderObj.ParseHeaderData(Data:String);
var
  ts:TStringlist;
  tmpStr:String;
  i:integer;
begin
  ts := TStringList.Create;
  HttpStat := '';
  HttpStatDesc := '';
  HttpServer := '';
  Location := '';
  ContentType := '';
  CookieVal := '';
  try
    ts.Text := Data;
    for i := 0 to ts.Count-1 do
    begin
      //ShowMessage(ts.Strings[i]);
      tmpStr := ts.Strings[i];

      //判断是否为HTTP状态描述
      if pos('HTTP/1.1 ',UpperCase(tmpStr))=1 then
      begin
        tmpStr := Copy(tmpStr,Length('HTTP/1.1 ')+1 , Length(tmpStr)-Length('HTTP/1.1 ')+1);
        tmpStr := Trim(tmpStr);
        HttpStat := Copy(tmpStr,1,3);
        HttpStatDesc := Copy(tmpStr,4,length(tmpStr)-4+1);
      end;
      
      //判断是否为HTTP服务器描述
      if pos('SERVER:',UpperCase(tmpStr))=1 then
      begin
        HttpServer := Copy(tmpStr,Length('SERVER:')+1 , Length(tmpStr)-Length('SERVER:')+1  );
      end;

      //判断是否为HTTP 跳转Location描述
      if pos('LOCATION',UpperCase(tmpStr))=1 then
      begin
        Location := Copy(tmpStr,Length('LOCATION:')+1, Length(tmpStr)-Length('LOCATION:')+1 );
      end;

      //判断是否为HTTP Set-Cookie描述
      if pos('SET-COOKIE: ',UpperCase(tmpStr))=1 then
      begin
        CookieVal := Copy(tmpStr,Length('SET-COOKIE: ')+1, Length(tmpStr)-Length('SET-COOKIE: ')+1 ) + #13#10 ;
        ParseCookieData(CookieVal);
      end;

      //判断是否为HTTP Content-Type描述
      if pos('CONTENT-TYPE: ',UpperCase(tmpStr))=1 then
      begin
        ContentType := Copy(tmpStr,Length('CONTENT-TYPE: ')+1,Length(tmpStr)-Length('CONTENT-TYPE: ')+1);
      end;
    end;
    
  finally
    ts.Free;
  end;
end;

procedure TMyHttpHeaderObj.SetCooikeData(CookieString: String);
var
  i:integer;
  cname,cvalue:String;
  isSetted:Boolean;
begin
  isSetted := false;
  CookieString := Trim(CookieString);
  i := pos('=',CookieString);
  if i>0 then
  begin
    cname := Copy(CookieString,1,i);
    cvalue := Copy(CookieString,i+1,Length(CookieString)-i-1);
    cname := UpperCase(cname);
  end
  else begin
    Exit;
  end;

  for i:= 0 to CookieValue.Count-1 do
  begin
    if pos(cname,UpperCase(CookieValue.Strings[i]))=1 then
    begin
      isSetted := true;
      CookieValue.Strings[i] := cname + cvalue + ';'
    end;
  end;
  if not isSetted then
    CookieValue.Add(cname + cvalue + ';')
end;

end.