Delphi实现解析百度搜索结果link？url=

首先看到CB放了一个PHP版（http://www.cnbeta.com/articles/206465.htm）的。遂敲了一个Delphi版的胡闹一下。

代码很简单 就不详细标注了。

unit uMain;{   Created at 2012/01/19   微博 http://weibo.com/yinyongyou   博客 http://blog.csdn.net/MichaelJScofield}interfaceuses  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,  Dialogs,WinSock, StdCtrls, IdBaseComponent, IdComponent, IdTCPConnection,  IdTCPClient, IdHTTP;type  TfrmBaiduURLDecode = class(TForm)    lblSrcUrl: TLabel;    edtEncode: TEdit;    lblDstURL: TLabel;    edtDecode: TEdit;    btnFuck: TButton;    mmo1: TMemo;    procedure btnFuckClick(Sender: TObject);  private    { Private declarations }  public    { Public declarations }  end;const  HttpLine = #13#10#13#10;var  frmBaiduURLDecode: TfrmBaiduURLDecode;  WSAData: TWSAData;implementation{$R *.dfm}{ 获取http返回头部 }function GetHTTPResponseHeader(URL:String;var lpHeader:string):String;const  BufLenth = 1024;  INTERNET_DEFAULT_HTTP_PORT = 80;var  Buf:array[0..1023] of AnsiChar;  t: linger;  hSocket:integer;  hSend,hRet,hConnect:Integer;  iHost:Integer;  TimeOut:integer;  dwPort,dwRecv:DWORD;  HostIP:PHostEnt;  Addr:sockaddr_in;  BufSend,BufRev:PChar;  lpHttpHead,lpRecvStr:String;  szHostName,szHostPort,szFileName:String;  procedure ParseURL(URL: string; var HostName, FileName: string);    procedure ReplaceChar(c1, c2: Char; var St: string);    var      p: Integer;    begin      while True do      begin        p := Pos(c1, St);        if p = 0 then Break        else St[p] := c2;      end;    end;  var    i: Integer;  begin    if Pos(UpperCase('http://'), UpperCase(URL)) <> 0 then System.Delete(URL, 1, 7);    i := Pos('/', URL);    HostName := Copy(URL, 1, i);    FileName := Copy(URL, i, Length(URL) - i + 1);    if (Length(HostName) > 0) and (HostName[Length(HostName)] = '/') then      SetLength(HostName, Length(HostName) - 1);  end;begin  Result:='';  ParseURL(URL, szHostName, szFileName);  iHost := Pos(':',szHostName);  if iHost <> 0 then  begin    szHostPort := Copy(szHostName, iHost+1, Length(szHostName)-iHost);    szHostName := Copy(szHostName, 1, iHost-1);    dwPort := StrToIntDef(szHostPort, INTERNET_DEFAULT_HTTP_PORT);  end  else dwPort := INTERNET_DEFAULT_HTTP_PORT;  hSocket:=Socket(AF_INET,SOCK_STREAM,IPPROTO_IP); //IPPROTO_IP IPPROTO_TCP  Try    if hSocket = INVALID_SOCKET then Exit;    HostIP:=GetHostByName(PChar(szHostName));    FillChar(Addr,SizeOf(Addr),#0);    Addr.sin_family:=AF_INET;    Addr.sin_addr.S_addr:=PDWORD(PDWORD(HostIP.h_addr)^)^;    Addr.sin_port:=htons(dwPort);    hConnect:=Connect(hSocket,Addr,SizeOf(Addr));    if WSAGetLastError() = 10060 then hConnect:=Connect(hSocket,Addr,SizeOf(Addr));    if hConnect = SOCKET_ERROR then    begin      CloseSocket(hSocket);      Exit;    end;    lpHttpHead := 'GET ' + szFileName + ' HTTP/1.1' + #13#10 +                  'Accept: image/gif, image/x-xbitmap, image/jpeg, image/pjpeg, */*'+ #13#10+                  'User-Agent: Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1)'+ #13#10 +                  'Host: ' + szHostName + #13#10 +                  'Referer: ' + URL + #13#10 +                  'Accept-Language: zh-cn' + #13#10 +                  'Cache-Control: no-cache' + #13#10 +                  'Connection: close' + #13#10 +                  'Cookie: ' + 'iscookies=0; ASPSESSIONIDACRQTBCS=OGALDEBDBBIGMLOHFKMOJFKO' + #13#10 +                  #13#10#13#10;    GetMem(BufSend, Length(lpHttpHead) + 1);    Try      ZeroMemory(BufSend, Length(lpHttpHead) + 1);      StrPCopy(BufSend, lpHttpHead);      hSend:=Send(hSocket, BufSend^, Length(BufSend), 0);      if hSend = SOCKET_ERROR then      begin        CloseSocket(hSocket);        Exit;      end;      FillChar(Buf, SizeOf(Buf), #00);      while Recv(hSocket, Buf, SizeOf(Buf), 0) > 0 do      begin        lpRecvStr:='';        SetString(lpRecvStr, Buf, SizeOf(Buf));        Result := Result + lpRecvStr;        FillChar(Buf, SizeOf(Buf), #00);        if Pos(HttpLine,Result)>0 then break;      end;      lpHeader := Copy(Result,1,Pos(HttpLine,Result)-1);    finally      FreeMem(BufSend);    end;       t.l_onoff:=1;    t.l_linger:=0;    SetSockopt(hSocket, SOL_SOCKET, SO_LINGER, @t, SizeOf(t));  finally    CloseSocket(hSocket);  end;end;{ 获取真实地址 }function GetRealURL(sUrl:string):string;var  lpHeader: string;begin  GetHTTPResponseHeader(sUrl,lpHeader);  frmBaiduURLDecode.mmo1.Text := lpHeader;  if (Pos('301',lpHeader)>0) or (Pos('302',lpHeader)>0) then  begin    Delete(lpHeader,1,Pos('Location:',lpHeader)+Length('Location:'));    Result := Copy(lpHeader,1,Pos(#13,lpHeader));  end;end;{ 提取真实地址 }procedure TfrmBaiduURLDecode.btnFuckClick(Sender: TObject);begin  edtDecode.Text := GetRealURL(edtEncode.Text);end;initialization  WSAStartUp($202, WSAData);finalization  WSACleanup;end.

源码程序打包下载：http://download.csdn.net/detail/michaeljscofield/4581199