获取网页的源码

function MyHttp_Get(const strUrl: string;var Options :THttpOptions; hWin: HWND=0): TRESULT;
const
 BUFFER_SIZE=1024;
var
    i :Integer;
    hInternetOpen ,hInternetConnect ,hHttpOpenRequest :HINTERNET;
    sHeader ,Url:string;
    bResult :Boolean;
    lNumberOfBytesRead :Cardinal;
    lpBuffer: array[0..BUFFER_SIZE+1] of Char;
    ProxyInfo : INTERNET_PROXY_INFO;


    //...Cookies
    CookieBuf: array [0..4096] of Char;
    Cookies : string;
    dwSize, dwIndex, nums, oBytesWritten: DWORD;


    //文件
    f: File;


    m :Integer;


    Flags: DWord;


    strValue, strSize: string;


    TmpStr ,uAgent ,tmpStr2 :string;


    InnerCreated :Boolean; //那个 stream 是否内部创建


    BufferIn:INTERNET_BUFFERS;
    szBuffer: string;


    //代理验证相关 jxf 2012-03-22 15:54
    //格式：options.proxy = <ip>ip:port</ip><username>username</username><password>password</password>
    proxy          :string;//格式：proxy= ip:port
    proxy_username :string;//代理验证账号
    proxy_password :string;//代理验证密码


    sUagent :string;


    postDatabuf : array [0..8192] of Char;
    sTimeOut :integer;
    TmpUrl ,sLeft ,sRight :string;
begin
    TmpUrl := strUrl;


    if not NCpos('recommend.php',strUrl)>0 then
    begin
        if Pos('\',TmpUrl)>0 then
        begin
            if NCpos('?',TmpUrl)>0 then
            begin
                sLeft  := FieldBetween('@'+TmpUrl,'@','?');
                sRight := FieldBetween(TmpUrl+'{@@@@}','?','{@@@@}');
                sLeft  := StringReplace(sLeft,'\','/',[rfReplaceAll,rfIgnoreCase]);
                TmpUrl := sLeft + '?' + sRight;
            end else
            begin
                TmpUrl  := StringReplace(TmpUrl,'\','/',[rfReplaceAll,rfIgnoreCase]);
            end;
        end;
    end else TmpUrl := strUrl;




    if trim(LowerCase(copy(TmpUrl, 1, 5)))='file:' then
    begin
        strValue:= copy(TmpUrl, 6, length(TmpUrl)-5);
        result.Code:= 0;
        result.Desc:= TextFromFile(strValue);
        Options.RespHtml:= result.Desc;
        exit;
    end;


    InnerCreated := False;
    //可采此处取出网址的域名与G.HttpInterval进行鉴别...
    //G.HttpInterval;


    //
    Options.UserAgent := Trim(Options.UserAgent);
    IF Options.UserAgent='' then Options.UserAgent := 'Mozilla/4.0 (compatible; myccs 5.5; Windows 98)'+';baiduspider';
    if NCpos('myccs',Options.UserAgent)=0 then Options.UserAgent := Options.UserAgent + 'myccs';
    if NCpos('baiduspider',Options.UserAgent)=0 then Options.UserAgent := Options.UserAgent + 'baiduspider';
    if Options.Intialized='' then
    begin
        Result.Code := 999;
        Result.Desc := 'Options没有初始化,请调用 Init_Http_Opions 函数进行初始化';
        Exit;
    end;
    Options.UserAgent := 'Mozilla/4.0 (compatible; MSIE 8.0; Windows NT 6.1; WOW64; Trident/4.0)';


    //初始化
    Result.Code := 999;
    Result.Desc := '';
    Url := Trim(TmpUrl);
    Options.Host       := Trim(Options.Host);
    Options.TargetPage := Trim(Options.TargetPage);
    //发包的时候，二进制的 可能会被trim掉，所以去掉trim 2010-10-15 19:01
    //Options.PostData   := Trim(Options.PostData);
    Options.Method    := Trim(UpperCase(Options.Method));
    Options.Accept     := Trim(Options.Accept);
    Options.UserAgent  := Trim(Options.UserAgent);
    Options.Referer    := Trim(Options.Referer);
    Options.ContentType:= Trim(Options.ContentType);
    Options.Cookie     := Trim(Options.Cookie);
    Options.Port       := Trim(Options.Port);
    Options.Proxy      := Trim(Options.Proxy);
    Options.Accept_Encoding := Trim(Options.Accept_Encoding);
    Options.RespHeader := '';
    Options.RespHtml   := '';
    Options.Location   := '';


    if NCpos('https://',TmpUrl)>0 then Options.Port := '443';
    if NCpos('https://',Url)>0 then Options.Port := '443';


    if Options.TargetPage='' then Options.TargetPage :='/';
    if (Url='') and (Options.Host='') then
    begin
        Result.Desc := '【strUrl】或【Host 和 TargetPage】中，至少有一个不能为空。';
        Exit;
    end;
    if TmpUrl<>'' then
    begin
        if (NCpos('http://',TmpUrl)=0) and (NCpos('https://',TmpUrl)=0) then Url := 'http://' + Url ;
    end;


    if Url <>'' then
    begin
        Options.Host := TrackDomain(Url);
        //Url := StringReplace(Url,Options.Host,'[myccs_flag]',[]);
        //...变量格式化
        Options.Host       := Trim(Options.Host);
        Options.TargetPage := FieldBetween(Url,Options.Host,'');
        Options.TargetPage := Trim(Options.TargetPage);
    end;
    if Options.TargetPage='' then Options.TargetPage := '/';


    if (Options.Method='POST') and (Options.PostData='') then
    begin
        Result.Desc := '要Post的数据不能为空';
        Exit;
    end;


    if Options.Method='' then
    begin
        if Options.PostData='' then
        begin
            Options.Method := 'GET'  //Get 或 POST
        end else
        begin
            Options.Method := 'POST';//Get 或 POST
        end;
    end;
    Options.Accept     := 'image/gif, image/x-xbitmap, image/jpeg, image/pjpeg, */*';
    //Options.Proxy      := '';      //目前先放空
    //Options.Proxy      := 'http://192.168.1.110:5555';      //test....
    //Options.ContentType:= '';      //目前先放空
    Options.Accept_Encoding := ''; //目前先放空
    if Options.Port <>'443' then
    begin
        if NCpos(':',Options.Host)>0 then
        begin
            Options.Port := Copy(Options.Host,NCpos(':',Options.Host)+1,Length(Options.Host));
            Options.Port := Trim(Options.Port);
            Options.Host := Copy(Options.Host,1,NCpos(':',Options.Host)-1);


        end else
        begin
            Options.Port := '80';
        end;
    end;


    DeleteUrlCacheEntry(PChar(Options.Host+'/'+Options.TargetPage));




    //...判断是否需要登陆采集，查表t_cookies，如果没有设置过登陆采集，可能表不存在
    try
   if TmpStr<>'' then
   begin
       Options.Cookie := TmpStr;
       Options.AutoCookie := False;
       Options.UserAgent  := uAgent;
   end;
    except
    end;


    proxy := Options.Proxy;
            proxy_username := '';
            proxy_password := '';


    //...0、构造包头
    sHeader := '';
    //...1、Accept
    if (Options.Accept<>'') then
        sHeader := sHeader + 'Accept: '+ Options.Accept+#13#10
    else
        sHeader := sHeader + 'Accept: */*'+#13#10;


    if Options.requested<>'' then sHeader := sHeader + Options.requested + #13#10;


    if not Options.AutoCookie then
    begin
        //sHeader := sHeader + 'Pragma：no-cache'+#13#10;
    end;
    //sHeader := sHeader + 'Content-Length: 190'+#13#10;
    //...2、Referer
    if Options.Referer<>'' then sHeader := sHeader + 'Referer: '      + Options.Referer     +#13#10;
    //...3、Accept-Language: zh-cn
    sHeader := sHeader + 'Accept-Language: zh-cn'+#13#10;
    //...4、Content-Type
    if (Options.ContentType<>'') and (Options.ContentType<>'undefined') then
    begin
        if Options.ContentType='null' then Options.ContentType := ''
        else
        begin
            sHeader := sHeader + 'Content-Type: ' + Options.ContentType +#13#10;
            //Options.PostData := Options.PostData +#13#10+#13#10;//加2个回车换行
            Options.PostData := Options.PostData +#13#10;//加2个回车换行
        end;
    end else
    begin
        sHeader := sHeader + 'Content-Type: application/x-www-form-urlencoded'+#13#10;
    end;


    //如果是执行接口脚本，加上baidu到useragent
    if NCpos('ccs/ccs_',strUrl)>0 then
    begin
        sUagent := 'baidu';
    end;


    //...5、User-Agent:
    if Options.UserAgent<>'' then
        sHeader := sHeader + 'User-Agent: ' + Options.UserAgent+sUagent +#13#10
    else
        sHeader := sHeader + 'User-Agent: Mozilla/4.0 (compatible; MSIE 5.5; Windows 98)'+sUagent+#13#10;
    //...6、Cookie
    if (Options.Cookie<>'') and (not Options.AutoCookie) then sHeader := sHeader + 'Cookie: ' + Options.Cookie  +#13#10;
    //...7、Accept-Encoding 默认为空
    if Options.Accept_Encoding<>'' then sHeader := sHeader + 'Accept-Encoding: '+ Options.Accept_Encoding +#13#10;


    if Options.OtherHead<>'' then sHeader := sHeader + Options.OtherHead +#13#10;


    //...1、是否使用代理
    if Options.Proxy='' then
    begin
        hInternetOpen:= InternetOpen(PChar(Options.UserAgent), INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);
    end else
    begin
        //...代理相关参数
        ProxyInfo.dwAccessType := INTERNET_OPEN_TYPE_PROXY;
        ProxyInfo.lpszProxy    := Pchar(Trim(Proxy));


        hInternetOpen:= InternetOpen(PChar(Options.userAgent), ProxyInfo.dwAccessType, ProxyInfo.lpszProxy, nil, 0);
        //该两句可能没用，这里先去掉，有问题再说 jxf 2012-03-22 15:54
        //InternetSetOption(hInternetOpen, INTERNET_OPTION_PROXY, @ProxyInfo, SizeOf(ProxyInfo));
        //InternetSetOption(hInternetOpen, INTERNET_OPTION_SETTINGS_CHANGED, nil, 0);
    end;


    //...2、建立连接
    hInternetConnect := InternetConnect(hInternetOpen,PChar(Options.Host),StrToInt(Options.Port),nil,'HTTP/1.1',INTERNET_SERVICE_HTTP, 0, 0);


    //代理用户名密码设置，验证
    if proxy_username<>'' then
    begin
        InternetSetOption(hInternetConnect, INTERNET_OPTION_PROXY_USERNAME, PChar(proxy_username), Length(proxy_username));
        InternetSetOption(hInternetConnect, INTERNET_OPTION_PROXY_PASSWORD, PChar(proxy_password), Length(proxy_password));
    end;
    if G_HTTP_TIMEOUT=0 then G_HTTP_TIMEOUT := 480;
    sTimeOut := G_HTTP_TIMEOUT*1000;  
    //设置8分钟超时，因为提取IIS的网页打开的比较慢
    InternetSetOption(hInternetConnect, INTERNET_OPTION_CONNECT_TIMEOUT, @sTimeOut, SizeOf(sTimeOut));
    InternetSetOption(hInternetConnect, INTERNET_OPTION_SEND_TIMEOUT, @sTimeOut, SizeOf(sTimeOut));
    InternetSetOption(hInternetConnect, INTERNET_OPTION_RECEIVE_TIMEOUT, @sTimeOut, SizeOf(sTimeOut));




    Flags:= 0;


    //...3、cookies
    if not Options.AutoCookie then
        Flags:= Flags or INTERNET_FLAG_NO_COOKIES;


    //...
    if not Options.AutoRedirect then
        Flags:= Flags or INTERNET_FLAG_NO_AUTO_REDIRECT;


    if Options.Port='443' then //Flags:= INTERNET_FLAG_SECURE or INTERNET_FLAG_IGNORE_CERT_DATE_INVALID;//处理 https 请求
    begin
        Flags:= Flags or INTERNET_FLAG_SECURE;
        //Flags:= Flags or INTERNET_FLAG_IGNORE_CERT_DATE_INVALID; //忽略证书
        //Flags := Flags or INTERNET_FLAG_IGNORE_CERT_CN_INVALID;
        //Flags := Flags or SECURITY_INTERNET_MASK;
    end;


    Flags := Flags or INTERNET_FLAG_DONT_CACHE;
    
    //...
    hHttpOpenRequest := HttpOpenRequest(hInternetConnect,PChar(Options.Method),PAnsiChar(Options.TargetPage),'HTTP/1.1',nil,nil,Flags,0);


    //...4、添加请求头（固定句子）
    bResult := HttpAddRequestHeaders(hHttpOpenRequest,PChar(sHeader),Length(sHeader),HTTP_ADDREQ_FLAG_REPLACE Or HTTP_ADDREQ_FLAG_ADD);


    //...5、添加postdata并post
    dwSize:= Length(Options.PostData);


    {
    if (Pos('@',Options.PostData)>0) and (dwSize<8192) then
    begin
        for i:=1 to dwSize do
        begin
            if Options.PostData[i]='@' then
                postDatabuf[i-1] := #13
                //postDatabuf[i-1] := ':'
            else
                postDatabuf[i-1] := Options.PostData[i];
        end;
        bResult := HttpSendRequest(hHttpOpenRequest,nil,0,@postDatabuf[0],dwSize-1);
    end else
    begin
        bResult := HttpSendRequest(hHttpOpenRequest,nil,0,PChar(Options.PostData),dwSize);
    end;
    }


    bResult := HttpSendRequest(hHttpOpenRequest,nil,0,PChar(Options.PostData),dwSize);




    //...6、获取包头信息
    dwIndex := 0;
    FillChar(CookieBuf, 4096, 00);
    dwSize := SizeOf(CookieBuf);
    HttpQueryInfo(hHttpOpenRequest, HTTP_QUERY_RAW_HEADERS_CRLF, @CookieBuf, dwSize, dwIndex);
    Cookies := CookieBuf;
    Options.RespHeader := Cookies;//返回数据包头


    //如果仅是获取包头
    if UpperCase(trim(Options.Method))='HEAD' then
    begin
        //...释放句柄
        bResult := InternetCloseHandle(hHttpOpenRequest);
        bResult := InternetCloseHandle(hInternetConnect);
        bResult := InternetCloseHandle(hInternetOpen);
        exit;
    end;


//大小
   // strValue:= Parse_HttpHead(Options.RespHeader);
//strValue:= vName(strValue, 'CONTENT-LENGTH');
if strValue='' then strValue:= '0';
    dwSize:= StrToInt(strValue);
   // strSize:= Format('%.3f', [TransDataSize(strValue+'Byte', 'Mb')])+'Mb';


    //...如果需要保存成文件
    if Options.SavePath<>'' then
    begin
        if not Assigned(Options.RespStream) then
        begin
            Options.RespStream := TMemoryStream.Create;
            InnerCreated := True;
        end;
    end;


    //...处理GZIP压缩，和 http_get_ex 结合起来 Content-Encoding: gzip
    Options.RespHtml := '';
    if NCpos('Content-Encoding: gzip',Options.RespHeader)>0 then
    begin
      //  Options.RespHtml := Http_Gzip_Decompress(hHttpOpenRequest,Options.RespStream);
    end;


    if Options.RespHtml='' then
    begin
        //...7、获取网页内容
        if Assigned(Options.RespStream) then
        begin
            //...流的方式
            m := 0;
            try
                Options.RespStream.Position:= 0;
                while True do
                begin
                    FillMemory(@lpBuffer[0], BUFFER_SIZE+1, 0);
                    lNumberOfBytesRead := BUFFER_SIZE;
                    InternetReadFile(hHttpOpenRequest, @lpBuffer, BUFFER_SIZE, lNumberOfBytesRead);
                    if lNumberOfBytesRead = 0 then Break;
                    lpBuffer[lNumberOfBytesRead] := #0;
                    Options.RespStream.Write(lpBuffer,lNumberOfBytesRead);
                    Inc(m);
                    if m>100000 then Break; //防止死循环


                    //SendCommonMsg(hWin, WM_APP_PROGRESS2, '<Act>下载</Act><Now>'+InttoStr(m*BUFFER_SIZE)+'</Now><Max>'+InttoStr(dwSize)+'</Max><Size>' + strSize +'</Size>');
                end;
                //Options.RespHtml :=
            finally
                //2010-06-20 17:45 HST 如果以流的方式输出HTTP应答数据, 则不给Options.RespHtml赋值, 通常用于附件下载
                //Options.RespHtml:= MemoryStreamToString(Options.RespStream);
            end;
        end else
        begin
            m := 0;
            while True do
            begin
                FillMemory(@lpBuffer[0], BUFFER_SIZE+1, 0);
                lNumberOfBytesRead := BUFFER_SIZE;
                InternetReadFile(hHttpOpenRequest, @lpBuffer, BUFFER_SIZE, lNumberOfBytesRead);
                if lNumberOfBytesRead = 0 then
                    Break;
                lpBuffer[lNumberOfBytesRead] := #0;
                Options.RespHtml := Options.RespHtml+lpBuffer;
                Inc(m);
                if m>100000 then Break;//防止死循环


               // SendCommonMsg(hWin, WM_APP_PROGRESS2, '<Act>下载</Act><Now>'+InttoStr(m*BUFFER_SIZE)+'</Now><Max>'+InttoStr(dwSize)+'</Max><Size>' + strSize +'</Size>');
            end;
        end;
    end;


    strValue := Options.RespHtml;
    if Options.ForceDecode then Options.RespHtml := HtmlToGbk(Options.RespHtml);
    if Options.RespHtml='' then Options.RespHtml := strValue;
    if Options.SavePath<>'' then
    begin
        if Options.RespStream.Size>0 then
        begin
            Options.RespStream.SaveToFile(Options.SavePath);
        end;
        Options.RespStream.Free;
    end;


    //...释放句柄
    bResult := InternetCloseHandle(hHttpOpenRequest);
    bResult := InternetCloseHandle(hInternetConnect);
    bResult := InternetCloseHandle(hInternetOpen);


    Result.Code := 0;
    Result.Desc := Options.RespHtml;
end;