检查一个 URL 是否有效函数 | |
//可用来检测网络连接是否正确,InternetCheckConnection函数检查不准确,有些情况无法检测到,而以下CheckUrl函数则不会。 //uses wininet; function CheckUrl(url: string): Boolean; var hSession, hfile, hRequest: hInternet; dwindex, dwcodelen: dword; dwcode: array[1..20] of Char; res: PChar; begin Result := false; if Pos(’http://’, LowerCase(url)) = 0 then url := ’http://’ + url; hSession := InternetOpen(’InetURL:/1.0’, INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0); if Assigned(hsession) then begin hfile := InternetOpenUrl(hsession, PChar(url), nil, 0, INTERNET_FLAG_RELOAD, 0); dwIndex := 0; dwCodeLen := 10; HttpQueryInfo(hfile, HTTP_QUERY_STATUS_CODE, @dwcode, dwcodeLen, dwIndex); res := PChar(@dwcode); Result := (res = ’200’) or (res = ’302’); //200,302未重定位标志 if Assigned(hfile) then InternetCloseHandle(hfile); InternetCloseHandle(hsession); end; end; //方法二: function CheckUrl(url: string; TimeOut: integer = 5000): boolean; var hSession, hfile, hRequest: hInternet; dwindex, dwcodelen: dword; dwcode: array[1..20] of char; res: pchar; re: integer; Err1: integer; j: integer; begin if pos(’http://’, lowercase(url)) = 0 then url := ’http://’ + url; Result := false; InternetSetOption(hSession, Internet_OPTION_CONNECT_TIMEOUT, @TimeOut, 4); hSession := InternetOpen(’Mozilla/4.0’, INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0); //设置超时 if assigned(hsession) then begin j := 1; while true do begin hfile := InternetOpenUrl(hsession, pchar(url), nil, 0, INTERNET_FLAG_RELOAD, 0); if hfile = nil then begin j := j + 1; Err1 := GetLastError; if j 〉 5 then break; if (Err1 〈〉 12002) or (Err1 〈〉 12152) then break; sleep(2); end else begin break; end; end; dwIndex := 0; dwCodeLen := 10; HttpQueryInfo(hfile, HTTP_QUERY_STATUS_CODE, @dwcode, dwcodeLen, dwIndex); res := pchar(@dwcode); re := strtointdef(res, 404); case re of 400..450: result := false; else result := true; end; if assigned(hfile) then InternetCloseHandle(hfile); InternetCloseHandle(hsession); end; end; |
delphi中检查URL是否存在的函数
最新推荐文章于 2022-04-23 13:32:04 发布