还是获取网页的问题，不过是多线程

09年我在这个问题上折腾了大半年，还因此写了篇博文[这下该不会阻塞了吧 ]，最初的是想实现多线程下载网页源码，但经过对HTTP协议的学习，发现只有支持断点继传的网站才用得上多线程下载，因此又把需求放在批量快速下载网页源码上，比如我同时需要访问100个网页，如果用IdHttp就头大了，Idhttp就连访问302页面也会出现异常，调试起来很麻烦。而用自己写的TWinHttp类，recv函数阻塞的问题是能解决了，但如果短时间频繁的获取网页源码，50%以上的访问都会出现connect失败和recv超时，以前很难解决的问题，这次却让我想到了一个较好的解决办法。

首先,对于connect，如果连接失败就进入死循环重复连接，直接连接成功才退出死循环

对于recv，由于recv失败一般都是因为该函数阻塞导致recv线程超时，而如果超时后不进行再处理的话，下载网页就会失败了。所以解决办法是当recv阻塞导致超时后，重新进行connect、send和recv，也就是当recv失败，就进行死循环重复connect、send和recv操作。

解决connect失败和recv失败的问题都用到了死循环，但如果在这两个操作上始终失败呢，怎么样才能退出死循环？我的解决办法是检查本地网络连接是否正常。当然，有必要也可以对目标网站能否访问进行判断，如果目标网站比较稳定，就不需要这个判断了，比如访问百度。

检查本地网络连接是否正常，我用的方法很简单，就是用gethostbyname函数来获取一个域名的IP地址。

使用以上的办法，目前还没发现有什么负作用，只是可能在短时间频繁访问网页时在死循环中耗费的时间比较多。

下面是新TWinHttp类的源码，这个类实现了GET/HEAD/POST这几个应用，如果本地网络连接正常，经测试，基本不会出现访问失败的现象。

unit WinHttp; interface uses WinSock, Sockets, Windows, SysUtils, Classes; const HTTP_OK = 1; HTTP_TIMEOUT = 2; HTTP_FAIL = 3; HTTP_STATECODE_ERR = 4; type THttpData = record WSAData:TWSAData; Host, Path:string; sockfd:Integer; //套接字 hostEnt:PHostEnt; addr:sockaddr_in; SocketHost:TSocketHost; IsCon:Boolean; end; PHttpData = ^THttpData; type TWinHttp = class( TObject ) private FHttpData:THttpData; FTimeOut:Integer; FCookie:string; FHttpHead:string; FStateCode:Integer; FLocation:string; FUrl:string; FReferer:string; private procedure ParseURL( const Url:string; var Host, Path:string); function Conn( var HttpData:THttpData ):Boolean; public property TimeOut: Integer read FTimeOut write FTimeOut; property Cookie: string read FCookie write FCookie; property Referer: string read FReferer write FReferer; function Get( Url:string ):string; procedure Head( Url:string ); function Post( Url:string; PostData:string ):string; function HttpHead:string; function StateCode:Integer; function Location:string; constructor Create;overload; end; implementation type TRecvThread = class( TThread ) private FHttpData:THttpData; protected procedure Execute; override; public HtmlSource:string; HttpHead:string; StateCode:Integer; ResultValue:Integer; public constructor Create( HttpData:THttpData );overload; end; constructor TRecvThread.Create( HttpData:THttpData ); begin FHttpData := HttpData; inherited Create( False ); end; procedure TRecvThread.Execute; var Buf:array[0..1024] of char; nPos,nRecv:Integer; HeadFine:Boolean; begin //FreeOnTerminate := True; HtmlSource := ''; HttpHead := ''; StateCode := 0; ResultValue := 1; HeadFine := False; while True do begin FillChar( Buf, 1024, 0 ); nRecv := recv( FHttpData.sockfd, Buf, 1024, 0 ); if nRecv > 0 then begin HtmlSource := HtmlSource + Buf; if not HeadFine then begin nPos := Pos( #13#10#13#10, HtmlSource ); if nPos <> 0 then begin HttpHead := Copy( HtmlSource, 1, nPos ); StateCode := StrToInt( Copy( HttpHead, 10, 3 ) ); HeadFine := True; end; end; end else if nRecv = -1 then begin ResultValue := -1; HtmlSource := ''; Break; end else begin ResultValue := 0; Break; end; end; end; constructor TWinHttp.Create; begin FTimeOut := 30; FHttpData.IsCon := False; end; procedure TWinHttp.Head( Url:string ); var SendBuf:array[0..10240] of char; RecvThread:TRecvThread; nPos:Integer; label start; begin start: FUrl := Url; Conn( FHttpData ); if FHttpData.IsCon then begin FillChar( SendBuf, 10240, 0 ); lstrcpy( SendBuf, PChar( 'HEAD ' + FHttpData.Path + ' HTTP/1.1' + #13#10 ) ); lstrcat( SendBuf, PChar( 'Host: ' + FHttpData.Host + #13#10 ) ); lstrcat( SendBuf, PChar( 'User-Agent: Mozilla/5.0' + ' (Windows; U; Windows NT 5.1; zh-CN; rv:1.9.2.15)' + ' Gecko/20110303 Firefox/3.6.15' + #13#10 ) ); lstrcat( SendBuf, PChar( 'Content-Type: ' + 'application/x-www-form-urlencoded;' + #13#10 ) ); lstrcat( SendBuf, PChar( 'Connection: Close' + #13#10 ) ); if FCookie <> '' then lstrcat( SendBuf, PChar( 'Cookie: ' + FCookie + #13#10#13#10 ) ) else lstrcat( SendBuf, PChar( #13#10 ) ); send( FHttpData.sockfd, SendBuf, StrLen( SendBuf ), 0 ); RecvThread := TRecvThread.Create( FHttpData ); if WaitForSingleObject( RecvThread.Handle, FTimeOut * 1000 ) = WAIT_TIMEOUT then begin //判断本地网络连接是否正常 if gethostbyname( PChar( FHttpData.Host ) ) <> nil then begin FHttpData.IsCon := False; RecvThread.Free; goto start; end; FHttpHead := ''; end; if RecvThread.ResultValue = 0 then begin FHttpHead := RecvThread.HttpHead; FStateCode := RecvThread.StateCode; if FStateCode = 302 then begin nPos := Pos( 'Location: ', FHttpHead ); FLocation := Copy( FHttpHead, nPos + Length( 'Location: ' ), Length( FHttpHead ) - nPos ); FLocation := Copy( FLocation, 1, Pos( #13#10, FLocation ) - 1 ); end; end else begin //判断本地网络连接是否正常 if gethostbyname( PChar( FHttpData.Host ) ) <> nil then begin FHttpData.IsCon := False; RecvThread.Free; goto start; end; FHttpHead := ''; end; RecvThread.Free; //Result := Recv end else begin //判断本地网络连接是否正常 if gethostbyname( PChar( FHttpData.Host ) ) <> nil then begin FHttpData.IsCon := False; goto start; end; FHttpHead := ''; end; end; //获取源码 function TWinHttp.Get( Url:string ):string; var SendBuf:array[0..10240] of char; RecvThread:TRecvThread; HtmlSource:string; i, nPos, nIndex:Integer; CookieList:TStringList; label start; begin CookieList := nil; start: if CookieList = nil then CookieList := TStringList.Create else CookieList.Clear; FUrl := Url; Conn( FHttpData ); if FHttpData.IsCon then begin FillChar( SendBuf, 10240, 0 ); lstrcpy( SendBuf, PChar( 'GET ' + FHttpData.Path + ' HTTP/1.1' + #13#10 ) ); lstrcat( SendBuf, PChar( 'Host: ' + FHttpData.Host + #13#10 ) ); lstrcat( SendBuf, PChar( 'User-Agent: Mozilla/5.0' + ' (Windows; U; Windows NT 5.1; zh-CN; rv:1.9.2.15)' + ' Gecko/20110303 Firefox/3.6.15' + #13#10 ) ); lstrcat( SendBuf, PChar( 'Content-Type: ' + 'application/x-www-form-urlencoded;' + #13#10 ) ); lstrcat( SendBuf, PChar( 'Connection: Close' + #13#10 ) ); if FReferer <> '' then begin lstrcat( SendBuf, PChar( 'Referer: ' + FReferer + #13#10 ) ); end; if FCookie <> '' then lstrcat( SendBuf, PChar( 'Cookie: ' + FCookie + #13#10#13#10 ) ) else lstrcat( SendBuf, PChar( #13#10 ) ); send( FHttpData.sockfd, SendBuf, StrLen( SendBuf ), 0 ); RecvThread := TRecvThread.Create( FHttpData ); if WaitForSingleObject( RecvThread.Handle, FTimeOut * 1000 ) = WAIT_TIMEOUT then begin //判断本地网络连接是否正常 if gethostbyname( PChar( FHttpData.Host ) ) <> nil then begin FHttpData.IsCon := False; RecvThread.Free; goto start; end; HtmlSource := ''; end; if RecvThread.ResultValue = 0 then begin HtmlSource := RecvThread.HtmlSource; FHttpHead := RecvThread.HttpHead; FStateCode := RecvThread.StateCode; if FStateCode = 302 then begin nPos := Pos( 'Location: ', FHttpHead ); FLocation := Copy( FHttpHead, nPos + Length( 'Location: ' ), Length( FHttpHead ) - nPos ); FLocation := Copy( FLocation, 1, Pos( #13#10, FLocation ) - 1 ); end; ExtractStrings( [#13], [], PChar( FHttpHead ), CookieList ); if CookieList.Count > 0 then begin FCookie := ''; for i := 0 to CookieList.Count - 1 do begin nPos := Pos( 'Set-Cookie: ', CookieList[i] ); if nPos = 1 then begin FCookie := FCookie + Copy( CookieList[i], Length( 'Set-Cookie: ' ) + 1, Length( CookieList[i] ) - Length( 'Set-Cookie: ' ) + 1 ); nIndex := Length( FCookie ); if FCookie[nIndex] <> ';' then FCookie := FCookie + '; '; end; end; end; end else begin //判断本地网络连接是否正常 if gethostbyname( PChar( FHttpData.Host ) ) <> nil then begin FHttpData.IsCon := False; RecvThread.Free; goto start; end; HtmlSource := ''; end; RecvThread.Free; end else begin //判断本地网络连接是否正常 if gethostbyname( PChar( FHttpData.Host ) ) <> nil then begin FHttpData.IsCon := False; goto start; end; HtmlSource := ''; end; CookieList.Free; Result := HtmlSource; end; function TWinHttp.Post( Url:string; PostData:string ):string; var SendBuf:array[0..10240] of char; RecvThread:TRecvThread; HtmlSource:string; i,nPos,nIndex:Integer; CookieList:TStringList; label start; begin CookieList := nil; start: if CookieList = nil then CookieList := TStringList.Create else CookieList.Clear; FUrl := Url; Conn( FHttpData ); if FHttpData.IsCon then begin FillChar( SendBuf, 10240, 0 ); lstrcpy( SendBuf, PChar( 'POST ' + FHttpData.Path + ' HTTP/1.1' + #13#10 ) ); lstrcat( SendBuf, PChar( 'Host: ' + FHttpData.Host + #13#10 ) ); lstrcat( SendBuf, PChar( 'User-Agent: Mozilla/5.0' + ' (Windows; U; Windows NT 5.1; zh-CN; rv:1.9.2.15)' + ' Gecko/20110303 Firefox/3.6.15' + #13#10 ) ); lstrcat( SendBuf, PChar( 'Content-Type: ' + 'application/x-www-form-urlencoded;' + #13#10 ) ); lstrcat( SendBuf, PChar( 'Content-Length: ' + IntToStr( Length( PostData ) ) + #13#10 ) ); lstrcat( SendBuf, PChar( 'Connection: Close' + #13#10 ) ); if FReferer <> '' then begin lstrcat( SendBuf, PChar( 'Referer: ' + FReferer + #13#10 ) ); end; if FCookie <> '' then lstrcat( SendBuf, PChar( 'Cookie: ' + FCookie + #13#10#13#10 ) ) else lstrcat( SendBuf, PChar( #13#10 ) ); lstrcat( SendBuf, PChar( PostData ) ); send( FHttpData.sockfd, SendBuf, StrLen( SendBuf ), 0 ); RecvThread := TRecvThread.Create( FHttpData ); if WaitForSingleObject( RecvThread.Handle, FTimeOut * 1000 ) = WAIT_TIMEOUT then begin //判断本地网络连接是否正常 if gethostbyname( PChar( FHttpData.Host ) ) <> nil then begin FHttpData.IsCon := False; RecvThread.Free; goto start; end; HtmlSource := ''; end; if RecvThread.ResultValue = 0 then begin HtmlSource := RecvThread.HtmlSource; FHttpHead := RecvThread.HttpHead; FStateCode := RecvThread.StateCode; if FStateCode = 302 then begin nPos := Pos( 'Location: ', FHttpHead ); FLocation := Copy( FHttpHead, nPos + Length( 'Location: ' ), Length( FHttpHead ) - nPos ); FLocation := Copy( FLocation, 1, Pos( #13#10, FLocation ) - 1 ); end; ExtractStrings( [#13], [], PChar( FHttpHead ), CookieList ); if CookieList.Count > 0 then begin FCookie := ''; for i := 0 to CookieList.Count - 1 do begin nPos := Pos( 'Set-Cookie: ', CookieList[i] ); if nPos = 1 then begin FCookie := FCookie + Copy( CookieList[i], Length( 'Set-Cookie: ' ) + 1, Length( CookieList[i] ) - Length( 'Set-Cookie: ' ) + 1 ); nIndex := Length( FCookie ); if FCookie[nIndex] <> ';' then FCookie := FCookie + '; '; end; end; end; end else begin //判断本地网络连接是否正常 if gethostbyname( PChar( FHttpData.Host ) ) <> nil then begin FHttpData.IsCon := False; RecvThread.Free; goto start; end; HtmlSource := ''; end; RecvThread.Free; end else begin //判断本地网络连接是否正常 if gethostbyname( PChar( FHttpData.Host ) ) <> nil then begin FHttpData.IsCon := False; goto start; end; HtmlSource := ''; end; CookieList.Free; Result := HtmlSource; end; //连接服务器 function TWinHttp.Conn( var HttpData:THttpData ):Boolean; var IsOk:Boolean; i, nCon:Integer; begin HttpData.IsCon := False; IsOk := False; HttpData.sockfd := 0; HttpData.hostEnt := nil; HttpData.SocketHost := ''; with HttpData do begin if WSAStartup(MakeWord(2,2), WSAData) = 0 then begin ParseURL(FUrl, Host, Path); //建立套接字 sockfd := socket(PF_INET, SOCK_STREAM, IPPROTO_TCP); if sockfd <> INVALID_SOCKET then begin if Host <> '' then begin if Host[1] in ['0'..'9'] then begin if inet_addr(PChar(Host)) <> INADDR_NONE then SocketHost := Host; end else begin hostEnt := gethostbyname(pchar(Host)); if hostEnt <> nil then with hostEnt^ do SocketHost := format('%d.%d.%d.%d', [ord(h_addr^[0]), ord(h_addr^[1]), ord(h_addr^[2]), ord(h_addr^[3])]); end; addr.sin_family := AF_INET; addr.sin_port := htons(80); addr.sin_addr.S_addr := inet_addr(PChar(SocketHost)); for i := 0 to 10 do begin //连接 nCon := connect(sockfd, addr, SizeOf(addr) ); if nCon <> 0 then begin Sleep(10); Continue; end else Break; end; if nCon = 0 then begin IsOk := True; HttpData.IsCon := True; end; end; end; end; end; if IsOk then FHttpData := HttpData; Result := IsOk; end; //分隔URL procedure TWinHttp.ParseURL( const Url:string; var Host, Path:string); var nIndex:Integer; S,tmpUrl:string; begin tmpUrl := Url; S := LowerCase(Url); if ( Pos('https://', S) <> 0 ) then begin //删除http:// Delete(tmpUrl, 1, Length('https://')); end else if( Pos( 'http://', S ) <> 0 ) then begin //删除http:// Delete(tmpUrl, 1, Length('http://')); end; nIndex := Pos('/', tmpUrl); if nIndex = 0 then begin Host := tmpUrl; Path := '/'; end else begin Host := Copy(tmpUrl, 1, nIndex - 1); Path := Copy(tmpUrl, nIndex, Length(Url)); end; end; function TWinHttp.HttpHead:string; begin Result := FHttpHead; end; function TWinHttp.StateCode:Integer; begin Result := FStateCode; end; function TWinHttp.Location:string; begin Result := FLocation; end; initialization finalization end.