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.




URL是否有效的更多相关文章

  1. HTML URL地址解析

    通过JavaScript的location对象,可获取URL中的协议.主机名.端口.锚点.查询参数等信息. 示例 URL:http://www.akmsg.com/WebDemo/URLParsing ...

  2. URL安全的Base64编码

    Base64编码可用于在HTTP环境下传递较长的标识信息.在其他应用程序中,也常常需要把二进制数据编码为适合放在URL(包括隐藏表单域)中的形式.此时,采用Base64编码不仅比较简短,同时也具有不可 ...

  3. Android业务组件化之URL Scheme使用

    前言: 最近公司业务发展迅速,单一的项目工程不再适合公司发展需要,所以开始推进公司APP业务组件化,很荣幸自己能够牵头做这件事,经过研究实现组件化的通信方案通过URL Scheme,所以想着现在还是在 ...

  4. ASP.NET Core的路由[1]:注册URL模式与HttpHandler的映射关系

    ASP.NET Core的路由是通过一个类型为RouterMiddleware的中间件来实现的.如果我们将最终处理HTTP请求的组件称为HttpHandler,那么RouterMiddleware中间 ...

  5. Node.js:path、url、querystring模块

    Path模块 该模块提供了对文件或目录路径处理的方法,使用require('path')引用. 1.获取文件路径最后部分basename 使用basename(path[,ext])方法来获取路径的最 ...

  6. angular2系列教程(十一)路由嵌套、路由生命周期、matrix URL notation

    今天我们要讲的是ng2的路由的第二部分,包括路由嵌套.路由生命周期等知识点. 例子 例子仍然是上节课的例子:

  7. MVC通过路由实现URL重写

    public static class WebApiConfig { public static void Register(HttpConfiguration config) { config.Ro ...

  8. 【转】java通用URL接口地址调用方式GET和POST方式

    java通用URL接口地址调用方式GET和POST方式,包括建立请求和设置请求头部信息等等......... import java.io.ByteArrayOutputStream; import ...

  9. linux字符串url编码与解码

    编码的两种方式 echo '手机' | tr -d '\n' | xxd -plain | sed 's/\(..\)/%\1/g' echo '手机' |tr -d '\n' |od -An -tx ...

  10. 如何获取url中的参数并传递给iframe中的报表

    在使用报表软件时,用户系统左边一般有目录树,点击报表节点就会在右侧网页的iframe中显示出报表,同时点击的时候也会传递一些参数给网页,比如时间和用户信息等.如何使网页中的报表能够获取到传递过来的参数 ...

随机推荐

  1. 1316. Electronic Auction(树状数组)

    1316 我想说 要不要这么坑 WA了一个小时啊 ,都快交疯了,拿着题解的代码交都WA 最后很无语的觉得题解都错了 重读了N遍题意 发现没读错啊 难道写题解的那个人和我都想错了?? 最后把g++换个C ...

  2. bzoj1426

    偷个懒,转自hzwer [“这种煞笔题怎么总有人问”,被吧主D了... 用f[i]表示已经拥有了i张邮票,则期望还需要购买的邮票数 则f[n]=0 f[i]=f[i]*(i/n)+f[i+1]*((n ...

  3. bzoj2245

    这道题还是比较简单的费用流,由于w是递增的 实际上,这题数据还可以强一点,比如说分段函数不保证费用递增, 就要加一点技巧了(要保证函数的顺序) ; type node=record        ne ...

  4. UVa 1151 (枚举 + MST) Buy or Build

    题意: 平面上有n个点,现在要把它们全部连通起来.现在有q个套餐,如果购买了第i个套餐,则这个套餐中的点全部连通起来.也可以自己单独地建一条边,费用为两点欧几里得距离的平方.求使所有点连通的最小费用. ...

  5. VC++6.0环境下调试c语言代码的方法和步骤_附图

    1.C语言程序四步开发步骤 (1)编辑.可以用任何一种编辑软件将在纸上编写好的C语言程序输入计算机,并将C语言源程序文件*.c以纯文本文件形式保存在计算机的磁盘上(不能设置字体.字号等). (2)编译 ...

  6. Deployed component GUIs and figures have different look and feel than MATLAB desktop

    原文:http://www.mathworks.com/support/bugreports/1293244 Description Deployed GUIs and figures look an ...

  7. 【转】【cocos2d-x教程】如何使用WebSocket

    介绍 WebSocket是HTML5开始提供的一种浏览器与服务器间进行全双工通讯的网络技术.在WebSocket API中,浏览器和服务器只需要做一个握手的动作,然后,浏览器和服务器之间就形成了一条快 ...

  8. jquery的API查看 / prepend、prependTo、append、appendTo的用法

    理解jquery设计思想 记住大部分jquery API的使用 英文:http://api.jquery.com/ 中文: http://www.css88.com/jqapi-1.9/ http:/ ...

  9. js特效第九天

    offset家族(获取元素尺寸) offsetWidth得到对象的宽度,自己的,与他人无关 offsetWidth = width+border+padding,不包含margin offsetHei ...

  10. TCP服务端和客户端的框架

    提供一个框架服务器端: 创建一个Socket sFd=socket(AF_INET,SOCK_STREAM,0) 把Socket和本机的IP,TCP口绑定 bind(sFd,(structsockad ...