Главная страница
    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.035 c
1-1109744968
WishMaster
2005-03-02 09:29
2005.03.13
маааленькая программулина


1-1109693035
Expl
2005-03-01 19:03
2005.03.13
Как определить создан ли экземпляр какого-либо класса?


10-1086174226
LexKz
2004-06-02 15:03
2005.03.13
Word


11-1092467454
Dmitry
2004-08-14 11:10
2005.03.13
Не работают хинты в KOL


3-1107988279
UVV
2005-02-10 01:31
2005.03.13
Oracle и тип date





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