[PEDIDO] Verificar se determinado site existe

[luicioaroldo]

Iaew galera... Joia? Bom pesquisei aqui e não achei nada sobre um seguinte assunto:
Verificar se determinado site existe.... Se alguem poder liberar o codigo vlew
xauxau

[Danjel]

Declare na Uses a unit WinInet


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;

Qualquer coisa tamo ai....

Outras dicas pegue aqui:
http://baixaki.ig.com.br/download/Dicas-Delphi.htm

Vlw, até mais

[luicioaroldo]

mas como uso ele em um button?

[Danjel]

CheckUrl('Site aqui');

[demoniako]

Declare na Uses a unit WinInet


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;

Qualquer coisa tamo ai....

Outras dicas pegue aqui:
http://baixaki.ig.com.br/download/Dicas-Delphi.htm

Vlw, até mais

durval eu usei a sua function ela testa e funciona certinho so ke o programa fica inativo por uns 20 seg. Isso tem como arrumar
tipow nem o mouse dentro do programa aparece quando eu passo o mouse dentro da janela do meu programa ele some ae se puxar pra fora volta a aparecer ate terminar de analisar se o site existe ou nao depois faz um beep e libera normal.