Sieć » Internet

A jak sprawdzić czy plik znajduje się na serwerze (HTTP) bez próby jego ściągnięcia

  • 2 komentarze
  • 842 odsłony
  • Oceń ten tekst jako pierwszy
Poniższy program wysyła metodą HEAD nagłówki do serwera, dzięki temu otrzymuje od serwera tylko nagłówki bez ew. treści pliku i stwierdza po nich obecność pliki na serwerze.

Do sekcji uses należy dopisać unit IdTCPClient - unit jest z pakietu Indy a program był testowany na Indy 9 i Delphi 7


Kod:

type TPlikInfo=record
  status:string;
  rozmiar:Int64;
  blad:byte;
  lokalizacja:string;
  typ:string;
 end;
 
const HeFileExist=0;
  HeServerError=1;
  HeFileNotFound=2;
  HeRedirected=3;
 
// powyżej jest zadeklarowany typ który zwraca funkcja sprawdzająca, zwraca ona status otrzymany od serwera, rozmiar pliku, rodzaj błędu jeśli wystąpił, lokalizację pliku jeśli nastąpiło przekierowanie oraz typ mime
 
{
  Kod sprawdzania dostępu do pliku na serwerze HTTP by Adamo 2005
}
 
function dajResztePo(co,wczym:string):string;
// funkcja zwraca ze stringa wszystko po wystąpieniu innego stringu
var c,w:string;
begin
  c:=lowercase(co); w:=lowercase(wczym);
  if Pos(c,w)>0 then
   Result:=Copy(wczym,Pos(c,w)+Length(c),Length(w)) else
   Result:='';
end;
 
function plikIstnieje(nazwa:string):TPlikInfo;
var host,request,data,text,status:string; client:TIdTCPClient;
 r:TPlikInfo;
const CRL=#13#10;
begin
 r.status:='503 Service Unavailable';
 r.rozmiar:=-1;
 r.blad:=HeServerError;
 r.typ:='...';
 client:=TIdTCPClient.Create(nil);
 host:=nazwa;
 if pos('://',host)>0 then
  host:=Copy(host,pos('://',host)+3,length(host));
 request:='';
 if pos('/',host)>0 then begin
  request:=Copy(host,pos('/',host),length(host));
  host:=Copy(host,1,pos('/',host)-1);
 end;
 if pos('?',host)>0 then begin
  request:=Copy(host,pos('?',host),length(host))+request;
  host:=Copy(host,1,pos('?',host)-1);
 end;
 if (length(request)<1) or (request[1]<>'/') then
  request:='/'+request;
 r.lokalizacja:='http://'+host+request;
 client.Port:=80;
 client.Host:=host;
 try
   client.Connect(3000);
   data:='HEAD '+request+' HTTP/1.0'+CRL+
     'Accept: ..., */*'+CRL+
     'Referer: http://'+host+CRL+
     'Accept-Language: pl'+CRL+
     'User-Agent: Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1)'+CRL+
     'Host: '+host+CRL+
     'Connection: close'+CRL+CRL;
   client.Write(data);
   r.blad:=HeFileNotFound;
   repeat
     data:=client.ReadLn(#$A,1000);
     ////
     text:=dajResztePo('HTTP/',data);
     if text<>'' then
      status:=dajResztePo(' ',text);
     ////
     text:=dajResztePo('Content-type: ',data);
     if text<>'' then r.typ:=text;
     ////
     text:=dajResztePo('Location: ',data);
     if text<>'' then begin
       r.lokalizacja:=text;
       r.blad:=3;
     end;
     ////
     text:=dajResztePo('Content-Length: ',data);
     if text<>'' then r.rozmiar:=StrToInt(text);
     ////
   until data='';
   if Pos('200',status)>0 then r.blad:=HeFileExist;
   r.status:=status;
 except
   r.blad:=HeServerError;
 end;
 if client.Connected then client.Disconnect;
 client.Free;
 if r.blad<>HeFileExist then r.rozmiar:=-1;
 Result:=r;
end;







Przykład użycia:

na formę wrzucić trzy kontrolki Label i jeden Edit oraz jeden Button, pod OnClick buttona przypisać tą procedurę:



procedure TForm1.Button1Click(Sender: TObject);
var r:TPlikInfo;
begin
  Enabled:=false;
  Label1.Caption:='Wysyłam zapytanie do serwera ...';
  Application.ProcessMessages;
  r:=plikIstnieje(Edit1.Text);
  case r.blad of
    HeServerError: Label1.Caption:='Plik jest nieosiągalny';
    HeFileNotFound: Label1.Caption:='Plik nie istnieje na serwerze';
    HeRedirected: Label1.Caption:='Nastąpiło przekierowanie na '+r.lokalizacja;
    HeFileExist: begin
      Label1.Caption:='Plik istnieje na serwerze';
      if r.rozmiar<>-1 then
        Label1.Caption:=Label1.Caption+' i zajmuje '+
          IntToStr(r.rozmiar)+' bajtów';
      end;
  end;
  ////
  Label2.Caption:='Typ: '+r.typ;
  Label3.Caption:='Status: '+r.status;
  Enabled:=true;
end;


procedura zwróci w pierwszym Labelu text czy plik istnieje i ew. ile zajmuje, w drugim typ mime tego pliku a w trzecim status zwrócony przez serwer, jeśli chcemy tylko "true" lub "false" to można dopisać taką funkcję i się do niej odwoływać:

function FileExistsOnServer(URL: String): Boolean;
var r:TPlikInfo; ur:string;
begin
  ur:=URL;
  repeat
    r:=plikIstnieje(ur);
    if r.blad=HeRedirected then ur:=r.lokalizacja;
  until r.blad<>HeRedirected;
  Result:=r.blad=HeFileExist; // zwraca true jeśli plik istnieje
end;


Wsio tongue1.gif

2 komentarze

Adamo 2005-07-10 00:10

że zwraca ze stringa wszystko po wystąpieniu innego stringa :P

tj. jest string
abcdefghijkl

i po wykonaniu tej funkcji (innystring,string) jako innystring podając \"def\" zwróci \"ghijkl\"

necrokris 2005-07-09 22:15

// funkcja zwraca ze stringa wszystko po wystąpieniu innego stringu

o so cho?