| Форумы
ЧАТ |
Орешник |
|
| Форумы -» | Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG |
|
| ||
|
|
Новости |
Поиск |
FAQ |
Статьи |
Книги |
Новости VCL
| | Форумы ЧАТ |
Орешник |
|
| |||
| |||
| |||
« предыдущая ветвь | форум | следующая ветвь »
NTLM-аутентификация - через что лучше и как? [D7]
GRAND © (2010-09-07 10:04:00)Сколько лет, сколько зим - здравствуйте, уважаемые!
Вот проблемка, блин, всего-то выкачать страничку из инета для дальнейшей обработки - ан никак! :( В сети NTLM-аутентификация, Indy для этой цели не прокатила, а в synapse я такой возможности вообще не нашел. Я плохо искал или можно поюзать что-нибудь более прогрессивное?
Дмитрий Тимохов (2010-09-10 17:06:00) [1]Тут в общем, некая моя специфика, но идея, думаю, понятна.
Дмитрий Тимохов (2010-09-10 17:04:00) [2]У меня что-то типа такого (не судите строго):
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:00) [3]
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:01:00) [4]Не надо ни Indy, ни ICS. Я долго бился и с тем и другим на предмет работы в различных конфигурация прокси (уже и деталей не помню) и всяких аутентификациях на них.
В итоге остановился на WinINet ( http://msdn.microsoft.com/en-us/library/aa385331%28VS.85%29.aspx).
У меня эта штука ходит через все прокси, на которых я тестировал и обрабатывает всякую аутентификацию.
GRAND (2010-09-09 11:36:00) [5]HttpCli1.RcvdStream.Seek(0,0) таки помогло, да :)
GRAND (2010-09-09 09:46:00) [6]А куды ж ее менять-то в ПУСТОМ потоке? Да и зачем?
Anatoly Podgoretsky (2010-09-08 18:34:00) [7]> GRAND (08.09.2010 15:46:02) [2]
А позицию потока Пушкин будет менять?
GRAND (2010-09-08 15:46:00) [8]Да, вспомнил о существовании такой штуки, скачал, попробовал. Аутентификация проходит, все вроде бы нормально, но почему-то RcvdStream после Get возвращается абсолютно пустой. В хедере имеем 200 OK. Странно... Приведу кусок кода на всякий случай:
HttpCli1.URL:=' http://delphimaster.ru';
HttpCli1.RcvdStream:=TStringStream.Create('');
HttpCli1.Get;
Memo1.Lines.LoadFromStream(HttpCli1.RcvdStream)
Anatoly Podgoretsky (2010-09-07 20:58:00) [9]> GRAND (07.09.2010 10:04:00) [0]
ICS?
| |
