URL是否有效

unit Unit1;

interface

uses
    Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
    Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;

type
    TForm1 = class(TForm)
        Button1: TButton;
        Edit1: TEdit;
    Label1: TLabel;
    procedure Button1Click(Sender: TObject);
    private
        { Private declarations }
    public
        { Public declarations }
    end;

var
    Form1: TForm1;

implementation

uses Wininet;
{$R *.dfm}


Function CheckUrl(url: string): Boolean;
var
    hSession, hfile, hRequest: hInternet;
    dwindex, dwcodelen: dword;
    dwcode: array [ 1 .. 20] of char;
    res: PChar;
begin
    if pos( 'http://', lowercase(url)) = 0 then
        url := 'http://' + url;
    Result := False;
    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');
        if assigned(hfile) then
            InternetCloseHandle(hfile);
        InternetCloseHandle(hSession);
    end;
end;


function CheckUrl1(url: string; TimeOut: integer = 3): 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;
    hSession := InternetOpen( 'Mozilla/4.0', INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);
    InternetSetOption(hSession, Internet_OPTION_CONNECT_TIMEOUT, @TimeOut, 4);
    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(2000);
            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
            200 .. 299:
                Result := true;
            401 .. 403:
                Result := true;
        else
            Result := False;
        end;
        if assigned(hfile) then
            InternetCloseHandle(hfile);
        InternetCloseHandle(hSession);
    end;
end;

procedure pro;
begin
 Form1.Caption := '检测URL中....';
  if CheckUrl1(Form1.Edit1.Text, 1) then
        Form1.Caption := 'URL能连接....'
    else
        Form1.Caption := 'URL无效....';
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
 TThread.CreateAnonymousThread(pro).Start;
end;

end.




来自为知笔记(Wiz)