cursomecanet.com

En esta sección de Código Fuente en Delphi vamos a explicar cómo podemos saber si un archivo existe en cierta dirección de Internet.

Para ello, he escrito esta pequeña app de ejemplo.

De todos es conocida la función de Delphi "FileExists" que nos permite saber si un archivo existe en nuestro sistema de archivos. Pero ¿ qué ocurre si necesitamos saber de la existencia de un archivo en cierto sitio web? Pues la respuesta es que esa función NO la trae Delphi y tendremos que escribirla nosostros mismos.

Hay distintas formas de aproximarnos a esta tarea, una puede ser utilizar los componentes Indy, otra es utilizar los componentes ICS (Internet Component Suit) y una tercera posibilidad es no utilizar ningún componente y hacerlo utilizando la api de WinInet, este es el método utilizado en este ejemplo, por ello debemos insertar "wininet" en la clausula uses de nuestra unidad.

Nuestra función InternetFileExists toma como único parámetro un string que contendrá la dirección URL del archivo del cual queramos comprobar su existencia, y devuelve un valor verdadero/falso.

Para conocer si un archivo existe en Internet no es necesario descargarlo, por ello la función HttpOpenRequest utilizada no realiza una solicitud "GET", en su lugar realiza una solicitud "HEAD" que solamente espera las cabeceras de respuesta del servidor, sin el cuerpo del archivo.

Una vez obtenida la respuesta del servidor, lo que nos interesa es el código de estado (Status Code) de esa respuesta. La función da por válida la existencia solamente en el caso de que el Status Code sea 200 (OK), cualquier otro código de estado devuelto por el servidor lo considera no válido (incluidas las redirecciones 301)

En la siguiente imagen puedes ver un ejemplo de uso de esta app.

A continuación, puedes ver el código completo de la app, y si lo deseas puedes descargarlo todo (código y app) en un archivo "zip".

unit Unit1;


interface

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

type
  TForm1 = class(TForm)
    Edit1: TEdit;
    Button1: TButton;
    Label1: TLabel;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}


uses wininet;

////////////////////////////////////////////////////////////////////////////////

{
http://login:password@somehost.somedomain.com:8080/some_path/something_else.html?param1=val&param2=val#nose
\__/   \___/ \______/ \_____________________/ \__/\____________________________/ \___________________/ \__/
 |       |      |               |               |                |                        |              |
Scheme Username Password       Host            Port             Path                    Query         Fragment
}

procedure ParseURL(const Url: ansistring; var Scheme, user, pass, host, port, path, extra: ansistring);
var resto, tmp: ansistring;
begin
  Scheme := '';
  user := '';
  pass := '';
  host := '';
  port := '';
  path := '';
  extra := '';

  resto := url;
  Scheme := copy(resto, 1, pos('://', resto) - 1);
  resto := copy(resto, pos('://', resto) + length('://'), maxint);

  tmp := copy(resto, 1, pos('@', resto) - 1);
  if tmp <> '' then begin
       //tiene user y pass
    user := copy(tmp, 1, pos(':', tmp) - 1);
    pass := copy(tmp, pos(':', tmp) + 1, maxint);
    resto := copy(resto, pos('@', resto) + 1, maxint);
  end;

  tmp := copy(resto, 1, pos(':', resto) - 1);
  if tmp <> '' then begin
       //trae puerto
    host := tmp;
    port := copy(resto, pos(':', resto) + 1, pos('/', resto) - 1);
    resto := copy(resto, pos('/', resto) + 1, maxint);
  end else begin
       // no trae puerto
    host := copy(resto, 1, pos('/', resto) - 1);
    resto := copy(resto, pos('/', resto) + 1, maxint);
  end;

  tmp := copy(resto, 1, pos('?', resto) - 1);
  if tmp <> '' then begin
        //trae param
    path := tmp;
    extra := copy(resto, pos('?', resto) + 1, maxint);

  end else begin
    path := resto;
    extra := '';
  end;

end;




function InternetFileExists(url: string): boolean;
const INTERNET_FLAG_PRAGMA_NOCACHE = $100;
const
  accept: packed array[0..1] of LPSTR = (PAnsiChar('*/*'), nil);
var
  hSession, hfile, hRequest: hInternet;
  dwindex, dwcodelen: dword;
  dwcode: array[1..20] of Ansichar;
  reply: pAnsichar;
  Scheme, user, pass, host, port, path, extra: ansistring;
  userAgent: AnsiString;
  puerto, servicio, modoPasivo, flagsOpenRequest: dword;
  usuario, password: PChar;
begin
  if (pos('http://', lowercase(url)) = 0)
    and (pos('https://', lowercase(url)) = 0)
    and (pos('ftp://', lowercase(url)) = 0)
    then url := 'http://' + url; //asumimos http por defecto
  Result := false;
  ParseURL(url, Scheme, user, pass, host, port, path, extra);
  flagsOpenRequest := INTERNET_FLAG_NO_AUTO_REDIRECT or
    INTERNET_FLAG_PRAGMA_NOCACHE or
    INTERNET_FLAG_NO_CACHE_WRITE
                      {or INTERNET_FLAG_IGNORE_REDIRECT_TO_HTTPS};
  if lowercase(Scheme) = 'http' then begin
    puerto := INTERNET_DEFAULT_HTTP_PORT;
    servicio := INTERNET_SERVICE_HTTP;
    modoPasivo := 0;
  end;
  if lowercase(Scheme) = 'https' then begin
    puerto := INTERNET_DEFAULT_HTTPS_PORT;
    servicio := INTERNET_SERVICE_HTTP;
    modoPasivo := 0;
    flagsOpenRequest := flagsOpenRequest or
      INTERNET_FLAG_SECURE or
      INTERNET_FLAG_IGNORE_CERT_CN_INVALID or
      INTERNET_FLAG_IGNORE_CERT_DATE_INVALID;
  end;
  if lowercase(Scheme) = 'ftp' then begin
    puerto := INTERNET_DEFAULT_FTP_PORT;
    servicio := INTERNET_SERVICE_FTP;
    modoPasivo := INTERNET_FLAG_PASSIVE;
  end;
  if user <> '' then usuario := PChar(user) else usuario := nil;
  if pass <> '' then password := PChar(pass) else password := nil;

  userAgent := 'Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36' +
    ' (KHTML, like Gecko) Chrome/64.0.3282.167 Safari/537.36';
  hSession := InternetOpen(PChar(userAgent), INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);
  if assigned(hsession) then begin
    hfile := InternetConnect(hsession, pchar(host), puerto, usuario, password, servicio, modoPasivo, 0);
    if Assigned(hfile) then begin
      hRequest := HttpOpenRequest(hfile, 'HEAD', pchar(path), nil, nil, @accept, flagsOpenRequest, 0);
      if Assigned(hRequest) then begin
        if HttpSendRequest(hRequest, nil, 0, nil, 0) then begin
          dwIndex := 0;
          dwCodeLen := 10;
          if HttpQueryInfo(hRequest, HTTP_QUERY_STATUS_CODE, @dwcode, dwcodeLen, dwIndex) then begin
            reply := pAnsichar(@dwcode);
            if reply = '200' then // File exists, all ok.
              result := True
            else if reply = '301' then // Moved permanently.
              result := False
            else if reply = '401' then // Not authorised. Assume page exists,but we can't check it.
              result := False
            else if reply = '404' then // No such file.
              result := False
            else if reply = '500' then // Internal server error.
              result := False
            else // Shouldn't get here! It means there is a status code left unhandled.
              result := False;
          end;
        end;
        InternetCloseHandle(hRequest);
      end;
      InternetCloseHandle(hfile);
    end;
    InternetCloseHandle(hsession);
  end;
end;



procedure TForm1.Button1Click(Sender: TObject);
begin
  if InternetFileExists(Edit1.Text) then
    label1.Caption := 'Existe: "SI"'
  else
    label1.caption := 'Existe: "NO"';
end;

end.