Другое (Интернет и сеть)

{ **** UBPFD *********** by http://kladovka.net.ru/delphibase/ ****
>> Определение размера файла в Интернете.

Функция определяет размер файла в Интернете, используя реферер (необходим для некоторых хостингов), а так же автоматически отключает автономный режим (если он включён) в интернет-соединении (без этого не работают некоторые функции в модуле Wininet).

Зависимости: Wininet, Registry.
Автор:       Прахожий
Copyright:   Народное творчество
Дата:        16 апреля 2008 г.
***************************************************************** }

function GetFileSize(const FileURL: string):string;

    function Extract_Referer(const S:String):String;
    var i:Integer;
    begin
      Result:='';
      if length(S)<8 then exit;
      for i:=8 to length(S) do if S[i]='/' then
        begin
          Result:=Copy(S,1,i-1);
          break;
        end;
    end;

var
   hSession, hFile: hInternet;
   dwBufferLen, dwIndex: DWORD;
   db:Array[1..512] of char;
   REG:TRegistry; Mode:Integer; Mode_reset:boolean;
   head:String;
begin
  Result := '';
  REG:=TRegistry.Create;
  try
    Reg.RootKey := HKEY_CURRENT_USER; // !!! В Интернет-Эксплорере отключить автономный режим:
    if Reg.OpenKey('\Software\Microsoft\Windows\CurrentVersion\Internet Settings', False) then
      begin
        Mode:=REG.ReadInteger('GlobalUserOffline');
        mode_reset:=false;
        if mode=1 then
          begin
            Reg.WriteInteger('GlobalUserOffline',0);
            mode_reset:=true;
          end;
             hSession := InternetOpen(PChar(Application.Title), PRE_CONFIG_INTERNET_ACCESS, nil, nil, 0);
             if Assigned(hSession) then
             begin
               head:= 'referer: '+Extract_Referer(FileURL)+#13#10#13#10;
               hFile := InternetOpenURL(hSession, PChar(FileURL), PChar(head), Length(head), 0, 0);
               dwIndex := 0;
               dwBufferLen := 512;
               if HttpQueryInfo(hFile, HTTP_QUERY_CONTENT_LENGTH, @db, dwBufferLen, dwIndex)
               then Result := PChar(@db);
               if Assigned(hFile) then InternetCloseHandle(hFile);
               InternetCloseHandle(hsession);
             end;
        if mode_reset then Reg.WriteInteger('GlobalUserOffline',1);
        Reg.CloseKey;
      end;
  finally
    REG.Free;
  end;
end;

uses Wininet, Registry;


function GetFileSize(const FileURL: string):string;

    function Extract_Referer(const S:String):String;
    var i:Integer;
    begin
      Result:='';
      if length(S)<8 then exit;
      for i:=8 to length(S) do if S[i]='/' then
        begin
          Result:=Copy(S,1,i-1);
          break;
        end;
    end;

var
   hSession, hFile: hInternet;
   dwBufferLen, dwIndex: DWORD;
   db:Array[1..512] of char;
   REG:TRegistry; Mode:Integer; Mode_reset:boolean;
   head:String;
begin
  Result := '';
  REG:=TRegistry.Create;
  try
    Reg.RootKey := HKEY_CURRENT_USER; // !!! В Интернет-Эксплорере отключить автономный режим:
    if Reg.OpenKey('\Software\Microsoft\Windows\CurrentVersion\Internet Settings', False) then
      begin
        Mode:=REG.ReadInteger('GlobalUserOffline');
        mode_reset:=false;
        if mode=1 then
          begin
            Reg.WriteInteger('GlobalUserOffline',0);
            mode_reset:=true;
          end;
             hSession := InternetOpen(PChar(Application.Title), PRE_CONFIG_INTERNET_ACCESS, nil, nil, 0);
             if Assigned(hSession) then
             begin
               head:= 'referer: '+Extract_Referer(FileURL)+#13#10#13#10;
               hFile := InternetOpenURL(hSession, PChar(FileURL), PChar(head), Length(head), 0, 0);
               dwIndex := 0;
               dwBufferLen := 512;
               if HttpQueryInfo(hFile, HTTP_QUERY_CONTENT_LENGTH, @db, dwBufferLen, dwIndex)
               then Result := PChar(@db);
               if Assigned(hFile) then InternetCloseHandle(hFile);
               InternetCloseHandle(hsession);
             end;
        if mode_reset then Reg.WriteInteger('GlobalUserOffline',1);
        Reg.CloseKey;
      end;
  finally
    REG.Free;
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Caption:=GetFileSize('http://the-test.nm.ru/MaunaLoa.jpg');
end;