1 function TFrameChannel.CheckUrl(url: string; TimeOut: Integer = 5000): boolean;
2 var
3 hSession, hfile : hInternet;
4 dwindex, dwcodelen: dword;
5 dwcode: array[1..20] of char;
6 res: pchar;
7 re: integer;
8 Err1: integer;
9 j: integer;
10 begin
11 if pos('http://', lowercase(url)) = 0 then
12 url := 'http://' + url;
13 Result := false;
14 hSession := nil;
15 hFile := nil;
16
17 //设置超时
18 InternetSetOption(hSession, Internet_OPTION_CONNECT_TIMEOUT, @TimeOut, 4);
19 hSession := InternetOpen('Mozilla/4.0', INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);
20 if assigned(hsession) then begin
21 j := 1;
22 while true do begin
23 hfile := InternetOpenUrl(hsession, pchar(url), nil, 0, INTERNET_FLAG_RELOAD, 0);
24 if hfile = nil then begin
25 j := j + 1;
26 Err1 := GetLastError;
27 if j > 5 then break;
28 if (Err1 <> 12002) or (Err1 <> 12152) then break;
29 sleep(2);
30 end else begin
31 break;
32 end;
33 end;
34 dwIndex := 0;
35 dwCodeLen := 10;
36 HttpQueryInfo(hfile, HTTP_QUERY_STATUS_CODE, @dwcode, dwcodeLen, dwIndex);
37 res := pchar(@dwcode);
38 re := strtointdef(res, 404);
39 case re of
40 400..450: result := false;
41 else result := true;
42 end;
43 if assigned(hfile) then
44 InternetCloseHandle(hfile);
45 InternetCloseHandle(hsession);
46 end;
47 end;
48
2 var
3 hSession, hfile : hInternet;
4 dwindex, dwcodelen: dword;
5 dwcode: array[1..20] of char;
6 res: pchar;
7 re: integer;
8 Err1: integer;
9 j: integer;
10 begin
11 if pos('http://', lowercase(url)) = 0 then
12 url := 'http://' + url;
13 Result := false;
14 hSession := nil;
15 hFile := nil;
16
17 //设置超时
18 InternetSetOption(hSession, Internet_OPTION_CONNECT_TIMEOUT, @TimeOut, 4);
19 hSession := InternetOpen('Mozilla/4.0', INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);
20 if assigned(hsession) then begin
21 j := 1;
22 while true do begin
23 hfile := InternetOpenUrl(hsession, pchar(url), nil, 0, INTERNET_FLAG_RELOAD, 0);
24 if hfile = nil then begin
25 j := j + 1;
26 Err1 := GetLastError;
27 if j > 5 then break;
28 if (Err1 <> 12002) or (Err1 <> 12152) then break;
29 sleep(2);
30 end else begin
31 break;
32 end;
33 end;
34 dwIndex := 0;
35 dwCodeLen := 10;
36 HttpQueryInfo(hfile, HTTP_QUERY_STATUS_CODE, @dwcode, dwcodeLen, dwIndex);
37 res := pchar(@dwcode);
38 re := strtointdef(res, 404);
39 case re of
40 400..450: result := false;
41 else result := true;
42 end;
43 if assigned(hfile) then
44 InternetCloseHandle(hfile);
45 InternetCloseHandle(hsession);
46 end;
47 end;
48