求代码unit HttpSocket;interfaceuses ShareMem,Classes,SysUtils,Dialogs,StdCtrls,WinSock,IdCTypes; const buf_len= 800003; const buf_lenh= 800000; type THttpSocket = class private addr: TSockAddrIn; Port,port_last,PortDefault:integer; sIp,ip_seted,ip_last,domain_last,current_path:ansistring; ipsetfg:boolean; sid:integer; Buf:array[0..buf_len] of AnsiChar; function ini():boolean; function HttpIni():boolean; function Action(url:AnsiString;ip:ansistring=''):boolean; function ParamsEncode(const ASrc: AnsiString): AnsiString; function GetHtml(var hs,html:AnsiString):boolean; function HttpGetHtml(var hs,html:AnsiString):boolean; public ConectTimes:integer; httpall,header,Connection,AcceptLanguage,Accept,ContentType,AcceptEncoding,Referer,Cookie,CacheControl,UserAgent:ansistring; X_requested_with,X_prototype_version,x_flash_version:ansistring; ReadTimeout:integer; constructor Create(); destructor Destroy;override; function GetIp(sDomain:AnsiString):AnsiString; procedure DisConnect; function Get(url:AnsiString;var htmls:AnsiString;ip:Ansistring=''):boolean; function Post(url:AnsiString;var htmls:AnsiString;const para:TStrings;ip:Ansistring=''):boolean;overload; function Post(url:AnsiString;var htmls:AnsiString;const para:AnsiString;ip:Ansistring=''):boolean;overload; procedure SetServerIp(ips:AnsiString); procedure ClearServerIp(); function GetDomain(url:AnsiString;var host:ansistring):boolean; end;implementationfunction HexToDex(d: AnsiString): integer; var i, l, j, n: integer; begin result := 0; l := length(d); if l < 1 then exit; d := LowerCase(d); n := 1; for i := 1 to l do begin j := Ord(d[l - i + 1]); if (j >= 48) and (j <= 57) then begin result := result + (j - 48) * n; end else if (j >= 97) and (j <= 102) then begin result := result + (j - 87) * n; end else exit; n := n * 16; end; end;procedure THttpSocket.SetServerIp(ips:AnsiString); begin ipsetfg:=true; ip_seted:=ips; end; procedure THttpSocket.ClearServerIp(); begin ipsetfg:=false; end; function THttpSocket.ParamsEncode(const ASrc: AnsiString): AnsiString; var i: Integer; const UnsafeChars = ['A'..'Z','a'..'z','*','.','_','-','0'..'9','!','''','(',')']; begin Result := ''; for i := 1 to Length(ASrc) do begin if not(ASrc[i] in UnsafeChars) then Result := Result + '%' + IntToHex(Ord(ASrc[i]), 2) else Result := Result + ASrc[i]; end; end; function THttpSocket.GetDomain(url:AnsiString;var host:ansistring):boolean; var p:integer; begin host:=''; p:=AnsiPos('://',url); if p<=4 then exit; delete(url,1,p+2); p:=AnsiPos('/',url); if p>1 then host:=Copy(url,1,p-1) else host:=url; result:=true; end; function THttpSocket.Action(url:AnsiString;ip:ansistring=''):boolean; var p,tmpport:integer; s,sb,domain,path,ts:AnsiString; begin result:=false; sb:=trim(url); s:=LowerCase(sb); p:=AnsiPos('://',s); if p<=1 then exit; delete(sb,1,p+2); s:=sb; PortDefault:=80; p:=AnsiPos('/',s); tmpport:=PortDefault; if p<1 then begin domain:=s; path:='/'; end else begin domain:=copy(s,1,p-1); path:=copy(s,p,length((s))); p:=AnsiPos(':',domain); if p>1 then begin ts:=copy(domain,p+1,length((domain))); delete(domain,p,length((domain))); tmpport:=strtointdef(ts,0); if tmpport<1 then exit; end; end; port:=tmpport; current_path:=path; if ip='' then begin if ipsetfg then sip:=ip_seted else sip:=GetIp(domain); end else sip:=ip;if (domain_last<>domain) or (ip_last<>sip) or (port_last<>port) then begin domain_last:=domain; ip_last:=sip; port_last:=port; if not ini() then exit; end else begin if sid<1 then begin if not ini() then exit; end; end; result:=true; end;function THttpSocket.Get(url:AnsiString;var htmls:AnsiString;ip:Ansistring=''):boolean; var s:AnsiString; begin result:=false; htmls:=''; if not Action(url) then exit; s:='GET '+current_path+' HTTP/1.1'+#13#10; if Referer<>'' then s:=s+'Referer: '+Referer+#13#10; s:=s+'Accept: '+Accept+#13#10; s:=s+'Accept-Language: '+AcceptLanguage+#13#10; s:=s+'UA-CPU: x86'+#13#10; if AcceptEncoding<>'' then s:=s+'Accept-Encoding: '+AcceptEncoding+#13#10; s:=s+'User-Agent: '+UserAgent+#13#10; if port_last<>PortDefault then s:=s+'Host: '+domain_last+':'+inttostr(port_last)+#13#10 else s:=s+'Host: '+domain_last+#13#10; s:=s+'Connection: '+Connection+#13#10; if CacheControl<>'' then s:=s+'Cache-control: '+CacheControl+#13#10; if Cookie<>'' then s:=s+'Cookie: '+Cookie+#13#10; s:=s+#13#10; if GetHtml(s,htmls) then begin result:=true; exit; end; DisConnect(); sleep(10); if not GetHtml(s,htmls) then exit; result:=true; end;function THttpSocket.Post(url:AnsiString;var htmls:AnsiString;const para:AnsiString;ip:Ansistring=''):boolean; var s:AnsiString; begin result:=false; if not Action(url) then exit; s:='POST '+current_path+' HTTP/1.1'+#13#10; if X_requested_with<>'' then s:=s+'x-requested-with: '+X_requested_with+#13#10; if X_prototype_version<>'' then s:=s+'x-prototype-version: '+X_prototype_version+#13#10; if x_flash_version<>'' then s:=s+'x-flash-version: '+x_flash_version+#13#10; s:=s+'Accept: '+Accept+#13#10; if Referer<>'' then s:=s+'Referer: '+Referer+#13#10; s:=s+'Accept-Language: '+AcceptLanguage+#13#10; s:=s+'Content-Type: '+ContentType+#13#10; s:=s+'UA-CPU: x86'+#13#10; if AcceptEncoding<>'' then s:=s+'Accept-Encoding: '+AcceptEncoding+#13#10; s:=s+'User-Agent: '+UserAgent+#13#10; if port<>PortDefault then s:=s+'Host: '+domain_last+':'+inttostr(port_last)+#13#10 else s:=s+'Host: '+domain_last+#13#10; s:=s+'Content-Length: '+inttostr(length((para)))+#13#10; s:=s+'Connection: '+Connection+#13#10; s:=s+'Cache-control: '+CacheControl+#13#10; if Cookie<>'' then s:=s+'Cookie: '+Cookie+#13#10; s:=s+#13#10; s:=s+para; //SaveFs('./hs.txt',s); if GetHtml(s,htmls) then begin result:=true; exit; end; DisConnect(); sleep(10); if not GetHtml(s,htmls) then exit; result:=true; end;function THttpSocket.Post(url:AnsiString;var htmls:AnsiString;const para:TStrings;ip:Ansistring=''):boolean; var s,ms:AnsiString; i:integer; pa:TStrings; begin pa:=TStringList.Create; for i:=0 to para.Count-1 do pa.Add(para[i]); for i:=pa.Count-1 downto 0 do begin s := pa.Names[i]; if Length(pa.Values[s]) > 0 then pa.Values[S] := ParamsEncode(pa.Values[s]); end; ms := StringReplace(Trim(pa.Text), sLineBreak, '&', [rfReplaceAll]);FreeAndNil(pa); pa:=nil; result:=post(url,htmls,ms); end; procedure THttpSocket.DisConnect(); begin if sid>0 then closesocket(sid); sid:=0; end; function THttpSocket.ini():boolean; begin result:=HttpIni; end; function THttpSocket.HttpIni():boolean; var TmpWSAData: TWSAData; iErr:integer; vi:u_long; begin result:=false; DisConnect(); try WSAStartup($0101,TmpWSAData); sid := socket(AF_INET, SOCK_STREAM,IPPROTO_IP); if (sid = INVALID_SOCKET) then begin DisConnect; exit; end; iErr:=SetSockOpt(sid,SOL_SOCKET,SO_SNDTIMEO,PAnsiChar(@ReadTimeout),SizeOf(ReadTimeout)); if iErr=SOCKET_ERROR then begin DisConnect; exit; end; SetSockOpt(sid,SOL_SOCKET,SO_RCVTIMEO,PAnsiChar(@ReadTimeout),SizeOf(ReadTimeout)); if iErr=SOCKET_ERROR then begin DisConnect; exit; end; vi:=1; WSAAsyncSelect(sid, 0, 0, FD_CONNECT); Addr.sin_addr.s_addr:=inet_addr(PAnsiChar(sIp)); Addr.sin_family := AF_INET; Addr.sin_port :=htons(port); iErr:=connect(sid,addr,sizeof(Addr)); if iErr<>0 then begin DisConnect; exit; end; result:=true; Inc(ConectTimes); exit; except DisConnect; end;end;
求代码 function THttpSocket.GetIp(sDomain:AnsiString):AnsiString; var HostEnt: PHostEnt; WSAData: TWSAData; begin result:=''; WSAStartup(2,WSAData); HostEnt := gethostbyname(PAnsiChar(sDomain)); with HostEnt^ do begin try result:=Format('%d.%d.%d.%d', [Byte(h_addr^[0]),Byte(h_addr^[1]), Byte(h_addr^[2]), Byte(h_addr^[3])]); except result:=''; end; end; WSACleanup; end; constructor THttpSocket.Create(); begin inherited Create();ConectTimes:=0; ReadTimeout:=30000; Cookie:=''; X_prototype_version:=''; X_requested_with:=''; x_flash_version:=''; UserAgent:='Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.2; SV1; .NET CLR 1.1.4322; .NET CLR 2.0.50727)'; UserAgent:='Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.2; SV1; .NET CLR 1.1.4322; .NET CLR 2.0.50727; .NET4.0C; .NET4.0E; .NET CLR 3.0.4506.2152; .NET CLR 3.5.30729)'; ContentType:='application/x-www-form-urlencoded'; AcceptLanguage := 'zh-cn'; Connection:='Keep-Alive'; Accept := 'image/gif, image/x-xbitmap, image/jpeg, image/pjpeg, application/vnd.ms-excel, application/vnd.ms-powerpoint, application/msword, application/x-shockwave-flash, */*'; Accept :='image/gif, image/x-xbitmap, image/jpeg, image/pjpeg, application/vnd.ms-powerpoint, '; Accept :=Accept+'application/vnd.ms-excel, application/msword, application/x-shockwave-flash, application/xaml+xml, application/x-ms-xbap, application/x-ms-application, application/vnd.ms-xpsdocument, */*'; Referer:=''; AcceptEncoding:='gzip, deflate'; CacheControl:='no-cache'; Port_last:=443; Ip_last:=''; current_path:='';end;destructor THttpSocket.Destroy; begin DisConnect;inherited; end; function THttpSocket.GetHtml(var hs,html:AnsiString):boolean; begin try result:=HttpGetHtml(hs,html); except result:=false; end; end; function THttpSocket.HttpGetHtml(var hs,html:AnsiString):boolean; function ReadBuf(var html:AnsiString;l:integer):boolean; var i,k,n,x:integer; begin if l<1 then begin result:=true;exit; end; result:=false; k:=length(html); while (k<l) do begin x:=l-k; if x>buf_lenh then x:=buf_lenh; fillchar(Buf,x,#0); i:=recv(sid,Buf,x,0); if i<=0 then exit; k:=k+i; for n:=0 to i-1 do begin html:=html+buf[n]; httpall:=httpall+buf[n]; end; end; result:=true; end; function ReadNext(var s1,s2:AnsiString):boolean;overload; var i,j:integer; begin result:=False; i:=recv(sid,Buf,buf_lenh,0); if i<1 then exit; for j:=0 to i-1 do begin s1:=s1+buf[j]; s2:=s2+buf[j]; end; result:=true; end; function ReadNext(var s1:AnsiString):boolean;overload; var i,j:integer; begin result:=False; i:=recv(sid,Buf,buf_lenh,0); if i<1 then exit; for j:=0 to i-1 do begin s1:=s1+buf[j]; end; result:=true; end; var ts,ks,hr:AnsiString; i,j,k,p,n:integer; begin result:=false; httpall:='';html:='';header:=''; if sid<1 then begin if not ini() then begin html:='1'+#13#10; exit; end; end; i:=send(sid,PAnsiChar(hs)^,length(hs),0); if i = -1 then begin if not ini() then begin html:='2'+#13#10; exit; end; i:=send(sid,PAnsiChar(hs)^,length(hs),0); if i = -1 then begin DisConnect(); html:='3'+#13#10; exit; end; end; hr:=#13#10;n:=2; try while true do begin if not ReadNext(httpall) then begin if httpall='' then exit; break; end; k:=AnsiPos(#13#10#13#10,httpall); if k<1 then begin k:=AnsiPos(#10#10,httpall); hr:=#10;n:=1; end; if k>1 then begin header:=copy(httpall,1,k-1); ts:=LowerCase(header); p:=AnsiPos('content-length:',ts); if p>0 then begin html:=copy(httpall,k+n*2,length(httpall)); delete(ts,1,p+15); ts:=StringReplace(ts,#13, '', [rfReplaceAll]); p:=AnsiPos(#10,ts); if p>1 then delete(ts,p,length(ts)); j:=strtointdef(ts,0); if not ReadBuf(html,j) then exit; break; end; p:=AnsiPos('transfer-encoding: chunked',ts); if p<=1 then p:=AnsiPos('transfer-encoding:chunked',ts); if p>1 then begin ts:=copy(httpall,k+n*2,length(httpall)); while(true) do begin p:=AnsiPos(hr,ts); if p>0 then begin ks:=Trim(copy(ts,1,p-1)); delete(ts,1,p+n-1); k:=HexToDex(ks); while k>length(ts) do begin if not ReadNext(httpall,ts) then exit; end; html:=html+copy(ts,1,k); delete(ts,1,k); while true do begin p:=AnsiPos(hr,ts); if p>0 then begin delete(ts,1,p+n-1); break; end; if not ReadNext(httpall,ts) then exit; end; if k=0 then Break; continue; end else if not ReadNext(httpall,ts) then break; end; Break; end; while ReadNext(httpall,ts) do begin end; html:=copy(httpall,k+n*2,length(httpall)); break; end; end;except DisConnect(); html:='10'+#13#10; exit; end; if (AnsiPos('connection: close',LowerCase(header))>1)or(AnsiPos('connection:close',LowerCase(header))>1) then DisConnect; result:=true; end;end.
求代码function SaveFs(fn, s: AnsiString; fg: boolean): boolean; var F: Text; begin try AssignFile(F, fn); if fg and FileExists(fn) then Append(F) else Rewrite(F); Write(F, S); CloseFile(F); result := true; except result := false; end; end; procedure TForm1.b1Click(Sender: TObject); var idh:THttpSocket; s:AnsiString; begin idh:=THttpSocket.Create; if idh.Get('http://data2.7m.cn/team_data/5580/big/index.shtml',s) then begin savefs('./aa.txt',s,false); end; idh.Free; end; 回复长度受限制,只能分开贴出来。这只是简单的实现下载,很多功能需要自己去补充。
求代码unit HttpSocket;interfaceuses ShareMem,Classes,SysUtils,Dialogs,StdCtrls,WinSock,IdCTypes;
const buf_len= 800003;
const buf_lenh= 800000;
type
THttpSocket = class
private
addr: TSockAddrIn;
Port,port_last,PortDefault:integer;
sIp,ip_seted,ip_last,domain_last,current_path:ansistring;
ipsetfg:boolean;
sid:integer;
Buf:array[0..buf_len] of AnsiChar;
function ini():boolean;
function HttpIni():boolean;
function Action(url:AnsiString;ip:ansistring=''):boolean;
function ParamsEncode(const ASrc: AnsiString): AnsiString;
function GetHtml(var hs,html:AnsiString):boolean;
function HttpGetHtml(var hs,html:AnsiString):boolean;
public
ConectTimes:integer;
httpall,header,Connection,AcceptLanguage,Accept,ContentType,AcceptEncoding,Referer,Cookie,CacheControl,UserAgent:ansistring;
X_requested_with,X_prototype_version,x_flash_version:ansistring;
ReadTimeout:integer;
constructor Create();
destructor Destroy;override;
function GetIp(sDomain:AnsiString):AnsiString;
procedure DisConnect;
function Get(url:AnsiString;var htmls:AnsiString;ip:Ansistring=''):boolean;
function Post(url:AnsiString;var htmls:AnsiString;const para:TStrings;ip:Ansistring=''):boolean;overload;
function Post(url:AnsiString;var htmls:AnsiString;const para:AnsiString;ip:Ansistring=''):boolean;overload;
procedure SetServerIp(ips:AnsiString);
procedure ClearServerIp();
function GetDomain(url:AnsiString;var host:ansistring):boolean;
end;implementationfunction HexToDex(d: AnsiString): integer;
var
i, l, j, n: integer;
begin
result := 0;
l := length(d);
if l < 1 then exit;
d := LowerCase(d);
n := 1;
for i := 1 to l do
begin
j := Ord(d[l - i + 1]);
if (j >= 48) and (j <= 57) then
begin
result := result + (j - 48) * n;
end
else if (j >= 97) and (j <= 102) then
begin
result := result + (j - 87) * n;
end
else exit;
n := n * 16;
end;
end;procedure THttpSocket.SetServerIp(ips:AnsiString);
begin
ipsetfg:=true;
ip_seted:=ips;
end;
procedure THttpSocket.ClearServerIp();
begin
ipsetfg:=false;
end;
function THttpSocket.ParamsEncode(const ASrc: AnsiString): AnsiString;
var i: Integer;
const UnsafeChars = ['A'..'Z','a'..'z','*','.','_','-','0'..'9','!','''','(',')'];
begin
Result := '';
for i := 1 to Length(ASrc) do
begin
if not(ASrc[i] in UnsafeChars) then Result := Result + '%' + IntToHex(Ord(ASrc[i]), 2)
else Result := Result + ASrc[i];
end;
end;
function THttpSocket.GetDomain(url:AnsiString;var host:ansistring):boolean;
var p:integer;
begin
host:='';
p:=AnsiPos('://',url);
if p<=4 then exit;
delete(url,1,p+2);
p:=AnsiPos('/',url);
if p>1 then host:=Copy(url,1,p-1)
else host:=url;
result:=true;
end;
function THttpSocket.Action(url:AnsiString;ip:ansistring=''):boolean;
var p,tmpport:integer;
s,sb,domain,path,ts:AnsiString;
begin
result:=false;
sb:=trim(url);
s:=LowerCase(sb);
p:=AnsiPos('://',s);
if p<=1 then exit;
delete(sb,1,p+2);
s:=sb;
PortDefault:=80;
p:=AnsiPos('/',s);
tmpport:=PortDefault;
if p<1 then
begin
domain:=s;
path:='/';
end
else
begin
domain:=copy(s,1,p-1);
path:=copy(s,p,length((s)));
p:=AnsiPos(':',domain);
if p>1 then
begin
ts:=copy(domain,p+1,length((domain)));
delete(domain,p,length((domain)));
tmpport:=strtointdef(ts,0);
if tmpport<1 then exit;
end;
end;
port:=tmpport;
current_path:=path;
if ip='' then
begin
if ipsetfg then sip:=ip_seted
else sip:=GetIp(domain);
end
else sip:=ip;if (domain_last<>domain) or (ip_last<>sip) or (port_last<>port) then
begin
domain_last:=domain;
ip_last:=sip;
port_last:=port;
if not ini() then exit;
end
else
begin
if sid<1 then
begin
if not ini() then exit;
end;
end;
result:=true;
end;function THttpSocket.Get(url:AnsiString;var htmls:AnsiString;ip:Ansistring=''):boolean;
var s:AnsiString;
begin
result:=false;
htmls:='';
if not Action(url) then exit;
s:='GET '+current_path+' HTTP/1.1'+#13#10;
if Referer<>'' then s:=s+'Referer: '+Referer+#13#10;
s:=s+'Accept: '+Accept+#13#10;
s:=s+'Accept-Language: '+AcceptLanguage+#13#10;
s:=s+'UA-CPU: x86'+#13#10;
if AcceptEncoding<>'' then s:=s+'Accept-Encoding: '+AcceptEncoding+#13#10;
s:=s+'User-Agent: '+UserAgent+#13#10;
if port_last<>PortDefault then s:=s+'Host: '+domain_last+':'+inttostr(port_last)+#13#10
else s:=s+'Host: '+domain_last+#13#10;
s:=s+'Connection: '+Connection+#13#10;
if CacheControl<>'' then s:=s+'Cache-control: '+CacheControl+#13#10;
if Cookie<>'' then s:=s+'Cookie: '+Cookie+#13#10;
s:=s+#13#10;
if GetHtml(s,htmls) then
begin
result:=true;
exit;
end;
DisConnect();
sleep(10);
if not GetHtml(s,htmls) then exit;
result:=true;
end;function THttpSocket.Post(url:AnsiString;var htmls:AnsiString;const para:AnsiString;ip:Ansistring=''):boolean;
var s:AnsiString;
begin
result:=false;
if not Action(url) then exit;
s:='POST '+current_path+' HTTP/1.1'+#13#10;
if X_requested_with<>'' then s:=s+'x-requested-with: '+X_requested_with+#13#10;
if X_prototype_version<>'' then s:=s+'x-prototype-version: '+X_prototype_version+#13#10;
if x_flash_version<>'' then s:=s+'x-flash-version: '+x_flash_version+#13#10;
s:=s+'Accept: '+Accept+#13#10;
if Referer<>'' then s:=s+'Referer: '+Referer+#13#10;
s:=s+'Accept-Language: '+AcceptLanguage+#13#10;
s:=s+'Content-Type: '+ContentType+#13#10;
s:=s+'UA-CPU: x86'+#13#10;
if AcceptEncoding<>'' then s:=s+'Accept-Encoding: '+AcceptEncoding+#13#10;
s:=s+'User-Agent: '+UserAgent+#13#10;
if port<>PortDefault then s:=s+'Host: '+domain_last+':'+inttostr(port_last)+#13#10
else s:=s+'Host: '+domain_last+#13#10;
s:=s+'Content-Length: '+inttostr(length((para)))+#13#10;
s:=s+'Connection: '+Connection+#13#10;
s:=s+'Cache-control: '+CacheControl+#13#10;
if Cookie<>'' then s:=s+'Cookie: '+Cookie+#13#10;
s:=s+#13#10;
s:=s+para;
//SaveFs('./hs.txt',s);
if GetHtml(s,htmls) then
begin
result:=true;
exit;
end;
DisConnect();
sleep(10);
if not GetHtml(s,htmls) then exit;
result:=true;
end;function THttpSocket.Post(url:AnsiString;var htmls:AnsiString;const para:TStrings;ip:Ansistring=''):boolean;
var s,ms:AnsiString;
i:integer;
pa:TStrings;
begin
pa:=TStringList.Create;
for i:=0 to para.Count-1 do pa.Add(para[i]);
for i:=pa.Count-1 downto 0 do
begin
s := pa.Names[i];
if Length(pa.Values[s]) > 0 then pa.Values[S] := ParamsEncode(pa.Values[s]);
end;
ms := StringReplace(Trim(pa.Text), sLineBreak, '&', [rfReplaceAll]);FreeAndNil(pa);
pa:=nil;
result:=post(url,htmls,ms);
end;
procedure THttpSocket.DisConnect();
begin
if sid>0 then closesocket(sid);
sid:=0;
end;
function THttpSocket.ini():boolean;
begin
result:=HttpIni;
end;
function THttpSocket.HttpIni():boolean;
var TmpWSAData: TWSAData;
iErr:integer;
vi:u_long;
begin
result:=false;
DisConnect();
try
WSAStartup($0101,TmpWSAData);
sid := socket(AF_INET, SOCK_STREAM,IPPROTO_IP);
if (sid = INVALID_SOCKET) then
begin
DisConnect;
exit;
end;
iErr:=SetSockOpt(sid,SOL_SOCKET,SO_SNDTIMEO,PAnsiChar(@ReadTimeout),SizeOf(ReadTimeout));
if iErr=SOCKET_ERROR then
begin
DisConnect;
exit;
end;
SetSockOpt(sid,SOL_SOCKET,SO_RCVTIMEO,PAnsiChar(@ReadTimeout),SizeOf(ReadTimeout));
if iErr=SOCKET_ERROR then
begin
DisConnect;
exit;
end;
vi:=1;
WSAAsyncSelect(sid, 0, 0, FD_CONNECT);
Addr.sin_addr.s_addr:=inet_addr(PAnsiChar(sIp));
Addr.sin_family := AF_INET;
Addr.sin_port :=htons(port);
iErr:=connect(sid,addr,sizeof(Addr));
if iErr<>0 then
begin
DisConnect;
exit;
end;
result:=true;
Inc(ConectTimes);
exit;
except
DisConnect;
end;end;
求代码
function THttpSocket.GetIp(sDomain:AnsiString):AnsiString;
var HostEnt: PHostEnt;
WSAData: TWSAData;
begin
result:='';
WSAStartup(2,WSAData);
HostEnt := gethostbyname(PAnsiChar(sDomain));
with HostEnt^ do
begin
try
result:=Format('%d.%d.%d.%d', [Byte(h_addr^[0]),Byte(h_addr^[1]), Byte(h_addr^[2]), Byte(h_addr^[3])]);
except
result:='';
end;
end;
WSACleanup;
end;
constructor THttpSocket.Create();
begin
inherited Create();ConectTimes:=0;
ReadTimeout:=30000;
Cookie:='';
X_prototype_version:='';
X_requested_with:='';
x_flash_version:='';
UserAgent:='Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.2; SV1; .NET CLR 1.1.4322; .NET CLR 2.0.50727)';
UserAgent:='Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.2; SV1; .NET CLR 1.1.4322; .NET CLR 2.0.50727; .NET4.0C; .NET4.0E; .NET CLR 3.0.4506.2152; .NET CLR 3.5.30729)';
ContentType:='application/x-www-form-urlencoded';
AcceptLanguage := 'zh-cn';
Connection:='Keep-Alive';
Accept := 'image/gif, image/x-xbitmap, image/jpeg, image/pjpeg, application/vnd.ms-excel, application/vnd.ms-powerpoint, application/msword, application/x-shockwave-flash, */*';
Accept :='image/gif, image/x-xbitmap, image/jpeg, image/pjpeg, application/vnd.ms-powerpoint, ';
Accept :=Accept+'application/vnd.ms-excel, application/msword, application/x-shockwave-flash, application/xaml+xml, application/x-ms-xbap, application/x-ms-application, application/vnd.ms-xpsdocument, */*';
Referer:='';
AcceptEncoding:='gzip, deflate';
CacheControl:='no-cache';
Port_last:=443;
Ip_last:='';
current_path:='';end;destructor THttpSocket.Destroy;
begin
DisConnect;inherited;
end;
function THttpSocket.GetHtml(var hs,html:AnsiString):boolean;
begin
try
result:=HttpGetHtml(hs,html);
except
result:=false;
end;
end;
function THttpSocket.HttpGetHtml(var hs,html:AnsiString):boolean;
function ReadBuf(var html:AnsiString;l:integer):boolean;
var i,k,n,x:integer;
begin
if l<1 then
begin
result:=true;exit;
end;
result:=false;
k:=length(html);
while (k<l) do
begin
x:=l-k;
if x>buf_lenh then x:=buf_lenh;
fillchar(Buf,x,#0);
i:=recv(sid,Buf,x,0);
if i<=0 then exit;
k:=k+i;
for n:=0 to i-1 do
begin
html:=html+buf[n];
httpall:=httpall+buf[n];
end;
end;
result:=true;
end;
function ReadNext(var s1,s2:AnsiString):boolean;overload;
var i,j:integer;
begin
result:=False;
i:=recv(sid,Buf,buf_lenh,0);
if i<1 then exit;
for j:=0 to i-1 do
begin
s1:=s1+buf[j];
s2:=s2+buf[j];
end;
result:=true;
end;
function ReadNext(var s1:AnsiString):boolean;overload;
var i,j:integer;
begin
result:=False;
i:=recv(sid,Buf,buf_lenh,0);
if i<1 then exit;
for j:=0 to i-1 do
begin
s1:=s1+buf[j];
end;
result:=true;
end;
var ts,ks,hr:AnsiString;
i,j,k,p,n:integer;
begin
result:=false;
httpall:='';html:='';header:='';
if sid<1 then
begin
if not ini() then
begin
html:='1'+#13#10;
exit;
end;
end;
i:=send(sid,PAnsiChar(hs)^,length(hs),0);
if i = -1 then
begin
if not ini() then
begin
html:='2'+#13#10;
exit;
end;
i:=send(sid,PAnsiChar(hs)^,length(hs),0);
if i = -1 then
begin
DisConnect();
html:='3'+#13#10;
exit;
end;
end;
hr:=#13#10;n:=2;
try
while true do
begin
if not ReadNext(httpall) then
begin
if httpall='' then exit;
break;
end;
k:=AnsiPos(#13#10#13#10,httpall);
if k<1 then
begin
k:=AnsiPos(#10#10,httpall);
hr:=#10;n:=1;
end;
if k>1 then
begin
header:=copy(httpall,1,k-1);
ts:=LowerCase(header);
p:=AnsiPos('content-length:',ts);
if p>0 then
begin
html:=copy(httpall,k+n*2,length(httpall));
delete(ts,1,p+15);
ts:=StringReplace(ts,#13, '', [rfReplaceAll]);
p:=AnsiPos(#10,ts);
if p>1 then delete(ts,p,length(ts));
j:=strtointdef(ts,0);
if not ReadBuf(html,j) then exit;
break;
end;
p:=AnsiPos('transfer-encoding: chunked',ts);
if p<=1 then p:=AnsiPos('transfer-encoding:chunked',ts);
if p>1 then
begin
ts:=copy(httpall,k+n*2,length(httpall));
while(true) do
begin
p:=AnsiPos(hr,ts);
if p>0 then
begin
ks:=Trim(copy(ts,1,p-1));
delete(ts,1,p+n-1);
k:=HexToDex(ks);
while k>length(ts) do
begin
if not ReadNext(httpall,ts) then exit;
end;
html:=html+copy(ts,1,k);
delete(ts,1,k);
while true do
begin
p:=AnsiPos(hr,ts);
if p>0 then
begin
delete(ts,1,p+n-1);
break;
end;
if not ReadNext(httpall,ts) then exit;
end;
if k=0 then Break;
continue;
end
else if not ReadNext(httpall,ts) then break;
end;
Break;
end;
while ReadNext(httpall,ts) do
begin
end;
html:=copy(httpall,k+n*2,length(httpall));
break;
end;
end;except
DisConnect();
html:='10'+#13#10;
exit;
end;
if (AnsiPos('connection: close',LowerCase(header))>1)or(AnsiPos('connection:close',LowerCase(header))>1) then DisConnect;
result:=true;
end;end.
求代码function SaveFs(fn, s: AnsiString; fg: boolean): boolean;
var
F: Text;
begin
try
AssignFile(F, fn);
if fg and FileExists(fn) then Append(F)
else Rewrite(F);
Write(F, S);
CloseFile(F);
result := true;
except
result := false;
end;
end;
procedure TForm1.b1Click(Sender: TObject);
var idh:THttpSocket;
s:AnsiString;
begin
idh:=THttpSocket.Create;
if idh.Get('http://data2.7m.cn/team_data/5580/big/index.shtml',s) then
begin
savefs('./aa.txt',s,false);
end; idh.Free;
end;
回复长度受限制,只能分开贴出来。这只是简单的实现下载,很多功能需要自己去补充。