Форум программистов [Powered by Invision Power Board]

Цитата

type
  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    ListBox1: TListBox;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

  TParam = class
    public
      url: string;
  end;

var
  Form1: TForm1;
  hThread: THandle;
  check: integer;
  text11: string;

implementation

{$R *.dfm}

function CheckUrl(p: Pointer): DWORD; stdcall;
var
  hSession,hfile: hInternet;
  dwindex,dwcodelen: dword;
  dwcode: array[1..20] of char;
  lpBuffer: array[0..1024 + 1] of Char;
  res: pchar;
  dwBytesRead: DWORD;
  URL: string;
begin
  URL:=TParam(p).url;
  hSession:= InternetOpen('InetURL:/1.0', INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 1);
  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);
    if (assigned(hfile) and (res = '200')) then begin
      dwBytesRead := 1024;
      InternetReadFile(hfile, @lpBuffer, 1024, dwBytesRead);
      text11:=utf8toansi(lpBuffer);
      if pos('<title>Доступ ограничен</title>',utf8toansi(lpBuffer)) = 0 then result:=1 else result:=0;
    end else result:=0;
    if assigned(hfile) then InternetCloseHandle(hfile);
    InternetCloseHandle(hsession);
  end else result:=0;

  check:=result;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  i: integer;
  param: TParam;
begin
  param:=TParam.Create;
  for i:=0 to ListBox1.Items.Count-1 do begin
    param.url:=ListBox1.Items.Strings[i];
    check:=-100;
    text11:='';
    hThread:=CreateThread(nil, 0, @CheckUrl, Pointer(param), 0, pdword(0)^);
    SetThreadPriority(hThread, THREAD_PRIORITY_BELOW_NORMAL);
    if WaitForSingleObject(hThread, 2000) = WAIT_TIMEOUT then begin
      SuspendThread(hThread);
      Memo1.Lines.Add('Time out!');
    end;
    if TerminateThread(hThread, 0) then Memo1.Lines.Add('TerminateThread - OK') else Memo1.Lines.Add('TerminateThread - ERROR');
    CloseHandle(hThread);
    Memo1.Lines.Add(IntToStr(check));
    //Memo1.Lines.Add(text11);
    Memo1.Lines.Add('========================================================');
  end;
  Memo1.Lines.Add('End');
end;