Как закачать страничку, только текст (без картинок!)
bsa © (2004-09-09 14:09:00)
сабж
Rouse_ (2004-09-09 14:54:00) [1]
////////////////////////////////////////////////////////////////////////////////
//
// Демо получения HTML кода страницы
// Автор: Александр (Rouse_) Багель
// © Fangorn Wizards Lab 1998 - 2003
// 19 января 2003
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('www.delphimaster.ru');
end;
end.
Наверх 
ЧАТ |
Орешник |
|
