httpget.pas

最好的局域网搜索软件

{-------------------------------------------------------------------------------
  Http get
  This is not a vcl component, it's just a unit, needn't install.
-------------------------------------------------------------------------------}

unit HttpGet;

interface

uses
  Windows, WinSock, ComCtrls, Classes, SysUtils;

type
  THttpGetThread=class(TThread)
  private
    { Private declarations }
    svr: string;
    GetStr: string;
    procedure OnTheEnd;
  public
    { Public declarations }
    ParentNode: TTreeNode;
    MyTree: TTreeView;
    procedure Execute; override;
    constructor Create(My_Tree: TTreeView; Parent_Node: TTreeNode; Server: string);
    destructor Destroy; override;
  end;

implementation

{
	Thanks to Darkbug and http://www.2ccc.com for this function.	
}
function getHttpDataByGetMethod(Server:String;Port:integer;Url:String;var CookieVal:TStringList):String;
var
  len,s:integer;
  name:sockaddr_in;
  he:PHostEnt;
  buf:array[0..1023]of char;
  str,data:string;
  wsd:WSADATA;
  i:integer;
begin
  WSAStartup($101,wsd);
  s:=socket(AF_INET,SOCK_STREAM,IPPROTO_TCP);
  he:=gethostbyname(PChar(Server));
  if he=nil then
    Raise Exception.Create('使用Sock连接异常或是指定服务器有误!');

  FillChar(name,sizeof(name),0);
  name.sin_family:=AF_INET;
  name.sin_port:=htons(Port);
  name.sin_addr.S_addr:=PDWORD(PDWORD(he.h_addr)^)^;
  connect(s,name,sizeof(name));
  str := 'GET /'+ Url +' HTTP/1.1'#13#10;
  str := str + 'Referer: http://' + Server;
  if Port<>80 then
    str := str + ':' + IntToStr(Port);
  str := str + '/' + Url + #13#10;
  str := str + 'User-Agent: Mozilla/4.0 (compatible; MSIE 5.01; Windows NT 5.0; MyIE 3.01)'#13#10;
  str := str + 'Host: ' + Server;
  if Port<>80 then
    str := str + ':' + IntToStr(Port);
  str := str + ''#13#10;
  str := str + 'Connection: Close'#13#10;
  str := str + 'Cache-Control: no-cache'#13#10;

  for i := 0 to CookieVal.Count-1 do
  begin
    str := str + 'Cookie: '+ CookieVal.Strings[i] + #13#10;
  end;

  str := str + #13#10;
  send(s,PChar(str)^,Length(str),0);
  while true do
  begin
    len:=recv(s,buf,sizeof(buf),0);
    if len<1 then
      break;
    SetString(str,buf,len);
    data:=data+str;
  end;
  closesocket(s);
  WSACleanup();
  Result := data;
end;

constructor THttpGetThread.Create(My_Tree: TTreeView; Parent_Node: TTreeNode;  Server: string);
begin

  MyTree := My_Tree;
  ParentNode := Parent_Node;
  svr := server;
  
  FreeOnTerminate := True;
  inherited Create(True);
  
end;

destructor THttpGetThread.Destroy;
begin
  //
end;

procedure THttpGetThread.OnTheEnd;
var
  i1, i2: integer;
  s: string;
  TemNode: TTreeNode;
begin
  if (GetStr = '') or
    (GetStr[10]='4') then
  begin
    ParentNode.ImageIndex := 121;
    ParentNode.SelectedIndex := 121;
  end
  else
  begin
    GetStr := LowerCase(GetStr);
    i1 := pos('<title>', GetStr);
    i2 := pos('</title>', GetStr);
    s := copy(GetStr, i1+7, i2-i1-7);

    {if s = '' then
    begin
      i1 := pos('<TITLE>', GetStr);
      i2 := pos('<TITLE>', GetStr);
      s := copy(GetStr, i1, i2-i1);
    end;}

    TemNode := MyTree.Items.AddChild(ParentNode, s);
    TemNode.ImageIndex := 128;
    TemNode.SelectedIndex := 128;

    ParentNode.ImageIndex := 120;
    ParentNode.SelectedIndex := 120;
  end;

  ParentNode.Expand(false);
end;

procedure THttpGetThread.Execute;
var
  CookieVal: TStringList;
begin
  CookieVal := TStringList.Create;
  GetStr := getHttpDataByGetMethod(svr, 80, '', CookieVal);
  CookieVal.Free;
  
  synchronize(OnTheEnd);
end;

end.