Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Сети";
Текущий архив: 2018.01.21;
Скачать: [xml.tar.bz2];

Вниз

NTLM-аутентификация - через что лучше и как?   Найти похожие ветки 

 
GRAND ©   (2010-09-07 10:04) [0]

Сколько лет, сколько зим - здравствуйте, уважаемые!

Вот проблемка, блин, всего-то выкачать страничку из инета для дальнейшей обработки - ан никак! :( В сети NTLM-аутентификация, Indy для этой цели не прокатила, а в synapse я такой возможности вообще не нашел. Я плохо искал или можно поюзать что-нибудь более прогрессивное?


 
Anatoly Podgoretsky ©   (2010-09-07 20:58) [1]

> GRAND  (07.09.2010 10:04:00)  [0]

ICS?


 
GRAND ©   (2010-09-08 15:46) [2]

Да, вспомнил о существовании такой штуки, скачал, попробовал. Аутентификация проходит, все вроде бы нормально, но почему-то RcvdStream после Get возвращается абсолютно пустой. В хедере имеем 200 OK. Странно... Приведу кусок кода на всякий случай:

 HttpCli1.URL:="http://delphimaster.ru";
 HttpCli1.RcvdStream:=TStringStream.Create("");
 HttpCli1.Get;
 Memo1.Lines.LoadFromStream(HttpCli1.RcvdStream)


 
Anatoly Podgoretsky ©   (2010-09-08 18:34) [3]

> GRAND  (08.09.2010 15:46:02)  [2]

А позицию потока Пушкин будет менять?


 
GRAND ©   (2010-09-09 09:46) [4]

А куды ж ее менять-то в ПУСТОМ потоке? Да и зачем?


 
GRAND ©   (2010-09-09 11:36) [5]

HttpCli1.RcvdStream.Seek(0,0) таки помогло, да :)


 
Дмитрий Тимохов   (2010-09-10 17:01) [6]

Не надо ни Indy, ни ICS. Я долго бился и с тем и другим на предмет работы в различных конфигурация прокси (уже и деталей не помню) и всяких аутентификациях на них.

В итоге остановился на WinINet (http://msdn.microsoft.com/en-us/library/aa385331%28VS.85%29.aspx).

У меня эта штука ходит через все прокси, на которых я тестировал и обрабатывает всякую аутентификацию.


 
Дмитрий Тимохов   (2010-09-10 17:04) [7]

У меня что-то типа такого (не судите строго):



unit HTTPClientImpl;

{$Q-}
{$R-}

interface

uses
  Classes, Windows, SysUtils, WinINet;

type
  THTTPClientImpl = class sealed(TObject)

     // == <<public>>

     // Синхронно выполняет запрос.
     public procedure Request(
        const aServerTimeout: Integer; // в секундах
        const aServerAddress: String;
        const aServerPort: Integer;
        const aServerPath: String;
        const aServerUserName: String;
        const aServerPassword: String;
        const aAccessType: Cardinal;
        const aProxyServerAddress: String;
        const aProxyServerPort: Integer;
        const aProxyServerUserName: String;
        const aProxyServerPassword: String;
        const aRequestData: TMemoryStream;
        const aReplyData: TMemoryStream);

     // == <<private>>

     strict private class procedure fRaiseLastWinINetError(
        const aDetails: String = ""); static;
     strict private class procedure fAddHttpHeader(
        const aRequest: HINTERNET; const aValue: String); static;
     strict private const CLRF = #13#10;
  end;

implementation

procedure THTTPClientImpl.Request;
label
  ResendRequest;
const
  cAgent = "BC_HTTP_CLIENT_V1.1";
var
  kSession, kConnect, kRequest: HINTERNET;
  kBytesRead: Cardinal;
  kReplyStatusCode, kReplyStatusCodeBufferSize,
  kReplyContentLength, kReplyContentLengthBufferSize,
  kHTTPQueryInfoIndex, kBytesAvailable: DWORD;
  kReplyStatusMessage: String;
  kReplyData: TMemoryStream;
  kReplyBuff: packed array of Byte;
  kServerTimeout: DWord;
  kServerPath: String;
  kProxyServerAuthIsSet, kServerAuthIsSet: Boolean;
begin
  kHTTPQueryInfoIndex := 0;

  kSession := nil;
  kConnect := nil;
  kRequest := nil;
  kReplyData := nil;
  try

     case aAccessType of

        INTERNET_OPEN_TYPE_DIRECT:
        begin
           kSession := InternetOpen(
              cAgent,
              INTERNET_OPEN_TYPE_DIRECT,
              "",
              "",
              0);
           if kSession = nil then
              fRaiseLastWinINetError("InternetOpen");
        end;

        INTERNET_OPEN_TYPE_PROXY:
        begin
           kSession := InternetOpen(
              cAgent,
              INTERNET_OPEN_TYPE_PROXY,
              PChar(aProxyServerAddress + ":" + IntToStr(aProxyServerPort)),
              "",
              0);
           if kSession = nil then
              fRaiseLastWinINetError("InternetOpen");
        end;

        INTERNET_OPEN_TYPE_PRECONFIG:
        begin
           kSession := InternetOpen(
              cAgent,
              INTERNET_OPEN_TYPE_PRECONFIG,
              "",
              "",
              0);
           if kSession = nil then
              fRaiseLastWinINetError("InternetOpen");
        end;

        else
           Assert(False);
     end;

     // Установка параметров сессии
     kServerTimeout := aServerTimeout * 1000;

     if not InternetSetOption(kSession, INTERNET_OPTION_CONNECT_TIMEOUT,
        @kServerTimeout, SizeOf(kServerTimeout))
     then
        fRaiseLastWinINetError("InternetSetOption");

     if not InternetSetOption(kSession, INTERNET_OPTION_SEND_TIMEOUT,
        @kServerTimeout, SizeOf(kServerTimeout))
     then
        fRaiseLastWinINetError("InternetSetOption");

     if not InternetSetOption(kSession, INTERNET_OPTION_RECEIVE_TIMEOUT,
        @kServerTimeout, SizeOf(kServerTimeout))
     then
        fRaiseLastWinINetError("InternetSetOption");

     // Попытка соединения с сервером
     kConnect := InternetConnect(
        kSession,
        PChar(Trim(aServerAddress)),
        aServerPort,
        "",
        "",
        INTERNET_SERVICE_HTTP,
        0,
        0);
     if kConnect = nil then
        fRaiseLastWinINetError("InternetConnect");

     // Подготавливаем запрос
     kServerPath := Trim(aServerPath);
     if (Length(kServerPath) > 0) and (kServerPath[1] <> "/") then
        kServerPath := "/" + kServerPath;
     // Добавляем параметр, чтобы заведомо предотвратить кеширование
     kServerPath := kServerPath + "?param=" + IntToStr(Random(MaxInt));
     kRequest := HttpOpenRequest(
        kConnect,
        "POST",
        PChar(kServerPath),
        "",
        "",
        nil,
        INTERNET_FLAG_RELOAD or INTERNET_FLAG_NO_CACHE_WRITE or INTERNET_FLAG_KEEP_CONNECTION,
        0);
     if kRequest = nil then
        fRaiseLastWinINetError("HttpOpenRequest");

     // Добавление заголовков
     fAddHttpHeader(kRequest, "Pragma: no-cache");
     fAddHttpHeader(kRequest, "Accept: */*");
     fAddHttpHeader(kRequest, "Content-Type: application/x-www-form-urlencoded");
     fAddHttpHeader(kRequest, "Content-Length: " + IntToStr(aRequestData.Size));
     fAddHttpHeader(kRequest, "Connection: Keep-Alive");
     // Cтрока важна для работы через прокси.
     // Без этой строки в режиме INTERNET_OPEN_TYPE_PROXY происходит подвисание,
     // причем вроде как со стороны клиента.
     // Видимо причина в том, что рвется соединение.
     fAddHttpHeader(kRequest, "Proxy-Connection: Keep-Alive");

     // Отправляем запрос

     kServerAuthIsSet := False;
     kProxyServerAuthIsSet := False;

     ResendRequest:

     if not HttpSendRequest(kRequest, nil, 0, aRequestData.Memory, aRequestData.Size) then
        fRaiseLastWinINetError("HttpSendRequest");

     // Получаем status code
     kReplyStatusCodeBufferSize := 4;
     if not HttpQueryInfo(kRequest, HTTP_QUERY_STATUS_CODE or HTTP_QUERY_FLAG_NUMBER,
        @kReplyStatusCode, kReplyStatusCodeBufferSize, kHTTPQueryInfoIndex)
     then
        fRaiseLastWinINetError("HttpQueryInfo");

     // Обработаем известные ошибки сразу
     if kReplyStatusCode = 407 then
     begin
        if kProxyServerAuthIsSet or (aProxyServerUserName = "") then
        begin
           raise Exception.Create(
              "Для доступа к прокси-серверу необходимо задать "+
              "имя пользователя и пароль!");
        end
        else
        begin
           InternetSetOption(
              kRequest,
              INTERNET_OPTION_PROXY_USERNAME,
              PChar(aProxyServerUserName),
              Length(aProxyServerUserName)+1);

           InternetSetOption(
              kRequest,
              INTERNET_OPTION_PROXY_PASSWORD,
              PChar(aProxyServerPassword),
              Length(aProxyServerPassword)+1);

           kProxyServerAuthIsSet := True;

           goto ResendRequest;
        end;
     end;

to be continued


 
Дмитрий Тимохов   (2010-09-10 17:04) [8]


     if kReplyStatusCode = 401 then
     begin
        if kServerAuthIsSet or (aServerUserName = "") then
        begin
           raise Exception.Create(
              "Для доступа к серверу необходимо задать "+
              "имя пользователя и пароль!");
        end
        else
        begin
           InternetSetOption(
              kRequest,
              INTERNET_OPTION_USERNAME,
              PChar(aServerUserName),
              Length(aServerUserName)+1);

           InternetSetOption(
              kRequest,
              INTERNET_OPTION_PASSWORD,
              PChar(aServerPassword),
              Length(aServerPassword)+1);

           kServerAuthIsSet := True;

           goto ResendRequest;
        end;
     end;

     if kReplyStatusCode = 403 then
        raise Exception.Create(
           "Доступ к указанному пути на сервере запрещен!");

     if (kReplyStatusCode = 404) or
        (kReplyStatusCode = 405)
     then
        raise Exception.Create(
           "Неверно задан путь!");

     if kReplyStatusCode = 502 then
        raise Exception.Create(
           "Неверно заданы параметры прокси-сервера!");

     // Временный поток для ответа. Потом либо получаем из него детали ошибки,
     // либо (если нет ошибки) преобразуем его к aReplyData.
     kReplyData := TMemoryStream.Create();

     // Получаем длину данных
     kReplyContentLengthBufferSize := 4;
     kHTTPQueryInfoIndex := 0;
     if HttpQueryInfo(kRequest, HTTP_QUERY_CONTENT_LENGTH or HTTP_QUERY_FLAG_NUMBER,
        @kReplyContentLength, kReplyContentLengthBufferSize, kHTTPQueryInfoIndex) then
     begin
        while kReplyData.Size < kReplyContentLength do
        begin
           if not InternetQueryDataAvailable(kRequest, kBytesAvailable, 0, 0) then
              fRaiseLastWinINetError("InternetQueryDataAvailable");

           SetLength(kReplyBuff, kBytesAvailable);

           if not InternetReadFile(kRequest, @kReplyBuff[0], kBytesAvailable, kBytesRead) then
              fRaiseLastWinINetError("InternetReadFile");

           kReplyData.Write(kReplyBuff[0], kBytesRead);
        end;
     end
     else
     begin
        // Я плохо разбираюсь в HTTP, но я понял, что вообще говоря
        // Content-Length может часто не возвращаться. В этом случае
        // WinInet сам как-то определит, длину сообщения. Насколько я понимаю
        // это может быть либо по разрыву соедения, либо по специальному
        // кодированию тела с помощью заголовка Transfer-Endoding.

        if GetLastError <> ERROR_HTTP_HEADER_NOT_FOUND then
           fRaiseLastWinINetError("HttpQueryInfo.2");

        // Считаем, что прочтется
        SetLength(kReplyBuff, 8*1024);
        while InternetReadFile(kRequest, @kReplyBuff[0],
           Length(kReplyBuff), kBytesRead) do
        begin
           if kBytesRead > 0 then
              kReplyData.Write(kReplyBuff[0], kBytesRead)
           else
             Break;
        end;
     end;

     // В зависимости от статуса считаем - либо ошибкой HTTP, либо нет.
     if kReplyStatusCode = 200 then
     begin
        aReplyData.Size := 0;
        aReplyData.CopyFrom(kReplyData, 0{т.е. все копируем});
        aReplyData.Position := 0; // Так вроде где-то в контракте обещал делать
     end
     else
     begin
        // Далее нужно решить, что показывать пользователю: если сообщение
        // не является HTML и не длинней заданной длины, то покажем его,
        // иначе покажем только строку c номером ошибки.

        SetLength(kReplyStatusMessage, kReplyData.Size);
        kReplyData.Position := 0;
        kReplyData.Read(Pointer(kReplyStatusMessage)^, kReplyData.Size);

        if (Length(kReplyStatusMessage) < 300) and
           (Pos("<", kReplyStatusMessage) = 0) and
           (Pos(">", kReplyStatusMessage) = 0) and
           (Pos("</", kReplyStatusMessage) = 0)
        then
           raise Exception.Create(Format("Неверный ответ сервера %d:"#13"%s!",
              [kReplyStatusCode, kReplyStatusMessage]))
        else
           raise Exception.Create(Format("Неверный ответ сервера %d",
              [kReplyStatusCode]));
     end;
  finally
     if kRequest <> nil then
        InternetCloseHandle(kRequest);
     if kConnect <> nil then
        InternetCloseHandle(kConnect);
     if kSession <> nil then
        InternetCloseHandle(kSession);
     if kReplyData <> nil then
        kReplyData.Free;
  end;
end;

class procedure THTTPClientImpl.fRaiseLastWinINetError(const aDetails: String = "");
var
  kLastError: DWORD;
begin
  kLastError := GetLastError();

  if (kLastError >= INTERNET_ERROR_BASE) and (kLastError <= INTERNET_ERROR_LAST) then
  begin
     case kLastError of
        ERROR_INTERNET_TIMEOUT:
           raise Exception.CreateFmt(
              "Первышено время выполнения операции (12002, %s)", [aDetails]);
        ERROR_INTERNET_INVALID_URL:
           raise Exception.CreateFmt(
              "Не корректный URL (12005, %s)", [aDetails]);
        ERROR_INTERNET_NAME_NOT_RESOLVED:
           raise Exception.CreateFmt(
              "Сервер не найден по имени (12007, %s)", [aDetails]);
        ERROR_INTERNET_CANNOT_CONNECT:
           raise Exception.CreateFmt(
              "Не могу соединиться с сервером (12029, %s)", [aDetails]);
        else
           RaiseLastOsError();
     end;
  end
  else
  begin
     RaiseLastOsError();
  end;
end;

class procedure THTTPClientImpl.fAddHttpHeader(
  const aRequest: HINTERNET; const aValue: String);
var
  kValue: String;
begin
  kValue := aValue + CLRF;
  if not HttpAddRequestHeaders(aRequest, PChar(kValue),
     Length(kValue), HTTP_ADDREQ_FLAG_REPLACE or HTTP_ADDREQ_FLAG_ADD)
  then
     fRaiseLastWinINetError("HttpAddRequestHeaders");
end;

end.



 
Дмитрий Тимохов   (2010-09-10 17:06) [9]

Тут в общем, некая моя специфика, но идея, думаю, понятна.



Страницы: 1 вся ветка

Форум: "Сети";
Текущий архив: 2018.01.21;
Скачать: [xml.tar.bz2];

Наверх





Память: 0.52 MB
Время: 0.002 c
15-1468837479
ВладОшин
2016-07-18 13:24
2018.01.21
Протестировать из программы качество соединения RDP


2-1455036814
sTDally
2016-02-09 19:53
2018.01.21
TImage


15-1469482202
Юрий
2016-07-26 00:30
2018.01.21
С днем рождения ! 26 июля 2016 вторник


2-1455005752
MS_Office
2016-02-09 11:15
2018.01.21
Установлен ли MSOffice 2010?


15-1469731224
iop
2016-07-28 21:40
2018.01.21
вернуться назад (rdp)





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский