faqs.org.ru

 Главная > Программирование > Языки Pascal/Delphi >

RU.DELPHI.INTERNET FAQ

Секция 2 из 2 - Предыдущая - Следующая

              begin
                FLastActivity := Now;
                FInterpreter.InterpretData(Data);
                Data := nil;
                FLastActivity := Now;
              end;
            end;
            WAIT_OBJECT_0 + 1:
              while PeekMessage(msg, 0, 0, 0, PM_REMOVE) do
                DispatchMessage(msg);
            WAIT_TIMEOUT:
              if (FTimeout > 0) and ((Now - FLastActivity) > FTimeout) then
                FTransport.Connected := False;
          end;
        except
          FTransport.Connected := False;
        end;
      finally
        FInterpreter.Free;
        FInterpreter := nil;
      end;
    finally
      FTransport := nil;
    end;
  finally
    CoUninitialize;
    Synchronize(RemoveClient);
  end;
end;


{ TSocketDispatcher }

constructor TSocketDispatcher.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ServerType := stThreadBlocking;
  OnGetThread := GetThread;
end;

procedure TSocketDispatcher.GetThread(Sender: TObject;
  ClientSocket: TServerClientWinSocket;
  var SocketThread: TServerClientThread);
begin
  SocketThread := TSocketDispatcherThread.Create(Self, False, ClientSocket,
    InterceptGUID, Timeout, RegisteredOnly);
end;

end.


------------------------------------------------------------
Q-17:  Как пеpесылать файл чеpез nonBlocking socket?
------------------------------------------------------------
   а форме ServerSocket1, ClientSocket1 : (Active := False,
  Host := localhost, Port := 2001, xType := xNonBlocking),
  OpenDialog1, Button1, Memo1.

procedure TfmMain.FormCreate(Sender: TObject);
begin
  ServerSocket1.Active:=true;
  ClientSocket1.Active:=true;
end;

{--- Server ---}

procedure TfmMain.Button1Click(Sender: TObject);
var
  sStream : TMemoryStream;
begin
  sStream := TMemoryStream.Create;
  if not OpenDialog1.Execute then
    Exit;
  sStream.LoadFromFile(OpenDialog1.FileName);
  ServerSocket1.Socket.Connections[0].SendStreamThenDrop(sStream);
end;

{--- Client ---}

const
  MAX_BUF_SIZE = $4095;

var
  fStream: TFileStream;

{OnConnect}
procedure TfmMain.ClientSocket1Connect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  fStream:= TFileStream.Create('Receive.fil', fmCreate);
end;

{OnRead}
procedure TfmMain.ClientSocket1Read(Sender: TObject;
  Socket: TCustomWinSocket);
var
  count :Integer;
  buffer: Array [0..MAX_BUF_SIZE] of Char;
begin
  repeat
    Socket.Lock;
    count:= Socket.ReceiveBuf(buffer,SizeOf(buffer));
    if count > 0 then
      fStream.WriteBuffer(buffer,count);
    Socket.Unlock;
   until (count <= 0);

   Memo1.Lines.Add(IntToStr(fStream.Size));
end;

{OnDisconnect}
procedure TfmMain.ClientSocket1Disconnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
   fStream.Free;
end;


------------------------------------------------------------
Q-18:  Хочу получать информацию о дате и времени из Internet.
------------------------------------------------------------
Вам помогут компоненты TNMDayTime и TNMTime, которые (согласно RFC867 и RFC868
соответственно) и предназначены для этих целей.


------------------------------------------------------------
Q-19:  При запросе по неверному адресу компонент TNMHTTP виснет или вылетает.
Что делать?
------------------------------------------------------------
Обработать событие OnFailure.


------------------------------------------------------------
Q-20:  Мне надо закодировать данные в UUE (MIME) код.
------------------------------------------------------------
Компонент TNMUUProcessor станет Вашим хорошим помощником.

Если Вам не хочется использовать компоненты от NetMasters, попробуйте
Indy. Информацию о данном наборе компонент можно найти в этом FAQ.

 о! При получении писем (атачей) в кoдировке UUE компоненты из
библиотеки Indy работают не очень корректно.  а http://www.rtfm.be/fpiette
можно найти нужный файл pop3cli.zip.

DK: Можно также почитать о MIME в RFCs 2045-2049


------------------------------------------------------------
Q-21:  Компоненты на странице FastNet глючат!
------------------------------------------------------------
Попробуйте набор компонент Internet Direct - Indy.

Взять его можно на http://www.nevrona.com/indy


------------------------------------------------------------
Q-22:  Хочу организовать чат. Как?
------------------------------------------------------------
В подкаталоге DEMOS\INTERNET\CHAT есть пример чата.

------------------------------------------------------------
Q-23:  Ассинхронная ошибка.
------------------------------------------------------------
Вопрос: Почему не работает следующий код?

     begin
       ClietnSocket1.Open;
       if ClietnSocket1.Socket.Connected then
         ClietnSocket1.Socket.SendText('Hello');
       {..}
     end;
     Выдает - ассинхронная ошибка.

Вы работаете в ассинхронном режиме. Следует использовать соответсвующие
события.


------------------------------------------------------------
Q-24:  Я слышал, что Delphi позволяет писать CGI-приложения. Так ли это?
------------------------------------------------------------
Да,  действительно, Delphi позволяет создавать CGI-приложения трех видов:

     * Stand-alone CGI (EXE)
     * Win-CGI (EXE)
     * ISAPI/NSAPI dynamic link library (DLL)

Рассмотрим их подробнее. Обычное CGI-приложение получает
необходимую информацию через переменные окружения и
STDIN, а выводит - через STDOUT. Понятно, что это в
условиях Windows не очень удобно, зато 100% работает
с любым сервером под Windows, который поддерживает CGI.

Win-CGI приложение отличается тем, что информация передается
через INI-файл, а выводится в файл, который затем сервер
передает в ответ на запрос.

ISAPI/NSAPI Dll (Internet Services API - Microsoft Server)/(Netscape
Services API - Netscape Server) работает как обычная dll. Она
загружается в адресное пространство сервера. Каждый запрос
обрабатывается в отдельном потоке. Сия dll должна экспортировать
три функции - GetExtensionVersion, HttpExtensionProc и TerminateExtension.

Основа этих приложений - классы TCGIApplication (для CGI и WinCGI) и
TISAPIApplication.

Сам процесс написания CGI-приложения на Delphi достаточно подробно описан в
help'е.


------------------------------------------------------------
Q-25:  Как мне отлаживать CGI-приложение?
------------------------------------------------------------
Во-первых, Вам необходим установленный WEB-сервер.

Для Stand-Alone CGI приложений достаточно любого сервера. Я
использую Xitami server. ISAPI/NSAPI Dll поддерживаются всеми
серверами от Microsoft, Netscape Server 2.0, а также сервером Apache.

Во-вторых, это зависит от того, что именно делает Ваша
программа. Если она должна предлагать пользователю
заполнить некую форму, то Вам нужно создать html-файл,
в котором эта форма была бы описана. Описывается форма тэгом

<form>:

<form name="GB" method="POST" action="http://127.0.0.1/cgi-bin/guestbook.pl">
<!-- здесь описываете содержание формы -->
</form>

Контролы на форму помещаются тэгом <input>:

<input
  type="*тип_контрола*"
  name="*имя_контрола*"
  [checked]
  value="*значение*"
  [size="*размер*">

Для того, чтобы получить нужный контрол, см. значения свойства type в следующей
таблице:

TEdit         text
TCheckBox     checkbox
TRadioButton  radio
TButton       submit

Для получения контрола типа TComboBox существует тэг <select>, внутри которого
тэгом <option> задается каждый пункт списка:

<select name="*имя_контрола*">
  <option value="*Значение0*" [selected]>Текст0
  <option value="*Значение1*">Текст1
  <!-- .. -->
  <option value="*ЗначениеN*">ТекстN
</option></select>

Для получение контрола типа TMemo cуществует тэг <textarea>:

<textarea
  name="*имя_контрола*"
  rows="*количество_видимых_строк*"
  cols="*количество_видимых_столбцов*">
Текст, который по умолчанию будет в контроле
</textarea>

Более подробную информацию о тэгах Вы можете получить, обратившись к
соответствующим источникам.

Далее напускаете Ваш браузер на эту страницу. Вводите тестовые значения и
нажимаете кнопку подтверждения, после чего сервер запустит Ваше приложение.

Если Вам не надо обрабатывать формы, то просто укажите Вашему браузеру URL
следующего вида:

http://127.0.0.1/cgi-bin/yourscript.exe/action?param0=value0&param1=value1

Слово 'action' означает имя одного из компонентов в списке
TWebModule.Actions[Index: Integer]: TWebAction. Параметры,
следующие после вопросительного знака, также необязательны.
Если же они есть, то будут помещены после декодирования в
свойство TWebRequest.QueryFields: TStrings и в виде целой
строки - в свойство TWebRequest.Query: String. Параметр
Request:TWebRequest передается в обработчик события OnAction компонента
TWebAction.

Также можно отлаживать CGI-приложение прямо в IDE любым из следующих способов:

0. Достаточно запустить CGI-приложение один раз под управлением http демона.
Выведите список переменных среды куда-нибудь - в файл или прямо в качестве
ответа клиенту. Это понадобится исключительно с информационной целью, для
справки.

На самом деле, для большинства тестов достаточно только тех установок
переменных окружения, которые непосредственно используются в тестируемой
вами части программы. В большинстве случаев достаточно установить три
переменные PATH_INFO, QUERY_STRING, METHOD. Это можно сделать прямо внутри
среды (Kylix - Project/Parameters, Delphi 6 - Tools\Environment options) и
запускать приложение из среды. Расставьте точки останова и наслаждайтесь
созерцанием собственных ошибок.

2. Только для Windows. Где-нибудь в тексте программы можно в самом начале
установить вывод на экран сообщения посредством функции Windows API
MessageBox. Важно, чтобы один из параметров включал в себя
MB_SERVICE_NOTIFICATION. Запустите CGI приложение штатным способом -
браузер/http сервер/CGI. Сразу после запуска программы, когда выполнение
дойдет до вызова MessageBox на дисплее появится окошко с сообщением. Теперь
можно присоединяться к процессу, представляющего вашу CGI-программу из IDE -
Run|Attach to process... Нажмите кнопочку на сообщении, выданном
CGI-приложением и продолжайте выполнение, но уже под управлением
отладчика среды.

Возможно, что нечто подобное покатит и для Linux'а. Там, разумеется, будет не
MessageBox с MB_SERVICE_NOTIFICATION, а что-нибудь другое.


------------------------------------------------------------
Q-26:  Мое CGI-приложение при обращении к нему ничего не возвращает. Что
делать?
------------------------------------------------------------
Вопрос: Мое CGI-приложение при обращении к нему, имеющим вид, например,
http://127.0.0.1/cgi-bin/mycgi.exe ничего не возвращает. Что делать?

Установите свойство TWebAction.Default: Boolean в true для той Action из
списка, которая должна по обрабатывать запросы тогда, когда это не делает ни
одна из других Actions.


------------------------------------------------------------
Q-27:  Бардак с кириллицей в параметрах CGI запроса
------------------------------------------------------------
Вопрос: Я хочу реализовать регистрацию своей программы через
Internet. Для этого я вызываю CGI-скрипт, которому в качестве
параметра передается имя пользователя. Однако, если имя
набрано кириллицей, происходит ошибка. В чем дело?

Дело в том, что при передаче запроса по протоколу HTTP
служебные символы и символы с кодами 128..255 надо
кодировать. То есть, если пользователь ввел имя 'Вася
Пупкин', то запрос для регистрации должен выглядеть не так:

     http://site/cgi-bin/reg.pl?user=Вася Пупкин

а вот так:

     http://site/cgi-bin/reg.pl?user=%C2%E0%F1%FF+%CF%F3%EF%EA%E8%ED

Решить проблему перекодировки туда и обратно может компонент TNMURL.

DK: В Делфи в стандартной поставке есть функции для [де]кодирования URL'а:
модуль httpapp, ф-ции HTTPEncode и HTTPDecode.
Дополнительную информацию про кодирование URL'ов, можно прочитать в RFC1738


------------------------------------------------------------
Q-28:  Как отправить письмо, с помощью клиента по умолчанию?
------------------------------------------------------------
В разделе uses
  ShellAPI.

В обработчике OnClick метки или клавиши ввести следующий код.

ShellExecute(Handle,'open','mailto:lalala@lala.ru',nil,nil,SW_SHOWNORMAL);


------------------------------------------------------------
Q-29:  Как открыть страничку с помощью браузера по умолчанию?
------------------------------------------------------------
В разделе uses
  ShellAPI.

В обработчике OnClick метки или клавиши ввести следующий код.

ShellExecute(Handle,'open','http://faq.delphiplus.org',nil,nil,SW_SHOWNORMAL);


------------------------------------------------------------
Q-30:  Как отправить письмо я знаю, а как указать тему, текст сообщения?
------------------------------------------------------------
Для отправки письма с помощью зарегистрированого клиента
используется функция Windows - ShellExecute, где в качестве
аргумента передается строка протокола Mailto. Для этого сделайте следующее.

по В разделе uses
  ShellAPI.

В обработчике OnClick метки или клавиши ввести следующий код.

ShellExecute(Handle,'open','mailto:lalala@lala.ru?par1=value1&par1=value1&...',nil,nil,SW_SHOWNORMAL);

Что здесь делается

1. Вызывается функция ShellExecute, где третий параметр -
это строка в соответствии с протоколом mailto и правилами оформления URL

mailto: - тип протокола (может быть http: в этом случае оставшая URL и
параметры запроса).

lalala@lala.ru - адрес получателя, можно включать несколько адресов, разделяя
из символом ";"

? - разделитель параметров от адреса

par1=value1 - имя параметра и его значение

& - разделитель параметров

Протокол Mailto имеет следующую форму.

   MAILTO:Recipients&Parameters

Поле Recipients может быть пустым, одиночным адресом и состоять из нескольких
адресов, разделенных символом ";".
Поле Parameters дополнительно и если оно есть то должно
быть отделено символом "&". Параметры должны появляться
в форме пары name/value. Следующий список описывает возможные параметры:

   PARAMETER     DESCRIPTION

   CC=           Carbon copy (дополнительные получатели)
   BCC=          Blind carbon copy (дополнительные получатели, адреса которых
не показываются остальным получателям)
   SUBJECT=      Subject text (тема)
   BODY=         Body text (текст)

Все данные указываемые в параметрах должны быть так называемые Internet safe
characters. Используййте %0d для символа перевод строки (LF), %20 для пробела и
так далее.
Пример:

mailto:email1;email2?cc=email3&subject=Это%20тема&body=это%20текст%20письма%0dЭто%20другая%20строка


------------------------------------------------------------
Q-31:  Как узнать IP машины по имени?
------------------------------------------------------------
uses
  WinSock;

const
  WINSOCK_VERSION = $0101;

function GetIPAddress(Name:String): string;
var
  WSAData : TWSAData;
  p : PHostEnt;
begin
  WSAStartup(WINSOCK_VERSION, WSAData);
  p := GetHostByName(PChar(Name));
  Result := inet_ntoa(PInAddr(p.h_addr_list^)^);
  WSACleanup;
end;


------------------------------------------------------------
Q-32:  Как из ActiveX запросить другую страницу в браузере?
------------------------------------------------------------
Смотрите urlmon.pas -> HLinkNavigateString.

К сожалению, это пройдет только под Internet Explorer.




------------------------------------------------------------
Q-33:  Какая реализация у ICQ и других Internet-пейджеров?
------------------------------------------------------------
Описание протокола: http://sophocles.mscom.ru/icq/
API: http://www.icq.com/api/


------------------------------------------------------------
Q-34:  Как у TWebBrowser отключить контекстное меню от правой кнопки мыши?
------------------------------------------------------------
http://www.compress.ru/Article.asp?id=1127


------------------------------------------------------------
Q-35:  Как узнать домен, к которому я в данный момент подключен? Используется
WinNT.
------------------------------------------------------------
Использовать функцию NetWkstaUserGetInfo, при этом учитывая две вещи:

0. The set of ported LAN Manager functions supported by MicrosoftR
WindowsR is based on the set of LAN Manager functions specified in
the LAN Manager 2.x Programmer's Reference. They are not a part
of the MicrosoftR Win32R application programming interface (API).

Certain LAN Manager functions are obsolete. Other LAN Manager
functions have been superseded. In addition, the MicrosoftR Windows
NTR operating system adds to the set of networking functions introduced
by LAN Manager.

1. В Delphi 5  ЕТ хедера с прототипом этой функции. Поэтому придется
ее импортировать самому.


------------------------------------------------------------
Q-36:  Как из своей программы вызвать диалог изменения настроек Internet?
------------------------------------------------------------
uses
  ShellApi;

{...}

ShellExecute(0, 0, 'inetcpl.cpl',...);


------------------------------------------------------------
Q-37:  Как определить наличие соединения c Internet?
------------------------------------------------------------
Следует подключить модуль WinInet.pas, в котором есть замечательная
функция InternetGetConnectedState...

Кстати, в этом модуле имеются заголовки еще массы других полезных
функций.

Предложение от Анатолия Подгорецкого

The easiest way to find out if and how (proxy, ras...) you are connected to the

Internet, without the overhead of installing components, is the following:

------------------------> Snippet
USES WinInet;
  ..
function InternetConnected: Boolean;
{
INTERNET_CONNECTION_MODEM  = 1; // local system uses a modem to
connect to the Internet.
INTERNET_CONNECTION_LAN        = 2; // local system uses a local area
network to connect to the Internet.
  INTERNET_CONNECTION_PROXY      = 4; // local system uses a proxy server to
connect to the Internet.
  INTERNET_CONNECTION_MODEM_BUSY = 8; // local system's modem is busy with a
non-Internet connection.
}
VAR
  dwConnectionTypes : DWORD;
BEGIN
  dwConnectionTypes :=
   INTERNET_CONNECTION_MODEM +
 INTERNET_CONNECTION_LAN +
 INTERNET_CONNECTION_PROXY;
  Result := InternetGetConnectedState(@dwConnectionTypes,0);
END;
<-------------------- Snippet

dwConnectiontype holds the appropriate flags after the call. This snippet comes
from
http://inner-smile.com/delphit2.htm



------------------------------------------------------------
Q-38:  Могут ли передаваться данные из html-страницы в программу (через
TWebBrowser)?
------------------------------------------------------------
Могyт. Подpобнее и с пpимеpами - зайди на стpаницy

http://www.calm.hw.ac.uk/davidf/papers/htmldlg.htm

или

http://sca.uwaterloo.ca/www.calm.hw.ac.uk/davidf/papers/htmldlg.htm


------------------------------------------------------------
Q-39:  Почему при использовании метода TWebBrowser.Navigate нужно указывать
полное имя файла?
------------------------------------------------------------
В соответствии с RFC 1808 браузер должен обрабатывать URL вида
[[[[протокол://]сервер]/][путь/]]страница
Если какая-то часть пропущена, браузер должен взять недостающее из
текущей страницы, или текущего URL, или из твоего приложения.

Поэтому, для загрузки файлов с локальных дисков нужно передавать
методу TWebBrowser.Navigate следующее:
file:///диск:/путь/имя-файла


------------------------------------------------------------
Q-40:  Как хранить web-страницы внутри файла?
------------------------------------------------------------
На сайте http://www.diagnostic.ru/delphi опубликована статья "Сайт внутри
EXE файла".

------------------------------------------------------------
Q-41:  Как определить свой IP адрес?
------------------------------------------------------------
uses
  WinSock;

function GetLocalIP: String;
const WSVer = $101;
var
  wsaData: TWSAData;
  P: PHostEnt;
  Buf: array [0..127] of Char;
begin
  Result := '';
  if WSAStartup(WSVer, wsaData) = 0 then begin
    if GetHostName(@Buf, 128) = 0 then begin
      P := GetHostByName(@Buf);
      if P <> nil then Result := iNet_ntoa(PInAddr(p^.h_addr_list^)^);
    end;
    WSACleanup;
  end;
end;


------------------------------------------------------------
Q-42:  Как с помощью Indy работать с Socks Proxy?
------------------------------------------------------------
Ответ для Indy9.

 а форму поместить TIdTCPClient, TIdIOHandlerSocket, TIdSocksInfo,
установить необходимые параметры, связать между собой:
TIdTCPClient.IOHandler := IdIOHandlerSocket1;
IdIOHandlerSocket.SocksInfo := IdSocksInfo1;

и, в принципе, все.

FAQmaker> если кто-то может дать более развернутый ответ на этот
FAQmaker> вопрос, то, пожалуйста, отправьте мне его по e-mail -
FAQmaker> будет использовано при обновлении FAQ


------------------------------------------------------------
Q-43:  Ищу исходники WEB-сервера на Object Pascal
------------------------------------------------------------
www.ritlabs.com


------------------------------------------------------------
Q-44:  Как в TWebBrowser организовать изменение размера шрифта?
------------------------------------------------------------
procedure TWebBrowserXXX.SetFontSize(nSize: OleVariant);
begin
  if (nSize >= 0) and (nSize <= 4) then
    ExecWB(OLECMDID_ZOOM, OLECMDEXECOPT_DONTPROMPTUSER, nSize)
end;


------------------------------------------------------------
Q-45:  Как перед активацией сокета определить, занят ли на данной машине нужный
порт?
------------------------------------------------------------
var SockAddrIn : TSockAddrIn;
    FSocket    : TSocket;

  ...

  If  bind(FSocket, SockAddrIn, SizeOf(SockAddrIn)) <> 0 Then
  begin
    обрабатываем WSAGetLastError
  end;


------------------------------------------------------------
Q-46:  Как скачать файл, используя proxy?
------------------------------------------------------------
DownloadFile('http://some.com/some.zip', 'c:\some.zip');

function DownloadFile(const FileURL, FileName: String): Cardinal;
var
  hSession, hFile: HInternet;
  Buffer: array[1..1024] of Byte;
  BufferLen, fSize: LongWord;
  f: File;
begin
  Result := 0;
  hSession := InternetOpen('STEROID Download',
                           INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);
  if Assigned(hSession) then begin
    hFile := InternetOpenURL(hSession, PChar(FileURL), nil, 0,
                             INTERNET_FLAG_RELOAD, 0);
    if Assigned(hFile) then begin
      AssignFile(f, FileName);
      Rewrite(f,1);
      fSize := 0;
      repeat
        InternetReadFile(hFile, @Buffer, SizeOf(Buffer), BufferLen);
        BlockWrite(f, Buffer, BufferLen);
        fSize := fSize + BufferLen;
      until (BufferLen = 0);
      CloseFile(f);
      Result := fSize;
      InternetCloseHandle(hFile);
    end;
    InternetCloseHandle(hSession);
  end;
end;

Комментарий:

function InternetOpen(lpszAgent: PChar;
                      dwAccessType: DWORD;
                      lpszProxy, lpszProxyBypass: PChar;
                      dwFlags: DWORD): HINTERNET; stdcall;
lpszAgent
  строка символов, которая передается серверу и идентифицирует
  программное обеспечение, пославшее запрос.

dwAccessType
  INTERNET_OPEN_TYPE_DIRECT : обрабатывает все имена хостов локально.
  INTERNET_OPEN_TYPE_PRECONFIG : берет установки из реестра.
  INTERNET_OPEN_TYPE_PRECONFIG_WITH_NO_AUTOPROXY - берет установки из
    реестра и предотвращает запуск Jscript или Internet Setup (INS)
    файлов.
! INTERNET_OPEN_TYPE_PROXY : использование прокси-сервера.
    В случае неудачи использует INTERNET_OPEN_TYPE_DIRECT.

LpszProxy - адрес прокси-сервера. Игнорируется только если параметр
    dwAccessType отличается от INTERNET_OPEN_TYPE_PROXY.

LpszProxyBypass - список имен или IP- адресов, соединяться с которыми
    нужно в обход прокси-сервера. В списке допускаются шаблоны. Так же,
    как и предыдущий параметр, не может содержать пустой строки. Если
    dwAccessType отличен от INTERNET_OPEN_TYPE_PROXY, то значения
    игнорируются, и параметр можно установить в nil.

DwFlags задает параметры, влияющие на поведение Internet- функций.
    Возможно применение комбинации из следующих разрешенных значений:
    INTERNET_FLAG_ASYNC, INTERNET_FLAG_FROM_CACHE,
    INTERNET_FLAG_OFFLINE.


------------------------------------------------------------
Q-47:  Как перед скачиванием узнать размер файла?
------------------------------------------------------------
GetUrlInfo(HTTP_QUERY_CONTENT_LENGTH, 'http://some.com/some.zip');

function GetUrlInfo(const dwInfoLevel: DWORD; const FileURL: string):
string;
var
  hSession, hFile: hInternet;
  dwBuffer: Pointer;
  dwBufferLen, dwIndex: DWORD;
begin
  Result := '';
  hSession := InternetOpen('STEROID Download',
                           INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);
  if Assigned(hSession) then begin
    hFile := InternetOpenURL(hSession, PChar(FileURL), nil, 0,
                             INTERNET_FLAG_RELOAD, 0);
    dwIndex  := 0;
    dwBufferLen := 20;
    if HttpQueryInfo(hFile, dwInfoLevel, @dwBuffer, dwBufferLen, dwIndex)
      then Result := PChar(@dwBuffer);
    if Assigned(hFile) then InternetCloseHandle(hFile);
    InternetCloseHandle(hsession);
  end;
end;


------------------------------------------------------------
Q-48:  Можно ли как-нибудь обеспечить стабильную работу на машинах со старыми
версиями WinInet?
------------------------------------------------------------
Еще кое-какой код, который может оказаться полезным в плане
обеспечения стабильной работы на машинах со старыми версиями
wininet.dll или вообще отсутствия оной.

var
  WinInetDLL: THandle =0;

  _InternetOpenA: function(lpszAgent: PAnsiChar; dwAccessType: DWORD;
                  lpszProxy, lpszProxyBypass: PAnsiChar;
                  dwFlags: DWORD): HINTERNET; stdcall;

  _InternetOpenURLA: function(hInet: HINTERNET; lpszUrl: PAnsiChar;
                     lpszHeaders: PAnsiChar; dwHeadersLength: DWORD;
                     dwFlags: DWORD; dwContext: DWORD): HINTERNET; stdcall;

  _InternetReadFile: function(hFile: HINTERNET; lpBuffer: Pointer;
                     dwNumberOfBytesToRead: DWORD;
                     var lpdwNumberOfBytesRead: DWORD): BOOL; stdcall;

  _InternetCloseHandle: function(hInet: HINTERNET): BOOL; stdcall;


procedure InitWinInet;
var
  OldError: Longint;
begin
  OldError := SetErrorMode(SEM_NOOPENFILEERRORBOX);
  try
    if WinInetDLL = 0 then begin
      WinInetDLL := LoadLibrary('wininet.dll');
      if WinInetDLL <> 0 then begin
        @_InternetOpenA :=
                        GetProcAddress(WinInetDLL,'InternetOpenA');
        @_InternetOpenURLA :=
                        GetProcAddress(WinInetDLL,'InternetOpenUrlA');
        @_InternetReadFile :=
                        GetProcAddress(WinInetDLL,'InternetReadFile');
        @_InternetCloseHandle :=
                        GetProcAddress(WinInetDLL,'InternetCloseHandle');
      end;
    end;
  finally
    SetErrorMode(OldError);
  end;
end;

  ...
  if WinInetDLL = 0 then InitWinInet;
  if WinInetDLL <> 0 then begin
    ...
  end else ShowMessageUser('Не могу загрузить WinInet.dll');
  ...

Секция 2 из 2 - Предыдущая - Следующая

где купить сусальное золото в москве цена
susalka.ru
Шлифованные бетонные полы вертолетом www.es-sk.ru
es-sk.ru

Вернуться в раздел "Языки Pascal/Delphi" - Обсудить эту статью на Форуме
Главная - Поиск по сайту - О проекте - Форум - Обратная связь

© faqs.org.ru