nyuuzyou/wikis huggingface dataset:
Двоичный поиск для TListView

=== Двоичный поиск для TListView ===
{+------------------------------------------------------------ 
| Function ListviewBinarySearch 
| 
| Parameters : 
| listview: listview to search, assumed to be sorted, must 
| be <> nil. 
| Item : item caption to search for, cannot be empty 
| index : returns the index of the found item, or the 
| index where the item should be inserted if it is not 
| already in the list. 
| Returns : True if there is an item with the passed caption 
| in the list, false otherwise. 
| Description: 
| Uses a binary search and assumes that the listview is sorted 
| ascending on the caption of the listitems. The search is 
| case-sensitive, like the default alpha-sort routine used by 
| the TListview class. 
| Note: 
| We use the lstrcmp function for string comparison since it 
| is the function used by the default alpha sort routine. If 
| the listview is sorted by another means (e.g. OnCompare event) 
| this needs to be changed, the comparison method used must 
| always be the same one used to sort the listview, or the 
| search will not work! 
| Error Conditions: none 
| Created: 31.10.99 by P. Below 
+------------------------------------------------------------}
function ListviewBinarySearch(listview: TListview; const Item: string;
 var Index: Integer): Boolean;
var
 First, last, pivot, res: Integer;
begin
 Assert(Assigned(listview));
 Assert(Length(item) > 0);
 Result := False;
 Index := 0;
 if listview.Items.Count = 0 then Exit;
 First := 0;
 last := listview.Items.Count - 1;
 repeat
 pivot := (First + last) div 2;
 res := lstrcmp(PChar(item), PChar(listview.Items[pivot].Caption));
 if res = 0 then
 begin
 { Found the item, return its index and exit. }
 Index := pivot;
 Result := True;
 Break;
 end { If }
 else if res > 0 then
 begin
 { Item is larger than item at pivot }
 First := pivot + 1;
 end { If }
 else
 begin
 { Item is smaller than item at pivot }
 last := pivot - 1;
 end;
 until last < First;
 Index := First;
end; { ListviewBinarySearch }
Source: Взято с сайта: http://www.swissdelphicenter.ch
ID: 01130
Деление строки не несколько строк

=== Деление строки не несколько строк ===
{ **** UBPFD *********** by delphibase.endimus.com ****
>> Делит строку аStr на три строки St1,St2,St3 длиной Long1,Long2,Long3
Делит строку аStr на три строки St1,St2,St3 длиной Long1,Long2,Long3
соответственно или меньше в зависимости от длины исходной строки.
Зависимости: ???
Автор: Сергей, nfkazak@inbox.ru, Краснодар
Copyright: VIP BANK
Дата: 11 сентября 2002 г.
***************************************************** }
procedure DivPart(aStr: string; var St1, St2, St3: string; Long1, Long2, Long3: byte);
var
 i, pos, Long: byte;
begin
 St1 := ;
 St2 := ;
 St3 := ;
 aStr := Trim(aStr);
 Long := Length(aStr);
 if Long <= Long1 then
 begin
 St1 := aStr;
 Exit
 end;
 Pos := Long1;
 for i := 1 to Long1 + 1 do
 if aStr[i] = ' ' then
 Pos := i;
 St1 := TrimRight(Copy(aStr, 1, Pos));
 Delete(aStr, 1, Pos);
 aStr := TrimLeft(aStr);
 Long := Length(aStr);
 if Long <= Long2 then
 begin
 St2 := aStr;
 Exit
 end;
 Pos := Long2;
 for i := 1 to Long2 + 1 do
 if aStr[i] = ' ' then
 Pos := i;
 St2 := TrimRight(Copy(aStr, 1, Pos));
 St3 := Trim(Copy(aStr, Pos + 1, Long3))
end;
Source: http://delphibase.endimus.com
ID: 00841
----
{ **** UBPFD *********** by delphibase.endimus.com ****
>> Разбивка строки на подстроки с использованием заданного разделителя
Параметры: Str: WideString - Строка для разбивки
Delimiter: String - Разделитель подстрок с строке Str
Результат: TStringList: Список найденных подстрок
Зависимости: System, Sysutils, Classes
Автор: Stoma, stoma@bitex.bg
Copyright: Собственная разработка
Дата: 4 августа 2003 г.
***************************************************** }
function Tokenize(Str: WideString; Delimiter: string): TStringList;
var
 tmpStrList: TStringList;
 tmpString, tmpVal: WideString;
 DelimPos: LongInt;
begin
 tmpStrList := TStringList.Create;
 TmpString := Str;
 DelimPos := 1;
 while DelimPos > 0 do
 begin
 DelimPos := LastDelimiter(Delimiter, TmpString);
 tmpVal := Copy(TmpString, DelimPos + 1, Length(TmpString));
 if tmpVal <> then
 tmpStrList.Add(UpperCase(tmpVal));
 Delete(TmpString, DelimPos, Length(TmpString));
 end;
 Tokenize := tmpStrList;
end;
// Пример использования: 
function TForm1.GetDirNames(FullPath: string): TStringList;
begin
 GetDirNames := Tokenize(FullPath, '\');
end;
Source: http://delphibase.endimus.com
ID: 00911
----
procedure Explode(var a: array of string; Border, S: string);
var
 S2: string;
 i: Integer;
begin
 i := 0;
 S2 := S + Border;
 repeat
 a[i] := Copy(S2, 0, Pos(Border, S2) - 1);
 Delete(S2, 1, Length(a[i] + Border));
 Inc(i);
 until S2 = ;
end;
 // How to use it: 
// Und hier ein Beispiel zur Verwendung: 
procedure TForm1.Button1Click(Sender: TObject);
var
 S: string;
 A: array of String;
begin
 S := 'Ein Text durch Leerzeichen getrennt';
 SetLength(A, 10);
 Explode(A, ' ', S);
 ShowMessage(A[0] + ' ' + A[1] + ' ' + A[2] + ' ' + A[3] + ' ' + A[4]);
end;
Source: Взято с сайта: http://www.swissdelphicenter.ch
ID: 00912
----
Дельфи компонент для подкраски синтаксиса

=== Дельфи компонент для подкраски синтаксиса ===
Результат совместной работы Fanasist'а и меня. Это компонент для Дельфи для известного пакета SynEdit (http://synedit.sourceforge.net), позволяющий на лету создавать подкраску синтаксиса по любым правилам любых форматов (создание и загрузка в run-time, хранение шаблонов на диске). В настоящее время пакет включает в себя более 300 готовых шаблонов для наиболее распространённых форматов, но каждый может создать свой собственный шаблон (можно с помошью компонента или используя прилагающуюся утилиту). Пример использования - простенький текстовый редактор с поддержкой любых расскрасок.
Загрузить можно с: http://www.unihighlighter.com
Платформа: Delphi 5/6/7
Для работы необходимо установить предварительно установить пакет SynEdit (http://synedit.sourceforge.net). 
Компонент свободен для распространения и поставляется с исходными кодами.
Логика работы:
Для подкраски синтаксиса необходимо предусмотреть следующие правила:
: 1) расскраска всего кода в промежутке от одного слова до второго - например комментарии /*...*/ или строки "...." 
: 2) расскраска ключевых слов
Это реализовано, кроме того бывают ситуации когда промежуток должен быть расскрашен по другому с другими правилами например ASP код внутри HTML или ассемблерные вставки внутри Дельфи - это тоже реализовано тем что внутри промежутка можно использовать свои правила и промежутки. Вложенность не лимитирована.
Всем кому интересно, я создал форум для обсуждения компонента, правда сообщения писать только на английском, там уже идёт дискуссия с авторами проекта SynEdit:
http://forum.vingrad.ru/SynUniHighlighter.html
http://forum.vingrad.ru/index.php?act=SF&f=170
Открыт русскоязыйчный портал для пользователей и разработчиков комполнентов подкраски синтаксиса здесь: 
Author: Vit (www.delphist.com, www.drkb.ru, www.unihighlighter.com, www.nevzorov.org)
ID: 00557
Демонстрационная программа получения информации о удаленном компьютере

Демонстрационная программа получения информации о компьютере на основе IP адреса
Позволяет узнать:
* Имя компьютера
* Список залогиненных пользователей
* Коментарий к компьютеру
* Провайдер (не тот который вы подумали :)
* MAC адрес
* Открытые сетевые ресурсы
* Домен в который входит компьютер
* Если сеть доменная то дополнительно определяет имя сервера домена и группы в которые входит текущий пользователь на удаленной машине...
* Скачать демонстрационный пример
Author: Александр (Rouse_) Багель
Source: http://rouse.drkb.ru
ID: 03335
== См. также ==
* Демонстрационная программа получения информации о компьютере по IP
Category:Связь
Демонстрационный пример сниффера

Демонстрационный пример сниффера.
Я не ставил перед собой целью написать что-то революционное, просто было желание показать сам принцип написания простейшего сниффера,
что я и осуществил :)
Работает на сетевом уровне модели OSI. (W2000 and later) 
* Скачать демонстрационный пример
Author: Александр (Rouse_) Багель
Source: http://rouse.drkb.ru
ID: 03332
== См. также ==
* Сниффер, Простое демо пакетного сниффера сетевого уровня модели OSI
Category:Связь
Демонстрация DefineProperties

=== Демонстрация DefineProperties ===
Хорошо, создайте на основе опубликованного ниже кода модуль PropDemo.pas и добавьте новый компонент в палитру компонентов. Расположите его на форме и сохраните ее. Затем посмотрите файл DFM каким-либо шестнадцатиричным редактором и проверьте наличие определенных свойств по их именованным тэгам. Вы можете также попробовать закрыть форму и модуль, а затем открыть его с помощью пункта меню File | Open file..., изменив тип файла в выпадающем списке на *.DFM.
unit PropDemo;
{ Демонстрация DefineProperties.Mike Scott, CIS 100140, 2420. }
interface
uses
 SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
 Forms, Dialogs;
type
 TDemoProps = class(TComponent)
 private
 { Private declarations }
 FStringThing: string;
 FThing: record
 i, j, k: integer;
 x, y: real;
 ch: char;
 end;
 procedure ReadStringThing(Reader: TReader);
 procedure WriteStringThing(Writer: TWriter);
 procedure ReadThing(Stream: TStream);
 procedure WriteThing(Stream: TStream);
 protected
 { Protected declarations }
 procedure DefineProperties(Filer: TFiler); override;
 public
 { Public declarations }
 constructor Create(AOwner: TComponent); override;
 published
 { Published declarations }
 end;
procedure Register;
implementation
constructor TDemoProps.Create(AOwner: TComponent);
begin
 inherited Create(AOwner);
 { создайте любые данные, чтобы было что передать в поток}
 FStringThing := 'Всем привет!';
 with FThing do
 begin
 i := 1;
 j := 2;
 k := 3;
 x := PI;
 y := 180 / PI;
 ch := '?';
 end;
end;
procedure TDemoProps.ReadStringThing(Reader: TReader);
begin
 FStringThing := Reader.ReadString;
end;
procedure TDemoProps.WriteStringThing(Writer: TWriter);
begin
 Writer.WriteString(FStringThing);
end;
procedure TDemoProps.ReadThing(Stream: TStream);
begin
 Stream.ReadBuffer(FThing, sizeof(FThing));
end;
procedure TDemoProps.WriteThing(Stream: TStream);
begin
 Stream.WriteBuffer(FThing, sizeof(FThing));
end;
procedure TDemoProps.DefineProperties(Filer: TFiler);
begin
 inherited DefineProperties(Filer);
 Filer.DefineProperty('StringThing', ReadStringThing, WriteStringThing,
 FStringThing <> );
 Filer.DefineBinaryProperty('Thing', ReadThing, WriteThing, true);
end;
procedure Register;
begin
 RegisterComponents('Samples', [TDemoProps]);
end;
end.
Author: Mike Scott, Mobius Ltd.
Source: из Советов по Delphi от Валентина Озерова, Сборник Kuliba
ID: 00119
Демонстрирация вариантов поиска записей в таблице базы данных

=== Демонстрирация вариантов поиска записей в таблице базы данных ===
Демонстрирация вариантов поиска записей в таблице базы данных
* Приложение баз данных, демонстрирующее варианты поиска записей в таблице базы данных
Author: Автор: Akella 
Source: Взято с Vingrad.ru http://forum.vingrad.ru
ID: 02422
Детектор мертвых ссылок

Любой серьезный web сайт и его web мастер должны всегда следить за актуальность ссылок. И если обнаружится мертвая ссылка (например другой web сайт прекратил существование), но нет никаких оправданий для внутренних мертвых ссылок. И поэтому я написал простую программу, назвав ее HTMLINKS, которая может сканировать .HTM файлы на их присутствие на локальной машине. (что бы потом загрузить их на сервер). HTM файлы из текущего каталога и всех подкаталогов рекурсивно читаются и проверяются на тег "<A HREF=" или "<FRAME SRC=". Если страница локальная, то есть без префикса "http://", то файл открывается с использованием относительно пути. Если страница не находится, то мы имеем внутреннюю мертвую ссылку, которая должна быть исправлена!!
Заметим, что программа игнорирует все "file://", "ftp://", "mailto:", "news:" and ".exe?" значения если они встретятся внутри "HREF" части. Конечно, вы свободны в расширить HTMLINKS для проверки и этих случаев, можно также реализовать проверку и внешних ссылок. Для информации я написал и детектор внешних мертвых ссылок в статье для The Delphi Magazine, подробности можно найти на моем web сайте. Для анализа мертвых локальных ссылок код следующий:
{$APPTYPE CONSOLE}
{$I-,H+}
uses
 SysUtils;
var
 Path: String;
procedure CheckHTML(const Path: String);
var
 SRec: TSearchRec;
 Str: String;
 f: Text;
begin
 if FindFirst('*.htm', faArchive, SRec) = 0 then
 repeat
 Assign(f, SRec.Name);
 Reset(f);
 if IOResult = 0 then { no error }
 begin
 while not eof(f) do
 begin
 ReadLn(f, Str);
 while (Pos('<A HREF="', Str) > 0) or
 (Pos('FRAME SRC="', Str) > 0) do
 begin
 if Pos('<A HREF="', Str) > 0 then
 Delete(Str, 1, Pos('HREF="', Str) + 8 - 3)
 else
 Delete(Str, 1, Pos('FRAME SRC="', Str) + 10);
 if (Pos('#', Str) <> 1)
 and (Pos('http://', Str) <> 1)
 and (Pos('mailto:', Str) <> 1)
 and (Pos('news:', Str) <> 1)
 and (Pos('ftp://', Str) <> 1)
 and (Pos('.exe?', Str) = 0) then { skip external links & exe }
 begin
 if Pos('file:///', Str) = 1 then
 Delete(Str, 1, 8);
 if (Pos('#', Str) > 0)
 and (Pos('#', Str) < Pos('"', Str)) then
 Str[Pos('#', Str)] := '"';
 if not FileExists(Copy(Str, 1, Pos('"', Str)-1)) then
 WriteLn(Path, '\', SRec.Name, ': [', Copy(Str, 1, Pos('"', Str)-1), ']');
 end;
 end;
 end;
 end;
 Close(f);
 //if IOResult <> 0 then { skip }
 until FindNext(SRec) <> 0;
 FindClose(SRec);
 // check sub-directories recursively
 if FindFirst('*.*', faDirectory, SRec) = 0 then
 repeat
 if ((SRec.Attr AND faDirectory) = faDirectory)
 and (SRec.Name[1] <> '.') then
 begin
 ChDir(SRec.Name);
 CheckHTML(Path + '\' + SRec.Name);
 ChDir('..')
 end;
 until FindNext(SRec) <> 0;
 FindClose(SRec);
end;
begin
 WriteLn('HTMLinks 4.0 (c) 1997-2000 by Bob Swart (aka Dr.Bob - www.drbob42.com)');
 WriteLn;
 FileMode := $40;
 GetDir(0, Path);
 CheckHTML(Path);
end.
Source: Интернет решения от доктора Боба (http://www.drbob42.com)
Author: (c) 2000, Анатолий Подгорецкий, перевод на русский язык (http://nps.vnet.ee/ftp)
ID: 03440
Category:Связь
Category:Web
Диалог отключения сетевого диска

=== Диалог отключения сетевого диска ===
{ **** UBPFD *********** by kladovka.net.ru ****
>> Открытие диалогового окна «Отключение сетевого диска»
Зависимости: Windows
Copyright: Dimka Maslov
Дата: 21 мая 2002 г.
********************************************** }
function DisconnectNetworkDrive(Wnd: HWND = 0): DWORD;
begin
 if Wnd = 0 then
 Wnd := FindWindow('Shell_TrayWnd', );
 Result := WNetDisconnectDialog(Wnd, RESOURCETYPE_DISK);
end; 
Пример использования:
DisconnectNetworkDrive(Application.Handle); 
ID: 01215
Диалог подключения сетевого диска

=== Диалог подключения сетевого диска ===
procedure TStartForm.NetBtnClick(Sender: TObject);
var
 OldDrives: TStringList;
 i: Integer;
begin
 OldDrives := TStringList.Create;
 // Запоминаем список дисков
 OldDrives.Assign(Drivebox.Items);
 // Показываем диалог подключения
 if WNetConnectionDialog(Handle, RESOURCETYPE_DISK) = NO_ERROR then
 begin
 // Обновляем список дисков
 DriveBox.TextCase := tcLowerCase;
 for i := 0 to DriveBox.Items.Count - 1 do
 begin
 // Ищем свободный логический диск
 if Olddrives.IndexOf(Drivebox.Items[i]) = -1 then
 begin
 // Показываем первый найденный логический диск
 DriveBox.ItemIndex := i;
 // Каскадируем обновление на список подключенных каталогов и др.
 DriveBox.Drive := DriveBox.Text[1];
 end;
 end;
 DriveBox.SetFocus;
 end;
 OldDrives.Free;
end;
Source: Взято с http://delphiworld.narod.ru
ID: 01213
----
{ **** UBPFD *********** by kladovka.net.ru ****
>> Открытие диалогового окна «Подключение сетевого диска»
Зависимости: Windows
Copyright: Dimka Maslov
Дата: 21 мая 2002 г.
********************************************** }
function MapNetworkDrive(Wnd: HWND = 0): DWORD;
begin
 if Wnd = 0 then
 Wnd := FindWindow('Shell_TrayWnd', );
 Result := WNetConnectionDialog(Wnd, RESOURCETYPE_DISK);
end; 
Пример использования:
MapNetworkDrive(Application.Handle); 
Source: kladovka.net.ru
ID: 01214
Диалог прекращения печати

Как мне создать диалог прекращения печати при работе с TPrinter?
Создайте форму с кнопкой "Abort". Обработчик нажатия кнопки должен вызывать Printer.Abort.
Теперь, при запуске печати, вам необходимо показать этот диалог в немодальном режиме методом Show(). Тем не менее, перед показом диалога необходимо деактивировать главную форму приложения, например так:
Application.MainForm.Enabled := False;
AbortDlg.Show;
{ Здесь код печати }
AbortDlg.Close;
Appliction.MainForm.Enable := True;
Имейте в виду, что для правильной логики работы необходимо проверять значение свойства Printer.Aborted. Если пользователь нажал кнопку прекращения печати, эта переменная укажет о необходимости выхода из подпрограммы печати. Но здесь есть небольшой подвох. Printer.Abort предполагает прерывание печати вызовом функции WinProcs.AbortDoc(), но он не делает этого (по крайней мере в Delphi 1). Следовательно, исправляя ошибку Borland, вы должны это делать сами в ответ на нажатие кнопки Abort (в обработчике события onClick)
Source: Взято из Советов по Delphi от Валентина Озерова
ID: 03244
Category:Принтер
Динамические и виртуальные методы

=== Динамические и виртуальные методы ===
Согласно онлайновой документации, динамические и виртуальные методы семантически идентичны, единственно различие заключается в их реализации, нижеследующий код генерирует указанную ошибку компиляции:
type t = class
 function a: integer; {статический}
 function b: integer; virtual;
 function c: integer; dynamic;
 property i: integer read a; { ok }
 property j: integer read b; { ok }
 property k: integer read c; { ОШИБКА: type mismatch (не совпадение типа) }
 end;
Source: из Советов по Delphi от Валентина Озерова, Сборник Kuliba
ID: 00114
Динамическое распределение памяти

=== Динамическое распределение памяти ===
uses WinCRT;
procedure TForm1.Button1Click(Sender: TObject);
var
 MyArray: array[0..30] of char;
 b: ^char;
 i: integer;
begin
 StrCopy(MyArray, 'Delphi World - это круто!!!');
 b := @MyArray;
 for i := StrLen(MyArray) downto 0 do
 begin
 write(b^);
 inc(b, sizeof(char));
 end;
end;
Source: http://delphiworld.narod.ru
ID: 00812
----
Как мне уменьшить количество занимаемой мной памяти в сегменте данных? (или как мне распределять память динамически?) 
Скажем, ваша структура данных выглядит похожей на эту: 
type
 TMyStructure = record
 Name: String[40];
 Data: array[0..4095] of Integer;
end;
Она слишком большая для глобального распределения, так что вместо объявления глобальной переменной,
var
 MyData: TMyStructure;
объявляете указательный тип, 
type
 PMyStructure = ^TMyStructure;
и переменную этого типа, 
var
 MyDataPtr: PMyStructure;
Такой указатель занимает всего лишь четыре байта сегмента данных. 
Прежде, чем вы сможете использовать структуру данных, вы должны распределить ее в куче:
New(MyDataPtr);
и получить к ней доступ через глобальные данные любым удобным для вас способом. Единственное отличие от традиционного способа заключается в необходимости использования символа "^" для обозначения указателя на данные:
MyDataPtr^.Name := 'Советы по Delphi';
MyDataPtr^.Data[0] := 12345;
И, наконец, после использования памяти, освободите ее:
Dispose(MyDataPtr);
Примечание от Vit: статья актуальна в основном для 16 разрядных систем
 
Source: http://delphiworld.narod.ru
ID: 00813
Динамическое создание полей

=== Динамическое создание полей ===
var
 I: Integer;
 Field: TField;
begin
 { Поля можно добавлять только к неактивному набору данных. }
 Table1.Active := False;
 { Распределяем определенные поля если набор данных еще не был активным. }
 Table1.FieldDefs.Update;
 { Создаем все поля из определений и добавляем к набору данных. }
 for I := 0 to Table1.FieldDefs.Count - 1 do
 begin
 { Вот где мы действительно сообщаем набору данных о необходимости создания поля. }
 { Поле "назначается", но нам нужно не это, нам нужна просто ссылка на новое поле. }
 Field := Table1.FieldDefs[I].CreateField(Table1);
 end;
 { Вот пример того, как вы можете добавить дополнительные, вычисленные поля }
 Field := TStringField.Create(Table1);
 Field.FieldName := 'Total';
 Field.Calculated := True;
 Field.DataSet := Table1;
 { Теперь мы можем увидеть наши поля. }
 Table1.Active := True;
end;
Source: Взято с http://delphiworld.narod.ru
ID: 02616
Длинные подсказки на StatusBar'e

=== Длинные подсказки на StatusBar'e ===
Этот пример показывает, как сделать, чтобы на StatusBar выводилась длинная подсказка при поднесении мыши к объекту. 
 public
 procedure DoShowHint(Sender: TObject);
implementation
procedure TForm1.DoShowHint(Sender: TObject);
begin
 StatusBar1.SimpleText := Application.Hint;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
 Application.OnHint := DoShowHint;
 Button1.Hint := 'Button 1|It is button 1';
 Button2.Hint := 'Button 2|It is button 2';
 Button3.Hint := 'Button 3|It is button 3';
 Form1.ShowHint := true;
end;
Символ "|" позволяет разделять две подсказки: та, что появляется на желтом фоне, и та, что лежит в Application.Hint. Для работы с частями подсказки существуют функции GetShortHint, GetLongHint. 
 
Source: http://delphiworld.narod.ru/
ID: 01273
----
 private
 procedure MyHint(Sender: TObject);
 end;
implementation
procedure TForm1.FormCreate(Sender: TObject);
begin
 Application.OnHint := MyHint;
 ShowHint := True;
 Button1.Hint := 'normal yellow hint|Text in Statusbar';
 Button2.Hint := 'only yellow hint|';
 Button3.Hint := '|text only in statusbar';
 Edit1.Hint := 'same text';
end;
procedure TForm1.MyHint(Sender: TObject);
begin
 StatusBar1.SimpleText := Application.Hint;
end;
Source: Взято с сайта: http://www.swissdelphicenter.ch
ID: 01274
Для своего браузера!, Как мне сохранить свой КУКИ?

unit Unit1;
interface
uses
 Windows, Messages, SysUtils, Classes, HTTPApp, WebUtils;
type
 TWebModule1 = class(TWebModule)
 procedure WebModule1WebActionItem1Action(Sender: TObject;
 Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
 procedure WebModule1WebActionItem2Action(Sender: TObject;
 Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
 private
 { Private declarations }
 public
 { Public declarations }
 end;
var
 WebModule1: TWebModule1;
implementation
{$R *.DFM}
procedure TWebModule1.WebModule1WebActionItem1Action(Sender: TObject;
 Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
var
 List: TStringList;
begin
 List := TStringList.Create;
 try
 List.Add('LastVisit=' + FormatDateTime('mm/dd/yyyy hh:mm:ss', Now));
 Response.SetCookieField(List, , , Now + 10, False);
 Response.Content := 'Cookie set -- ' + Response.Cookies[0].Name;
 finally
 List.Free;
 end;
 Handled := True;
end;
procedure TWebModule1.WebModule1WebActionItem2Action(Sender: TObject;
 Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
var
 Params: TParamsList;
begin
 Params := TParamsList.Create;
 try
 Params.AddParameters(Request.CookieFields);
 Response.Content := 'You last set the cookie on ' + Params['LastVisit'];
 finally
 Params.Free;
 end;
end;
end.
А вот пример странички:
<!-- This document was created with HomeSite v2.0 -->
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2//EN">
<HTML>
<HEAD>
 <TITLE>Delphi 4 Developer's Guide Cookie Setting and Retreiving Example</TITLE>
</HEAD>
<BODY BGCOLOR="Silver">
<FONT SIZE="+1"><FONT SIZE="+1"><FONT COLOR="Red"><B>Delphi 4 Developer's Guide - Cookie Example</B></FONT></FONT></FONT>
<P>
The following links set and get a cookie onto your browser<P>
<A HREF="../bin/cookie.dll/cookie">Click Here</A> to set the cookies
<P>
<A HREF="../bin/cookie.dll/getcookie">Click Here</A> to get cookie.
</BODY>
</HTML>
 © Delphi 4 Developer's Guide
Source: http://forum.sources.ru
ID: 03477
Category:Связь
Category:WebBrowser