Защита от SoftIce

SoftIce – один из самых лучших отладчиков на планете. Этим дебаггером очень часто пользуются как начинающими так и опытными кракерами. От последних вряд ли какая защита поможет, а вот от начинающих мы в силе защититься. Обидно, когда ты написал какую-нибудь утилиту, а деньги на пиво не получил.

В этой статье я приведу код, который будет блокировать SoftIce95.

Во-первых проверь, прописан ли у тебя в разделе uses модуль windows. Прописан? Нет, так прописывай и поехали дальше…

Напишем функцию когда SoftIce загружен и выхода из системы. Затем, в конче кода, в разделе initialization совместим их.

Привожу код с комментариями:

interface  
  
implementation  
  
uses windows;  
  
function isSoftIce95Loaded: boolean; // функция загрузки SoftIce  
 var hfile:thandle;  
 begin  
 result:=false;  
 hfile:=createfileA('\\.\sice',generic_read or generic_write,   
      file_share_read or file_share_write,   
      nil, open_existing,  file_attribute_normal,0);  
 if(hfile <> invalid_handle_value) then begin  
 closehandle(hfile);  
 result:=true;  
 end;  
end;  
  
function winexit(flags:integer):boolean; // функция выхода из системы  
  
// эта функция поможет   
//нам определить выходить ли из системы или продолжать работу программы  
function Setprivilege (privilegename:string; enable:boolean):boolean;   
var  
tpPrev, tp:TTokenPrivileges;  
token: Thandle;  
dwRetLen: Dword;  
begin  
result:= false;  
openprocesstoken (GetCurrentProcess, token_adjust_privileges or token_query,token);  
tp.privilegecount:=1;  
if lookupprivilegeValue(nil, pchar(privilegename),tp.Privileges[0].luid) then begin  
if enable then tp.privileges[0].attributes:=se_privilege_enabled  
else tp.privileges[0].attributes:=0;  
dwRetLen:=0;  
result:=AdjustTokenPrivileges(token,false, tp, sizeof(tpprev),tpprev, dwretlen);  
end;  
closeHandle(token);  
end;  
  
begin   
if SetPrivilege ('SeShutdownPrivilege', true) then begin // если true то выходим из системы   
exitwindowsex(flags,0);  
SetPrivilege('SeShutdownPrivilege', false); // иначе работаем дальше  
end;  
end;  
  
initialization // начинаем сравнивать  
if isSoftIce95Loaded then begin // если SoftIce95 загружен то  
winexit (ewx_shutdown or ewx_force); // выходим из системы  
halt;  
end;  

Ну вот и все, идем пить пиво :)

Я привел код для 95-ого SoftIce, но не забывай есть еще NT-ный

А от NT-ого тебе придется догадаться самому. Сразу говорю, поменять надо всего пару букв.

Функции работы с датами и временем

function Now: TDateTime; 

Возвращает текущую датау и время на вашем компьютере. TDateTime в KOL ни чем не отличается от VCL аналога. TDateTime представляет из себя число с плавающей запятой (т.е. Double), целая часть которого содержит число дней, отсчитанное от некоторого начала календаря, а дробная часть равна части 24-часового дня, т.е. характеризует время и не относится к дате.

function CompareSystemTime( const D1, D2: TSystemTime ): Integer; 

Функция сравнивает 2-е записи типа TSystemTime. На выходе:
-1 если D1 < D2
0 если D1 = D2
1 если D1 > D2.
TSystemTime - структура используемая в Winddows API для хранения данных о датах и времени. IMHO зачастую она даже удобней в использование обычной TDateTime.
Подробней конечно можно посмотреть и в Win32.hlp, но всетаки...
Для получения системного времени : GetSystemTime
Для установки системено времени на вашем компьютере: SetSystemTime

type  
PSystemTime = ^TSystemTime;  
   TSystemTime = record  
   wYear: Word; // год  
   wMonth: Word; // месец  
   wDayOfWeek: Word; // день недели  
   wDay: Word; // день  
   wHour: Word; // часы  
   wMinute: Word; // минуты  
   wSecond: Word; // секунды  
   wMilliseconds: Word; // миллисекунды  
end;   

procedure IncDays( var SystemTime: TSystemTime; DaysNum: Integer ); 

Увеличивает или уменьщает количество дней в записи типа TSystemTime. DaysNum может быть отрицательным.

procedure IncMonths( var SystemTime: TSystemTime; MonthsNum: Integer ); 

Увеличивает или уменьщает количество дней в записи типа TSystemTime. DaysNum может быть отрицательным. Правильный результат не гарантирован если число дней превышено для нового месяца

function IsLeapYear( Year: Word ): Boolean;

.
Возвращает true если указанные год Year является высокосным (то есть имеет 29 дней в Феврале).

function DayOfWeek( Date: TDateTime ): Integer;

Возвращает день недели (от 0 до 6) для текушей даты.

function SystemTime2DateTime( const SystemTime: TSystemTime; var DateTime: TDateTime ): Boolean; 

Преобразует дату из типа TSystemTime в TDateTime

function DateTime2SystemTime( const DateTime: TDateTime; var SystemTime: TSystemTime ): Boolean;

Преобразует дату из типа TDateTime в TSystemTime.

function CatholicEaster( nYear: Integer ): TDateTime; 

Возвращает дату католического рождества в указаном году

Функции преобразования типов

function Int2Hex( Value: DWord; Digits: Integer ): String; 

Конветирует Value типа integer в строку составленную из символов цифр в шестеричном исчисление. Параметр Digits определяет минимальное количество цифр

function Int2Str( Value: Integer ): String;

Конвертирует Value типа integer в строку

function Int2Ths( I: Integer ): String;

Конвертирует Value типа integer в строку. Между тремя цифрами ставится символ: ',' (удобна для вывода цифр больше тысячи).

function Int2Digs( Value, Digits: Integer ): String;

Преобразование integer в string. Digits - указывает сколько минимально символов в строке. Если Digits больше количества цифр в Value то недостающие цифры заменяются нулями.

function Num2Bytes( Value: Double ): String;

Преобразование Value в строку исходя из того, что Value это количество байт. Если Value достаточно большое, число представляется в виде килобайт (с буквой K в конце), или мегабайт (M), гигабайт (G) или терабайт (T).

function Str2Int( const Value: String ): Integer;

Перевод Value типа string в integer.

function Hex2Int( const Value: String ): Integer;

Перевод шестеричного числа в integer. Value конвертируется до первого символа не входящую в шестеричные цифры.

Следующие функции аналогичны описанным выше и отличаются только переводимыми типами данных :

function Str2Double( const S: String ): Double; 
function Double2Str( D: Double ): String; 
function Int64_2Str( X: Int64 ): String; 
function Str2Int64( const S: String ): Int64; 
function Int64_2Double( const X: Int64 ): Double; 
function Double2Int64( D: Double ): Int64;

Системные функции

function ExecuteWait( const AppPath, CmdLine, DfltDirectory: String; Show: DWORD; TimeOut: DWORD; ProcID: PDWORD ): Boolean; 

Запускает приложение и ждет его выполнения.
TimeOut - сколько времени должно выполнятся приложение. Если за это время приложение не закончило свою работу, то функция возвращает true и ProcID приравнивается к nil. В случае если TimeOut = INFINITE, то время ожидания окончания работы не определено (предполагается, что когда нибудь оно и закроется).
AppPath, CmdLine, DfltDirectory - имя приложения, параметры с которыми оно запускается и рабочая директория
Show - это SW_SHOW, SW_HIDE или любая другая SW_XXX константа
ProcID - хендл запущенного процесса

function GetStartDir: String; 

Возвращает путь до вашего приложения

function GetTempDir: string; 

Возвращает путь до временного каталога (С:\WINDOWS\TEMP)

function GetWindowsDir: string; 

Возвращает директорию в которой находится Windows

function WinVer: TWindowsVersion; 

Возвращает текущую версию Windows
TWindowsVersion может иметь следующие значения:
wv31, wv95, wv98, wvNT, wvY2K

function IsWinVer( Ver: TWindowsVersions ): Boolean; 

Возвращает true если указанная версия Ver Windows работает на данной машине

Работа со строками

function AnsiEq( const S1, S2: String ): Boolean; 

Возвращает true, если AnsiLowerCase(S1) = AnsiLowerCase(S2) т.е сравнивает 2 строки без учета регистра. Данная функция подойдет только для русских символов.

function DelimiterLast( const Str, Delimiters: String ): Integer; 

Функция ищет в строке Str последнее вхождение строки Delimiters и возвращает номер символа с которого он идет. Если Delimiters не найден возвращается длина Str.

function AnsiUpperCase( const S: string ): string; 

Преобразует символы в строке S к верхнему регистру.

function AnsiLowerCase( const S: string ): string; 

Преобразует символы в строке S к нижнему регистру.

function AnsiCompareStr( const S1, S2: string ): Integer; 

Сравнивает две строки ANSI S1 и S2 без учета регистра. Возвращает значение < 0, если S1 < S2, 0, если S1 = S2, и > 0, если S1 > S2.

function _AnsiCompareStr( S1, S2: PChar ): Integer;

Аналог AnsiCompareStr только для PChar.

function CopyEnd( const S: String; Idx: Integer ): String;

Копирует строку из строки S с Idx символа до последнего

function CopyTail( const S: String; Len: Integer ): String; 

Возвращает последние Len символа из строки S. Если Len > Length( S ), возвращается вся строка S.

procedure DeleteTail( var S: String; Len: Integer );

Удаляет последние Len символа из строки.

function LowerCase( const S: string ): string; 

Преобразует символы в строке S к нижнему регистру. Только для латинских символов.

procedure NormalizeUnixText( var S: String ); 

В строке S происходит замена всех символов #10 на символ #13

function IndexOfChar( const S: String; Chr: Char ): Integer; 

Возвращает положение символа Chr в строке S. Возвращаемое значение может быть то 1 до Length(S), если возвращается -1 то символ не найден.

function IndexOfCharsMin( const S, Chars: String ): Integer;

Возвращает положение ближайшего от начала(строки) символа Chr в строке S. Если возвращается -1 то символ не найден.

function IndexOfStr( const S, Sub: String ): Integer;

Возвращает положение строки Sub в строке S. Возвращаемое значение может быть то 1 до Length(S)-Length(Sub), если возвращается -1 то строка не найдена.

function Parse( var S: String; const Separators: String ): String; 

Функция ищет в строке S строку Separators и возвращает все что шло до этого разделителя (т.е. до Separators). В строке S удаляется возвращаемая часть и найденный Separators.
Т.е. если S= '1-2-3',а Separators= '-' то при первом вызове на выходе '1' , а S='2-3'
Если в S нет Separators то возвращаемое значение рано S, а сама S становится пуcтой.

function StrEq( const S1, S2: String ): Boolean; 

Возвращает true, если LowerCase(S1) = LowerCase(S2) т.е сравнивает 2 строки без учета регистра. Данная функция подойдет только для латинских символов.

function StrIn( const S: String; A: array of String ): Boolean;

Функция возвращает True если в одна из строк массива А равна строке S. Спавнение идет с помощью функции StrEq поэтому оно не чуствительно к регистру букв.

function StrSatisfy( const S, Mask: String ): Boolean;

Возвращает True если строка S соответствует маске Mask. Строка Mask может содержать символ '*' (любое количество любых символов) и '?' (один любой символ). Например чтобы проверить содержит ли S адрес почты надо :
StrSatisfy(S,'*@*.*');

function StrReplace( var S: String; const From, ReplTo: String ): Boolean;

Производит замену в строке S первой встреченной строки From на строку ReplTo. Если замена произошла успешно возвращает True.

function StrPCopy( Dest: PChar; const Source: string ): PChar; 

Копирует паскалевскую строку в строку типа PChar

function StrLCopy( Dest: PChar; const Source: PChar; MaxLen: Cardinal ): PChar; 

Копирует первые MaxLen символов из паскалевсокой строки в строку типа PChar.

function StrComp( const Str1, Str2: PChar ): Integer; 

Быстрое сравнение 2-х строк. На выходе -1: Str1<Str2; 0: Str1=Str2; +1: Str1>Str2

function StrLComp( const Str1, Str2: PChar; MaxLen: Cardinal ): Integer; 

Сравнивает до MaxLen символов двух строк Str1 и Str2 с учетом регистра. Возвращает значение < 0, если Str1 < Str2, 0, если Str1 = Str2, и > 0, если Str1 > Str2.

function StrCopy( Dest, Source: PChar ): PChar; 

Функция производит быстрое копирование строки Source в Dest и возвращает Dest.

function StrLen( const Str: PChar ): Cardinal; 

Функция возвращает число символов в строке Str, не учитывая конечного нулевого символа.

function StrScanLen( Str: PChar; Chr: Char; Len: Integer ): PChar; 

Быстрое сканирование строки Str длиной Len на нахождение в нем первого символа Chr . Если Chr не входит в Str, возвращается nil.

function StrScan( Str: PChar; Chr: Char ): PChar; 

Полный аналог предыдущей функции только сканирование происходит всей строки Str до последнего символа.

function StrRScan( const Str: PChar; Chr: Char ): PChar;

Возвращает указатель на последнее вхождение символа Chr в строку Str. Если Chr не входит в Str, возвращается nil.

function StrIsStartingFrom( Str, Pattern: PChar ): Boolean; 

Возвращает True если строка Str начинается со строки Pattern, то есть если Copy( Str, 1, StrLen( Pattern ) ) = Pattern

procedure Str2LowerCase( S: PChar ); 

Переводит символы в нуль-терминальной строке в верхней регистр.

function TrimLeft( const S: string ): string; 

Удаляет из начала строки S пробелы и управляющие символы

function TrimRight( const S: string ): string;

Удаляет в конца строки S пробелы и управляющие символы.

function Trim( const S: string ): string;

Удаляет в конца и в начале строки S пробелы и управляющие символы.

function UpperCase( const S: string ): string; 

Преобразует символы в строке S к верхнему регистру. Только для латинских символов.

function WStrReplace( var S: WideString; const From, ReplTo: WideString ): Boolean; 

Производит замену в строке S первой встреченной строки From на строку ReplTo. Если замена произошла успешно возвращает True. Анналог функции StrReplace только для WideString (поэтому в Delphi 2 не будет)

function WStrLen( W: PWideChar ): Integer; 

Возвращает длину строки типа PWideChar.

procedure WStrCopy( Dest, Src: PWideChar );

Копирует строку Dest тип PWideChar в Src

function WStrCmp( W1, W2: PWideChar ): Integer; 

Сравнивает 2-е строки тип PWideChar. На выходе тоже что и у StrComp

function Clipboard2Text: String;

Возвращает из буфера обмена текст.

function Text2Clipboard( const S: String ): Boolean;

Помещает в буфер обмена текст

Работа с файлами

function DirectoryExists( const Name: string ): Boolean; 

Возвращает Tгue если директория существует.

function DirectoryEmpty( Name: String ): Boolean;

Возвращает Tгue если директория не существует.

function DirectoryHasSubdirs( const Path: String ): Boolean; 

Возвращает True если директория Path существует и не имеет подкаталоги.

function CheckDirectoryContent( const Path: String; SubDirsOnly: Boolean; const Mask: String ): Boolean; 

Возвращает TRUE если директория Path не содержит файлов (или каталогов если вы установили SubDirsOnly = true) с определенной маской.

function IncludeTrailingPathDelimiter( const S: string ): string; 

Добавляет символ '\' в конец строки если он там не присутствует.

function ExcludeTrailingPathDelimiter( const S: string ): string;

Удаляет из конца строки символ '\' если он там присутствует.

procedure ForceDirectories( Dir: String );

Создает каталог Dir если он не существует. Если нужно то создает и подкаталоги для этого каталога.

function CreateDir( const Dir: string ): Boolean; 

Создает каталог.

function ExtractShortPathName( const Path: String ): String;

Из длиного пути создает короткий путь.То есть если у вас
D:\Program Files\Borland\Delphi 3 то будет
D:\PROGRA~1\BORLAND\DELPHI~1

function ExtractFileNameWOext( const Path: String ): String;

Из полного пути к файлу выделяет имя файла без расширения.
То есть если у вас на входе
D:\Program Files\Borland\Delphi 3\prog\api.txt
на выходе : api

function FileFullPath( const FileName: String ): String;

Из короткого пути создает длинный путь.

function FileShortPath( const FileName: String ): String; 

Из длинного пути создает короткий путь.

function FileSize( const Path: String ): Integer;

Возвращает размер файла

function GetUniqueFilename( PathName: string ): String;

Создает уникальное имя файла на основе существующего PathName. Например у вас файл aaa.txt то на выходе получится aaa1.txt , aaa2.txt ...

function DiskFreeSpace( const Path: String ): Int64; 

Возвращает свободное место на диске. В Path должен находится путь до корневой директории, например : 'C:\'.

Работа с реестром

Сейчас уже стало стандартом, что настройки программы, важные (да и не очень) параметры храняться в реестре Windows. По этой причине и в KOL существует поддержка работы с реестром. Нельзя сказать, что эти инструменты такие же мощные, как и TRegister в VCL, но необходимый минимум найдется.

Работа с регистром в KOL построена с помощью функций. Их список я привожу в таблице с кратким описанием (хотя человек знакомый с TRegister поймет их и так).

Функция Выполняемое действие
Функции для работы с ключами
RegKeyOpenCreate

Создание ключа и его открытие

function RegKeyOpenCreate( Key: HKey; const SubKey: String ): HKey;

RegKeyOpenRead

Открытие ключа для чтения

function RegKeyOpenRead( Key: HKey; const SubKey: String ): HKey;

RegKeyOpenWrite

Открытие ключа для записи

function RegKeyOpenWrite( Key: HKey; const SubKey: String ): HKey;

RegKeyClose

Закрытие ключа регистра ранее открытого с помощью RegKeyOpenRead или RegKeyOpenWrite

procedure RegKeyClose( Key: HKey );

RegKeyDelete

Удаление ключа регистра

function RegKeyDelete( Key: HKey; const SubKey: String ): Boolean;

RegKeyExists

Возвращение true, если "подключ" (SubKey) существует в данном ключе (Key)

function RegKeyExists( Key: HKey; const SubKey: String ): Boolean;

RegKeyGetSubKeys

Возвращение в List список всех "подключей"(ниже лежащих ключей) для ключа Key

function RegKeyGetSubKeys( const Key: HKEY; List: PStrList ): Boolean;

Функции для работы с переменными
RegKeyDeleteValue

Удаление из ключа Key переменной с именем Value.

function RegKeyDeleteValue( Key: HKey; const Value: String ): Boolean;

RegKeyValExists

Возвращение TRUE, если параметр ValueName существует в ключе Key.

function RegKeyValExists( Key: HKey; const ValueName: String ): Boolean;

RegKeyValueSize

Возвращает размер переменной(ValueName). Для переменных типа строка (string) возвращаемое значение равно длине строки + 1 (нулевой символ)

function RegKeyValueSize( Key: HKey; const ValueName: String ): Integer;

RegKeyGetValueNames

Возвращает список всех имен переменных находящихся в ключе Key

function RegKeyGetValueNames( const Key: HKEY; List: PStrList ): Boolean;

RegKeyGetValueTyp

Возвращает тип переменной под именем ValueName. Возвращаемое значение может быть следующие :

REG_BINARY , REG_DWORD, REG_DWORD_LITTLE_ENDIAN,
REG_DWORD_BIG_ENDIAN, REG_EXPAND_SZ, REG_LINK , REG_MULTI_SZ,
REG_NONE, REG_RESOURCE_LIST, REG_SZ

function RegKeyGetValueTyp( const Key: HKEY; const ValueName: String ): DWORD;

Функции для работы с переменными DWORD
RegKeyGetDw

Чтение из ключа данных типа DWORD. Если чтение не успешно, то возвращение 0

function RegKeyGetDw( Key: HKey; const ValueName: String ): DWORD;

RegKeySetDw

Запись в ключ данных типа DWORD.

function RegKeySetDw( Key: HKey; const ValueName: String; Value: DWORD ): Boolean;

Функции для работы с переменными STRING
RegKeyGetStr

Чтение из ключа данных типа String. Если чтение не успешно, то возвращение пустой строки

function RegKeyGetStr( Key: HKey; const ValueName: String ): String;

RegKeyGetStrEx

Чтение из ключа данных типа String. Если чтение не успешно, то возвращение пустой строки. Расширенный по саоим возможносям вариант RegKeyGetStr.

function RegKeyGetStrEx( Key: HKey; const ValueName: String ): String;

RegKeySetStr

Запись в ключ данных типа String.

function RegKeySetStr( Key: HKey; const ValueName: String; const Value: String ): Boolean;

Функции для работы с переменными BINARY
RegKeyGetBinary

Чтение из ключа данных типа binary. Происходит запись данных из реестра в буфер Buffer размером Count. На выходе у функции количество прочитанных байт.

function RegKeyGetBinary( Key: HKey; const ValueName: String; var Buffer; Count: Integer ): Integer;

RegKeySetBinary

Запись в ключ данных типа Binary.

function RegKeySetBinary( Key: HKey; const ValueName: String; const Buffer; Count: Integer ): Boolean;

Функции для работы с датой
RegKeyGetDateTime

Чтение из переменной с именем ValueName дыты. В реестре эти данные хранятся в бинарном виде.

function RegKeyGetDateTime( Key: HKey; const ValueName: String ): TDateTime;

RegKeySetDateTime

Запись даты в реестр.

function RegKeySetDateTime( Key: HKey; const ValueName: String; DateTime: TDateTime ): Boolean;

Для начала работы с каким-либо ключом регистра, вы должны открыть его с помощью функций RegKeyOpenRead, RegKeyOpenWrite или RegKeyOpenCreate. В первом параметре должен передаватся HKey какого нибудь ранее открытого ключа или одна из следующих констант:
HKEY_CLASSES_ROOT, HKEY_CURRENT_USER, HKEY_LOCAL_MACHINE, HKEY_USERS
Второй параметр:SubKey - имя ключа расположенного ниже Key.

После того как вы открыли ключ, вы можете записывать и читать данные. Ну и логическое завершение всего процесса - это команда RegKeyClose, т.е. закрытие ключа, если он вам больше не нужен.

Пример чтения и записи в реестра:

program Primer_1;   
   
uses   
  windows,   
  messages,   
  kol;   
   
{$R *.RES}   
const   
 KeyWin = 'SOFTWARE\Microsoft\Windows\CurrentVersion';   
   
var   
 Form,   
 edOption,   
 buOption,   
 List,   
 panTop:pControl;   
 Key:HKey;   
   
///////////////////////////////////////////////////////////   
Procedure ClickOnList( Dummy : Pointer; Sender : PControl );   
begin   
 // чтение из реестра   
 Key := RegKeyOpenRead(HKEY_LOCAL_MACHINE,KeyWin);   
 edOption.Text := RegKeyGetStr(Key,List.Items[List.CurIndex]);   
 RegKeyClose(Key);   
end;   
///////////////////////////////////////////////////////////   
Procedure ClickOnButton( Dummy : Pointer; Sender : PControl );   
begin   
 // запись в реестра  
 if edOption.Text='' then exit;   
 Key := RegKeyOpenWrite(HKEY_LOCAL_MACHINE,KeyWin);   
 RegKeySetStr(Key,List.Items[List.CurIndex],edOption.Text);   
 RegKeyClose(Key);   
end;   
///////////////////////////////////////////////////////////   
   
begin   
 Form := NewForm(Applet,'Пример работы с реестром').SetSize(400,200);   
   
 // можно было обойтись и Form.CanResize := false   
 Form.Style := WS_BORDER or WS_SYSMENU or WS_VISIBLE;   
   
 Form.Font.FontName := 'MS Sans Serif';   
 Form.Font.FontHeight := 8;   
   
 panTop := NewPanel(Form,esRaised).SetAlign(caTop);   
 edOption := NewEditbox(panTop,[]);   
 buOption := NewButton (panTop,'Применить').PlaceRight;   
 buOption.OnClick := TOnEvent( MakeMethod( nil, @ClickOnButton ) );   
   
 List := NewListbox(Form,[]).SetAlign(caClient);   
 List.Add('ProductId');   
 List.Add('ProductName');   
 List.Add('RegisteredOrganization');   
 List.Add('RegisteredOwner');   
 List.Add('Version');   
 List.Add('VersionNumber');   
 List.OnClick := TOnEvent( MakeMethod( nil, @ClickOnList ) );   
    
 // ----- Наводим красоту жонглируя с размерами.--------   
 //  Можно и не вникать :)   
 edOption.Width := panTop.Width - buOption.Width-10;   
 buOption.Left := edOption.Width+ 4 ;   
 panTop.Height := edOption.Height+10;   
 //-----------------------------------------------------   
   
 Run(Form);   
end.   

Если вы читали мои предыдущие монологи про KOL, вам должно быть в основном все понятно. Не говорил я только про свойства Font.FontName и Font.FontHeight, но тут можно вполне догадатся, что мы меняем параметры шрифта.

Работа с потоками

Поговорим про потоки в KOL. Вещь безусловно нужная и поэтому очень приятная :). Потоки позволяют сделать более гибкой работу по обмену и выводу данных из различных источников. Для разных источников (носителей), чтение данных происходит по разному, а потоки унифицируют этот процесс. Теоретическую часть этого вопроса можно найти в любой книжке по Delphi, так что особо разглагольствовать я не буду. Скажу лишь что во многих случаях без них совершенно не обойтись. Например :
Вы в ресурс вашей программы поместили gif или jpg файл (ну не хочется вам таскать их отдельными файлами). Разумеется вы захотите когда-нибудь показать их миру . Но не все так просто. Объекты PGif и PJpeg не читают данные из ресурса (только поток или файл). Т.е. у нас сложилась так, что ресурс (источник), не может передать информацию объектам PGif или PJpeg. Вот тут и приходят на помощь потоки. И таких примеров если покопаться можно отыскать достаточно.

В конце урока будет приведен пример именно работы с ресурсами (вывод изображения формата gif на экран и сохранения ресурса на диск), а сейчас рассмотрим "школьный минимум".

Конструкторы.

Для создания потока в памяти (чтение и запись):
function NewMemoryStream: PStream;
Для создания потоков работающих с файлами:

function NewReadFileStream( const FileName: String ): PStream;
function NewWriteFileStream( const FileName: String ): PStream;
function NewReadWriteFileStream( const FileName: String ): PStream;

FileName - имя фала на диске.
Эти три конструктора отличаются по целям для которых вы собираетесь использовать файл.
1-й для чтения ; 2-й для записи ; 3-й для записи и чтения.

Основные свойства PStream

Свойства PStream
Свойство
Описание
Size: DWord; Возвращает размер данных в потоке.
Position: DWord; Текущая позиция в потоке
Memory: Pointer; Указатель. Только для потоков созданных в памяти
Handle: THandle; Хэндл. Только для файловых потоков
Список методов:
Методы PStream
Метод
Описание

function Read( var Buffer; Count: DWord ): DWord;	Чтение в буфер (Buffer) Count байт из потока
function Write( var Buffer; Count: DWord ): DWord;	Запись Count байт в поток из буфера Buffer начиная с текущей позиции.

function WriteStr( S: String ): DWORD; Запись любой паскалевской строки (не заканчивающейся нулем) в поток. Запись происходит с текущей позиции.
А теперь сам обещанный пример. Для его работы у вас должен быть установлен KolGif. Вы также должны создать ресурс содержащий любой gif с именем logo.gif (в моем случаем это логотип нашего сайта).
Для этого создайте файл с расширение *.rc (у меня pic.rc) содержащий следующий текст:
LOGOTIP RCDATA "logo.gif"
Скомпилируйте при помощи brcc32.exe:
brcc32.exe pic.rc

В процедуре SavePic выполняется сохранения ресурса на жесткий диск (эта процедура происходит при клике по рисунку). В ShowForma gif рисунок извлекается из ресурса и выводится на экран.
В обоих процедурах используется функция Resource2Stream. Она переводит данные из ресурса в поток.

program Primer11;   
   
uses   
 kol,   
 messages,   
 windows,   
 kolgif;   
   
{$R *.RES}   
{$R pic.res}   
var   
 forma,   
 pb:pControl;   
 Gif: pGif;   
 PicStream:PStream;   
//////////////////////////////////////////////////////////////////////////   
// рисование избражения   
procedure DrawPaint( Dummy: Pointer; Sender: PControl; DC: HDC );   
begin   
 Gif.Draw(PB.Canvas.Handle,0,0);   
end;   
//////////////////////////////////////////////////////////////////////////   
//"забрасываем" ресурс на диск   
procedure SavePic( Dummy : Pointer; Sender: PControl );   
begin   
 //GetWindowsDir[1] - будем мусорить на системном диске :)   
 //создаем файл-поток для изображения   
 PicStream := NewWriteFileStream(GetWindowsDir[1]+':\logo.gif');   
 // переводим данные из ресурса в поток   
 Resource2Stream(PicStream,HInstance,'LOGOTIP',RT_RCDATA);   
 PicStream.free;   
end;   
//////////////////////////////////////////////////////////////////////////   
// показываем картинку из ресурса   
procedure ShowForma( Dummy : Pointer; Sender: PControl );   
begin   
 PicStream := NewMemoryStream; //создаем поток для изображения   
 // переводим данные из ресурса в поток   
 Resource2Stream(PicStream,HInstance,'LOGOTIP',RT_RCDATA);   
 //Указываем с какой позиции у нас будут читаться данные   
 PicStream.Position := 0;   
   
 gif := NewGif;   
 gif.LoadFromStream(PicStream);   
   
 PB := NewPaintBox(forma);   
 PB.OnPaint := TOnPaint( MakeMethod( nil, @DrawPaint ) );   
 // в случае клика по картинке сохраняем ее на диск   
 PB.OnClick := TOnEvent( MakeMethod( nil, @SavePic ) );   
   
 PB.Width := gif.Width ;   
 PB.Height:= gif.Height;   
 PB.CenterOnParent;   
   
 PicStream.free;   
end;   
//////////////////////////////////////////////////////////////////////////   
begin   
 Applet:=NewApplet('Работа с потоком');   
 Forma :=NewForm(Applet,'Работа с потоком (вывод gif)');   
 Forma.SetSize(310,120);   
 Forma.CenterOnParent;   
 Forma.Font.FontName := 'MS Sans Serif';   
 Forma.Font.FontHeight := 9;   
 Forma.onShow :=  TOnEvent(MakeMethod(nil,@ShowForma));   
 Run(Applet);   
end.   

Пример не совсем выгоден с точки зрения экономии дискового пространства :) Дело в том что логотип в bmp весит всего 24 Кб (цвет 8 бит), а KOLGif примерно 12Кб добавляет в размер программы + 12 Кб рисунок. Но при больших картинках помещать в ресурс gif уже более разумней.

Работа с ini файлами

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

В KOL работа с ini организованна с помощью объекта TIniFile.
Для того чтобы открыть ini-файл (и одновременно создать TIniFile), надо воспользоваться функцией OpenIniFile.
Свойство Mode отвечает за то, что вы будете делать с ini файлом : производить запись или чтение. Для записи вы должны прировнять Mode к ifmWrite, и соответственно для чтения к ifmRead. По умолчанию (при открытии) Mode = ifmRead, т.е. для чтения.

Для чтения/записи данных из ini используют 4 функции. Их описание приведено в таблице :

Функция Выполняемое действие
ValueInteger

Чтение/запись данных Value типа integer под именем Key

function ValueInteger( const Key: String; Value: Integer ): Integer;

ValueString

Чтение/запись данных Value типа string под именем Key

function ValueString( const Key: String; const Value: String ): String;

ValueBoolean

Чтение/запись данных Value типа boolean под именем Key

function ValueBoolean( const Key: String; Value: Boolean ): Boolean;

ValueData

Чтение/запись данных на которые указывает Value длинной Count под именем Key

function ValueData( const Key: String; Value: Pointer; Count: Integer ): Boolean;

Еще раз повторюсь и напомню, что чтение или запись происходит в зависимости от того чему равно свойство Mode.

Как известно ini файлы построены по следующему принципу

[Section1]
Key1=Value
Key2=Value
...
[Section2]
Key1=Value
Key1=Value
...

Section - секция (раздел) ini файла.
Key - имя переменной
Value - Переменная которая записывается под именем Key
(Кто этого не знал, может открыть любой ini файл и убедится в этом).
За то из какой секции происходит чтение (или запись) отвечает свойство Section. Для того чтобы получить список секций надо обратится к GetSectionNames. А для получения данных из секции, надо воспользоваться SectionData. И у первой и второй процедуры данные записываются в объект типа pStrList (список строк).
Я про него пока ничего не рассказывал, но он мало чем отличается от от VCL аналога TStringList. Но отличия все-таки есть, и к сожалению не в пользу pStrList. У pStrList нет таких свойств как Name и Value, а они бы не помешали, так как SectionData возвращает список из переменных и их значений в том же виде, в каком они записаны в ini файле (т.е разделенные знаком равно).
Ну это не такая и большая проблема :) В подтверждение этого, маленький примерчик простенького ini-редактора.
Программа внешне состоит из двух списков (List1 и List2). В List1 заносятся имена секторов, а в List2 список переменных и их значения. Сверху два поля (edName и edDan), в которые заносятся имя переменной и ее значение, когда происходит двойной клик по List2. Поле edDan (в него заносятся значение) можно редактировать.

program Primer_2;   
   
uses   
  windows,   
  messages,   
  kol;   
   
var   
 Form,   
 panTop,   
 buWrite,   
 edDan,edName,   
 List1,List2:pControl;   
 dialog:pOpenSaveDialog;   
 strList:pStrList;   
 ini:pIniFile;   
 i:integer;   
   
/////////////////////////////////////////////////////////////////////  
  
// обработка клика по кнопке"записать "  
Procedure ClickOnBuWrite( Dummy : Pointer; Sender : PControl );   
begin   
 if edName.Text = '' then exit;   
 ini.Mode := ifmWrite;   
 ini.ValueString(edName.Text,edDan.text);   
 ini.Mode := ifmRead;   
end;   
/////////////////////////////////////////////////////////////////////   
Procedure ClickOnList2( Dummy : Pointer; Sender : PControl );   
var   
 s:string;   
 i:integer;   
begin   
 s:= List2.Items[List2.CurIndex];   
 i:= IndexOfChar(s,'=');   
 edName.Text := Copy(s,0,i-1);   
 edDan.Text := CopyEnd(s,i+1);   
end;   
/////////////////////////////////////////////////////////////////////   
Procedure ClickOnList1( Dummy : Pointer; Sender : PControl );   
var   
 j:integer;   
begin   
 edName.Clear ;   
 edDan.Clear ;   
 j:=List1.CurIndex;   
 // заносим в List2 данные, которые находятся в j-ой секции   
 strList.Clear ;   
 List2.Clear ;   
 ini.Section := List1.Items[j];   
 ini.SectionData(strList);   
 for i:=0 to strList.Count-1 do   
  List2.Items[i]:=strList.Items[i];   
end;   
/////////////////////////////////////////////////////////////////////   
begin   
 Applet := NewApplet('Пример #2');   
   
 dialog := NewOpenSaveDialog('Выбор ini','',[]);   
 dialog.Filter := '*.ini|*.ini|все|*.*';   
 dialog.OpenDialog := true;   
 if dialog.Execute then   
   ini:=OpenIniFile(dialog.Filename)   
  else   
   exit;   
   
 //----------- делаем интерфейс ------------------------   
 Form := NewForm(Applet,'Работа с Ini файлами').setSize(400,300);   
 Form.Font.FontName := 'MS Sans Serif';   
 Form.Font.FontHeight := 9;   
 Form.Style := WS_BORDER or WS_SYSMENU or WS_VISIBLE;   
   
 panTop := NewPanel(Form,esRaised ).SetAlign(caTop) ;   
 panTop.Height := 60 ;   
 buWrite := NewButton(panTop,'Записать');   
 buWrite.OnClick := TOnEvent( MakeMethod( nil, @ClickOnBuWrite ) );   
   
 edName := NewEditBox(panTop,[eoReadOnly]). PlaceDown;   
 edDan := NewEditBox(panTop,[]). PlaceRight;   
 edDan.Width := Form.Width -edName.Width- 30;   
   
 strList:= NewStrList;   
   
 List1 := NewListBox(Form,[]).setAlign(caLeft);   
 List2 := NewListBox(Form,[]).setAlign(caClient);   
 //---------------------------------------------------   
   
 // заносим в List1 список секций   
 ini.GetSectionNames(strList);   
 for i:=0 to strList.Count-1 do   
  List1.Items[i]:=strList.Items[i];   
   
 List1.OnChange := TOnEvent( MakeMethod( nil, @ClickOnList1 ) );   
   
 // показываем данные из 0-ой секции   
 List1.CurIndex := 0;   
 ClickOnList1(nil,nil);   
   
 List2.OnClick := TOnEvent( MakeMethod( nil, @ClickOnList2 ) );   
 run(Applet);   
end.   

Программа в треe с легкостью

Часто можно услышать вопрос : как сделать так, чтобы программа была видна и в трее (рядом с часами) ? Конечно и на VCL это возможно сделать, но в KOL это реализуется очень просто. Для этого у него есть объект TTrayIcon. Воспользовавшись им, вы получите маленькую программу (а не VCL-монстра) с иконкой в трее.

function NewTrayIcon( AParent: PControl; Icon :HIcon): PTrayIcon;

Icon - это иконка, которая будет у нас грузится из ресурса созданного например с помощь Image Editor, или BRCC32.EXE, ну или другой утилиты (я очень рекомендую Resource Builder).
Скомпонованный фай с расширением .res помещаем в каталог с нашей программой. В тексте программы должно быть прописано, что программа компилируется вместе с ресурсами: {$R *.res} .
Сама иконка грузится из ресурса через API ф-цию LoadIcon.

Function LoadIcon(Instance: THandle; IconName: PChar): HIcon;

Загpужает поименнованный ресурс пиктограммы.

Паpаметpы:
Instance:
Экземпляp модуля, исполнимый файл которого содержит пиктограмму или 0 для предопределенной пиктограммы.

IconName:
Стpока или имя целочисленного идентификатора или предопределенная пиктограмма, определенная одной из констант idi_.

Возвpащаемое значение:
В случае успешного завершения - идентификатор пиктограммы; 0 - в противном случае.

Функция находится в файле user32.dll .

Также для значка в трее мы должны создать Applet. Совсем не обязательно чтобы этот Applet был родительским объектом окна.
Лучше тысячи слов может быть наглядней только пример. Напишем утилиту облегчающую программирование на KOL

program KOLProcedure;  
  
uses  
  windows,  
  messages,  
  kol;  
  
{$R *.RES}  
var  
 frmMain,  
 panel:pControl;  
 Tray:pTrayIcon;  
 Menu:pMenu;  
  
//////////////////////////////////////////////////////////  
procedure doTrayMouse(dummy:pointer;sender:Tobject;Message:Word);  
var  
P:Tpoint;  
begin  
  if message = WM_LBUTTONUP then  
  begin  
    getcursorpos(p); //узнаем позицию курсора  
    Menu.PopUp(p.x,p.y); // выводим в этой позиции меню  
  end;  
end;  
//////////////////////////////////////////////////////////  
procedure doWorkMenu(Dummy:pointer;Sender:pMenu;Item:Integer);  
begin  
 case Item of  
  0:Text2Clipboard('Procedure NameProc ( Dummy : Pointer; Sender: PControl );') ;  
  1:Text2Clipboard('Procedure NameProc ( Sender: PObj; var Accept: Boolean );') ;  
  2:Text2Clipboard('Procedure NameProc ( Sender: PControl; var Mouse: TMouseEventData );') ;  
  3:Text2Clipboard('Procedure NameProc ( Sender: PControl; var Key: Longint; Shift: DWORD );') ;  
  4:Text2Clipboard('Procedure NameProc ( Sender: PControl; var Key: Char; Shift: DWORD );') ;  
  5:Text2Clipboard('Procedure NameProc ( Sender : PMenu; Item :Integer );') ;  
  6:Text2Clipboard('Function NameFunc ( var Msg: TMsg; var Rslt:Integer ): Boolean;') ;  
  7:Applet.close;  
  8:MsgOK('8');  
 end;{case}  
end;  
//////////////////////////////////////////////////////////  
begin  
 Applet := NewApplet('KOL Procedure');  
  
 frmMain := NewForm(nil,'KOL Procedure');  
 frmMain.Icon:=LoadIcon(hinstance,'MainIco');  
 frmMain.Hide; // прячем главное окно   
  
 panel := NewPanel(frmMain,esNone);  
 Menu := NewMenu(panel,0,  
[ 'TOnEvent',  
  'TOnEventAccept',  
  'TOnEventAccept',  
  'TOnKey',  
  'TOnChar',  
  'TOnMenuItem',  
  'TOnMessage',  
  '-',  
  'Exit'],  
 TOnMenuItem( MakeMethod( nil, @doWorkMenu ))  
 );  
 Tray := NewTrayIcon(panel,frmMain.Icon) ; // иконка в трее - аналог иконки на форме  
 Tray.OnMouse:=TOnTrayIconMouse(Makemethod(nil,@doTrayMouse));  
 run(frmMain)  
end.  

Меню. Как много в этом слове...

Почти в любой программе есть меню. И у нас оно тоже будет.
Меню создается на объектах типа pMenu

function NewMenu( AParent: PControl; FirstCmd: Integer; const Template: array of PChar; aOnMenuItem: TOnMenuItem ): PMenu;

В AParent вы указываете к чему будет принадлежать меню. Если вы указали форму, то для нее это будет главное меню.

Template - это массив, состоящий из пунктов меню. В этих пунктах могут встречаться специальные символы. Вот их список:

Символ Значение
& подчеркивает следующий символ
+ галочка в меню
- разделитель между пунктами меню
( начало подменю
) конец подменю
Через aOnMenuItem указывается процедура, обрабатывающая выбранный пункт меню.

Описание некоторых свойств меню

Свойство Описание
ItemChecked[idx:integer]:boolean Ставит/убирает галочку на пункт меню с индексом idx
RadioCheck(idx:integer) Ставит радио-галочку на один из пунктов меню
Popup(x,y:integer); Вызывает меню на экран в позиции x,y
ItemText[idx:integer]:string Текст пункта меню с индексом idx
ItemEnabled[idx:integer]:boolean Включает/выключает пункт меню с индексом idx
ItemVisible[idx:integer]:boolean Показывать/не показывать пункт меню с индексом idx
Давайте добавим в наш редактор пару пунктов меню:

program Primer;  
  
uses  
  Windows,  
  messages,  
  KOL;  
  
{$R *.RES}  
var  
  form,  
  PanTools,  
  REdit,  
  butOpen,  
  butSave:PControl;  
  mainMenu:pMenu;  
  Dialog:pOpenSaveDialog;  
  
procedure clikButOpenSave( Dummy : Pointer; Sender : PControl );  
var  
 title:string;  
begin  
 if sender= butOpen then  
  begin  
   Dialog.title := 'Открыть';  
   Dialog.OpenDialog := true;  
   REdit.Clear ;  
  end  
 else  
  begin  
   Dialog.title := 'Сохранить как...';  
   Dialog.OpenDialog := false;  
  end;  
 if Dialog.Execute then  
 if sender= butOpen then  
    REdit.RE_LoadFromFile(Dialog.Filename,reText,false)  
   else  
    REdit.RE_SaveToFile(Dialog.Filename,reText,false);  
 form.StatusText[0]:=PChar(Dialog.Filename);  
end;  
  
procedure ProcessingMenu (Dummy:pointer;Sender:pMenu;Item:Integer);  
//обработка  пунктов меню  
begin  
 case Item of  
  1:begin {NEW}  
     REdit.Clear ;  
     form.StatusText[0]:='';  
    end;  
  2:clikButOpenSave(nil,butOpen); {Open}  
  3:clikButOpenSave(nil,butSave); {Save As}  
  4:Applet.Close; {Exit}  
 end;{case}  
end;  
  
begin  
  form:=NewForm(Applet,'Редактор');  
  panTools := NewPanel(form,esRaised).SetAlign(caTop);  
  panTools.Height := 35 ;  
  REdit := NewRichEdit(form,[]).SetAlign(caClient);  
  butOpen:= NewButton(panTools,'Open').SetSize(50,25);  
  butSave:= NewButton(panTools,'Save as').SetSize(60,25).PlaceRight ;  
  Dialog:=NewOpenSaveDialog('','',[]) ;  
  mainMenu := NewMenu(form,0,  
  [  
  'File',  
  '(',  
    'New',  
    'Open',  
    'Save As..',  
    '-',  
    '&Exit',  
  ')'  
  ],  
  TOnMenuItem( MakeMethod( nil, @ProcessingMenu ))  
  );  
  
  butOpen.OnClick := TOnEvent(MakeMethod(nil,@clikButOpenSave));  
  butSave.OnClick := TOnEvent(MakeMethod(nil,@clikButOpenSave));  
  run(form);  
end.

Жизнь и смерть в режиме RunTime на KOL

В этом разделе у нас будет немного мистики и чертовщины (Кнопки и прочие контролы интерфейса будут возникать и пропадать неоткуда). В общем если вы немного Гарри Потерр данный монолог будет вам интересен :)

В форуме уже звучали вопросы про "динамическое" создание кнопок. Если ваш проект на VCL то глоток знаний по данному вопросу можно получить на сайте Королевство DELPHI в статья "Жизнь и смерть в режиме run-time" (надеюсь автор статьи не обвинит меня в плагиате).
Рекомендую вам прочесть данный опус для общего развития и потому что фактически все ниже изложенное вытекает из этого произведения.

Что бы понять отличия от VCL в данном вопросе надо уяснить 2 вещи :

У объектов нет свойства Name (поэтому вы не сможете их искать через FindComponent)
Все изменения вытекают из 1-го пункта :)
При создание объекта на уже работающем окне вам кроме обычного конструктора надо сделать обращение к CreateWindow.
Пример :

// form - родительский объект на котором создается контрол  
NewBigButton := NewButton(form,'КНОПКА');  
NewBigButton.CreateWindow;  

Если все нормально CreateWindow возвращает true. Так что если вы "правильный" программист неплохо бы эту функцию вызывать c проверкой через IF.

"Родительский" объект "нумерует" все объекты которые вы создаете на нем.
Для того что бы узнать под каким номером идет ваш "дочерний" объект нужно обратившись к свойству ChildIndex. А если вам известен номер "дочернего" объекта то вы сможете обратится к нему через свойство Children.
Пример :

var  
i:integer;  
...  
  
// form - родительский объект  
NewBigButton := NewButton(form,'КНОПКА');  
NewBigButton.CreateWindow;  
  
i := form.ChildIndex(NewBigButton) // получаем номер объекта  
form.Children(i).caption := ' Это кнопка' // обращаемся к тому же NewBigButton  

Количество дочерних объектов узнается с помощью ChildCount. Таким образом можно устроить "перебор" всех дочерних объектов определенного контрола.

Наверное у некоторых читателей может возникнуть вопрос: к чему мне все эти "номера дочерних объектов"?
Ответ на вопрос лежит на поверхности. Если вы создаете ваши контролы динамически(их количество не определено заранее) вы не сможете обратится к ним другим способом только как через его номер.
При этом надо учесть что номера объектов сдвигается если ранее созданный объект удален.

Для того что бы создаваемые вами визуальные объекты имели дополнительную информацию можно использовать свойство Tag. В него можно заносить любое целое число. В ниже приведенном примере в Tag заносится константа которая указывает на "функциональный тип" объекта (кнопка, EditBox и т.д.)

program Primer13;   
   
uses   
  kol,   
  messages,   
  windows;   
   
{$R *.RES}   
var   
 form,butNewElement,lebDel,edNoDel,butDelElement,gb,   
 rbButton,rbEditBox,rbRadioBox,rbCheckBox:pControl;   
 new:pControl;   
 Nomer:integer;   
   
const   
 cButton=1;   
 cEditBox=2;   
 cRadioBox=3;   
 cCheckBox=4;   
   
procedure ClickElemet( Dummy : Pointer; Sender: PControl );   
begin   
 case Sender.Tag of   
  cButton:ShowMessage('Нажата кнопка - № '+Int2Str(form.ChildIndex(Sender)));   
  cRadioBox:ShowMessage('Нажата RadioBox - № '+Int2Str(form.ChildIndex(Sender)));   
  cCheckBox:ShowMessage('Нажат CheckBox - № '+Int2Str(form.ChildIndex(Sender)));   
 end;{case}   
end;   
   
Procedure ClickButMakeButton ( Dummy : Pointer; Sender : PControl );   
begin   
 // Фактически самая главная функция.   
 // В зависимости от того какой RadioBox выбран создаем   
 // определенного вида объект   
   
 if rbButton.Checked then   
  begin   
   new:= NewButton(form,'');   
   new.Width := 100;   
   new.Caption := 'Button №'+int2Str(form.ChildIndex(new));   
   new.Tag := cButton;   
  end   
 else   
 if rbEditBox.Checked then   
  begin   
   new:= NewEditBox(form,[]);   
   new.Text :='EditBox №'+int2Str(form.ChildIndex(new));   
   new.Tag := cEditBox;   
  end   
 else   
 if rbRadioBox.Checked then   
  begin   
   new:= NewRadioBox(form,'');   
   new.Caption := 'RadioBox №'+int2Str(form.ChildIndex(new));   
   new.Width := 100;   
   new.Tag := cRadioBox;   
  end   
 else   
 if rbCheckBox.Checked then   
  begin   
   new:= NewCheckBox(form,'');   
   new.caption := 'CheckBox №'+int2Str(form.ChildIndex(new));   
   new.Width := 100;   
   new.Tag := cCheckBox;   
  end;   
   
 new.CreateWindow;   
   
 // ------- располагаем по красивее новый контрол -------   
 new.Left:= 10;   
 inc(Nomer);   
 // так как все 4 элемента имеют одинаковую высоту...   
 new.Top := Nomer*new.Height;   
 // ------------------------------------------------------   
   
 new.OnClick := TOnEvent(MakeMethod(nil,@ClickElemet));   
end;   
//////////////////////////////////////////////////////////////////////////   
procedure ClickDelElemet( Dummy : Pointer; Sender: PControl );   
begin   
 form.Children[Str2Int(edNoDel.Text)].free;   
end;   
//////////////////////////////////////////////////////////////////////////   
begin   
 Applet := NewApplet('RunTime');   
 Applet.Font.FontName := 'Arial';   
 Applet.Font.FontWidth := 15;   
 form:=NewForm(Applet,'Создание в режиме RunTime элементов интерфейса').SetSize(600,450);   
 form.CenterOnParent;   
   
//--------------------------- рисуем интерфейс ---------------------------   
 gb := NewGroupBox(form,'Выберите').SetAlign(caRight);   
 gb.Width := 100;   
   
 rbButton  := NewRadioBox(gb,'Button').SetAlign(caTop);   
 rbEditBox := NewRadioBox(gb,'EditBox').SetAlign(caTop);   
 rbRadioBox:= NewRadioBox(gb,'RadioBox').SetAlign(caTop);   
 rbCheckBox:= NewRadioBox(gb,'CheckBox').SetAlign(caTop);   
   
 // главная кнопка   
 butNewElement := NewButton(gb,'Создать');   
 butNewElement.Width := 110;   
 butNewElement.Align := caTop;   
 butNewElement.OnClick := TOnEvent( MakeMethod( nil, @ClickButMakeButton ) );   
   
 butDelElement :=NewButton(gb,'Удалить').SetAlign(caBottom);   
 butDelElement.OnClick := TOnEvent( MakeMethod( nil, @ClickDelElemet));   
 edNoDel := NewEditBox(gb,[]).SetAlign(caBottom);   
 edNoDel.Text := '1';   
 lebDel := NewWordWrapLabel(gb,'Номер удаляемого элемента').SetAlign(caBottom);   
 //------------------------------------------------------------------------   
   
 run(Applet);   
end.   

Размер кода 3,3 Кб. Размер программы 31,5 Кб (без сжатия и замены модулей).

P.S.
Уже когда все было написано Дмитрий Жаров aka Gandalf внес замечание по поводу того что (далее идет цитата)

>1) Есть Tag, ему можно присвоить PChar, вот так:
>obj1.Tag := Integer( 'Obj1' );

(это вырезка из переписки Gandalf с Кладовым)
Мысль очень не плохая так как дает возможность назначать контролам имена и делать поиск по ним.

KOL - кодоэкономичная объектная библиотека для Delphi

Цель данной статьи - убедить читателя (я надеюсь, этот текст попадет в руки программиста), привыкшего к большим размерам современных программ (о, нет, приложений, программы-то как раз были еще не очень большими) в том, что его бессовестно надувают. Когда утверждают, что программа для среды Windows, если она что-то полезное умеет делать, никак не может быть меньше... ну, скажем, трехсот килобайт. А если это очень "умная" программа, содержащая очень много полезных возможностей, хороший интерфейс, отлично взаимодействующая с пользователем, поддерживает различные форматы данных, современные клиент-серверные технологии, то без полсотни мегабайт ну никак не обойтись. Чушь несусветная. Нас обманывают!

На самом деле, объектное программирование позволяет создавать очень экономичный по размеру код. Причем, достаточно эффективный. Примеры? Пожалуйста. Ява - объектно-ориентированное программирование. Ява-апплеты очень невелики по своим размерам, а как много полезного они умеют делать! Впрочем, речь пойдет не о Яве. Предметом данного разговора будет среда Delphi.

Как ни странно, именно Delphi оказался тем инструментом, с помощью которого оказалось возможным изготовить библиотеку KOL - Key Objects Library (Ключевую Объектную Библиотеку). Странно потому, может быть, что программы, изготовленные средствами Delphi, обычно маленькими не бывают. Минимальный стартовый размер приложения, представляющего из себя одно пустое окно, которое можно подвигать по экрану и закрыть, и которое, собственно, ничего больше делать не умеет, составляет около трехсот килобайт. Причем, с выпуском каждой очередной версии Delphi этот стартовый размер вырастает еще на несколько десятков ни в чем неповинных килобайт.

Библиотека KOL позволяет изготавливать не менее мощные приложения, чем стандартная библиотека Delphi - VCL (Visual Component Library, Визуальная Библиотека Компонентов). И при этом добиваться уменьшения размеров программ в 5-15 раз! Например, приложение DirComp, доступное для загрузки на сайте KOL, занимает без сжатия упаковывающими программами около 65 килобайт. Аналогичное приложение, написанное за два года до этого с использованием стандартной библиотеки Delphi, занимало 750 килобайт. Разница впечатляет, не правда ли?

KOL - не только объектно-ориентированная, но и визуальная библиотека. Программы и их графический интерфейс возможно проектировать практически так же, как и в визуальной среде VCL. В дополнение к KOL идет библиотека MCK (Mirror Classes Kit, Библиотека Зеркальных Классов), которая содержит VCL-компоненты, устанавливающиеся на палитру обычным образом. Единственное отличие в том, что зеркальные компоненты библиотеки MCK существуют только на стадии разработки (design time), участвуя в генерации "настоящего" кода, совместимого с требованиями библиотеки KOL. Во время работы (run time) выполняется этот код, и тот, который был добавлен самим разработчиком. В коде времени исполнения нет ссылок на компоненты VCL, есть только объекты KOL, компактные и эффективные.

В чем же заключается секрет компактности кода? Ответ не один, но выделить главные составляющие все же представляется возможным. В первую очередь следует отметить способность компилятора Delphi не включать в код конечного приложения невостребованный код. Процедуры и переменные, на которые нет ссылок из того кода, который уже внесен в список участков кода, подлежащих включению в конечный продукт, отбрасываются и в дальнейшей сборке не участвуют. К сожалению, данная способность компилятора Delphi, называемая самими разработчиками компилятора "smart linking" (умное связывание), несколько ограничена. В частности, виртуальные методы используемых классов и объектов не могут быть изъяты из процесса компиляции и сборки приложения. Соответственно, и те переменные и процедуры (методы), на которые имеются ссылки из таких виртуальных методов, также не могут быть отброшены.

При разработке библиотеки KOL это обстоятельство было учтено. Автору пришлось отказаться от жесткого следования канонам объектно-ориентированного программирования. В частности, в KOL один и тот же объектный тип может использоваться для инкапсуляции нескольких подобных друг другу объектов. Например, тип TControl не является базовым для описания визуальных объектов подобно тому, как это сделано в VCL. Представители объектного типа TControl в библиотеке KOL уже без какого-либо наследования могут выполнять роль различных визуальных объектов (кнопок, меток, панелек, и т.п.) - в зависимости от того, какая глобальная функция использовалась для конструирования каждого конкретного объекта (например, NewPanel, NewButton и т.д.)

Такое совмещение нескольких объектов в одном объектном типе, вообще говоря, может приводить к некоторой путанице, поскольку наряду с методами и свойствами, общими для всех объектов, инкапсулированных этим объектным типом, могут иметься методы и свойства сугубо индивидуальные, характерные только для некоторой конкретной разновидности объектов. Поскольку тип (класс) тот же самый, существует вероятность ошибочного применения метода, не свойственного для данной разновидности объекта. Единственная причина, заставившая автора поступать так, это необходимость избежать большого числи виртуальных методов.

Разумеется, если бы виртуальные методы благополучно пропускались компилятором в тех случаях, когда они не нужны (а потенциально такая возможность существует), структуру объектов можно было бы сделать более ясной. Тем не менее, даже и в этом случае VCL не позволил бы программам стать намного компактнее. И проблема здесь уже в том, что разработчики VCL спроектировали свою библиотеку так, что многие объекты создаются и многие действия производятся еще до того, как будет известно, понадобятся ли они вообще, или так и останутся лежать в коде программы мертвым грузом. Например, если создается визуальный объект, то для него инициализируется шрифт, полотно для рисования, менеджеры перетаскивания, множество других объектов - на всякий случай: а вдруг понадобятся! Конечно, программе может понадобиться что-нибудь нарисовать, или изменить какой-нибудь шрифт. Программа может быть спроектирована для использования популярного интерфейса расположения плавающих панелей drag-and-dock. Может, но ведь не обязана, так?

В противоположность VCL, библиотека KOL поступает с необязательными действиями и объектами значительно более аккуратно. Они (действия) выполняются и (объекты) инициализируются только тогда, когда они впервые потребуются. Очистка ресурсов и памяти по завершении использования при этом проблем как раз не представляет. Один и тот же (виртуальный) метод Free прекрасно справляется с освобождением отработавших подчиненных объектов, независимо от их типа. Собственно, это и есть главная причина того, почему программы, изготовленные с использованием библиотеки KOL, настолько кодоэкономичны.

В описываемой библиотеке используется несколько различных способов реализации такого отложенного принятия решения, в зависимости от природы необязательного к включению в программу кода. Важнее не столько перечислить эти способы, которые, вообще говоря, являются просто удачным применением общепринятых программистских приемов, сколько объяснить и понять суть их действия.

Как известно, исходный текст программы превращается в исполняемый машинный код в результате работы иногда нескольких программ: предкомпилятора, компилятора, сборщика. Отметим, что когда речь идет о среде Delphi, разделять эти шаги особого смысла не имеет, так как все они выполняются одной и той же программой. Поэтому, говоря "компилятор", будем подразумевать все эти этапы вместе. Поскольку именно компилятор Delphi принимает решение, подключать или не подключать код той или иной процедуры к программе, откладывание решения о необходимости ее использования путем первого обращения к ней в коде только тогда, когда ее функциональность оказалась востребована разработчиком проекта, требует пояснения.

На самом деле, все очень просто разъясняется следующим небольшим примером. Пусть наш визуальный объект (кнопка, к примеру) содержит свойство Font (шрифт). В отличие от VCL, не будем создавать подчиненный объект, соответствующий этому свойству, в конструкторе нашего объекта (кнопки, хозяина шрифта). Создадим его в том методе, который выполняет чтение свойства Font (в методе GetFont), в случае если он еще не создан. В итоге, если в приложении к свойству Font нигде нет обращений (т.е. разработчику не было нужды изменять шрифт своих визуальных объектов, и его устраивают стандартные шрифты, настроенные пользователем), компилятор не обнаружит и ни одного вызова метода GetFont, и соответственно, не включит в программу код этого метода. Следовательно, ни одной ссылки не будет обнаружено ни на конструктор объекта шрифта, ни на другие процедуры, которые иначе бы оказались задействованы и попали бы в исполнимый модуль.

Понятно, что приведенный пример поясняет только один из многих использованных приемов. Но принцип всех таких приемов один и тот же, а именно, как уже сказано выше: отложить принятие решения о подключении дополнительного кода до тех пор, пока он не потребуется разработчику программного продукта. По мнению автора, данный принцип в корне расходится со сложившейся практикой программирования. Пожалуй, на примере KOL, в частности доказана нелепость общепринятого подхода, который приводит к тому, что 90% кода в современных приложениях - это шлак, мусор, который если и работает, то вхолостую, и лишь попусту затрачивает ресурсы процессора, оперативной памяти, занимает место на жестком диске, отнимает время при передаче лишних сотен килобайт по сети и через Интернет, и залезает при этом в ваш карман. И недаром в ответ на вопрос, как уменьшить размер программы, иногда можно получить такой ответ, что, дескать, зачем уменьшать? - чем больше объем, тем больше заплатят. (Варианты: "солидней", заказчик больше уважает). Не бессмыслица ли?

Если кто-то из Delphi-программистов, прочитавших эту статью, заинтересуется, то милости прошу на Интернет-страницу KOL/MCK, берите себе эти библиотеки (все совершенно бесплатно, в исходных кодах), и обязательно попробуйте. Уверяю: не пожалеете!

Hello World или Обработка событий в KOL

Конечно кнопки и панели на форме - это хорошо, но они должны реагировать на действия совершаемые пользователем. Этим мы и займемся.
Смысл "обработки" действий такой же как и в VCL. К определенному действию над объектом, "привязывают" процедуры, которые и совершают полезную работу. Привязка идет через свойства, названия которых начинаются на OnXXXXXX: OnClick,OnResize,OnMouseDblClk,OnClose... Это довольно привычно.

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

тип события пример заголовка процедуры, обрабатывающего это событие
TOnEvent Procedure NameProc ( Dummy : Pointer; Sender : PControl );
TOnEventAccept Procedure NameProc ( Sender: PObj; var Accept: Boolean );
TOnMouse Procedure NameProc( Sender: PControl; var Mouse: TMouseEventData );
TOnKey Procedure NameProc( Sender: PControl; var Key: Longint; Shift: DWORD );
TOnChar Procedure NameProc( Sender: PControl; var Key: Char; Shift: DWORD );
TOnMenuItem Procedure NameProc( Sender : PMenu; Item : Integer );
TOnMessage Function NameFunc( var Msg: TMsg; var Rslt: Integer ): Boolean;
Например:

Procedure ButtonDn( Sender: PControl; var  Mouse: TMouseEventData );  
begin  
// обработка   
end;  
...  
  
Button := NewButton(Form,'Кнопка')  
// указываем на процедуру ButtonDn обрабатывающую событие OnMouseDown  
// имеющее тип TOnMouse:  
Button.OnMouseDown := TOnMouse( MakeMethod( nil, @ButtonDn ) );

Исходя из полученных знаний, давайте напишем программу, выводящую сообщение ( например: Hello World !!! ) при каком нибудь действии.

procedure ClikButton( Dummy : Pointer; Sender: PControl );  
begin  
 MsgOK( 'Hello World!!!' );  
end;  
  
var  
  form,button:PControl;  
  
begin  
  form:=NewForm(Applet,'Пример');  
  button:= NewButton(form,'Hello !!!').Size(150,50);  
  button.OnClick := TOnEvent(MakeMethod(nil,@ClikButton));  
  run(form);  
end.

Процедура MsgOk - это аналог VCL процедуры ShowMessage.