unit_checkurl.pas

菜鸟猜地址(完全源码) DELPHI 源代码 菜鸟猜地址(完全源码) DELPHI 源代码

unit Unit_CheckURL;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls,wininet,Unit_GetUrl;

type
  TForm_CheckURL = class(TForm)
    Label1: TLabel;
    procedure FormActivate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form_CheckURL: TForm_CheckURL;

implementation

{$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)  and (Pos('ftp://', LowerCase(url)) = 0) and
    (pos('rtsp://',LowerCase(url))= 0) and (Pos('mms://',LowerCase(url)) = 0) then
url  :=  'http://'+url;

Result  :=  false;//这句并不是针对上面的if
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;

//探测地址函数结束

procedure TForm_CheckURL.FormActivate(Sender: TObject);
var n:integer;
var CostTime:integer;//自动删除所需时间
var CostTimeStr:string;
{列表中若未选中项,则开始项的index号为  0  }
var ChangeN:integer;//用于调整列表处理顺序
begin
with Unit_GetUrl.Form_GetUrl do
begin
UrlList.ItemIndex:=0;
StatusBar1.Panels[1].Text:='';
StatusBar1.Panels[1].Text:='探测时间取决于网速与猜测数量,请耐心等待';
form_GetURl.Cursor:=crHourGlass;
  n:=UrlList.Items.Count;
  ChangeN:=0;
  if n>0 then
  begin
    while n>0 do
    begin
      if CheckUrl(UrlList.Items.Strings[UrlList.ItemIndex+ChangeN])<>True then
      begin
        //Showmessage('删除:'+UrlList.Items.Strings[UrlList.ItemIndex+ChangeN]+#13+#10+'序号:'+inttostr(UrlList.ItemIndex+ChangeN));
        UrlList.Items.Delete(UrlList.ItemIndex+ChangeN);
        ChangeN:=ChangeN-1;
      end;
      ChangeN:=ChangeN+1;
      n:=n-1;
    end;
    StatusBar1.Panels[1].Text:='自动删除无效地址完成!';
    Application.MessageBox('删除无效地址完成!','提示信息',MB_OK);
  end
  else
  showmessage('没有找到要探测的地址！');
end;
end;

end.