Мастера DELPHI (документация, исходники, скачать)

Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

« предыдущая ветвь | форум | следующая ветвь »

HTTPS и POST метод [D7, WinXP]

Alex_C © (2007-10-24 14:01:00)
Подскажите пожайлуста: есть страничка
https://www.arrl.org/lotw/upload
зайти туда может любой и загрузить свой фаил.
Как это сделать, кратко описано тут:
http://www.arrl.org/lotw/developer/uploads.html
Делал такой запрос:

const
multipart_boundary = '-----------------------------7cf87224d2020a';
...

PostStr := TStringList.Create;

// Создание header
PostStr.Add( 'Content-type: multipart/form-data, boundary=' + multipart_boundary );
PostStr.Add( 'Content-length: ' + FileSize(F) + Length('--' + multipart_boundary + '--')+2 );
PostStr.Add( '' );

// Заголовок
PostStr.Add( '--'+ multipart_boundary );
PostStr.Add( 'Content-Disposition: form-data; name="upfile"; filename="'+
CurrDir + '\Log\UploadToLoTW.tq8"');
PostStr.Add( 'Content-type: application/octet-stream' );
PostStr.Add( '' );

// Считываем фаил в файловый поток и копируем его в строковый поток
fstream := TFileStream.Create( CurrDir + '\Log\UploadToLoTW.tq8', fmOpenRead+fmShareDenyNone );
sstream := TStringStream.Create('');
sstream.CopyFrom(fstream, 0);
fstream.Free;
PostStr.Add(sstream.DataString);
sstream.Free;

// Добавляем окончание
PostStr.Add( '' );
PostStr.Add( '--' + multipart_boundary + '--' );

Вроде все как надо делаю, но не получается. Может кто подскажет?

MetalFan (2007-10-30 13:32:00) [1]
и хоть бы одна проверка результата, возвращаемого функциями...
да, одна есть)

Alex_C (2007-10-24 18:35:00) [2]
Гм. Это не извраты. Просто не хочу по опрелеленным причинам использовать дополнительные компоненты.
Сам запрос осуществляется так:
(я это нашел в инете и модифицировал для использования с https. Все с https работает - пробовал заполнять формы, а вот именно фаил загрузить не могу.)

function HTTPGet(URL, RequestMethod, PostQuery: String; ProgressProc: TProgresProc): String;
var
hSession, hConnect, hRequest: hInternet;
HostName, FileName: String;
dwBufLen, dwIndex: DWord;
Data: Array[0..$400] of Char;
BytesToRead, BytesReaded: DWord;
TempStr: String;
Buf: Pointer;
AcceptType: String;
IP: String;
HTTP_Port: DWord;
dwFlags, dwError: DWord;
SendReqestResult: Boolean;

procedure CloseHandles;
begin
InternetCloseHandle(hRequest);
InternetCloseHandle(hConnect);
InternetCloseHandle(hSession);
end;

begin
Result := '';

// Проверяем соединение
IP := LocalIP;
if (IP = '') or (IP = '127.0.0.1') then
Exit;

ParseURL(URL, HostName, FileName);

if Pos('https://', URL) <> 0 then
HTTP_Port := INTERNET_DEFAULT_HTTPS_PORT
else
HTTP_Port := INTERNET_DEFAULT_HTTP_PORT;

hSession := InternetOpen(nil, INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);
hConnect := InternetConnect (hSession, PChar(HostName),
HTTP_Port, nil, nil, INTERNET_SERVICE_HTTP, 0, 0);
AcceptType := PChar('Accept: image/gif, image/x-xbitmap, image/jpeg, image/pjpeg, application/msword, application/vnd.ms-excel, application/vnd.ms-powerpoint, */*');

if HTTP_Port = INTERNET_DEFAULT_HTTPS_PORT then
dwFlags := INTERNET_FLAG_SECURE or INTERNET_FLAG_IGNORE_CERT_CN_INVALID or INTERNET_FLAG_IGNORE_CERT_DATE_INVALID
else
dwFlags := 0;

dwFlags := dwFlags or INTERNET_FLAG_RELOAD;

hRequest := HttpOpenRequest(hConnect, PChar(RequestMethod), PChar(FileName), HTTP_VERSION,
nil, @AcceptType, dwFlags, 0);

if RequestMethod = 'GET' then
SendReqestResult := HttpSendRequest(hRequest, nil, 0, nil, 0)
else
SendReqestResult := HttpSendRequest(hRequest, 'Content-Type: application/x-www-form-urlencoded', 47,
PChar(PostQuery), Length(PostQuery));

if not SendReqestResult then
begin
dwError := GetLastError;
ShowMessage( 'Error connect: ' + IntToStr(dwError) );
end;

dwIndex := 0;
dwBufLen := 1024;
GetMem(Buf, dwBufLen);

HttpQueryInfo(hRequest, HTTP_QUERY_CONTENT_LENGTH or HTTP_QUERY_FLAG_NUMBER, Buf, dwBufLen, dwIndex);

BytesReaded := 0;
BytesToRead := 0;

try
while True do
begin
if not InternetReadFile(hRequest, @Data, SizeOf(Data), BytesToRead) then
Break
else
if BytesToRead = 0 then
Break
else
begin
TempStr := Data;
SetLength(TempStr, BytesToRead);
Result := Result + TempStr;
inc(BytesReaded, BytesToRead);
if Assigned(ProgressProc) then
ProgressProc(BytesReaded);
end;
end;
finally
FreeMem(Buf);
CloseHandles;
end;
end;

Выкинул чтоб не загламлять незначачие ф-ции. Основное - вот.

umbra (2007-10-24 14:52:00) [3]
а как сам запрос делается то?

Reindeer Moss Eater (2007-10-24 14:09:00) [4]
а зачем такие извраты, если у тебя семерка?

Наверх

	« предыдущая ветвь \| форум \| следующая ветвь »