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

Вниз

Послать запрос скрипту на сервере и получить ответ   Найти похожие ветки 

 
TButton ©   (2005-01-10 19:09) [0]

Доброго времени суток, господа умные дядьки и тетьки (если таковые имеются)
Задача (см. сабж):
есть некий сервер, на котором есть некий скрипт, полуающий запросы и выдающий ответы.
нужно программно послать запрос и получить ответ.
используя для этого TClientSocket.

Например (чистая абстракция):
http://www.marcuch.ru/lib.pl?theme=Delphi
возвращает страницу со списком, скажем ссылок на F.A.Q.

ПыСы
Искал по форуму и сайту, ничего не нашел, наверное хреново искал.

ПыПыСы
буду рад и совету, и ссылке, и коду (главное - чтоб в тему)


 
Rouse_ ©   (2005-01-10 19:46) [1]

unit Unit1;

interface

uses
 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
 Dialogs, ComCtrls, Wininet, StdCtrls;

const
 HTTP_PORT = 80;
 CLRF = #13#10;
 Header = "Content-Type: application/x-www-form-urlencoded" + CLRF;

type
 TForm1 = class(TForm)
   Button1: TButton;
   Memo1: TMemo;
   procedure Button1Click(Sender: TObject);
 end;

var
 Form1: TForm1;

implementation

{$R *.dfm}

function DelHttp(URL: String): String;
begin
 if Pos("http://", URL) > 0 then Delete(Url, 1, 7);
 Result := Copy(Url, 1, Pos("/", Url) - 1);
 if Result = "" then Result := URL;
end;

function GetUrl(const URL: String): String;
var
 FSession, FConnect, FRequest: HINTERNET;
 FHost, FScript: String;
 Ansi: PAnsiChar;
 Buff: array [0..1023] of Char;
 BytesRead: Cardinal;
begin
 Result := "";
 // Небольшой парсинг
 // вытаскиваем имя хоста и параметры обращения к скрипту
 FHost := DelHttp(Url);
 FScript := Url;
 Delete(FScript, 1, Pos(FHost, FScript) + Length(FHost));

 // Инициализируем WinInet
 FSession := InternetOpen("DMFR", INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);
 if not Assigned(FSession) then Exit;
 try
   // Попытка соединения с сервером
   FConnect := InternetConnect(FSession, PChar(FHost), HTTP_PORT, nil,
                               "HTTP/1.0", INTERNET_SERVICE_HTTP, 0, 0);
   if not Assigned(FConnect) then Exit;
   try
     // Подготавливаем запрос страницы
     Ansi := "text/*";
     FRequest := HttpOpenRequest(FConnect, "GET", PChar(FScript), "HTTP/1.0",
                                 "", @Ansi, INTERNET_FLAG_RELOAD, 0);
     if not Assigned(FConnect) then Exit;
     try
       // Добавляем заголовки
       if not (HttpAddRequestHeaders(FRequest, Header, Length(Header),
                                     HTTP_ADDREQ_FLAG_REPLACE or
                                     HTTP_ADDREQ_FLAG_ADD)) then Exit;
       // Отправляем запрос
       if not (HttpSendRequest(FRequest, nil, 0, nil, 0)) then Exit;
       // Получаем ответ
       FillChar(Buff, SizeOf(Buff), 0);
       repeat
         Result := Result + Buff;
         FillChar(Buff, SizeOf(Buff), 0);
         InternetReadFile(FRequest, @Buff, SizeOf(Buff), BytesRead);
       until BytesRead = 0;
     finally
       InternetCloseHandle(FRequest);
     end;
   finally
     InternetCloseHandle(FConnect);
   end;
 finally
   InternetCloseHandle(FSession);
 end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
 Memo1.Text := GetUrl("http://www.marcuch.ru/lib.pl?theme=Delphi");
end;

end.


 
TButton ©   (2005-01-10 20:08) [2]

благодарю. а можно вопрос?
каково значение константы header
я так предполагал что там будет text/html


 
Piter ©   (2005-01-10 20:18) [3]

TButton ©   (10.01.05 20:08) [2]
каково значение константы header


В примере же явно указано:

Header = "Content-Type: application/x-www-form-urlencoded" + CLRF;

и это очень грамотно. Потому что некоторые скрипты могут возвращать совсем не то, если не указать данный параметр в заголовке HTTP пакета.


 
TButton ©   (2005-01-10 23:52) [4]


> каково значение константы header

пардон, не правильно выразился. каков смысл ее значения?


 
Piter ©   (2005-01-11 00:12) [5]

TButton ©   (10.01.05 23:52) [4]
каков смысл ее значения?


Указывает какой тип контента готов принять клиент.

Piter ©   (10.01.05 20:18) [3]
Потому что некоторые скрипты могут возвращать совсем не то, если не указать данный параметр в заголовке HTTP пакета


 
TButton ©   (2005-01-11 00:58) [6]

т.е. типа, вариант универсальный?


 
Piter ©   (2005-01-11 09:45) [7]

типа, типа...

Что значит универсальный?


 
Seeker ©   (2005-01-11 10:48) [8]


> Rouse_ ©

Код конечно правильный, но есть маленький нюанс.Если взять снифер и посмотреть отправляемые заголовки, то можно увидеть что неизвестно откуда к "text/*" добавляется всякий мусор.На многих серверах это проходит,но есть такие где это не проходит.
В этом случае строку
Ansi := "text/*";
нужно заменить на
FillChar(Ansi, SizeOf(""), 0);
а Header = "Content-Type: application/x-www-form-urlencoded" + CLRF; наHeader = "text/*"+CLRF+"Content-Type: application/x-www-form-urlencoded" + CLRF;
Тогда этот мусор пропадет.



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

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

Наверх




Память: 0.47 MB
Время: 0.038 c
3-1108452396
DmitriyG
2005-02-15 10:26
2005.03.13
TBDECallBack + MSSQL


4-1106907887
MiF
2005-01-28 13:24
2005.03.13
Помогите получить список групп из Active Directory


3-1107890484
XAN
2005-02-08 22:21
2005.03.13
QReport+Unicode


1-1109420012
ser35
2005-02-26 15:13
2005.03.13
как отобразить данные комбобоксов?


8-1101173290
fashionguide
2004-11-23 04:28
2005.03.13
BassPlayer





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
Английский Французский Немецкий Итальянский Португальский Русский Испанский