procedure TForm1.Button1Click(Sender: TObject);
var
sl: TStringList;
S,LstrCNonce,LstrResponse: string;
st: TFileStream;
i: Integer;
function HexToInt(Text: string): Integer;
const
Convert: array['0'..'f'] of SmallInt =
(0, 1, 2, 3, 4, 5, 6, 7, 8, 9,-1,-1,-1,-1,-1,-1,
-1,10,11,12,13,14,15,-1,-1,-1,-1,-1,-1,-1,-1,-1,
-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
-1,10,11,12,13,14,15);
var
I: Integer;
function Stepen(Number, count: integer): integer;
var
I: Integer;
begin
if Count=0 then
result:=1
else
begin
result:=Number;
for I := 1 to Count - 1 do
result:=result*Number;
end;
end;
begin
result:=0;
for I := length(Text) downto 1 do
result:=result+Convert[Text[I]]*Stepen(16,length(Text)-i);
end;
function RemoveQuote(const aStr: string):string;
begin
if (Length(aStr) >= 2) and (aStr[1] = '"') and (aStr[Length(aStr)] = '"') then
Result:=Copy(aStr,2,Length(aStr)-2)
else
Result := aStr;
end;
//эта функция просчитывает хэш md5 для передаваемой строки
function ResultString(const S: String): String;
begin
Result := '';
with TIdHashMessageDigest5.Create do
try
Result:=AnsiLowerCase(AsHex(HashValue(s)));
finally
Free;
end;
end;
begin
IdTCPClient.Host:='localhost';
IdTCPClient.Port:=8550;
IdTCPClient.Connect;
try
IdTCPClient.WriteLn('GET /page.htm HTTP/1.1');
IdTCPClient.WriteLn('Host: localhost:8550');
IdTCPClient.WriteLn('');
sl:=TStringList.Create;
try
//тут заранее знаю сколько строк в заголовке
IdTCPClient.ReadStrings(TStrings(sl),10);
Memo1.Lines.Assign(sl); //это для красоты, чтобы видеть результат
if pos('401',sl.Strings[0])>1 then
begin
//тут я заранее знаю в какой строке придёт заголовок с указанием на данные, необходимые для ответа
s:=trim(copy(sl.Strings[5],25,1024));
sl.Text:=StringReplace(s,', ',#13#10,[rfReplaceAll]); //превращаю в StringList для удобства работы со значениями
sl.Insert(0,'username="admin"'); //параметр имени пользователя
sl.Add('uri="/page.htm"'); //параметр запрашиваемой страницы
LstrCNonce:=ResultString(DateTimeToStr(Now));
sl.Add('cnonce="'+LstrCNonce+'"'); //добавляю уникальный код, по которому будет вести проверку сервер
sl.Add('nc=00000001'); //счётчик попыток
//тут собирается воедино всё что требуется по RFC2617
//admin в первом случае - логин, во втором - пароль
LstrResponse:=ResultString(ResultString('admin:'+RemoveQuote(sl.Values['realm'])+':admin')+':'+
RemoveQuote(sl.Values['nonce'])+':00000001:'+LstrCNonce+
':auth:'+ResultString('GET:/page.htm'));
sl.Add('response="'+LstrResponse+'"');
s:='Authorization: Digest '+stringreplace(sl.Text,#13#10,',',[rfReplaceAll]);
Delete(s,length(s),1);
sl.Clear;
//отправляем обратно авторизацию
IdTCPClient.WriteLn('GET /page.htm HTTP/1.1');
IdTCPClient.WriteLn('Host: localhost:8550');
IdTCPClient.WriteLn(s);
IdTCPClient.WriteLn('');
IdTCPClient.ReadStrings(TStrings(sl),10);
Memo1.Lines.Assign(sl);
//тут по идее надо вставить проверку на ответ 200
//плюс я заранее знаю что для этого примера у меня приходит картинка и chunked передача
st:=TFileStream.Create('C:\qwe.jpg',fmCreate);
try
s:=IdTCPClient.ReadLn;
while s<>'0' do
begin
i:=HexToInt(s);
IdTCPClient.ReadStream(st,i);
s:=IdTCPClient.ReadLn;
s:=IdTCPClient.ReadLn;
end;
finally
FreeAndNil(st);
end;
end;
finally
FreeAndNil(sl);
end;
finally
IdTCPClient.Disconnect;
end;
end;
