Главная страница
Top.Mail.Ru    Яндекс.Метрика
Текущий архив: 2018.01.21;
Скачать: CL | DM;

Вниз

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;
Скачать: CL | DM;

Наверх




Память: 0.53 MB
Время: 0.005 c
4-1247728148
Кошкин
2009-07-16 11:09
2018.01.21
textout


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


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


15-1469568601
Юрий
2016-07-27 00:30
2018.01.21
С днем рождения ! 27 июля 2016 среда


15-1469741912
Германн
2016-07-29 00:38
2018.01.21
Оранжевый цвет