Sergei Dubarev пишет:

Ваши "Советы…" — классная штука. Столько всего вкусного! :-) Со своей стороны хочу предложить несколько тормозной и местами упрощенный, но все же рабочий ;), алгоритм UUE кодирования (см. аттач). Не вершина искусства, но все же… :)

Для того, чтобы ОНО заработало, необходимо создать проект в составе:

Форма (form) — 1 шт. Поле ввода (edit) — 2 шт., используются события OnDblClick. Кнопка (button) — 1 шт., используется событие OnClick. Диалог открытия файла (Open Dialog) — 1 шт. Диалог сохранения файла (Save Dialog) — 1 шт.

Имена файлов будут вводится либо вручную, либо из диалога (double-click на поле ввода edit), причем в edit1.text должно лежать имя входного файла, в edit2.text — выходного. По нажатии кнопки пойдет процесс, который завершится сообщением "DONE."

Всего хорошего.

P.S. Функция toanysys обнаружена в книге "Для чего нужны и как работают персональные ЭВМ" от 1990 г. Там она присутствует в виде программы на BASIC'e.

P.P.S. Для стимулирования фантазии читателей "Советов…" высылаю так же мессагу из эхи, на основе которой я сваял свое чудо.

//UUE кодирование

unit Unit1;

interface

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

type TForm1 = class(TForm)

 Button1: TButton;

 Edit1: TEdit;

 Edit2: TEdit;

 OpenDialog1: TOpenDialog;

 SaveDialog1: TSaveDialog;

 procedure Edit1DblClick(Sender: TObject);

 procedure Edit2DblClick(Sender: TObject);

 procedure Button1Click(Sender: TObject);

private

  { Private declarations }

public

  { Public declarations }

end;

var Form1: TForm1;

implementation

{$R *.DFM}

const

 ssz = (High(Cardinal) - $F) div sizeof(byte);//эта константа используется при выделении памяти

 p: string = '0123456789ABCDEF';//эта константа используется функцией toanysys

//выбор входного файла

procedure TForm1.Edit1DblClick(Sender: TObject);

begin

 if opendialog1.execute then edit1.text:= opendialog1.filename;

end;

//выбор выходного (UUE) файла

procedure TForm1.Edit2DblClick(Sender: TObject);

begin

 if savedialog1.execute then edit2.text:= savedialog1.filename;

end;

//выделение подстроки

function mid(s: string; fromc, toc: byte): string;

var

 s1: string;

 i : byte;

begin

 s1:= '';

 for i:= fromc to toc do s1:= s1+s[i];

 mid:= s1;

end;

//перевод числа (a) из десятичной системы в другую

//с основанием (r)

function toanysys(a, r: byte): string;

var

 s, k : string;

 n,m,i : byte;

begin

 s:='';

 m:= 1;

 while m<>0 do begin

  m:= a div r;

  n:= a-m*r+1;

  k:= p[n];

  s:= k+s;

  a:= m;

 end;

 //добавляет незначащие нули

 for i:=1 to 8-length(s) do s:='0'+s;

 toanysys:= s;

end;

//перевод 6-разрядного числа из двоичной системы в десятичную

//двоичное число подставляется в виде строки символов

function frombin(s: string): byte;

var i, e, b: byte;

begin

 b:= 0;

 for i:=1 to 6 do begin

  e:= 1 shl (6-i);

  if s[i]='1' then b:= b+e;

 end;

 frombin:= b;

end;

//непосредственно кодирование

type tcoola = array [1..1] of byte;

pcoola = ^tcoola;

procedure TForm1.Button1Click(Sender: TObject);

var

 inf: file of byte;

 ouf: textfile;

 uue: pcoola;

 b  : array[1..4] of byte;

 bin,t  : string;

 szf,oum,szl,szh,sxl,sxh,i, j  : longint;

begin

 {$I-}

 assignfile(inf, edit1.text); //входной файл

 reset(inf);

 szf:= filesize(inf);    //

 szh:= (szf*8) div 6;    //

 if szf*8-szh*6 = 0 then szl:= 0

 else szl:= 1;      //

 getmem(uue, szh+szl); //выделение памяти

 oum:= 1;

 while not(eof(inf)) do begin

  b[1]:= 0;

  b[2]:= 0;

  b[3]:= 0;

  b[4]:= 0;

  //чтение должно быть сделано посложнее,

  //дабы избежать "read beyond end of file"

  read(inf, b[1], b[2], b[3]);

  //читаем 3 байта из входного файла

  //и формируем "двоичную" строку

  bin:= toanysys(b[1],2)+toanysys(b[2],2)+toanysys(b[3],2);

  //разбиваем строку на куски по 6 бит и добавляем 32

  t:= mid(bin, 19, 24);

  b[4]:= frombin(t)+32;

  t:=mid(bin, 13, 18);

  b[3]:= frombin(t)+32;

  t:= mid(bin, 07, 12);

  b[2]:= frombin(t)+32;

  t:= mid(bin, 01, 06);

  b[1]:= frombin(t)+32;

  //запихиваем полученнные байты во временный массив

  uue[oum]:= b[1];

  oum:= oum+1;

  uue[oum]:= b[2];

  oum:= oum+1;

  uue[oum]:= b[3];

  oum:= oum+1;

  uue[oum]:= b[4];

  oum:= oum+1;

 end;

 //входной файл больше не нужен - закрываем его

 closefile(inf);

 //формируем выходной файл

 assignfile(ouf, edit2.text); //выходной файл

 rewrite(ouf);

 oum:= 1;

 sxh:= (szh+szl) div 60; //число строк в UUE файле

 sxl:= (szh+szl)-sxh*60;

 //заголовок UUE-файла

 writeln(ouf, 'begin 644 '+extractfilename(edit1.text));

 //записываем строки в файл

 for i:=1 to sxh do begin

  write(ouf, 'M');

  // 'M' значит, что в строке 60 символов

  for j:= 1 to 60 do begin

   write(ouf, chr(uue[oum]));

   oum:= oum+1;

  end;

  writeln(ouf);

 end;

 //записываем последнюю строку, которая//обычно короче 60 символов

 sxh:= (sxl*6) div 8;

 write(ouf, chr(sxh+32));

 for i:= 1 to sxl do begin

  write(ouf, chr(uue[oum]));

  oum:= oum+1;

 end;

 // "добиваем" строку незначащими символами

 for i:= sxl+1 to 60 do write(ouf, '`');

 //записываем последние строки файла

 writeln(ouf);

 writeln(ouf, '`');

 writeln(ouf, 'end');

 closefile(ouf);

 freemem(uue, szh+szl);

 //освобождаем память

 showmessage('DONE.'); //Готово. Забирайте!

end;

end.

Из FIDO-переписки:

- New auto-created HomeNet area (555:172/89.2) ------------- HOME.PROGRAMMERS -

 Msg : 34 of 35

 From : Philip Bondarovich 555:172/445.43 Пнд 17 Янв 00 02:51

 To : Denis Guravski Втp 18 Янв 00 22:21

 Subj : UUE

-------------------------------------------------------------------------------

 Wednesday January 12 2000 22:56, Denis Guravski писал All:

 DG> Люди , сpочно нyжно описание сабжа .

=== Begin uuecode ===

- INT.PROGRAMMERS (256:172/43) ------------------------------ INT.PROGRAMMERS -

 Msg : 38 of 38 -36 Scn

 From : Monk 256:172/10 15 Jan 00 18:24:30

 To : Nikolay Severikov 16 Jan 00 03:47:50

 Subj : UU-code

-------------------------------------------------------------------------------

 Жывi сабе памаленькy, /_*Nikolay*_/!

У чацьвэp Стyдзеня 13 2000 y 23:25, цёмнай ночкаю, Nikolay Severikov тайна пiсаў All, i я ўцягнyўся...

 NS> Расскажите плиз о сyбже... Как он кодиpyется.

Калi ласка.

=== Cut ===

1) Читаем из исходного хфайла 3 байта.

2) Разбиваем полyченные 24 бита (8x3=24) на 4 части, т.е. по 6 бит.

3) Добавляем к каждой части число 32 (десятичн.)

Примеp: Имеем тpи числа 234 12 76. Побитово бyдет так -

 11101010 00001100 01001100 pазбиваем и полyчаем -

 111010 100000 110001 001100 добавляем 32 -

+100000 +100000 +100000 +100000

 ------ ------ ------ ------

1011010 1000000 1010001 101100 или в бyквах -

   Z       @       Q ,

Вот собственно и все. В UUE файле в пеpвой позиции стоит кол-во закодиpованных

символов + 32. Т.е. вся стpока содеpжит 61 символ. 1 символ идет на кол-во.

Остается 60 символов _кода_. Если подсчитать, то мы yвидим, что для полyчения

60

символов кода необходимо 45 исходных символов. Для полной стpоки в начале стоит

бyква "M", а ее ASCII код = 77. 45+32=77.

=== Cut ===

 З павагай да ўсiх вас, Monk. Спадзяюся на пpацяг pазмовы, *Nikolay*!

... -Папа, я есть хочy! -Стыдись, сынок, в твои годы я хотел стать космонавтом!

-+- GoldED+/386 1.1.1.2

 + Origin: - Тавеpна BBS - 241-5714 23:00-6:00. Freqs allowed. (256:172/10)

=== End uuecode ===

WBR.

... Чешиpский Котенок лyчше всех

--- GoldED+/W32 1.1.1.2

 * Origin: WonderLand (555:172/445.43)

 

Nomadic отвечает:

Волшебник по созданию ISAPI DLL в Delphi 3 создает полностью безопасную многопоточную библиотеку, но не выставляет флаг, говорящий приложению, что эта библиотека в этом отношении безопасна. Это легко исправить, просто добавив строчку:

IsMultiThread := TRUE;

end;

первой строкой в Вашем блоке begin-end файла проекта (DPR).

The_Sprite отвечает:

Данная функция позволяет Вам проверить существование определённого адреса(URL) в интернете. Естественно она может пригодиться веб-мастерам, у которых на сайте много ссылок, и необходимо с определённой периодичнойстью эти ссылки проверять.

URL может быть как с префиксом http:/ так и без него - эта функция добавляет префикс http:// если он отсутствует (необходимо для функции internetOpenUrl которая так же поддерживает FTP:// и gopher://

Эта функция проверяет только два возвращаемых кода '200'(ОК) или '302' (Редирект), но Вы можете заставить проверять функцию и другие коды. Для этого достаточно модифицировать строчку "result := ".

Платформа: Delphi 3.x (или выше)

uses wininet;

Function CheckUrl(url:string):boolean;

var

 hSession, hfile, hRequest: hInternet;

 dwindex,dwcodelen :dword;

 dwcode:array[1..20] of char;

 res : pchar;

begin

 if pos('http://',lowercase(url))=0 then url := 'http://'+url;

 Result := false;

 hSession := InternetOpen('InetURL:/1.0', INTERNET_OPEN_TYPE_PRECONFIG,nil, nil, 0);

 if assigned(hsession) then begin

  hfile := InternetOpenUrl(hsession, pchar(url), nil, 0, INTERNET_FLAG_RELOAD, 0);

  dwIndex  := 0;

  dwCodeLen := 10;

  HttpQueryInfo(hfile, HTTP_QUERY_STATUS_CODE, @dwcode, dwcodeLen, dwIndex);

  res := pchar(@dwcode);

  result:= (res ='200') or (res ='302');

  if assigned(hfile) then InternetCloseHandle(hfile);

  InternetCloseHandle(hsession);

 end;

end;

Delphi 2 

Тема: Объект DocInput: свойства и методы

Объект DocInput — объект из пакета Internet Solutions Pack фирмы NetManage, поставляемого в составе Delphi 2.01. Он предназначен для описания входной информции для документа, передаваемого элементу управления. Все элементы управления для работы с Интернетом, имеющиеся в данном пакете, имеют доступ к объекту через соответствующее свойство, могут хранить в нем документы и передавать его от одного элемента управления другому. Объект DocInput имеет следующие свойства:

BytesTotal, BytesTransferred, DocLink, FileName, Headers, PushStreamMode, State и Suspended.

BytesTotal — счетчик общего количества байт передаваемого элемента. Значение по умолчанию и начальное значение равно нулю. Тип данных — Long. Данное свойство времени выполнения и только для чтения. Значение данного свойства получается из свойства заголовка "content-length" (длина содержимого). Это значение используется элементом управления для определения размера (объема) передаваемой информации. С помощью него также возможно управление буфером, который вы используете для "сборки" данных после их передачи.

Свойство BytesTranferred является свойством, передаваемым вам при наступлении события OnDocInput. Данное свойство времени выполнения, только для чтения и имеет тип long. При начале новой передачи значение свойства обнуляется. Обновляется в начале события OnDocInput. Значение данного свойства отражает величину последней передачи, когда другие передачи не осуществлялись. Свойство BytesTransferred может использоваться для показа линейки прогресса или для утверждения того, насколько фактически переданный размер соответствует ожидаемому.

Свойство DocLink сообщает получающему элементу управления о том, что источник не будет посылать документ через поток данных или входной файл. Оно ссылается на свойство DocOutput.DocLink, которое становится источником при передаче данных. Данное свойство является read/write-свойством (для чтения и записи) и доступно только во время выполнения программы. Свойство имеет тип DocLink. Это строковый тип, имеющий значение по умолчанию ''. Если значению данного свойства присваивается величина, отличная от '', свойство FileName автоматически устанавливается в ''. Данное свойство используется для определения источника, являющегося internet-компонентом с указывающим на объект свойством DocOutput.DocLink, т.е. они используются в парах.

Свойство FileName является read/write-свойством (для чтения и записи) только времени выполнения и имеет строковый тип. Значение по умолчанию ''. Это должно быть правильным именем файла. Данное свойство может быть установлено при его передаче в качестве аргумента объекту DocInput. Если значению данного свойства присваивается величина, отличная от '', свойство DocLink автоматически устанавливается в ''.

Свойство Headers является свойстом только для чтения и времени выполнения. "headers" — коллекция элементов DocHeader, которые определяют передаваемый документ. Содержимое свойства headers должно быть изменено перед вызовом метода GetDoc. Каждый DocHeader представляет собой MultiPurpose Internet Mail Extension (MIME). Mime является механизмом для определения и описания формата тела сообщения Интернет (Internet Message Bodies). (Для получения дополнительной информации смотри документ rfc1341). Используемые headers (заголовки) зависят от используемого протокола, но существуют два заголовка, независимые от протокола:

1. content-type (тип содержимого)

content type указывает спецификацию MIME для следующего за заголовком документа. Примером этого является "text/plain".

2. content-length (размер содержимого)

content length указывает размер документа в байтах.

Свойтво state является свойством только для чтения и времени выполнения, и имеет перечислимый тип DocStateConstants. Значение по умолчанию icDocNone. Свойство state элемента управления обновляет себя каждый раз при наступлении события DocInput.

Свойство suspended является свойством только для чтения и времени выполнения, и имеет логический тип. Устанавливается вызывом метода suspend. При установке значения, равного True, передача приостанавливается.

Свойство PushStream является read/write-свойством (для чтения и записи) только времени выполнения и имеет логический тип. Значение по умолчанию — False. Если свойству FileName или DocLink присваивается значение, отличное от '', то свойство PushStream становится недоступным.

Объект DocInput имеет 4 метода: GetData, PushStream, SetData и Suspend.

Метод GetData сообщает объекту DocInput об извлечении текущего блока данных в момент наступления события DocOutput. Данный метод может быть вызван только в течение события OnDocInput, и только когда свойство State установлено в icDocData(3). При использовании свойства FileName или DocLink, данный метод позволяет исследовать данные во время их передачи. Метод PushStream может быть вызван только если PushStreamMode установлен в True и когда данные доступны. PushStream устанавливает свойство State на основе следующего шага передачи документа и активизирует в нужный момент событие DocInput. Затем происходит возврат до следующего вызова PushStream. Перед вызовом PushStream должен быть вызван SetData.

Метод SetData определяет следующий буфер передаваемых данных при наступлении события DocInput. SetData вызывается в течение события DocInput или перед вызовом SendDoc. Если метод используется перед вызовом SendDoc, он может служить альтернативой передачи параметров InputData в InputData. Тип должен быть определен как variant.

Метод Suspend передает форме команду suspend(true) или suspend(false). Если метод с параметром True был вызван дважды, то для продолжения передачи его необходимо дважды вызвать с параметром False.

Вот некоторый код примера, показывающий как можно использовать объект DocInput. Полный проект, содержащий данный код, вы можете найти в подкаталоге demos на CD-ROM с Delphi 2.01. Имя проекта SimpMail.dpr. Данные проект представляет собой большое пример использования свойтсва объекта headers. Также показано соответствующее использование события DocInput и свойства State.

{Очистка и новое заполнение заголовков MIME с помощью свойства компонента DocInput. Может также использоваться отдельный OLE объект DocInput. Для получения полной информации о типах MIME смотри документ RFC1521/1522.}

procedure TMainForm.CreateHeaders;

begin

 with SMTP1 do begin

  DocInput.Headers.Clear;

  DocInput.Headers.Add('To', eTo.Text);

  DocInput.Headers.Add('From', eHomeAddr.Text);

  DocInput.Headers.Add('CC', eCC.Text);

  DocInput.Headers.Add('Subject', eSubject.Text);

  DocInput.Headers.Add('Message-Id',

   Format('%s_%s_%s', [Application.Title, DateTimeToStr(Now), eHomeAddr.Text]));

  DocInput.Headers.Add('Content-Type', 'TEXT/PLAIN charset=US-ASCII');

 end;

end;

{Посылаем простое почтовое сообщение}

procedure TMainForm.SendMessage;

begin

 CreateHeaders;

 with SMTP1 do SendDoc(NoParam, DocInput.Headers, reMessageText.Text, '', '');

end;

{Посылаем файл, расположенный на диске. Оставляем пустым параметр SendDoc InputData и определяем имя файла для InputFile для посылки содержимого файла, расположенного на диске. Для осуществления собственного кодирования (Base64, UUEncode и др.), вы можете использовать событие DocInput и методы GetData }

procedure TMainForm.SendFile(Filename: string);

begin

 CreateHeaders;

 with SMTP1 do begin

  DocInput.Filename := FileName;

  SendDoc(NoParam, DocInput.Headers, NoParam, DocInput.FileName, '');

 end;

end;

{Событие DocInput возникает при каждом изменении состояния DocInput во время передачи почтового сообщения. DocInput хранит всю информацию о текущей передаче, включая заголовки, количество переданных байт и сами данные сообщения. Хотя в этом примере и не показано, для кодирования данных перед отправкой каждого блока вы можете вызвать метод DocInput SetData, если DocInput.State = icDocData. }

procedure TMainForm.SMTP1DocInput(Sender: TObject; const DocInput: Variant);

begin

 case DocInput.State of

 icDocBegin:

  SMTPStatus.SimpleText := 'Начало передачи документа';

 icDocHeaders:

  SMTPStatus.SimpleText := 'Посылаем заголовки';

 icDocData:

  if DocInput.BytesTotal > 0 then

   SMTPStatus.SimpleText:=

    Format('Послано данных: %d из %d байт (%d%%)',

    [Trunc(DocInput.BytesTransferred),

    Trunc(DocInput.BytesTotal),

    Trunc(DocInput.BytesTransferred/DocInput.BytesTotal*100)])

  else SMTPStatus.SimpleText := 'Посылка...';

 icDocEnd:

  if SMTPError then SMTPStatus.SimpleText := 'Передача прервана'

  else

   SMTPStatus.SimpleText :=

    Format('Почта послана %s (%d байт данных)',

    [eTo.Text,Trunc(DocInput.BytesTransferred)]);

 end;

 SMTPStatus.Update;

end;

Delphi 2

Тема: Объект DocOutput: свойства и методы

Объект DocOutput — объект из пакета Internet Solutions Pack фирмы NetManage, поставляемого в составе Delphi 2.01. Он описывает выходную информацию передаваемого документа. Все элементы управления, имеющие свойство DocOutput, используют этот тип. Он также является объектом, на который указывает событие DocOutput. Объект DocOutput имеет следующие свойства:

BytesTotal, BytesTransferred, DocLink, FileName, Headers, PushStreamMode, State и Suspend.

BytesTotal — счетчик общего количества байт передаваемого элемента. Значение по умолчанию и начальное значение равно нулю. Тип данных — Long. Данное свойство времени выполнения и только для чтения. Значение данного свойства получается из свойства заголовка "content-length" (длина содержимого). Это значение используется элементом управления для определения размера (объема) передаваемой информации. С помощью него также возможно управление буфером, который вы используете для "сборки" данных после их передачи.

Свойство BytesTranferred является свойством, передаваемым вам при наступлении события OnDocInput. Данное свойство времени выполнения, только для чтения и имеет тип long. При начале новой передачи значение свойства обнуляется. Обновляется в начале события OnDocInput. Значение данного свойства отражает величину последней передачи, когда другие передачи не осуществлялись. Свойство BytesTransferred может использоваться для показа линейки прогресса или для утверждения того, насколько фактически переданный размер соответствует ожидаемому.

Свойство DocLink сообщает получающему элементу управления о том, что источник не будет посылать документ через поток данных или входной файл. Оно ссылается на свойство DocOutput.DocLink, которое становится источником при передаче данных. Данное свойство является read/write-свойством (для чтения и записи) и доступно только во время выполнения программы. Свойство имеет тип DocLink. Это строковый тип, имеющий значение по умолчанию ''. Если значению данного свойства присваивается величина, отличная от '', свойство FileName автоматически устанавливается в ''. Данное свойство используется для определения источника, являющегося internet-компонентом с указывающим на объект свойством DocOutput.DocLink, т.е. они используются в парах.

Свойство FileName является read/write-свойством (для чтения и записи) только времени выполнения и имеет строковый тип. Значение по умолчанию ''. Это должно быть правильным именем файла. Данное свойство может быть установлено при его передаче в качестве аргумента объекту DocInput. Если значению данного свойства присваивается величина, отличная от '', свойство DocLink автоматически устанавливается в ''.

Свойство Headers является свойстом только для чтения и времени выполнения. "headers" — коллекция элементов DocHeader, которые определяют передаваемый документ. Содержимое свойства headers должно быть изменено перед вызовом метода GetDoc. Каждый DocHeader представляет собой MultiPurpose Internet Mail Extension (MIME). Mime является механизмом для определения и описания формата тела сообщения Интернет (Internet Message Bodies). (Для получения дополнительной информации смотри документ rfc1341). Используемые headers (заголовки) зависят от используемого протокола, но существуют два заголовка, независимые от протокола:

1. content-type (тип содержимого)

content type указывает спецификацию MIME для следующего за заголовком документа. Примером этого является "text/plain".

2. content-length (размер содержимого)

content length указывает размер документа в байтах.

Свойтво state является свойством только для чтения и времени выполнения, и имеет перечислимый тип DocStateConstants. Значение по умолчанию icDocNone. Свойство state элемента управления обновляет себя каждый раз при наступлении события DocInput.

Свойство suspended является свойством только для чтения и времени выполнения, и имеет логический тип. Устанавливается вызывом метода suspend. При установке значения, равного True, передача приостанавливается.

Свойство PushStream является read/write-свойством (для чтения и записи) только времени выполнения и имеет логический тип. Значение по умолчанию — False. Если свойству FileName или DocLink присваивается значение, отличное от '', то свойство PushStream становится недоступным.

Объект DocOutput имеет три метода: GetData, SetData и Suspend.

Метод GetData сообщает объекту DocInput об извлечении текущего блока данных в момент наступления события DocOutput. Данный метод может быть вызван только в течение события OnDocInput, и только когда свойство State установлено в icDocData(3). При использовании свойства FileName или DocLink, данный метод позволяет исследовать данные во время их передачи.

Метод SetData определяет следующий буфер передаваемых данных при наступлении события DocInput. SetData вызывается в течение события DocInput или перед вызовом SendDoc. Если метод используется перед вызовом SendDoc, он может служить альтернативой передачи параметров InputData в InputData. Тип должен быть определен как variant.

Метод Suspend передает форме команду suspend(true) или suspend(false). Если метод с параметром True был вызван дважды, то для продолжения передачи его необходимо дважды вызвать с параметром False.

Приведенный здесь код взят из демонстрационного проекта, расположенного в подкаталоге Delphi 2.01 demos\internet. Имя проекта HTTPDemo.dpr. Данный проект представляет собой пример использования свойств объекта BytesTransferred и state. Также показано использование различных типов данных, являющимися новыми для Delphi 2.01. Эти типы данных важны для использования OLE, и пользователи Delphi должны о них узнать как можно скорее, если они хотят начать использовать технологию OLE в своих приложениях.

procedure TForm1.HTTP1DocOutput(Sender: TObject; const DocOutput: Variant);

var

 S: String;

 i: integer;

 MsgNo, Header: String;

 Parser: TSimpleHTMLParser;

 ALine: String;

begin

 Statusbar1.Panels[2].Text :=Format('Байт: %s',[DocOutput.BytesTransferred]);

 case DocOutput.State of

 icDocBegin:

  begin

   Memo1.Lines.Clear;

   Data := '';

  end;

 icDocData:

  begin

   DocOutput.GetData(S, VT_BSTR);

   Data := Data + S;

  end;

 icDocEnd:

  begin

   { Теперь удаляем все HTML-тэги и отображаем текст }

   Parser := TSimpleHTMLParser.Create(Data);

   ALine := '';

   while Parser.FToken <> etEnd do begin

    case Parser.FToken of

    etHTMLTag:

     begin

      if Parser.TokenHTMLTagIs('BR') then ALine := ALine + #13#10;

      if Parser.TokenHTMLTagIs('P') then ALine := ALine + #13#10#13#10;

     end;

    etSymbol:

     ALine := ALine + ' ' + Parser.FTokenString;

    etLineEnd:

     begin

      Memo1.Lines.Add(ALine);

      ALine := '';

     end;

    end;

    Parser.NextToken;

   end;

   Memo1.Lines.Add(ALine);

   Memo1.SelStart := 0;

   SendMessage(Memo1.Handle, EM_ScrollCaret, 0, 0);

  end;

 end;

 Refresh;

end;

The_Sprite советует:

Пример показывает, как найти окно Internet Explorer, и захватить из него текущий URL, находящийся в поле адреса IE. В Исходнике используются простые функции win32 api на delphi.

{-------------------------------------------------------}

Function GetText(WindowHandle: hwnd):string;

var

 txtLength : integer;

 buffer: string;

begin

 TxtLength := SendMessage(WindowHandle, WM_GETTEXTLENGTH, 0, 0);

 txtlength := txtlength + 1;

 setlength(buffer, txtlength);

 sendmessage(WindowHandle, wm_gettext, txtlength, longint(@buffer[1]));

 result := buffer;

end;

function GetURL:string;

var ie, toolbar, combo, comboboxex, edit, worker, toolbarwindow: hwnd;

begin

 ie := FindWindow(pchar('IEFrame'), nil);

 worker := FindWindowEx(ie, 0, 'WorkerA', nil);

 toolbar := FindWindowEx(worker, 0, 'rebarwindow32', nil);

 comboboxex := FindWindowEx(toolbar, 0, 'comboboxex32', nil);

 combo := FindWindowEx(comboboxex, 0, 'ComboBox', nil);

 edit := FindWindowEx(combo, 0, 'Edit', nil);

 toolbarwindow := FindWindowEx(comboboxex, 0, 'toolbarwindow32', nil);

 result := GetText(edit);

{-------------------------------------------------------}

procedure TForm1.Button1Click(Sender: TObject);

begin

 showmessage(GetURL);

end;