Программирование на Delphi

FAQ VCL
Интернет

:: Меню ::

:: На главную ::

:: FAQ ::

:: Заметки ::

:: Практика ::

:: Win API ::

:: Проекты ::

:: Скачать ::

:: Секреты ::

:: Ссылки ::

:: Сервис ::

:: Написать ::

:: MVP ::

:: RSS ::

Как сделать ссылку - URL?


uses
  {...,} ShellApi;

// Для того, чтобы Internet Explorer запустился, 
// обязательно нужно, чтобы Label1.Caption начинался с 
// "www." или "http://" { естественно без ковычек }
procedure TForm1.Label1Click(Sender: TObject);
begin
   ShellExecute( 0, nil, PChar( Label1.Caption ),
                 nil, nil, SW_NORMAL );
end;

Как открыть почтовую программу с нужным адресом?


uses
  {...,} ShellApi;

// Просто запустить почтовый клиент
ShellExecute( Handle, 'open',
              PChar( 'mailto:decoding@narod.ru' ),
              '', '', SW_SHOW );
// Если в письмо нужно вставить тему, то пишите так
ShellExecute( Handle, 'open',
              PChar( 'mailto:decoding@narod.ru?Subject=Tema' ),
              '', '', SW_SHOW );
// А если и текст нужно вставить, то так
ShellExecute( Handle, 'open',
              PChar( 'mailto:decoding@narod.ru?Subject=Tema&Body=Text' ),
              '', '', SW_SHOW );
// Добавляем адресатов
ShellExecute( Handle, 'open',
              PChar( 'mailto:decoding@narod.ru?Subject=Tema&Body=Text&cc=адрес@получателя&bcc=скрытая@копия' ),
              '', '', SW_SHOW );
// Ну и для полного счастья...
ShellExecute( Handle, 'Open',
              'mailto:decoding@narod.ru?subject=Tema&Body=Строка%201%0D%0AСтрока%202&CC=decoding@narod.ru',
              nil, nil, SW_RESTORE );

// Краткие пояснения к последнему примеру
// 1) Пробелы в тексте желательно заполнять сочетанием %20
// 2) Конец строки обозначать как %0D%0A
// 3) Поля отделять друг от друга символом &

Как скопировать файл из сети?


uses
  {...,} WinInet;

function GetInetFile ( const fileURL, FileName: string ): boolean;
const
  BufferSize = 1024;
var
  hSession, hURL: HInternet;
  Buffer: array[1..BufferSize] of byte;
  BufferLen: DWORD;
  f: file;
  sAppName: string;
begin
   Result := false;
   sAppName := ExtractFileName( Application.ExeName );
   hSession := InternetOpen( PChar( sAppName ),
                             INTERNET_OPEN_TYPE_PRECONFIG,
                             nil, nil, 0 );
   try
      hURL := InternetOpenURL( hSession, PChar( fileURL ), nil, 0, 0, 0 );
      try
         AssignFile( f, FileName );
         Rewrite( f, 1 );
         repeat
            InternetReadFile( hURL, @Buffer, SizeOf( Buffer), BufferLen );
            BlockWrite( f, Buffer, BufferLen )
         until BufferLen = 0;
         CloseFile( f );
         Result := true;
      finally
         InternetCloseHandle( hURL );
      end
   finally
      InternetCloseHandle( hSession );
   end
end;

procedure TForm1.Button1Click(Sender: TObject);
var
   FileOnNet, LocalFileName: string;
begin
   // Полный путь к файлу
   FileOnNet := 'http://decoding.narod.ru/book/doc/synchronization.zip';
   // Имя, под которым файл будет сохранен
   LocalFileName:='File Downloaded From the Net.zip';
   if GetInetFile( FileOnNet, LocalFileName ) then
      ShowMessage( 'Download successful' )
   else
      ShowMessage( 'Error in file download' );
end;

Как узнать размер файла в интернете?


// Способ первый
uses
  {...,} WinInet;

(* Функция возвращает размер файла в байтах *)
function GetUrlSizeInByte( const URL: string ): integer;
var
  hSession, hFile: hInternet;
  dwBuffer: array[1..20] of char;
  dwBufferLen, dwIndex: DWORD;
begin
   Result := 0;
   hSession := InternetOpen( 'GetUrlSize', 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;
      dwBufferLen := 20;
      if HttpQueryInfo( hFile, HTTP_QUERY_CONTENT_LENGTH, @dwBuffer, dwBufferLen, dwIndex ) then
         Result := StrToInt( StrPas( @dwBuffer ) );
      if Assigned( hFile ) then
         InternetCloseHandle( hFile );
      InternetCloseHandle( hSession );
   end;
end;

// Способ второй
uses
  {...,} WinInet;

function GetHttpFileSize( const URL: string ): Int64;
var
  hSession, hRequest: Pointer;
  lpBuf: array[0..30] of Char;
  dwBufLen: DWORD;
begin
   hSession := InternetOpen( nil, INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0 );
   hRequest := InternetOpenUrl( hSession, PChar( URL ), nil, 0, 0, 0 );
   dwBufLen := SizeOf( lpBuf );
   if not HttpQueryInfo( hRequest, HTTP_QUERY_CONTENT_LENGTH, @lpBuf, dwBufLen, PDWORD( nil )^ ) then
      Result := -1
   else
      Result := StrToInt64Def( lpBuf, -1 );
   InternetCloseHandle( hRequest );
   InternetCloseHandle( hSession );
end;

Как проверить, есть ли соединение с Интернет?


// Способ первый
const  
  INTERNET_CONNECTION_MODEM      = 1;  
  INTERNET_CONNECTION_LAN        = 2;  
  INTERNET_CONNECTION_PROXY      = 4;  
  INTERNET_CONNECTION_MODEM_BUSY = 8;

function InternetGetConnectedState( lpdwFlags: LPDWORD; dwReserved:DWORD ): BOOL; stdcall;
  external 'wininet.dll' name 'InternetGetConnectedState';

{...}

function IsInternetConnected: Boolean;
var  
  dwConnectionTypes: DWORD;
begin 
   dwConnectionTypes := INTERNET_CONNECTION_MODEM or 
                        INTERNET_CONNECTION_LAN or 
                        INTERNET_CONNECTION_PROXY;  
   Result := InternetGetConnectedState( @dwConnectionTypes, 0 );
end;

// Способ второй
const
  NETWORK_ALIVE_LAN = $00000001;
  NETWORK_ALIVE_WAN = $00000002;

function IsNetworkAlive(flags: LPDWORD) : BOOL; stdcall; external 'sensapi.dll';

procedure TForm1.Button1Click(Sender: TObject);
var
 Flags: DWORD;
 Res: Boolean;
begin
  Flags := NETWORK_ALIVE_WAN;
  Res := IsNetworkAlive(@Flags);
  if Res then
     case Flags of
        NETWORK_ALIVE_LAN: ShowMessage('Подключено по локальной сети');
        NETWORK_ALIVE_WAN: ShowMessage('Можемное подключение');
     end
  else
     ShowMessage('Подключения нет');
end;

Как закодировать URL адрес?


// Способ первый
uses
  {...,} NetEncoding;

procedure TForm1.Button1Click(Sender: TObject);
begin
  // Кодируется как :// так и кириллица
  ShowMessage(TNetEncoding.URL.Encode('http://qwerty/йцукен'));
end;

// Способ второй
uses
  {...,} HTTPApp;

procedure TForm1.Button1Click(Sender: TObject);
begin
  // Кодируется как :// так и кириллица
  ShowMessage(HTTPEncode('http://qwerty/йцукен'));
end;

// Способ третий
uses
  {...,} IdURI;

procedure TForm1.Button1Click(Sender: TObject);
begin
  // Не кодируется ://, только кириллица
  ShowMessage(TIdURI.URLEncode('http://qwerty/йцукен'));
end;

// Способ четвертый (Synapse)
uses
  {...,} synacode;

procedure TForm1.Button1Click(Sender: TObject);
begin
  // Не кодируется ://, только кириллица
  ShowMessage(EncodeUrl('http://qwerty/йцукен'));
end;

// Способ пятый
uses
  {...,} REST.Utils;

procedure TForm1.Button1Click(Sender: TObject);
begin
  // Кодируется как :// так и кириллица
  ShowMessage(URIEncode('http://qwerty/йцукен'));
end;

Как раскодировать URL адрес?


// Способ первый
uses
  {...,} NetEncoding;

procedure TForm1.Button1Click(Sender: TObject);
begin
  ShowMessage(TNetEncoding.URL.Decode('http%3A%2F%2Fqwerty%2F%D0%B9%D1%86%D1%83%D0%BA%D0%B5%D0%BD'));
end;

// Способ второй
uses
  {...,} HTTPApp;

procedure TForm1.Button3Click(Sender: TObject);
begin
  ShowMessage(HTTPDecode('http%3A%2F%2Fqwerty%2F%D0%B9%D1%86%D1%83%D0%BA%D0%B5%D0%BD'));
end;

// Способ третий
uses
  {...,} IdURI;

procedure TForm1.Button1Click(Sender: TObject);
begin
  ShowMessage(TIdURI.URLDecode('http%3A%2F%2Fqwerty%2F%D0%B9%D1%86%D1%83%D0%BA%D0%B5%D0%BD'));
end;

// Способ четвертый (Synapse)
uses
  {...,} synacode;

procedure TForm1.Button1Click(Sender: TObject);
begin
  ShowMessage(Utf8ToAnsi(DecodeUrl('http%3A%2F%2Fqwerty%2F%D0%B9%D1%86%D1%83%D0%BA%D0%B5%D0%BD')));
end;

При использовании материала - ссылка на сайт обязательна