IPTV-UrlChecker - نسخة قابلة للطباعة

كود :
uses wininet;

function urlcheck(const sUrl: string; CheckTimeout: DWORD = 3000): DWORD;

var

   hInet, hConnect: HINTERNET;

   StatusCode, dummy, bufLen, Option: DWORD;

begin

   Result := 0;

   hInet := InternetOpen(PChar(Application.Title),

     INTERNET_OPEN_TYPE_PRECONFIG_WITH_NO_AUTOPROXY, nil, nil, 0);

   if Assigned(hInet) then

     try

       Option := CheckTimeout;

       InternetSetOption(hInet, INTERNET_OPTION_CONNECT_TIMEOUT, @Option,

         SizeOf(Option));

       InternetSetOption(hInet, INTERNET_OPTION_RECEIVE_TIMEOUT, @Option,

         SizeOf(Option));

       hConnect := InternetOpenUrl(hInet, PChar(trim(sUrl)), nil, 0,

         INTERNET_FLAG_NO_UI, 0);

       if Assigned(hConnect) then

         try

           dummy := 0;

           bufLen := SizeOf(StatusCode);

           if HttpQueryInfo(hConnect, HTTP_QUERY_STATUS_CODE or

             HTTP_QUERY_FLAG_NUMBER, @StatusCode, bufLen, dummy) then

             Result := StatusCode;

         finally

           InternetCloseHandle(hConnect);

         end;

     finally

       InternetCloseHandle(hInet);

     end;

end;

function htcodes(mycode: Integer): string;

begin

   case mycode of

     200: Result := 'succès';

     301: Result := 'Adresse déplacée';

     400: Result := 'Demande incorrecte';

     401: Result := 'pas d''authentification';

     403: Result := 'pas de permission';

     404: Result := 'Pas de réponse';

     408: Result := 'Timeout';

     else

       Result := 'erreur inconnue';

   end;

end;

procedure TForm1.Button1Click(Sender: TObject);

var stc: Integer;

begin

 stc:=urlcheck(memo1.Text);

 Showmessage(htcodes(stc));

end;



end.