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¶m2=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.