Оригинальный DVD-ROM: eXeL@B DVD !
eXeL@B ВИДЕОКУРС !

ВИДЕОКУРС ВЗЛОМ
выпущен 1 марта!


УЗНАТЬ БОЛЬШЕ >>
Домой | Статьи | RAR-cтатьи | FAQ | Форум | Скачать | Видеокурс
Новичку | Ссылки | Программирование | Интервью | Архив | Связь

БОЛЬШОЙ FAQ ПО DELPHI



Как конвертировать виртуальную клавишу в ASCII код

Получаем символ, соответствующий виртуальной клавише:


 function GetCharFromVKey(vkey: Word): string;
 var
   keystate: TKeyboardState;
   retcode: Integer;
 begin
   Win32Check(GetKeyboardState(keystate));
   SetLength(Result, 2);
   retcode := ToAscii(vkey,
     MapVirtualKey(vkey, 0),
     keystate, @Result[1],
     0);
   case retcode of
     0: Result := '';
     1: SetLength(Result, 1);
     2: ;
   else
     Result := '';
   end;
 end;
 
 // Использование:
 
 procedure TForm1.Edit1KeyDown
   (Sender: TObject; var Key: Word;
   Shift: TShiftState);
 begin
   ShowMessage(GetCharFromVKey(Key));
 end;
 




Визуализация нажатия кнопки

Автор: Ed Jordan

Я знаю как нажать кнопку через keypress, но хотя пользователь определил действие в обработчике события OnClick, сама кнопка не отражает видимых изменений, происходящих при ее нажатии мышью. Кто-нибудь может мне помочь?

Вы можете сделать кнопку "нажатой" или "ненажатой", посылая ей сообщение BM_SETSTATE. Определить ее текущее состояние можно, послав ей сообщение BM_GETSTATE.

Для нажатия кнопки:


 Button1.Perform( BM_SETSTATE, 1, 0 );
 

Для отжатия кнопки:


 Button1.Perform( BM_SETSTATE, 0, 0 );
 

Чтобы обнаружить нажатие кнопки:


 ButtonPressed := Button1.Perform( BM_GETSTATE, 0, 0 ) = 1;
 




Подождать завершения DOS-задачи

Выдержка из лекций компьютерных курсов. Изучают DOS и Norton Commander. Дословно: Запуск команды NORTON. Если запуск команды NORTON не включен в команду автозапуска, либо в процессе работы осуществлялся выход программы NORTON, то запустить ее можно с помощью посредства nc.exe - это запускающий файл программы NORTON, находится он в каталоге NC, где собрана вся программа.

Каким образом организовать ожидание завершения DOS-задачи? Например, надо подождать, пока заархивируется файл, и далее обработать его.


 uses Windows;
 
 procedure RunRarAndWait;
 var
   si: TStartupInfo;
   pi: TProcessInformation;
 begin
   //подготовливаем записи si и pi к использованию
   FillChar(si, SizeOf(si));
   si.cb := SizeOf(si);
   FillChar(pi, SizeOf(pi));
   //попытаемся запустить рар
   if CreateProcess('rar.exe', 'parameters',
   nil, nil, //безопасность по умолчанию
   false,    //не наследовать хэндлов
   0,        //флаги создания по умолчанию
   nil,      //переменные среды по умолчанию
   nil,      //текущая директория по умолчанию
   si,       //стартовая информация
   pi)       //а в эту запись получим информацию о созданом процессе
   then
   begin
     //удалось запустить рар
     //подождем пока рар работает
     WaitForSingleObject(pi.hProcess, INFINITE);
     //убираем мусор
     CloseHandle(pi.hProcess);
     CloseHandle(pi.hThread);
   end
   else
     //выдаем сообщение об ощибке
     MessageDlg(SysErrorMessage(GetLastError), mtError, [mbOK], 0);
 end;
 




Подождать завершения DOS-задачи 2

Сантехник - администратор сервера фирмы Sun.


 function WinExecute(CmdLine: string; Wait: Boolean): Boolean;
 var
   StartupInfo: TStartupInfo;
   ProcessInformation: TProcessInformation;
 begin
   Result := True;
   try
     FillChar(StartupInfo, SizeOf(StartupInfo), 0);
     StartupInfo.cb := SizeOf(StartupInfo);
     if not CreateProcess(nil, PChar(CmdLine), nil, nil, True, 0, nil,
     nil, StartupInfo, ProcessInformation) then
       RaiseLastWin32Error;
     if Wait then
       WaitForSingleObject(ProcessInformation.hProcess, INFINITE);
   except
     Result := False;
   end;
 end;
 




Подождать завершения DOS-задачи 3

Молодого программиста спрашивают: что ты, мол, подружку себе не заводишь? Пора бы уже.. Тот отвечает:
- Зачем, если есть компьютер?


 function TForm1.StartWithShell(Prog, par, Verz: string;
 var hProcess: THandle): DWord;
 var
   exInfo: TShellExecuteInfo;
 begin
   hProcess := 0;
   FillChar(exInfo, Sizeof(exInfo), 0);
   with exInfo do
   begin
     cbSize:= Sizeof(exInfo);
     fMask := SEE_MASK_NOCLOSEPROCESS or SEE_MASK_FLAG_DDEWAIT;
     Wnd := 0;
     lpVerb:= 'open';
     lpParameters := PChar(par);
     lpFile:= Pchar(prog);
     nShow := SW_HIDE;
   end;
   Result := ERROR_SUCCESS;
   if ShellExecuteEx(@exInfo) then
     hProcess := exinfo.hProcess
   else
     Result := GetLastError;
 end;
 
 function TForm1.StartProgramm : Boolean;
 var
   r, ExitCode: DWord;
   err: string;
   hProcess: THandle;
 begin
   Result := False;
   r := StartWithShell('rar.exe', , 'c:\windows\system',
   hProcess);
   if r = ERROR_SUCCESS then
   begin
     repeat
       Application.ProcessMessages;
       GetExitCodeProcess(hProcess, ExitCode);
     until
       ExitCode <> STILL_ACTIVE;
     result := true;
   end
   else
   begin
     case r of
       ERROR_FILE_NOT_FOUND : err:='The specified file was not found.';
       ERROR_PATH_NOT_FOUND : err:='The specified path was not found.';
       ERROR_DDE_FAIL : err:='The DDE transaction failed.';
       ERROR_NO_ASSOCIATION : err:='There is no application associated ' +
       'with the given filename extension.';
       ERROR_ACCESS_DENIED : err:='Access denied';
       ERROR_DLL_NOT_FOUND : err:='DLL not found';
       ERROR_CANCELLED : err:='The function prompted the user for the ' +
       'location of the application, but the user cancelled the request.';
       ERROR_NOT_ENOUGH_MEMORY: err:='Not enough memory';
       ERROR_SHARING_VIOLATION: err:='A sharing violation occurred.';
       else
         err := 'Unknown';
     end;
     MessageDlg('Error: ' + err, mtError, [mbOk], 0);
   end;
 end;
 




Как определить, что моё приложение хотят завершить

Дорогая служба поддержки, В прошлом году я произвела обновление программ на компьютере: вместо Приятель 5.0 я установила Муж 1.0 и заметила, что новая программа стала производить неожиданные изменения в финансовых модулях и ограничила доступ к приложениям типа цветы и ювелир, которые прекрасно работали под управлением Приятель 5.0. Кроме того, Муж 1.0 удалил многие другие ценные программы, например, Романтика 9.9, и одновременно установил Футбол 5.0, Гараж 4.5 и Телевизор 6.0. Программа Разговор 8.0 больше не запускается, а при запуске программы Уборка Дома 2.6, вся система зависает. Я пробовала запустить Нытье 5.3, но результатов не добилась. Пожалуйста, помогите! Отчаявшаяся


 procedure WMQueryEndSession(var message: TWMQueryEndSession);
 message WM_QUERYENDSESSION;
 
 ...
 
 procedure TMainFrm.WMQueryEndSession(var message: TWMQueryEndSession);
 begin
   message.Result := 1;
   gEndSession := True;
 end;
 
 ...
 
 procedure TMainFrm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
 begin
   CanClose := True;
   if gQueryEnd and not gEndSession then
     if MessageDlg('Quitting (your app name). Are you sure?',
     mtInformation, mbOKCancel, 0) = mrCancel then
       CanClose := False
 end;
 




Определить, что изменились настройки экрана


 type
   {...}
   private
     procedure WMDisplayChange(var msg: TMessage);
       message WM_DISPLAYCHANGE;
   public
   {...}
   end;
 end;
 
 var
   Form1: TForm1;
 
 implementation
 
 {$R *.DFM}
 
 procedure TForm1.WMDisplayChange(var msg: TMessage);
 begin
   ShowMessage('Display settings changed!');
   inherited;
 end;
 




Обнаружение прокрутки TListBox

Автор: Dr. Bob

Хмм, было бы неплохо отлавиливать это сообщение и генерировать для этого случая событие OnVScroll. Например так:


 unit Listbob;
 
 interface
 
 uses
   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
   Forms, Dialogs, StdCtrls;
 
 type
   TListBob = class(tlistbox)
   private
     { Private declarations }
     FOnHScroll: TNotifyEvent;
     FOnVScroll: TNotifyEvent;
   protected
     { Protected declarations }
     procedure WMHScroll(var Message: TWMHScroll); message WM_HSCROLL;
     procedure WMVScroll(var Message: TWMVScroll); message WM_VSCROLL;
   public
     { Public declarations }
     constructor Create(AOwner: TComponent); override;
   published
     { Published declarations }
     property OnHScroll: TNotifyEvent read FOnHScroll write FOnHScroll;
     property OnVScroll: TNotifyEvent read FOnVScroll write FOnVScroll;
   end;
 
 procedure Register;
 
 implementation
 
 constructor TListBob.Create(AOwner: TComponent);
 begin
   inherited Create(AOwner);
   FOnHScroll := nil;
   FOnVScroll := nil;
 end;
 
 procedure TListBob.WMHScroll(var Message: TWMHScroll);
 { помните что данное сообщение вызывается дважды!! }
 begin
   if Assigned(FOnHScroll) then
     FOnHScroll(Self);
   DefaultHandler(Message);
 end;
 
 procedure TListBob.WMVScroll(var Message: TWMHScroll);
 { помните что данное сообщение вызывается дважды!! }
 begin
   if Assigned(FOnVScroll) then
     FOnVScroll(Self);
   DefaultHandler(Message);
 end;
 
 procedure Register;
 begin
   RegisterComponents('Dr.Bob', [TListBob]);
 end;
 
 end.
 




Как определить - нажал ли пользователь клавишу PrintScreen


В событиях, обрабатывающих нажатия клавишь в TForm, клавиша PrintScreen не обрабатывается. Однако проблему можно решить при помощи 'GetAsyncKeyState'. Функция GetAsyncKeyState определяет, когда клавиша была нажата или отпущена каждый раз, когда функция вызвана, а так же, когда клавиша была нажата после предыдущего вызова GetAsyncKeyState.

Событие OnIdle в TApplication как раз подходит для вызова этой API функции:


 procedure TForm1.FormCreate(Sender: TObject);
 begin
   Application.OnIdle := AppIdle;
 end;
 
 procedure TForm1.AppIdle(Sender: TObject; var Done: Boolean);
 begin
   if GetAsyncKeyState(VK_SNAPSHOT) <> 0 then
     Form1.Caption := 'PrintScreen нажата !';
   Done := True;
 end;
 




Проверка изменения данных таблицы

В обработчике события формы OnClose вы можете поместить следующий код:


 if Table1.State in dsEditModes then
   if MessageDlg( 'Сохранить изменения?', mtInformation, [mbYes, mbNo], 0 ) = mrYes then
     Table1.Post
   else
     Table1.Cancel ;
 




Формат Wave-файла

Вот он:


 TWaveHeader = record
 Marker1:        Array[0..3] of Char;
 BytesFollowing: LongInt;
 Marker2:        Array[0..3] of Char;
 Marker3:        Array[0..3] of Char;
 Fixed1:         LongInt;
 FormatTag:      Word;
 Channels:       Word;
 SampleRate:     LongInt;
 BytesPerSecond: LongInt;
 BytesPerSample: Word;
 BitsPerSample:  Word;
 Marker4:        Array[0..3] of Char;
 DataBytes:      LongInt;
 end;
 

Для создания собственного WAV-файла сделайте следующее:


 DataBytes := Channels;
 DataBytes := DataBytes * SampleRate;
 DataBytes := DataBytes * Resolution;
 DataBytes := DataBytes div 8;
 DataBytes := DataBytes * Duration;
 DataBytes := DataBytes div 1000;
 
 
 WaveHeader.Marker1 := 'RIFF';
 WaveHeader.BytesFollowing := DataBytes + 36;
 WaveHeader.Marker2 := 'WAVE';
 WaveHeader.Marker3 := 'fmt ';
 WaveHeader.Fixed1 := 16;
 WaveHeader.FormatTag := 1;
 WaveHeader.SampleRate := SampleRate;
 WaveHeader.Channels := Channels;
 WaveHeader.BytesPerSecond := Channels;
 WaveHeader.BytesPerSecond := WaveHeader.BytesPerSecond * SampleRate;
 WaveHeader.BytesPerSecond := WaveHeader.BytesPerSecond * Resolution;
 WaveHeader.BytesPerSecond := WaveHeader.BytesPerSecond div 8;
 WaveHeader.BytesPerSample := Channels * Resolution div 8;
 WaveHeader.BitsPerSample := Resolution;
 WaveHeader.Marker4 := 'data';
 WaveHeader.DataBytes := DataBytes;
 

Остальная часть файлы является звуковыми данными. Порядок следования: верхний уровень для левого канала, верхний уровень для правого канала и так далее. Для моно или 8-битных файлов сделайте соответствующие изменения.




Проигрывание wave-файла, помещенного в ресурс

Я пытаюсь проиграть wave-файл при щелчке на кнопке моего Delphi-приложения. Я установил звуковой файл и воспользовался вызовом API функции PlaySound(), но мне хотелось бы поместить его в ресурс приложения, т.е. "вложить" его в EXE-файл и проигрывать его оттуда.

Во первых, вам необходимо скомпилировать необходимый ресурс (например, с помощью Resource Workshop) и включить туда ваш WAVE-файл. Затем для его вызова и проигрывания используйте следующий код:


 var
   FindHandle, ResHandle: THandle;
   ResPtr: Pointer;
 begin
   FindHandle := FindResource(HInstance, '<Имя вашего ресурса>', 'WAVE');
   if FindHandle <> 0 then
   begin
     ResHandle := LoadResource(HInstance, FindHandle);
     if ResHandle <> 0 then
     begin
       ResPtr := LockResource(ResHandle);
       if ResPtr <> nil then
         SndPlaySound(PChar(ResPtr), snd_ASync or snd_Memory);
       UnlockResource(ResHandle);
     end;
     FreeResource(FindHandle);
   end;
 end;
 

Спустя некоторое время я нашел лучшее решение (в Delphi 3):


 PlaySound('S1', HInstance, SND_RESOURCE or SND_ASYNC);
 

где S1 - ID (идентификатор) звука.

Эта единственная строчка кода сама ищет, загружает, блокирует, разблокирует и освобождает ресурс.




Получить информацию о WAV файле


 unit W32Waves;
 { Unit for accessing Windows PCM wave file informations
   By Ulli Conrad <uconrad@gmx.net> }
 
 interface
 
 uses SysUtils, Windows, MMSystem, Dialogs;
 
 type
   PWaveInformation = ^tWaveInformation;
   TWaveInformation = record
     WaveFormat: Word;         { Wave format identifier }
     Channels: Word;         { Mono=1, Stereo=2 }
     SampleRate: Longint;      { Sample rate in Hertz }
     BitsPerSample: Word;         { Resolution, e.g. 8 or 16 Bit }
     SamplesNumber: Longint;      { Number of samples }
     Length: Extended;     { Sample length in seconds }
     ValidWave: bool;         { Specifies if the file could be read }
   end;
 
 const                            { Constants for wave format identifier }
   WAVE_FORMAT_PCM = $0001;   { Windows PCM }
   WAVE_FORMAT_G723_ADPCM = $0014;   { Antex ADPCM }
   WAVE_FORMAT_ANTEX_ADPCME = $0033;   { Antex ADPCME }
   WAVE_FORMAT_G721_ADPCM = $0040;   { Antex ADPCM }
   WAVE_FORMAT_APTX = $0025;   { Audio Processing Technology }
   WAVE_FORMAT_AUDIOFILE_AF36 = $0024;   { Audiofile, Inc. }
   WAVE_FORMAT_AUDIOFILE_AF10 = $0026;   { Audiofile, Inc. }
   WAVE_FORMAT_CONTROL_RES_VQLPC = $0034;   { Control Resources Limited }
   WAVE_FORMAT_CONTROL_RES_CR10 = $0037;   { Control Resources Limited }
   WAVE_FORMAT_CREATIVE_ADPCM = $0200;   { Creative ADPCM }
   WAVE_FORMAT_DOLBY_AC2 = $0030;   { Dolby Laboratories }
   WAVE_FORMAT_DSPGROUP_TRUESPEECH = $0022;   { DSP Group, Inc }
   WAVE_FORMAT_DIGISTD = $0015;   { DSP Solutions, Inc. }
   WAVE_FORMAT_DIGIFIX = $0016;   { DSP Solutions, Inc. }
   WAVE_FORMAT_DIGIREAL = $0035;   { DSP Solutions, Inc. }
   WAVE_FORMAT_DIGIADPCM = $0036;   { DSP Solutions ADPCM }
   WAVE_FORMAT_ECHOSC1 = $0023;   { Echo Speech Corporation }
   WAVE_FORMAT_FM_TOWNS_SND = $0300;   { Fujitsu Corp. }
   WAVE_FORMAT_IBM_CVSD = $0005;   { IBM Corporation }
   WAVE_FORMAT_OLIGSM = $1000;   { Ing C. Olivetti & C., S.p.A. }
   WAVE_FORMAT_OLIADPCM = $1001;   { Ing C. Olivetti & C., S.p.A. }
   WAVE_FORMAT_OLICELP = $1002;   { Ing C. Olivetti & C., S.p.A. }
   WAVE_FORMAT_OLISBC = $1003;   { Ing C. Olivetti & C., S.p.A. }
   WAVE_FORMAT_OLIOPR = $1004;   { Ing C. Olivetti & C., S.p.A. }
   WAVE_FORMAT_IMA_ADPCM = $0011;   { Intel ADPCM }
   WAVE_FORMAT_DVI_ADPCM = $0011;   { Intel ADPCM }
   WAVE_FORMAT_UNKNOWN = $0000;
   WAVE_FORMAT_ADPCM = $0002;   { Microsoft ADPCM }
   WAVE_FORMAT_ALAW = $0006;   { Microsoft Corporation }
   WAVE_FORMAT_MULAW = $0007;   { Microsoft Corporation }
   WAVE_FORMAT_GSM610 = $0031;   { Microsoft Corporation }
   WAVE_FORMAT_MPEG = $0050;   { Microsoft Corporation }
   WAVE_FORMAT_NMS_VBXADPCM = $0038;   { Natural MicroSystems ADPCM }
   WAVE_FORMAT_OKI_ADPCM = $0010;   { OKI ADPCM }
   WAVE_FORMAT_SIERRA_ADPCM = $0013;   { Sierra ADPCM }
   WAVE_FORMAT_SONARC = $0021;   { Speech Compression }
   WAVE_FORMAT_MEDIASPACE_ADPCM = $0012;   { Videologic ADPCM }
   WAVE_FORMAT_YAMAHA_ADPCM = $0020;   { Yamaha ADPCM }
 
 function GetWaveInformationFromFile(FileName: string; Info: pWaveInformation): bool;
 
 implementation
 
 type
   TCommWaveFmtHeader = record
     wFormatTag: Word;                  { Fixed, must be 1 }
     nChannels: Word;                  { Mono=1, Stereo=2 }
     nSamplesPerSec: Longint;               { SampleRate in Hertz }
     nAvgBytesPerSec: Longint;
     nBlockAlign: Word;
     nBitsPerSample: Word;                  { Resolution, e.g. 8 or 16 }
     cbSize: Longint;               { Size of extra information in the extended fmt Header }
   end;
 
 function GetWaveInformationFromFile(FileName: string; Info: pWaveInformation): bool;
 var
   hdmmio: HMMIO;
   mmckinfoParent: TMMCKInfo;
   mmckinfoSubchunk: TMMCKInfo;
   Fmt: TCommWaveFmtHeader;
   Samples: Longint;
 begin
   Result := False;
   FillChar(Info^, SizeOf(TWaveInformation), #0); { Initialize first }
   hdmmio := mmioOpen(PChar(FileName), nil, MMIO_READ);
   if (hdmmio = 0) then
     Exit;
       {* Locate a 'RIFF' chunk with a 'WAVE' form type
        * to make sure it's a WAVE file.
        *}
   mmckinfoParent.fccType := mmioStringToFOURCC('WAVE', MMIO_TOUPPER);
   if (mmioDescend(hdmmio, PMMCKINFO(@mmckinfoParent), nil, MMIO_FINDRIFF) <> 0) then
     Exit;
       {* Now, find the format chunk (form type 'fmt '). It should be
        * a subchunk of the 'RIFF' parent chunk.
        *}
   mmckinfoSubchunk.ckid := mmioStringToFOURCC('fmt ', 0);
   if (mmioDescend(hdmmio, @mmckinfoSubchunk, @mmckinfoParent, MMIO_FINDCHUNK) <> 0) then
     Exit;
 
   // Read the format chunk. 
   if (mmioRead(hdmmio, PChar(@fmt), Longint(SizeOf(TCommWaveFmtHeader))) <>
     Longint(SizeOf(TCommWaveFmtHeader))) then
     Exit;
   Info^.WaveFormat    := fmt.wFormatTag;
   Info^.Channels      := fmt.nChannels;
   Info^.SampleRate    := fmt.nSamplesPerSec;
   Info^.BitsPerSample := fmt.nBitsPerSample;
   mmioAscend(hdmmio, @mmckinfoSubchunk, 0); // Ascend out of the format subchunk. 
   mmckinfoSubchunk.ckid := mmioStringToFOURCC('data', 0); // Find the data subchunk. 
   if (mmioDescend(hdmmio, @mmckinfoSubchunk, @mmckinfoParent, MMIO_FINDCHUNK) <> 0) then
     Exit;
   Info^.SamplesNumber := mmckinfoSubchunk.cksize; // Get the size of the data subchunk. 
 
   Samples      := (Info^.SamplesNumber * 8 * Info^.Channels) div Info^.BitsPerSample;
   Info^.Length := Samples / Info^.Samplerate;
   mmioClose(hdmmio, 0); // We're done with the file, close it. 
   Info^.ValidWave := True;
   Result          := True;
 end;
 end.
 




Определить длину WAV файла


 type
   EMyMCIException = class(Exception);
 
 var
   FDeviceID: Word;
   MyError, dwFlags: Longint;
 
 procedure TForm1.GetWaveLength;
 var
   WaveLen: DWORD;
 begin
   OpenMedia('C:\Hickory.wav');
   SetMediaTimeFormat;
   WaveLen := GetMediaStatus(MCI_STATUS_LENGTH);
   CloseMedia;
   Form1.label1.Caption := IntToStr(WaveLen) + 'mS';
 end;
 
 procedure TForm1.OpenMedia(FileName: string);
 var
   MyOpenParms: TMCI_Open_Parms;
 begin
   with MyOpenParms do
   begin
     dwCallback := Handle; // TForm1.Handle 
     lpstrDeviceType := PChar('WaveAudio');
     lpstrElementName := PChar(FileName);
   end; {with MyOpenParms}
   dwFlags := MCI_WAIT or MCI_OPEN_ELEMENT or MCI_OPEN_TYPE;
   MyError := mciSendCommand(0, MCI_OPEN, dwFlags, Longint(@MyOpenParms));
   // one could use mciSendCommand(DevId, etc here to specify a particular 
   device
   if MyError = 0 then
     FDeviceID := MyOpenParms.wDeviceID
   else
     raise EMyMCIException.Create('Open Failed');
 end;
 
 procedure TForm1.SetMediaTimeFormat;
 var
   MySetParms: TMCI_Set_Parms;
 begin
   if FDeviceID <> 0 then
   begin
     dwFlags := MCI_WAIT or MCI_SET_TIME_FORMAT;
     MySetParms.dwCallback := Handle; // TForm1.Handle 
     MySetParms.dwTimeFormat := MCI_FORMAT_MILLISECONDS;
     MyError := mciSendCommand(FDeviceID, MCI_SET, dwFlags,
       Longint(@MySetParms));
     if MyError <> 0 then
       raise EMyMCIException.Create('Status Failed');
   end;
 end;
 
 function TForm1.GetMediaStatus(StatusItem: DWORD): DWORD;
 var
   MyStatusParms: TMCI_Status_Parms;
 begin
   if FDeviceID <> 0 then
   begin
     dwFlags := MCI_WAIT or MCI_STATUS_ITEM;
     MyStatusParms.dwCallback := Handle; // TForm1.Handle 
     MyStatusParms.dwItem := StatusItem;
     MyError := mciSendCommand(FDeviceID, MCI_STATUS, dwFlags,
       Longint(@MyStatusParms));
     if MyError = 0 then
       Result := MyStatusParms.dwReturn
     else
     begin
       raise EMyMCIException.Create('Status Failed');
     end;
   end;
 end;
 
 procedure TForm1.CloseMedia;
 var
   MyGenParms: TMCI_Generic_Parms;
 begin
   if FDeviceID <> 0 then
   begin
     dwFlags := 0;
     MyGenParms.dwCallback := Handle; // TForm1.Handle 
     MyError := mciSendCommand(FDeviceID, MCI_CLOSE, dwFlags,
       Longint(@MyGenParms));
     if MyError = 0 then
       FDeviceID := 0
     else
     begin
       raise EMyMCIException.Create('Close Failed');
     end;
   end;
 end;
 




WAV в EXE

Жизнь.exe?

В файл MyWave.rc пишешь:

 MyWave RCDATA LOADONCALL MyWave.wav

brcc32.exe MyWave.rc, получаешь MyWave.res.

В своей программе пишешь:


 {$R MyWave.res}
 

Все!

Предупреждая следующий твой вопрос "а как прочитать wave-файл из исполняемого файла?"


 procedure RetrieveMyWave;
 var
   hResource: THandle;
   pData: Pointer;
 begin
   hResource := LoadResource(hInstance, FindResource(hInstance, 'MyWave',
     RT_RCDATA));
 
   try
     pData := LockResource(hResource);
 
     if pData = nil then
       raise Exception.Create('Cannot read MyWave');
 
     // Здесь pData указывает на MyWave
     // Теперь можно, например, проиграть его (Win32):
     PlaySound('MyWave', 0, SND_MEMORY);
   finally
     FreeResource(hResource);
   end;
 end;
 




Как добавить в исполняемый файл WAV-файл и затем проиграть этот звук

Как-то летели Холмс с Ватсоном на воздушном шаре. И заснули. Просыпаются над какой-то незнакомой местностью, видят - внизу какой-то мужик коров пасет. Снизились они и спрашивают мужика:
- Скажите, сэр, где мы находимся?
(долго думал)- На воздушном шаре.
- Спасибо, сэр! - и поднялись вверх. Холмс задумчиво говорит:
- Интересная местность, Ватсон! Программист пасет коров!
- Но, Холмс, с чего вы взяли, что он программист?
- Это элементарно! Во-первых, он долго думал над ответом. Во-вторых, его ответ был абсолютно точен. И самое главное - абсолютно бесполезен!


 // В файл MyWave.rc пишешь:
 // MyWave RCDATA LOADONCALL MyWave.wav
 // Затем компилируешь
 // brcc32.exe MyWave.rc, получаешь MyWave.res.
 // В своей программе пишешь:
 // {$R MyWave.res}
 // или используешь программу для работы с ресурсами
 // ( н-р Borland Resource WorkShop) для получения res файла
 
 procedure RetrieveMyWave;
 var
   hResource: THandle;
   pData: Pointer;
 begin
   hResource:=LoadResource( hInstance, FindResource(hInstance, 'MyWave', RT_RCDATA));
   try
     pData := LockResource(hResource);
     if pData = nil then
       raise Exception.Create('Cannot read MyWave');
 
     // Здесь pData указывает на MyWave
     // Теперь можно, например, проиграть его (Win32):
     PlaySound('MyWave', 0, SND_MEMORY);
 
   finally
     FreeResource(hResource);
   end;
 end;
 




Как поменять цвет или стиль бордюра в TWebBrowser

IN ternet SEXplorer - русская поисковая программа для порносайтов.


 uses
   MSHTML;
 
 procedure WB_SetBorderColor(Sender: TObject; BorderColor: String);
 {
   BorderColor: Can be specified in HTML pages in two ways.
                1) by using a color name (red, green, gold, firebrick, ...)
                2) or by using numbers to denote an RGB color value. (#9400D3, #00CED1,...)
 
   See: http://msdn.microsoft.com/library/default.asp?url=/workshop/author/dhtml/
     reference/properties/borderstyle.asp
 }
 
 var
   Document : IHTMLDocument2;
   Element : IHTMLElement;
 begin
   Document := TWebBrowser(Sender).Document as IHTMLDocument2;
   if Assigned(Document) then
   begin
     Element := Document.Body;
     if Element <> nil then
     begin
       Element.Style.BorderColor := BorderColor;
     end;
   end;
 end;
 
 procedure WB_SetBorderStyle(Sender: TObject; BorderStyle: String);
 {
   BorderStyle values:
 
   'none'         No border is drawn
   'dotted'       Border is a dotted line. (as of IE 5.5)
   'dashed'       Border is a dashed line. (as of IE 5.5)
   'solid'        Border is a solid line.
   'double'       Border is a double line
   'groove'       3-D groove is drawn
   'ridge'        3-D ridge is drawn
   'inset'        3-D inset is drawn
   'window-inset' Border is the same as inset, but is surrounded by an additional single line
   'outset'       3-D outset is drawn
 
   See: http://msdn.microsoft.com/library/default.asp?url=/workshop/author/dhtml/
     reference/properties/borderstyle.asp
 }
 
 var
   Document : IHTMLDocument2;
   Element : IHTMLElement;
 begin
   Document := TWebBrowser(Sender).Document as IHTMLDocument2;
   if Assigned(Document) then
   begin
     Element := Document.Body;
     if Element <> nil then
     begin
       Element.Style.BorderStyle := BorderStyle;
     end;
   end;
 end;
 
 procedure WB_Set3DBorderStyle(Sender: TObject; bValue: Boolean);
 {
   bValue: True: Show a 3D border style
           False: Show no border
 }
 var
   Document : IHTMLDocument2;
   Element : IHTMLElement;
   StrBorderStyle: string;
 begin
   Document := TWebBrowser(Sender).Document as IHTMLDocument2;
   if Assigned(Document) then
   begin
     Element := Document.Body;
     if Element <> nil then
     begin
       case BValue of
         False: StrBorderStyle := 'none';
         True: StrBorderStyle := '';
       end;
       Element.Style.BorderStyle := StrBorderStyle;
     end;
   end;
 end;
 
 
 
 procedure TForm1.WebBrowser1NavigateComplete2(Sender: TObject;
   const pDisp: IDispatch; var URL: OleVariant);
 // Put this code in the OnDocumentComplete event as well 
 begin
   // Examples: 
   // Show no border 
   WB_Set3DBorderStyle(Sender, False);
   // Draw a double line border 
   WB_SetBorderStyle(Sender, 'double');
   // Set a border color 
   WB_SetBorderColor(Sender, '#6495ED');
 end;
 
 procedure TForm1.Button1Click(Sender: TObject);
 begin
   Webbrowser1.Navigate('www.SwissDelphiCenter.ch');
 end;
 




Спрятать скроллбары в TWebBrowser

Встречаются два программиста:
- Говорят, ты женился!
- Да, есть такое дело.
- А как зовут?
- (в задумчивости) Окс.. нет, Тат..., КОРОЧЕ ICQ# 98760138109


 {A page must be loaded into TWebBrowser}
 
 procedure TForm1.Button1Click(Sender: TObject);
 begin
   WebBrowser1.OleObject.Document.Body.Style.OverflowX := 'hidden';
   WebBrowser1.OleObject.Document.Body.Style.OverflowY := 'hidden';
 end;
 




Проверить активность команды Copy в TWebBrowser


 procedure TForm1.ButtonIsCopyEnabledClick(Sender: TObject);
 begin
   if Webbrowser1.OleObject.Document.queryCommandEnabled('Copy') then
     ShowMessage('Copy is active/ Copy ist aktiv');
 end;
 




Проверить страницу в TWebBrowser на локальность


 procedure TForm1.Button1Click(Sender: TObject);
 begin
   Webbrowser1.Navigate('file:///c:/test.txt');
 end;
 
 procedure TForm1.WebBrowser1DocumentComplete(Sender: TObject;
   const pDisp: IDispatch; var URL: OleVariant);
 begin
   if Webbrowser1.Oleobject.Document.Location.Protocol = 'file:' then
   begin
     label1.Caption := 'The file is on a local drive!'
     // label1.Caption := 'Das File befindet sich auf einer lokalen Harddisk!' 
   end;
 end;
 




Как поменять цвет скроллбаров в TWebBrowser

Программа, позволяющая сэкономить деньги на интернет-соединениях. Установите программу. Запустите, перейдите на вкладку "Настройки", введите в поля тарифы вашего провайдера, нажмите кнопку "Ок". В появившемся диалоговом окне выберите пункт меню "Сжечь модем".


 procedure TForm1.Button1Click(Sender: TObject);
 begin
   with WebBrowser1 do
   begin
     OleObject.document.body.Style.scrollbarArrowColor := '#0099FF';
     OleObject.document.body.Style.scrollbar3DLIGHTCOLOR := '#FFFFFF';
     OleObject.document.body.Style.scrollbarDarkShadowColor := '#0099FF';
     OleObject.document.body.Style.scrollbarFaceColor := '#99CCFF';
     OleObject.document.body.Style.scrollbarHighlightColor := '#0099FF';
     OleObject.Document.body.Style.scrollbarShadowColor := '#0099FF';
     OleObject.Document.body.Style.scrollbarTrackColor := '#FFFFFF';
   end;
 end;
 




Получить все URLs фреймов в TWebBrowser

Звонок в компьютерную контору:
- У меня с модемом проблемы, компьютер его не видит...
- Как не видит?
- Да пишет все время: "Не могу найти модем... подключите модем".
- А вы модем подключать к компьютеру пробовали?
- Хм... нет... Как-то в голову не приходило.


 procedure TForm1.Button2Click(Sender: TObject);
 var
   i: Integer;
 begin
   Listbox1.Clear;
   //if frames available 
   if Webbrowser1.OleObject.Document.Frames.Length <> 0 then
   begin
     //walk through all frames and get the url 
     //to the Listbox 
     for i := 0 to Webbrowser1.OleObject.Document.Frames.Length - 1 do
     begin
       Listbox1.Items.Add(Webbrowser1.OleObject.Document.Frames.item(i).Document.URL);
     end;
   end;
 end;
 




Сохранить страницу в WebBrowser на диск

Договорились встретиться ламер, юзер и хакер. Ламер и хакер пришли вовремя, а юзер опоздал. Приходит с огромной книгой и говорит:
- Извините! Купил книгу по TCP/IP да зачитался.
Ламер:
- А что такое TCP/IP?
Хакер:
- А что такое книга??


 uses
   ActiveX, MSHTML_TLB, SHDocVw_TLB,
   ComCtrls, OleCtrls;
 
 procedure TForm1.Button1Click(Sender: TObject);
 var
   HTMLDocument: IHTMLDocument2;
   PersistFile: IPersistFile;
 begin
   HTMLDocument := WebBrowser1.Document as IHTMLDocument2;
   PersistFile  := HTMLDocument as IPersistFile;
   PersistFile.Save(StringToOleStr('c:\SavedFile.html'), System.True);
 end;
 




Распечатать страницу в TWebBrowser


 procedure TForm1.Button1Click(Sender: TObject);
 begin
   WebBrowser1.Navigate('http://www.SwissDelphiCenter.com');
 end;
 
 // Print without Printer Dialog 
 
 procedure TForm1.Button2Click(Sender: TObject);
 var
   vaIn, vaOut: OleVariant;
 begin
   WebBrowser1.ControlInterface.ExecWB(OLECMDID_PRINT, OLECMDEXECOPT_DONTPROMPTUSER,
     vaIn, vaOut);
 end;
 
 // Print with Printer Dialog 
 
 procedure TForm1.Button3Click(Sender: TObject);
 var
   vaIn, vaOut: OleVariant;
 begin
   WebBrowser1.ControlInterface.ExecWB(OLECMDID_PRINT, OLECMDEXECOPT_PROMPTUSER,
     vaIn, vaOut);
 end;
 
 // Print Preview 
 
 procedure TForm1.Button4Click(Sender: TObject);
 var
   vaIn, vaOut: OleVariant;
 begin
   WebBrowser1.ControlInterface.ExecWB(OLECMDID_PRINTPREVIEW,
     OLECMDEXECOPT_DONTPROMPTUSER, vaIn, vaOut);
 end;
 
 // Page Setup Dialog 
 
 procedure TForm1.Button5Click(Sender: TObject);
 var
   vaIn, vaOut: OleVariant;
 begin
   WebBrowser1.ControlInterface.ExecWB(OLECMDID_PAGESETUP, OLECMDEXECOPT_PROMPTUSER,
     vaIn, vaOut);
 end;
 
 // as of Internet Explorer 4
 




Показать диалог свойства TWebBrowser

- Сколько на свете дураков есть - ума не приложу!
- Что случилось?
- Да сказал я вчера одному "сходи на сайт".
- И?
- Так после него компьютер сушить пришлось!


 // Show the "Properties Dialog" 
 // Den Eigenschaften Dialog anzeigen 
 
 procedure TForm1.Button1Click(Sender: TObject);
 var
   eQuery: OLECMDF;
   vaIn, vaOut: OleVariant;
 begin
   try
     eQuery := Webbrowser1.QueryStatusWB(OLECMDID_PROPERTIES);
     if (eQuery and OLECMDF_ENABLED) = OLECMDF_ENABLED then
       Webbrowser1.ExecWB(OLECMDID_PROPERTIES, OLECMDEXECOPT_PROMPTUSER, vaIn, vaOut);
   except
   end;
 end;
 




Отправить данные формы с помощью WebBrowser

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


 procedure TForm1.Button1Click(Sender: TObject);
 var
   i: Integer;
   EncodedStr: string;
   Header: OleVariant;
   Post: OleVariant;
 begin
   // Make the post string URL encoded 
   EncodedStr := 'name=SwissDelphiCenter.ch&text=Test Guestbook entry';
 
   // The post must be an array. But without null terminator (-1) 
   Post := VarArrayCreate([0, Length(EncodedStr) - 1], varByte);
 
   // Put Post in array 
   for I := 1 to Length(EncodedStr) do
     Post[I - 1] := Ord(EncodedStr[I]);
 
   Header := 'Content-Type: application/x-www-form-urlencoded' + #10#13;
 
   WebBrowser1.Navigate('http://www.swissdelphicenter.ch/en/addguestsent.php', EmptyParam,
     EmptyParam, Post, Header);
 end;
 




WEB страничка внутри Delphi приложения


В слове "Веб" не хватает твердого знака после буквы "В".

Многие из Вас спрашивают, как сделать, чтобы приложением могло содержать в себе различные компоненты в стиле Web, включая HTML ресурсы и картинки, которые являются частью Вашего проекта. Статья показывает, как можно легко добавить в Delphi приложение HTML и связанные с ним файлы (картинки).

Создание HTML страницы

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


 <img src="../graphics/adp.gif" ...>
 

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


 <img src="ABOUTDP" ...>
 

У меня HTML код выглядит следующим образом:


 <HTML>
   <HEAD>
     <TITLE>HTML inside a Delphi exe</TITLE>
   </HEAD>
   <BODY>
     This is a HTML Delphi World resource test:<br>
     <img src="ABOUTDP" width=106 height=58 border=0 alt="">
   </BODY>
 </HTML>
 

Создание и компиляция файла ресурсов

Запомните, что для того, чтобы создать новый скрипт-файл ресурсов, необходимо:

  1. Создать новый текстовый файл в директории Вашего проекта.
  2. Переименовать его в AHTMLDelphi.rc.
  3. Добавить следующие две строки текста в файл AHTMLDelphi.rc.

 DELPHIINDEX HTML "c:\Delphi\projects\aboutindex.htm"
 ABOUTDP GIF "c:\library\graphics\adp.gif"
 

Обратите внимание, что "HTML" тип ресурса RT_HTML, определён как "23". Это значение является дефолтовым для протокола RES.

Таким образом мы подготовили одну HTML страницу и одну картинку GIF, которые будут включены в исполняемый EXE модуль.

Следующий шаг - это компиляция .rc файла. Для компиляции файла AHTMLDelphi.rc в файл .res, выполните следующую команду из командной строки (в директории Вашего проекта):


 BRCC32 AHTMLDelphi.RC
 

Заключительный шаг - это добавление следующей директивы компилятора в unit Вашего проекта. Следующая строка заставляет компилятор включить в проект файл RES:


 {$R AHTMLDelphi.RES}
 

Отображение внутри Web браузера

После того, как Вы получите экзешник приложения (назовём его, например, myhtmldelphi.exe), то HTML ресурсы, содержащиеся в нём, могут быть доступны через протокол RES: . Запустите Internet Explorer и, адресной строке напишите следующее:


 res://c:\myhtmldelphi.exe/DELPHIINDEX
 




Как получить страницу с вебсервера при помощи TClientSocket и поместить её в строковую переменную

Автор: E.J.Molendijk


 {
 Присоедините следующий обработчик к Вашему TClientSocket.
 Он получает файл с сервера и помещает его в строковую переменную
 FText string variable. Однако он не убирает заголовок, который
 так же посылается вебсервером.
 
 Не забудьте задать правильный адрес сервера в объекте Socket.
 Установите порт 80. А затем откройте его при помощи команды
 "Socket.Open;".
 
 Автор: E.J.Molendijk
 }
 
 const
   WebPage = '/index.html';
 var
   FText: string;
 
 procedure TForm1.SocketWrite(Sender: TObject;
   Socket: TCustomWinSocket);
 begin
   Socket.SendText('GET ' + Webpage + ' HTTP/1.0'#10#10);
 end;
 
 procedure TForm1.SocketRead(Sender: TObject;
   Socket: TCustomWinSocket);
 begin
   FText := FText + Socket.ReceiveText
 end;
 
 procedure TForm1.SocketConnecting(Sender: TObject;
   Socket: TCustomWinSocket);
 begin
   FText := '';
 end;
 
 procedure TForm1.SocketDisconnect(Sender: TObject;
   Socket: TCustomWinSocket);
 begin
   { --- }
   { ЗДЕСЬ ВЫ МОЖЕТЕ ОБРАБАТЫВАТЬ ВАШ FText !!! }
   { --- }
 end;
 
 procedure TForm1.SocketError(Sender: TObject;
   Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
   var ErrorCode: Integer);
 begin
   ErrorCode := 0; { Ошибки игнорируем }
 end;
 




Число текущей недели

На конференции после обсуждения того, что компьютершики надули всех с "проблемой 2000", поимели с этого и тэдэ. Билл Гейтс буркнул про себя:
- Рано радуетесь господа, я вам ТАААКУЮ проблему 2000 заготовил! Вот когда все её себе заинсталите - тада и посмотрим, хе-хе...


 function WeekOfYear(ADate: TDateTime): word;
 var
   day: word;
   month: word;
   year: word;
   FirstOfYear: TDateTime;
 begin
   DecodeDate(ADate, year, month, day);
   FirstOfYear := EncodeDate(year, 1, 1);
   Result := Trunc(ADate - FirstOfYear) div 7 + 1;
 end;
 
 procedure TForm1.Button1Click(Sender: TObject);
 begin
   ShowMessage(IntToStr(WeekOfYear(Date)));
 end;
 




Число текущей недели 2


 function WeekNum(const ADate: TDateTime): word;
 var
   Year: word;
   Month: word;
   Day: word;
 begin
   DecodeDate(ADate + 4 - DayOfWeek(ADate + 6), Year, Month, Day);
   result := 1 + trunc((ADate - EncodeDate(Year, 1, 5) +
     DayOfWeek(EncodeDate(Year, 1, 3))) / 7);
 end;
 




Число текущей недели 3


 function WeekOfYear(Dat: TDateTime): Word;
 // Интерпретация номеров дней:
 // ISO: 1 = Понедельник, 7 = Воскресенье
 // Delphi SysUtils: 1 = Воскресенье, 7 = Суббота
 var
   Day, Month, Year: Word;
   FirstDate: TDateTime;
   DateDiff: Integer;
 begin
   day := SysUtils.DayOfWeek(Dat) - 1;
   Dat := Dat + 3 - ((6 + day) mod 7);
   DecodeDate(Dat, Year, Month, Day);
   FirstDate := EncodeDate(Year, 1, 1);
   DateDiff := Trunc(Dat - FirstDate);
   Result := 1 + (DateDiff div 7);
 end;
 




Что такое порт (правила работы с портами)

Автор: Дмитрий Кузан

Сегодня мама грохнула о пол мой любимый компьютер. Горестно гляжу на разлетевшиеся детали:
- Вот она материнская плата за сыновью любовь!

Известно что в компьютере очень много собрано различных устройств , возникает вопрос как операционная система общается с ними. Для этого и служит порт, то есть эта «дверь» через которую программа (операционная система) может управлять данным устройством (считывать данные, заносить их).Причем я разделяю порты на две категории (это чисто мое разделение) - порты общеизвестные (COM LPT) и порты внутренние ,служащие для связи с внутренними устройствами ЭВМ.

2.Некоторые правила для работы с портами

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

а) Стараться использовать функции высокого уровня для доступа к портам (в частности WinAPI) и не прибегать к низкоуровневым операциям чтения/записи портов. Если вы все-таки решили писать низкоуровневое чтение то эти процедуры нужно выносить в отдельную DLL или VXD, по следующим причинам - известно, что операционная система Windows95/98 а особенно NT являются по своей сути многозадачными системами. То есть если ваша программа обращается конкретно к порту не через динамический вызов функции DLL или VXD ( использования механизма DLL) а напрямую то это может сказаться на корректной работе системы или даже завалить ее. И даже если в Windows95/98 такой подход вполне может работать то в Windows NT вследствие его архитектуры не разрешит непосредственное чтение/запись напрямую, а использование механизма DLL или VXD позволяет обойти эту проблему.

б)Если вы работаете с каким-то нестандартным портом ввода-вывода (например портом хранящим состояние кнопок пульта ДУ TVTunera то наверняка в комплекте поставки родного софта найдется DLL или VXD для управления этим устройством и отпадет нужда писать код, так я при работе с пультом ДУ TVTunerа использую стандартную DLL поставляемую в комплекте, это сразу решило вопросы связанные с управлением портами данного тюнера)

Итак, отступление — немного практики

Маленький пример для работы с портами (первый пример был уже опубликован в королевстве Дельфи и представлял собой пример работы с весами ПетрВес)


 function PortInit : boolean; //инициализация
 var f: THandle;
     ct: TCommTimeouts;
     dcb: TDCB;
 begin
   f := Windows.CreateFile(PChar('COM1'), GENERIC_READ or
                               GENERIC_WRITE,
                               FILE_SHARE_READ or FILE_SHARE_WRITE,
                               nil, OPEN_EXISTING,
                               FILE_ATTRIBUTE_NORMAL, 0);
   if (f <  0) or not Windows.SetupComm(f, 2048, 2048)or not
       Windows.GetCommState(f, dcb) then exit; //init error
 
   dcb.BaudRate := скоpость;
   dcb.StopBits := стоп-биты;
   dcb.Parity := четность;
   dcb.ByteSize := 8;
   if not Windows.SetCommState(f, dcb)
   or not Windows.GetCommTimeouts(f, ct) then exit; //error
   ct.ReadTotalTimeoutConstant := 50;
   ct.ReadIntervalTimeout := 50;
   ct.ReadTotalTimeoutMultiplier := 1;
   ct.WriteTotalTimeoutMultiplier := 0;
   ct.WriteTotalTimeoutConstant := 10;
   if not Windows.SetCommTimeouts(f, ct)
   or not Windows.SetCommMask(f, EV_RING + EV_RXCHAR + EV_RXFLAG + EV_TXEMPTY)
 then exit; //error
   result := true;
 end;
 
 function DoneComm: boolean; //закpыть поpт
 begin
   result := Windows.CloseHandle(f);
 end;
 
 function PostComm(var Buf; size: word): integer; //пеpедача в поpт
 var p: pointer; i: integer;
 begin
   p := @Buf;
   result := 0;
   while size >  0 do begin
     if not WriteFile(f, p^, 1, i, nil) then exit;
     inc(result, i); inc(integer(p)); dec(size);
     Application.ProcessMessages;
     end;
 end;
 
 function ReadComm(var Buf; size: word): integer; //пpием из поpта
 var i: integer; ovr: TOverlapped;
 begin
   fillChar(buf, size, 0);
   fillChar(ovr, sizeOf(ovr), 0); i := 0; result := -1;
   if not windows.ReadFile(f, buf, size, i, @ovr) then exit;
   result := i;
 end;
 

Данный пример был взят мной из многочисленный FAQ посвященных в DELPHI в сети ФИДО Итак,для работы с портами COM и LPT нам понадобится знание функций Windows API.

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

CreateFile


 HANDLE CreateFile(
     LPCTSTR lpFileName,    // указатель на строку PCHAR с именем файла
     DWORD dwDesiredAccess, // режим доступа
     DWORD dwShareMode,    // share mode
     LPSECURITY_ATTRIBUTES lpSecurityAttributes, // указатель на атрибуты
     DWORD dwCreationDistribution,          // how to create
     DWORD dwFlagsAndAttributes,       // атрибуты файла
     HANDLE hTemplateFile   // хендл на temp файл
    );
 
 // Пример кода на Дельфи
 // < вырезано>
 
 CommPort := 'COM2';
 hCommFile := CreateFile(Pchar(CommPort),
                         GENERIC_WRITE, 0, nil,
                         OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL,
                         0);
 // < вырезано>
 

Параметры

LpFileName - Указатель на строку с нулевым символом в конце (PCHAR) , которая определяет название создаваемого объекта (файл, канал, почтовый слот, ресурс связи (в данном случае порты), дисковое устройство, приставка, или каталог)

DwDesiredAccess - Указывает тип доступа к объекту ,принимает значение

GENERIC_READ - для чтения
GENERIC_WRITE - для записи (смешивание с GENERIC_READ операцией GENERIC_READ and GENERIC_WRITE предостовляет полный доступ )

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

Чтобы разделять объект(цель), используйте комбинацию одних или большее количество следующих значений:

FILE_SHARE_DELETE (Только для Windows NT)
FILE_SHARE_READ
FILE_SHARE_WRITE

LpSecurityAttributes - Указатель на структуру SECURITY_ATTRIBUTES, которая определяет может ли возвращенный дескриптор быть унаследован дочерними процессами. Если lpSecurityAttributes НУЛЕВОЙ, маркер не может быть унаследован. Используется только в windows NT.

dwCreationDistribution - Определяет поведение функции если объект уже существует и как он будет открыт в этом случае Принимает одно из следующих значений :

CREATE_NEW - Создает новый объект (файл) Выдает ошибку если указанный объект (файл) уже существует.

CREATE_ALWAYS - Создает новый объект (файл) Функция перезаписывает существующий объект (файл)

OPEN_EXISTING - Открывает объект (файл) Выдает ошибку если указанный объект (файл) не существует.(Для более детального смотрите SDK)

OPEN_ALWAYS - Открывает объект (файл), если он существует. Если объект (файл) не существует, функция создает его, как будто dwCreationDistribution были CREATE_NEW.

TRUNCATE_EXISTING - Открывает объект (файл). После этого объект (файл) будет усечен до нулевого размера.Выдает ошибку если указанный объект (файл) не существует.

DwFlagsAndAttributes - Атрибуты объекта (файла) , атрибуты могут комбинироваться

  • FILE_ATTRIBUTE_ARCHIVE
  • FILE_ATTRIBUTE_COMPRESSED
  • FILE_ATTRIBUTE_HIDDEN
  • FILE_ATTRIBUTE_NORMAL
  • FILE_ATTRIBUTE_OFFLINE
  • FILE_ATTRIBUTE_READONLY
  • FILE_ATTRIBUTE_SYSTEM
  • FILE_ATTRIBUTE_TEMPORARY

HTemplateFile - Определяет дескриптор с GENERIC_READ доступом к временному объекту(файлу). Временный объект(файл)поставляет атрибуты файла и расширенные атрибуты для создаваемого объекта (файла) ИСПОЛЬЗУЕТСЯ ТОЛЬКО В WINDOWS NT Windows 95: Это значение должно быть установлено в Nil. Возвращаемые значения

Если функция преуспевает, возвращаемое значение - открытый дескриптор к указанному объекту(файлу). Если файл не существует - 0. Если произошли функциональные сбои, возвращаемое значение - INVALID_HANDLE_VALUE. Чтобы получить расширенные данные об ошибках, вызовите GetLastError.

Обратите внимание!

Для портов, dwCreationDistribution параметр должен быть OPEN_EXISTING, и hTemplate должен быть Nil. Доступ для чтения-записи должен быть определен явно.

SECURITY_ATTRIBUTES

Структура содержит описание защиты для объекта и определяет, может ли дескриптор быть унаследован дочерними процессами.


 typedef struct _SECURITY_ATTRIBUTES
 {   DWORD  nLength;
     LPVOID lpSecurityDescriptor;
     BOOL   bInheritHandle;
 } SECURITY_ATTRIBUTES;
 

Параметры

NLength - Определяет размер, в байтах, этой структуры. Набор это значение к размеру структуры SECURITY_ATTRIBUTES В Windows NT функции которые используют структуру SECURITY_ATTRIBUTES, не

LpSecurityDescriptor - Дескриптор указывающий на описатель защиты для объекта, Если дескриптор ПУСТОЙ объект может быть назначен в наследование дочерними процессами.

BInheritHandle - Определяет, унаследован ли возвращенный дескриптор, когда новый дескриптор, создан. Если это значение принимает ИСТИНУ новый дескриптор наследует от головного.

Замечания

Указатель на структуру SECURITY_ATTRIBUTES используется как параметр в большинстве функций работы с окнами в Win32 API.

Структура DCB

Структура DCB определяет установку управления для последовательного порта ввода-вывода (нам она понадобится для разбора примера с программой управления весами ПетрВес)

Примечание : В местах где нельзя дать точный перевод будет дано определение на английском из MSDK и приблизительный его перевод Описание в эквиваленте C


 typedef struct _DCB { // dcb
     DWORD DCBlength;           // Размер DCB
     DWORD BaudRate;            // Скорость пересылки данных в бодах;
                                // текущая скорость в бодах
     DWORD fBinary: 1;          // binary mode, no EOF check
                                // двоичный режим , не проверять конец
                                // данных (по умолчанию значение = 1)
     DWORD fParity: 1;          // Включить проверку четность (по умолчанию
                                // значение = 1)
     DWORD fOutxCtsFlow:1;      // CTS управление потоком выхода
     DWORD fOutxDsrFlow:1;      // DSR управление потоком выхода
     DWORD fDtrControl:2;       // DTR Тип управления потоком скорости
                                // передачи данных
     DWORD fDsrSensitivity:1;   // DSR sensitivity (чувствительность)
     DWORD fTXContinueOnXoff:1; // XOFF continues Tx (стоп-сигнал
                                // продалжает выполнение)
     DWORD fOutX: 1;            // XON/XOFF out flow control (СТАРТ-
                                // СИГНАЛ / СТОП-СИГНАЛ для управления
                                // выходящим потоком (по умолчанию
                                // значение = 1)
     DWORD fInX: 1;             // XON/XOFF in flow control (СТАРТ-
                                // СИГНАЛ / СТОП-СИГНАЛ для управления
                                // входящим потоком (по умолчанию
                                // значение = 1)
     DWORD fErrorChar: 1;       // enable error replacement (включить
                                // проверку погрешностей по умолчанию=1)
     DWORD fNull: 1;            // enable null stripping (отвергать
                                // пустой поток данных (по умолчанию=1))
     DWORD fRtsControl:2;       // RTS управление потоком данных
     DWORD fAbortOnError:1;     // abort reads/writes on error
                                // (проверять операции чтения/записи
                                // по умолчанию=1)
     DWORD fDummy2:17;          // reserved ЗАРЕЗЕРВИРОВАНО
     WORD wReserved;            // not currently used НЕ ДЛЯ
                                // ИСПОЛЬЗОВАНИЯ
     WORD XonLim;               // transmit XON threshold (порог
                                // чувствительности старт-сигнала)
     WORD XoffLim;              // transmit XOFF threshold (порог
                                // чувствительности стоп-сигнала)
     BYTE ByteSize;             // Бит в байте  (обычно 8)
     BYTE Parity;               // 0-4=no,odd,even,mark,space
                                // (четность байта)
     BYTE StopBits;             // 0,1,2 = 1, 1.5, 2 (стоповые биты)
     char XonChar;              // Tx and Rx XON character (вид
                                // старт сигнал в потоке)
     char XoffChar;             // Tx and Rx XOFF character (вид
                                // стоп сигнал в потоке)
     char ErrorChar;            // error replacement character (какой
                                // сигнал погрешности,его вид)
     char EofChar;              // end of input character (сигнал
                                // окончания потока)
     char EvtChar;              // received event character  РЕЗЕРВ
     WORD wReserved1;           // reserved; do not use НЕ ДЛЯ
                                // ИСПОЛЬЗОВАНИЯ
 } DCB;
 

Пример:


 with Mode do
   Begin
     BaudRate := 9600;
     ByteSize := 8;
     Parity := NOPARITY;
     StopBits := ONESTOPBIT; // одиночный стоп-бит
     Flags := EV_RXCHAR + EV_EVENT2;
   End;
 

Параметры :

DCBlength - Размер DCB структуры.

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

 CBR_110 	CBR_19200
 CBR_300 	CBR_38400
 CBR_600 	CBR_56000
 CBR_1200	CBR_57600
 CBR_2400	CBR_115200
 CBR_4800	CBR_128000
 CBR_9600	CBR_256000
 CBR_14400
 

fBinary - Определяет, допускается ли двоичный (бинарный) способ передачи данных. Win32 API не поддерживает недвоичные (небинарные) способы передачи данных в потоке порта, так что этот параметр должен быть всегда ИСТИНЕН. Попытка использовать ЛОЖЬ в этом параметре не будет работать.

Примечание :

Под Windows 3.1 небинарный способ передачи допускается, но для работы данного способа необходимо заполнит параметр EofChar который будет восприниматься конец данных.

fParity - Определяет, допускается ли проверка четности. Если этот параметр ИСТИНЕН, проверка четности допускается

fOutxCtsFlow - CTS (clear-to-send) управление потоком выхода

fOutxDsrFlow - DSR (data-set-ready) управление потоком выхода

fDtrControl - DTR (data-terminal-ready) управление потоком выхода

Принимает следующие значения :

DTR_CONTROL_DISABLE - Отключает линию передачи дынных
DTR_CONTROL_ENABLE - Включает линию передачи дынных
DTR_CONTROL_HANDSHAKE - Enables DTR handshaking. If handshaking is enabled, it is an error for the application to adjust the line by using the EscapeCommFunction function.

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

fDsrSensitivity - Specifies whether the communications driver is sensitive to the state of the DSR signal. If this member is TRUE, the driver ignores any bytes received, unless the DSR modem input line is high. Определяет возможна ли по порту двухсторонняя передача в ту и в другую сторону сигнала.

fTXContinueOnXoff - Определяет, останавливается ли передача потока , когда входной буфер становится полный, и драйвер передает сигнал XoffChar. Если этот параметр ИСТИНЕН, передача продолжается после того, как входной буфер становится в пределах XoffLim байтов, и драйвер передает сигнал XoffChar, чтобы прекратить прием байтов из потока . Если этот параметр ЛОЖНЫЙ, передача не продолжается до тех пор , пока входной буфер не в пределах XonLim байтов, и пока не получен сигнал XonChar, для возобновления приема .

fOutX - Определяет, используется ли управление потоком СТАРТ-СИГНАЛА / СТОП-СИГНАЛА в течение передачи потока порту. Если этот параметр ИСТИНЕН, передача останавливается, когда получен сигнал XoffChar и начинается снова, когда получен сигнал XonChar.

fInX - Specifies whether XON/XOFF flow control is used during reception. If this member is TRUE, the XoffChar character is sent when the input buffer comes within XoffLim bytes of being full, and the XonChar character is sent when the input buffer comes within XonLim bytes of being empty. Определяет, используется ли управление потоком СТАРТ-СИГНАЛА / СТОП-СИГНАЛА в течение приема потока портом. Если этот параметр ИСТИНЕН,сигнал XoffChar посылается , когда входной буфер находится в пределах XoffLim байтов, а сигнал XonChar посылается тогда когда входной буфер находится в пределах XonLim байтов или является пустым

fErrorChar - Определяет, заменены ли байты, полученные с ошибками четности особенностью, указанной параметром ErrorChar Если этот параметр ИСТИНЕН, и fParity ИСТИНЕН, замена происходит.

fNull - Определяет, отвергнуты ли нулевые(пустые) байты. Если этот параметр ИСТИНЕН, нулевые(пустые) байты, будут отвергнуты при получении их.

fRtsControl - RTS управление потоком " запрос пересылки " . Если это значение нулевое, то по умолчанию устанавливается RTS_CONTROL_HANDSHAKE. Принимает одно из следующих значений:

RTS_CONTROL_DISABLE - Отключает строку RTS, когда устройство открыто
RTS_CONTROL_ENABLE - Включает строку RTS
RTS_CONTROL_HANDSHAKE - Enables RTS handshaking. The driver raises the RTS line when the " type-ahead" (input) buffer is less than one-half full and lowers the RTS line when the buffer is more than three-quarters full. If handshaking is enabled, it is an error for the application to adjust the line by using the EscapeCommFunction function.

Допускает RTS подтверждение связи. Драйвер управляет потоком пересылки. RTS выравнивается , когда входной буфер - меньше чем половина полного и понижается, когда буфер - больше 2/3 полного .Если подтверждение связи допускается, это используется для регулирования передачи данных EscapeCommFunction.

RTS_CONTROL_TOGGLE - Specifies that the RTS line will be high if bytes are available for transmission. After all buffered bytes have been sent, the RTS line will be low. Определяет, что буфер будет высокий при подготовке данных для передачи. После того, как все байты отосланы, буфер RTS будет низок.

FAbortOnError - Определяет, закончена ли операции чтения/записи, если происходит погрешность. Если этот параметр ИСТИНЕН, драйвер закрывает все операции чтения/записи с состоянием погрешности при возникновении оной.

Драйвер не будет принимать никакие дальнейшие действия, пока не дождется подтверждения погрешности в передоваемых (принимаемых) данных, вызывая функцию ClearCommError.

fDummy2 - ЗАРЕЗЕРВИРОВАНО Microsoft
wReserved - ЗАРЕЗЕРВИРОВАНО Microsoft

XonLim - Определяет минимальное число байтов, находящихся во в

XoffLim - Определяет максимальное число байтов, находящихся во входном буфере прежде, чем будет генерирована подача СТОП-СИГНАЛА. Максимальное число байтов, позволенных во входном буфере вычитается из размеров, в байтах, самого входного буфера.

ByteSize - Определяет число битов в байтах, переданных и полученных.

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

EVENPARITY
MARKPARITY
NOPARITY
ODDPARITY

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

ONESTOPBIT 1 stop bit
ONE5STOPBITS 1.5 stop bits
TWOSTOPBITS 2 stop bits

XonChar - Определяет значение СТАРТ-СИГНАЛА для передачи и приема.
XoffChar - Определяет значение СТОП-СИГНАЛА для передачи и приема.
ErrorChar - Определяет значение СИГНАЛА ОШИБКИ (генерируемого при ошибке четности) для передачи и приема.
EofChar - Определяет значение сигнала конца данных.
EvtChar - Определяет значение сигнала события.
wReserved1 - ЗАРЕЗЕРВИРОВАНО Microsoft

Дополнение :

Когда структура DCB использует «ручной» выбор конфигурации , следующие ограничения используются для ByteSize и StopBits параметров : Число информационных разрядов должно быть от 5 до 8 битов. Использование 5 информационных разрядов с 2 стоповыми битами - недопустимая комбинация, как - 6, 7, или 8 информационных разрядов с 1.5 стоповыми битами.




Чтобы при выполнении длительного цикла другие приложения не подвисали

Встретились Windows 95 и Windows 98:
- Ну что, в бар пойдем, или тут зависнем?

Нужно вставить в тело цикла:


 Application.ProcessMessages;
 

После этого даже само приложение, выполняющее цикл не будет виснуть. Например, по нажатию на кнопку напишите следующий код:


 procedure TForm1.Button2Click(Sender: TObject);
 var
   i: integer;
 begin
   randomize;
   for i:=0 to 50000000 do
   begin
     Form1.Caption := IntToStr(Random(5000));
     Application.ProcessMessages;
   end;
 end;
 




Зачем ломают программы или крэкеры на воле

Автор: Fess

Одна программа спрашивает у другой:
- Kак ты думаешь, есть ли жизнь после reset-а?

Target: Crackers

Tools:

  • Some brains

Вступление

Зачем все это:

Приветствую Вас! В этой статье не будет описано конкретного взлома, здесь я попытаюсь рассказать "Зачем крэкеры ломают программы и чем это хорошо и чем плохо. Конечно, Вы можете не согласиться с моими размышлениями это Ваше право, я никого не заставляю думать так же как и я. Этой статьей я хочу Вас подтолкнуть к познанию искусства крэка и что за ним стоит. Именно ИСКУССТВА, а не просто мелочевки.

Филосовствования

Хм.Хм.

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

Вернемвся в наши дни, сейчас при развитии техники, обилия программ и документации, любой, я повторюсь - ЛЮБОЙ может стать крэкером, для этого уже не нужно досканальное знание математики и архитектуры компьютера (хотя и не помешает) достаточно иметь компьютер, время, кучу статей по крэку и чуть-чуть логического мышления и вы, можно считать, уже без пяти минут крэкер.

Так вот перво наперво, давайте определимся, что же подталкивает человека к изучению искусства крэка. Первое, желание себя показать, что вот я рульный крэкер. Второе, заработать деньжат. Третье, испытать неизведанное. Вот три основных желания. Ну второй пункт, можно почти однозначно выкинуть - заработать на этом врядли удастся, хотя кто знает...

Тем временем, количество крэкеров увеличивается. Почему такое происходит? А по одной простой причине - чувство Победы. Радость. Счастье. Гармония души. Все Вы знаете, что значит выйграть в лотерею или победить в каком-либо соревновании, радость испытанная после этого. Чем выйгрыш больше или крупнее соревнования, тем сильнее радость. Например, выйгать на городских соревнованиях и на олимпийских играх не одно и тоже, так ведь? Здесь теже соревнования, соревнования крэкер-программист, кто кого? И чем сложней программа, чем трудней был взлом, тем сильнее это не с чем не сравнимое чувство ПОБЕДЫ.

Чем же это плохо? Хорошо и плохо понятия расплывчатые, как добро и зло. Но вот, что я скажу: тут, как всегда происходит из-за нескольких нерадивых, которые после взлома выкладывают патчи, кейгены, серийные номера в интернете, где их может найти любой и естественно воспользоватся ими. Вот, например, я Fess. Ну сломал я программу, воспользовался крэком, даже дал своим ближайшим друзьям, но и все, ущерб минимальный, а если я бы выкладывал их в инете или в FIDO, где их могли бы все найти, тем самым я бы нанес компании намного больший ущерб. Согласитесь. Что же еще, ну то, что программистам приходится трудится над защитой вместо того, чтобы улучшать свои продукты.

"И чем же это хорошо?" - Спросите Вы, - "Покамест ты называл только отрицательные стороны". Если есть плохое, значит есть и хорошее.

  • Первое, это я назвал, чувство ПОБЕДЫ.
  • Второе, обратная сторона плохого, если бы программисты не разробатывали защиты, то постепенно, все программы превратились бы в горы мусора, т.е. не оптимальный код, жутко тормозит и прочее, чего простому пользователю, ой как не хочется. А при разработке достойной защиты приходится пользоваться низкоуровневыми средствами и исхитряться, чтобы не сразу разгадали алгоритм. Отсюда ясно видно, что квалификация программистов повышается и позволяет писать более оптимальные программы.
  • Третье, крэк это способ скоротать время, вместо него можно или пить, или ширятся наркотой, а это уже не дела.
  • Четвертое, это способ повышения уровня знаний о компьютере и процессах протекающих в нем.
  • Пятое, это интелектуальный спорт позволяющий разминать свои мозги, как кроссворды или шахматы.
  • Шестое, этот спорт усиливает силу воли при движении к успеху.
  • Седьмое, чем дешевле продукт, тем меньше причин у потребителя искать кряк или кейген, легче купить. Тем самым выигрывают потребители, цены у умных компаний не очень высоки.
  • Восьмое, так как для создания защиты нужны дополнительные программисты, тем самым это увеличивает количество работающих людей, т.е. дает им шанс легально зарабатывать на жизнь.
  • Девятое, это как и любое другое хобби объединяет людей разных национальностей и верований в единую нацию.

Как видите достаточно много причин, чтобы заниматься этим, и мало чтобы не заниматься. По мне, так это гораздо интересней, чем воевать и торговать (ширятся) наркотой. По этому спорту равно, как и искусству давно пора проводить соревнования.

Спасибо за интерес к моему творчеству!

Удачи в Reversing Engeneering!

Послесловие

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

 	Вредный совет:
 	Если сканер Ваш планшетный
 	Не работает как надо,
 	А листочки уже завтра
 	Надо к вечеру сдавать -
 	Все прозрачные фигнюшки
 	Изолентою заклейте,
 	Пусть он гадина узнает,
 	Что такое слепота.
 	               (Fess)
 

Все ругательства отправлять в null
Все остальное на lomovskih@yandex.ru

P.S. Запомните все материалы публикуются только в учебных целях и автор за их использование ответственности не несет!!

P.P.S. Возможно имеют место опечатки, заранее извините!

With best wishes Fess

И да пребудет с вами великий дух bad-сектора.




Прозрачные меню для XP, Win2000

Невиданную рекламную акцию устроила Microsoft в России по продвижению своего продукта Windows XP. 5 мая логотип XP был везде! Даже на празничных яйцах и куличах. По неофицальным данным несмотря на то, что юзеры просто молились на XP, продажа так и не возросла.


 var
   hHookID: HHOOK;
 
 // function to make the menu transparent 
 function MakeWndTrans(Wnd: HWND; nAlpha: Integer = 10): Boolean;
 type
   TSetLayeredWindowAttributes = function(hwnd: HWND; crKey: COLORREF; bAlpha: Byte;
     dwFlags: Longint): Longint; stdcall;
 const
   // Use crKey as the transparency color. 
   LWA_COLORKEY = 1;
   // Use bAlpha to determine the opacity of the layered window.. 
   LWA_ALPHA = 2;
   WS_EX_LAYERED = $80000;
 var
   hUser32: HMODULE;
   SetLayeredWindowAttributes: TSetLayeredWindowAttributes;
   i : Integer;
 begin
   Result := False;
   // Here we import the function from USER32.DLL 
   hUser32 := GetModuleHandle('USER32.DLL');
   if hUser32 <> 0 then
   begin
     @SetLayeredWindowAttributes := GetProcAddress(hUser32,'SetLayeredWindowAttributes');
     // If the import did not succeed, make sure your app can handle it! 
     if @SetLayeredWindowAttributes <> nil then
     begin
       // Check the current state of the dialog, and then add the WS_EX_LAYERED attribute 
       SetWindowLong(Wnd, GWL_EXSTYLE, GetWindowLong(Wnd, GWL_EXSTYLE) or WS_EX_LAYERED);
       // The SetLayeredWindowAttributes function sets the opacity and 
       // transparency color key of a layered window 
       SetLayeredWindowAttributes(Wnd, 0, Trunc((255 / 100) * (100 - nAlpha)), LWA_ALPHA);
       Result := True;
     end;
   end;
 end;
 
 // hook procedure 
 function HookCallWndProc(nCode: Integer; wParam, lParam: Longint): Longint; stdcall;
 const
  MENU_CLASS = '#32768';
  N_ALPHA = 60;
 var
   cwps: TCWPStruct;
   lRet: THandle;
   szClass: array[0..8] of char;
 begin
   if (nCode = HC_ACTION) then
   begin
     CopyMemory(@cwps, Pointer(lParam), SizeOf(CWPSTRUCT));
     case cwps.message of
       WM_CREATE:
         begin
           GetClassName(cwps.hwnd, szClass, Length(szClass)-1);
           // Window name for menu is #32768 
           if (lstrcmpi(szClass, MENU_CLASS) = 0) then
           begin
             MakeWndTrans(cwps.hwnd, N_ALPHA {Alphablending});
           end;
         end;
     end;
   end;
   // Call the next hook in the chain 
   Result := CallNextHookEx(WH_CALLWNDPROC, nCode, wParam, lParam);
 end;
 
 // Install the hook in the OnCreate Handler 
 procedure TForm1.FormCreate(Sender: TObject);
 var
   tpid: DWORD;
 begin
   // Retrieve the identifier of the thread that created the specified window 
   tpid := GetWindowThreadProcessId(Handle, nil);
   // The SetWindowsHookEx function installs an application-defined 
   // hook procedure into a hook chain 
   hHookID := SetWindowsHookEx(WH_CALLWNDPROC, HookCallWndProc, 0, tpid);
 end;
 
 // Stop the hook in the OnDestroy Handler 
 procedure TForm1.FormDestroy(Sender: TObject);
 begin
   if (hHookID <> 0) then
     // Removes the hook procedure 
     UnhookWindowsHookEx(hHookID);
 end;
 




Основы работы с Win32API

Введение

Цель этого обзора - помочь человеку перейти от использования средств Delphi к функциям Win API. Предполагается, что читатель уже неплохо владеет Delphi, поэтому будет подчёркиваться прежде всего разница между этими двумя инструментами. Кроме того, многие авторы книг по Delphi не уделяют достаточно внимания функциям Win API, предназначенным для работы с окнами и графикой, потому что считают, что VCL Delphi достаточно хорошо справляется с этими задачами. Так что часто приходится учиться работе с Win API по книгам по 16-разряд-ному Borland Pascal'ю. Поэтому я буду обращать внимание и на отличие 32-разрядных версий от 16-разрядных. Но я не буду без особой необходимости останавливаться на подробном опи-сании конкретных функций, так как это всё сделано в справочной системе. Я также остановлюсь и на этой самой справочной системе, потому что начинающему программисту может оказаться не очень просто разобраться с ней.

Что такое Win API

Win API - это набор функций, предоставляемых операционной системой каждой программе. Эти функции находятся в стандартных динамически компонуемых библиотеках (Dynamic Linked Li-brary, DLL), таких как kernel32.dll, user32.dll, gdi32.dll. Эти файлы находятся в директории Win-dow. Вообще говоря, каждая программа должна самостоятельно заботится о том, чтобы подключить эти библиотеки. DLL могут подключаться к программе статически и дина-мически. В первом случае программа <освобождает> DLL только при завершении, во втором освобождение может произойти в любой момент. Если после освобождения DLL оказывается, что её больше не использует ни одна программа, она выгружается из памяти. Так как стандартные библиотеки используются самой системой, они всегда находятся в памяти, и поэтому использование динамического подключения бессмысленно. Чтобы статически подключить в Delphi некоторую функцию Win API, например, функцию GetWindowDC из модуля user32.dll, надо написать конструкцию вида


 function GetWindowDC(Wnd: HWnd); HDC;
 stdcall; external 'user32.dll' name 'GetWindowDC';
 

Такая запись обеспечивает одновременно и статическое подключение библиотеки user32, и декларацию функции GetWindowDC, что позволяет компилятору в дальнейшем работать с ней. Обратите внимание, что все функции Win API написаны в соответствии с моделью вызова stdcall, а в Delphi по умолчанию используется другая модель - register (модель вызова определяет, как функции передаются параметры). Поэтому при импорте функций из стандартных биб-лиотек необходимо явно указывать эту модель. Далее указывается, из какой библиотеки импор-тируется функция и какое название в ней она имеет. Дело в том, что имя функции в библиотеке может не совпадать с тем, под которым она становится известна компилятору. Позже я остановлюсь на тех случаях, когда это используется. Главным недостатком DLL следует считать то, что в них сохраняется информация только об именах функций, но не об их параметрах. По-этому, если при импорте функции указать не те параметры, какие подразумевались автором DLL, то программа будет работать неправильно (вплоть до зависания), а ни компилятор, ни операционная система не смогут указать на ошибку.

Обычно программа использует довольно большое число функций Win API. Декларировать их все довольно утомительно. К счастью, Delphi избавляет программиста от этой работы: все эти функции уже описаны в соответствующих модулях, достаточно упомянуть их имена в разделе uses. Например, большинство общеупотребительных функций описаны в модулях Windows.dcu и Messages.dcu.

Как получить справку по функциям Win API

Для тех, кто решил использовать Win API, самым необходимым инструментом становится ка-кая-либо документация по этим функциям. Их так много, что запомнить все совершенно нере-ально, поэтому работа без справочника под рукой просто невозможна. Наиболее доступным справочником для российского программиста является Win32 Developer's Reference, справочная система фирмы Microsoft, потому что фирма Inprise (тогда ещё Borland), получила лицензию на включение её в состав Delphi. Сам я буду постоянно ссылаться на эту справку, потому что под-робное описание функций займёт слишком много места, да и нет особого смысла описывать то, что описали и без меня.

Хотя в комплект поставки Delphi и входит эта справочная система, содержащая описание всех функций Win API, получение справки по ним не настолько удобное, как по стандартным функ-циям Delphi. Если набрать в редакторе Delphi имя какой-нибудь функции Win API, поставить курсор в начало этой функции и нажать F1, то откроется справка по ней, как и в случае обыч-ных функций и процедур. Однако функции Win API не появляются в предметном указателе справочной системы. Авторы Delphi объясняют это ограничениями, накладываемыми самой справочной системой (как обычно, всех собак вешают Windows). Они же советуют создать в меню кнопки <Пуск> ярлык к справочной системе Win32 Developer's Reference. Мне остаётся только присоединиться к этому совету и добавить, что ярлык надо создавать к файлу MSTools.hlp, который находится в директории $(Delphi).

Другая проблема заключается в том, что, так как система Windows написана на Си, все описа-ния функций Win API даны в соответствии с синтаксисом именно этого языка, а не Паскаля. Во-первых, необходимо разобраться с типами. Ниже приведена таблица, какие типы Си чему соответствуют.

  • WCHAR = WideChar;
  • LPSTR = PChar;
  • LPCSTR = PChar;
  • LPWSTR = PWideChar;
  • LPCWSTR = PWideChar;
  • DWORD = Integer;
  • BOOL = LongBool;
  • PBOOL = ^BOOL;
  • PINT = ^Integer;
  • PWORD = ^Word;
  • PDWORD = ^DWORD;
  • LPDWORD = PDWORD;
  • UCHAR = Byte;
  • PUCHAR = ^Byte;
  • SHORT = Smallint;
  • UINT = Integer;
  • PUINT = ^UINT;
  • ULONG = Longint;
  • PULONG = ^ULONG;
  • LCID = DWORD;
  • LANGID = Word;
  • int = Integer;
  • long = LongInt;
  • PVOID = Pointer;
  • HANDLE = THandle;
  • LPPOINT = TPoint;
  • RECT = TRect;
  • LPRECT = PRect;
  • LPSIZE = PSize;
  • BITMAP = TBitmap;

Все типы, приведённые в первой части таблицы, в целях совместимости описаны в модуле Win-dows.dcu, поэтому их можно использовать наравне с обычными типами Delphi. Кроме этих типов общего назначения существуют ещё специальные. Например, дескриптор окна имеет тип HWND, первый параметр сообщения - тип WPARAM. Эти специальные типы также описаны в Windows.dcu. В некоторых имена типов, встречающихся в справке, и соответствующих им ти-пов из Windows.dcu отличаются только добавлением буквы , как это можно видеть из вто-рой части таблицы. Кстати, не следует путать тип TBitmap, определённый в Windows.dcu, с классом TBitmap, определённым в Graphics.dcu. Зачем разработчикам Delphi потребовалось на-зывать разные типы одним именем, не понятно, тем более что во второй версии Delphi был тип BITMAP, который куда-то исчез в третьей. Зато в четвёртой версии снова появился BITMAP, остался TBitmap, да ещё добавился tagBITMAP, и все эти три типа означают то же самое.

Теперь о синтаксисе описания самой функции в Си. Оно имеет вид


 <Тип функции> <Имя функции>(<Тип параметра> <Имя параметра>,
 <Тип параметра2> <Имя параметра2>, ...);
 

Еще в Си различается верхний и нижний регистр, поэтому идентификаторы HDC, hdc, hDC и т. д. - разные идентификаторы (автор Си очень любил краткость и хотел, чтобы можно было делать не 26, а 52 переменные с именем из одной буквы). Поэтому часто можно встретить, что имя параметра и его тип совпадают с точностью до регистра. К счастью, при описании функции в Delphi мы не обязаны сохранять имена параметров, значение имеют лишь их типы и порядок следования. С учётом всего этого функция, описанная в справке как


 HMETAFILE CopyMetaFile(HMETAFILE hmfSrc, LPCTSTR lpszFile);
 

в Delphi имеет вид:


 function CopyMetaFile(hmfSrc: HMETAFILE; lpszFile: LPCTSTR): HMETAFILE;
 

или, что то же самое,


 function CopyMetaFile(hmfSrc: HMetaFile; lpszFile: PChar): HMetaFile;
 

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

Несколько особняком стоит тип VOID. Если функция имеет такой тип, то в Паскале она описы-вается как процедура. Если вместо параметров у функции в скобках стоит VOID, это означает, что функция не имеет параметров. Например, функция


 VOID CloseLogFile(VOID);
 

в Delphi описывается как


 procedure CloseLogFile;
 

Не путайте VOID и PVOID. PVOID - это нетипизированный указатель, соответствующий типу Pointer.

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


 int GetRgnBox(HRGN hrgn, LPRECT lprc);
 

в файле Windows.pas описана


 function GetRgnBox(RGN: HRGN; var p2: TRect): Integer;
 

И, наконец, если не удаётся понять, как функция, описанная в справке, должна быть переведена на Паскаль, можно попытаться найти описание этой функции в исходных текстах модулей, по-ставляемых вместе с Delphi. Эти модули находятся в директории $(DELPHI). Можно также воспользоваться подсказкой, которая всплывает в редакторе Delphi после того, как будет набрано имя функции.

Если посмотреть справку, например, по функции GetSystemMetrics, то видно, что эта функция должна иметь один целочисленный параметр. Однако далее в справке предлагается при вызове этой функции подставлять в качестве параметра не числа, а SM_ARRANGE, SM_CLEANBOOT и т. д. Подобная ситуация и со многими другими функциями Win API. Все эти SM_ARRANGE, SM_CLEANBOOT и т. д. являются именами числовых констант. Эти константы описаны в том же модуле, в котором описана функция, использующая их, поэтому можно не выяснять числен-ные значения этих констант, а указывать при вызове функций их имена, например, GetSystem-Metric-s(SM_Arrange); Если по каким-то причинам всё-таки потребовалось выяснить численные значения, то в справочной системе их искать не стоит - их там нет. Я могу только опять отправить к исходным текстам модулей Delphi, в которых эти константы описаны. Так, например, просматривая Windows.pas, можно узнать, что SM_ARRANGE = 56. Кстати, всем, кто решиться самостоятельно просматривать исходники, я очень рекомендую использовать для этого не текстовый редактор, а программу, которая может только показать, но не изменить файл (что-то вроде просмотра по F3 в Norton Commander'е). Так безопаснее. Или же стоит по-думать о резервной копии.

В описании многих функций Win API вверху можно увидеть три ссылки: QuickInfo, Overview и Group. Первая даёт краткую информацию о функции. Самой полезной частью этой информации является то, для каких версий Windows эта функция реализована. Например, очень полезна функция MaskBlt, однако QuickInfo показывает, что она реализована только в Windows NT. Программа, использующая эту функцию, не будет работать в Windows 95. Иногда напротив на-звания одной из систем стоит слово , которое переводится как <пень>, <обрубок> (например, для функции GetDeviceGammaRamp это слово стоит напротив Windows NT). Это означает, что в данной версии эта функция присутствует (то есть обращение к ней не вызывает ошибки), но ничего не делает. Оставим на совести программистов из Microsoft вопрос, зачем нужны такие пни. Overview - это краткий обзор какой-то большой темы. Например, для любой функции, работающей с растровыми изображениями, обзор будет в двух словах объяснять, за-чем в принципе нужны эти самые растровые изображения. Судя по непроверенным данным, первоначально эти обзоры замышлялись как нечто большее, но потом остановились на таких вот лаконичных фразах. Как бы то ни было, найти в обзоре полезную информацию удаётся крайне редко, поэтому заглядывать туда стоит только если ну совсем ничего не понятно. И, наконец, Group. Эта ссылка приводит к списку всех функций, родственных данной. Например, для функции CreateRectRgn группу будут составлять все функции, имеющие отношение к ре-гионам. Если теперь нажимать на кнопку << (два знака <меньше>) сразу под главным меню окна справки, то будут появляться страницы с кратким описанием возможных применений объ-ектов, с которыми работают функции (в приведённом примере описание возможностей ре-гионов). Чтобы читать их в нормальной последовательности, лучше всего нажать на < столько раз, сколько возможно, а затем пойти в противоположном направлении с помощью кнопки >.

Иногда в справке можно встретить указания или . К этим замечаниям следует относится критически, так как справка написана для Windows 95, когда ещё не было Windows NT 4.0, описывается версия со старым интерфейсом. Так что то, про что на-писано , может вполне успешно работать и в Windows NT 4.0 и выше, осо-бенно если это <что-то> связано с пользовательским интерфейсом. То же самое относится и к QuickInfo. Такие вещи лучше всего проверять на практике.

Ещё несколько слов о числовых константах. В справке можно встретить числа вида, например, 0xC56F или 0x3341. Префикс <0x> в Си означает шестнадцатеричное число. В Delphi надо его заменить на <$>, то есть вышеназванные числа должны быть записаны как $C56F и $3341 соот-ветственно.

Дескрипторы вместо классов

Программируя в Delphi, мы быстро привыкаем к тому, что каждый объект реализуется экземпляром соответствующего класса. Например, кнопка реализуется экземпляром класса TButton, контекст устройства - классом TCanvas. Но когда создавались первые версии Windows, объ-ектно-ориентированный метод программирования ещё не был общепризнанным, поэтому он не был реализован. Современные версии Windows частично унаследовали этот недостаток, по-этому в большинстве случаев приходится работать по старинке, тем более что DLL могут экс-пор-тировать только функции, но не классы.

Когда мы создаём некоторый объект в Windows, ему присваивается уникальный 32-разрядный номер, называемый дескриптором. В дальнейшем при работе с этим объектом каждой функции передаётся этот дескриптор. В этом и заключается главное различие между методами класса и функциями Win API. Первые связаны с тем экземпляром класса, через который они вызыва-ются, и поэтому не требуют явного указания на объект. Вторым необходимо такое указание, так как они сами по себе никак не связаны ни с одним объектом.

Не следует думать, что при работе с Win API следует полностью отказываться от классов Delphi. Эти методы прекрасно работают вместе. Правда, внутренние механизмы Delphi не могут вклю-читься, если изменение объекта происходит через Win API. Например, если спрятать окно не с помощью метода Hide, а с помощью вызова функции Win API ShowWindow(Handle, SW_Hide), не возникнет событие OnHide, потому что оно запускается теми самыми внутренними механиз-мами Delphi. Но такие недоразумения случаются обычно только тогда, когда функциями Win API дублируется то, что можно сделать и с помощью Delphi. Для вызова функций Win API объ-екта, созданного с помощью Delphi, используйте свойство Handle. В нём хранится дескриптор.

В некоторых случаях класс Delphi инкапсулирует несколько объектов Windows. Например, класс TBitmap включает в себя HBitmap и HPalette - картинку и палитру к ней. Соответственно, он хранит два дескриптора - в свойствах Handle и Palette.

Все экземпляры классов, созданные в Delphi, должны удаляться. В некоторых случаях это происходит автоматически, в некоторых программист должен сам позаботиться о <выносе му-сора>. Аналогичная ситуация и с объектами, создаваемыми в Win API. Если посмотреть справку по функции, создающей какой-то объект, то там обязательно будет информация о том, какой функцией можно удалить объект и может ли система сделать это автоматически. Во многих случаях совершенно разные объекты могут удаляться одной и той же функцией. Так, функция DeleteObject удаляет косметические карандаши, геометрические карандаши, кисти, шрифты, регионы, растровые изображения и палитры. Обращайте внимание на возможные исключения. Например, регионы не удаляются системой автоматически, однако если вызвать для региона функцию SetWindowRgn, то этот регион переходит в собственность операционной системы. Никакие дальнейшие операции с ним, в том числе и удаление, совершать нельзя

Формы Delphi и окна Windows

Принято считать, что класс TForm реализует окно. Это не совсем верно, потому что TForm реализует лишь часть тех объектов, которые принято называть окнами. Например, кнопка - это тоже окно, но реализуется она классом TButton.

Каждое окно принадлежит к какому-то оконному классу. Не следует путать оконный класс с классами Delphi. Это некий шаблон, определяющий базовые свойства окна. Каждому такому шаблону присваивается имя, уникальное в его области видимости. Классы делятся на локаль-ные (видимые только в приложении, регистрирующем их) и глобальные (видимые вне прило-жения). В 16-разрядных версиях Windows локальный класс, зарегистрированный приложением, был виден всем другим экземплярам этого же приложения. В 32-разрядных версиях различные экземпляры одного приложения стали более самостоятельными, поэтому каждый экземпляр должен заново регистрировать все свои классы. Перед использованием класс необходимо заре-гистрировать ( функция RegisterClassEx). При завершении программы все классы, зарегистриро-ванные в ней, удаляются автоматически, хотя при необходимости их можно удалить и само-стоятельно. Отсюда очевидно, что глобальный оконный класс, доступный всем программам, должен быть зарегистрирован динамической библиотекой, постоянно находящейся в памяти. Как это сделать, можно прочитать в Win32 Developer's Reference, тема WNDCLASS. Если же глобальный класс регистрируется программой обычным образом, то это означает, что он будет доступен не только самой программе, но и всем библиотекам, вызванным ею, но никак не другим программам и не другим экземплярам этой программы. Если наоборот, глобальный класс регистрирует DLL, то он становится доступным всем программам, использующим эту DLL. Но в этом случае класс не удаляется автоматически.

При создании окна обязательно указывать его класс. Данный класс должен быть к этому мо-менту зарегистрирован. В Delphi имя оконного класса для окон, созданных наследниками TForm, всегда совпадает с именем класса Delphi. Существуют предопределённые классы Win-dows, которые не надо регистрировать. Это 'BUTTON', 'COMBOBOX', 'EDIT', 'LISTBOX', 'MDICLIENT', 'SCROLLBAR' и 'STATIC'. Назначение этих классов понятно из их названий (класс 'STATIC' реализует статические, то есть не реагирующие на мышь и клавиатуру, но имеющие дескриптор элементы, текстовые или графические). Впрочем, можно определить локальный класс с зарезервированным именем, он перекроет глобальный в пределах приложения.

Кроме имени, класс включает в себя другие параметры, такие как стиль, кисть и т. д. Они подробно перечислены в справке по теме WNDCLASS.

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

Функции, создающие окна, требуют указать дескриптор приложения. В Delphi этот дескриптор хранится стразу в двух переменных - MainInstance модуля System и HInstance модуля SysInit. Оба эти модуля автоматически подключаются к любому модулю, созданному в Delphi, так что можно использовать ту или иную переменную по своему вкусу. Кстати, не следует путать авто-матическое подключение этих модулей с автоматической генерацией кода IDE Delphi для под-ключения таких модулей, как Windows, Forms, SysUtils и т. д. В первом случае модули подклю-чаются несмотря на то, что не упомянуты в списке uses. Более того, их упоминание там приве-дёт к ошибке. Во втором случае эти модули явным образом подключаются, просто Delphi автоматически пишет эту часть программы за программиста. Можно написать модуль или даже це-лую программу, которые не будут использовать SysUtils, но нельзя написать такие, которые не будут использовать System.

Создание окон через Win API требует кропотливой работы. VCL Delphi справляется с этой задачей замечательно, поэтому создавать окна самостоятельно приходится только тогда, когда ис-пользование VCL нежелательно, например, если необходимо написать как можно более ком-пактное приложение. Во всех остальных случаях приходится только слегка подправлять работу VCL. Например, с помощью Win API можно изменить форму окна или убрать из него заголо-вок, оставив рамку. Подобные действия не требуют от программиста создания нового окна, можно воспользоваться тем, что уже создано VCL.

Другой случай, когда могут понадобиться функции Win API для окон - если приложение должно что-то делать с чужими окнами. Например, хотя бы просто перечислить все окна, от-крытые в данный момент, как это делает WinSight32. Но в этом случае также не приходится самому создавать окна, работа идёт с уже имеющимися.

Callback функции

Прежде чем двигаться дальше, необходимо разобраться с тем, что такое callback функции. На русский язык это обычно переводится как функции косвенного вызова. Эти функции в программе описываются, но обычно не вызываются напрямую, хотя ничто не запрещает сделать это. В этом они похожи на те методы класса, которые связаны с событиями. Ничто не мешает вызывать напрямую, например, метод FormCreate, но делать это приходится крайне редко. С другой стороны, даже если этот метод не вызывается явно, он всё равно выполняется, потому что VCL автоматически вызывает его без прямого указания программиста. Еще одно общее свойство - конкретное имя метода при косвенном вызове не важно. Можно изменить его, но если этот метод по-прежнему будет связан с событием OnCreate, он так же будет успешно вы-зываться. Разница заключается только в том, что такие методы вызываются внутренними меха-низмами Delphi, а callback функции - самой системой Windows. Соответственно, на эти функции налагаются следующие требования: во-первых, эти функции должны быть именно функциями, а не методами класса (впрочем, иногда это условие удаётся обойти); во-вторых, эти функции должны быть написаны в соответствии с моделью вызова stdcall. Справочная система предла-гает использовать модель callback, которая в имеющихся версиях Windows совпадает с stdcall. Однако в Delphi такая модель не поддерживается. Что же касается того, как программист сообщает системе о том, что он написал callback функцию, то это в каждом случае по-своему.

Очень часто функции косвенного вызова используются при перечислении некоторых объектов. В качестве примера рассмотрим перечисление окон с помощью функции EnumWindows. В справке она описана так:


 BOOL EnumWindows(WNDENUMPROC lpEnumFunc, LPARAM lParam);
 

Соответственно, в Windows.pas она имеет вид


 function EnumWindows(lpEnumFunc: TFNWndEnumProc;
 lParam: LPARAM): BOOL; stdcall;
 

тип TFNWndEnumProc совпадает с типом Pointer. Здесь должен стоять указатель на callback функцию. Синтаксис этой функции описан так:


 BOOL CALLBACK EnumWindowsProc(HWND hwnd, LPARAM lParam);
 

Функции с таким именем не существует в Win API. Это так называемый прототип функции, согласно которому следует описывать callback функцию. На самом деле этот прототип предос-тавляет большую свободу, чем это может показаться на первый взгляд. Как я уже сказал выше, имя может быть любым. Любыми могут быть и типы функции и параметров, при условии что новые типы совпадают по размерам с теми, которые указываются. Что касается типа функции и типа первого параметра, то они имеют определённый смысл и менять их тип практически бес-смысленно. Другое дело со вторым параметром. Он предназначен специально для передачи значения, которое программист волен использовать по своему усмотрению, система не имеет на него никаких видов. А программисту может показаться удобнее работать не с типом LPARAM (то есть LongInt), а, например, с указателем или же с массивом из четырёх байт. Лишь бы были именно четыре байта, а не восемь, шестнадцать или ещё какое-то число. Можно даже превратить этот параметр в параметр-переменную, так как при этом функции будут переда-ваться всё те же четыре байта - адрес переменной. Но эти удовольствия для тех, кто хорошо разбирается с тем, как используется стек для передачи параметров при различных моделях вы-зова.

Как же работает EnumWindows? После вызова эта функция начинает по очереди перебирать все имеющиеся в данный момент окна верхнего уровня, то есть те, у которых нет родителя. Для каждого такого окна вызывается эта самая callback функция, в качестве первого параметра ей передаётся дескриптор данного окна (каждый раз, естественно, новый), в качестве второго - то, что было передано самой функции EnumWindows в качестве второго параметра (каждый раз одно и то же). Что же может делать callback функция с этим дескриптором? А всё, на что у про-граммиста хватит фантазии. Например, можно минимизировать или вообще закрыть все эти окна, хотя не понятно, с чего бы вдруг устраивать такую диверсию. Или можно проверять все эти окна на соответствие какому-то условию, пытаясь найти нужное. А значение, возвращаемое callback функцией, влияет на работу EnumWindows. Если она возвращает False, значит, всё, что нужно, уже сделано, можно не перебирать остальные окна.

Окончательный код для того случая, когда второй параметр имеет тип Pointer, выглядит так:


 function MyCallbackFunction(Wnd:HWnd; P: Pointer):Bool; stdcall;
 begin
   { что-то делаем }
 end;
 ...
 
 var
   MyPointer: Pointer;
 ...
 
 EnumWindows(@MyCallbackFunction, LongInt(MyPointer));
 

Что бы мы ни делали с типом второго параметра callback функции, тип соответствующего па-раметра EnumWindows не меняется. Поэтому необходимо явное приведение передаваемого па-раметра к типу LongInt. Обратное преобразование типов при вызове MyCallbackFunction осуще-ствляется автоматически.

В 16-разрядных версиях Windows вызов callback функций осложнялся тем, что для них необхо-димо было делать специальный код, называемый прологом. Пролог создавался с помощью функции MakeProcInstance, удалялся после завершения с помощью FreeProcInstance. То есть вызов EnumWindows должен был бы выглядеть так:


 var
   MyProcInstnace: TFarProc;
 ...
 
 MyProcInstance := MakeProcInstance(@MyCallbackFunction, HInstance);
 EnumWindows(MyProcInstance, LongInt(MyPointer));
 FreeProcInstance(MyProcInstance);
 

В Delphi этот код будет работоспособным, так как для совместимости MyProcInstance и FreePro-cInstance оставлены. Но они ничего не делают (в чём легко убедиться, просмотрев ис-ходный файл Windows.pas), поэтому можно обойтись и без них. Другой способ, с помощью которого в 16-разрядных версиях можно сделать пролог - описать функцию с директивой export. Эта директива сохранена для совместимости и в Delphi, но в 32-разрядных версиях она также ничего не делает (несмотря на то, что справка, например, по Delphi 3.0 утверждает обрат-ное; в справке по Delphi 4.3 этой ошибки уже нет).

Сообщения Windows

Человеку, знакомому с Delphi, должна быть ясна схема событийного управления. Программист пишет только код реакции на какое-либо событие, а дальше программа ждёт, когда система сочтёт, что настало время передать управление этому участку кода. Простые программы в Del-phi состоят исключительно из методов реакции на события вроде OnCreate, OnClick, OnClose-Qerry и т. д. Причём событием называется не только событие в обычном смысле этого слова, то есть когда происходит что-то внешнее, но и ситуация, когда событие используется просто для передачи управления основной программе в тех случаях, когда VCL не может сама справиться с какой-то задачей. Примером такого события является, например, TListBox.OnDrawItem. Устанавливая стиль списка в lbOwnerDrawFixed или lbOwnerDrawVariable, программист как бы сообщает VCL, что он не доволен теми средствами рисования элементов списка, которыми она располагает, и что он берёт эту часть задачи на себя. И каждый раз, когда возникает необходимость в рисовании элемента, VCL передаёт управление специально написанному коду. На самом деле разница между двумя типами собы-тий весьма условна. Можно так же сказать, что когда пользователь нажимает клавишу, VCL не знает, что делать, и поэтому передаёт управление обработчику OnKeyPress.

Событийное управление не есть изобретение авторов Delphi. Такой подход исповедует сама система Windows. Только здесь события называются сообщениями (message), что, на мой взгляд, даже лучше отражает ситуацию. Windows посылает программе сообщения, связанные либо с тем, что произошло что-то внешнее (мышь, клавиатура...), либо с тем, что самой сис-теме потребовались от программы какие-то действия. Самым распространённым таким дейст-вием является предоставление информации. Например, когда Windows хочет узнать заголовок окна, она посылает этому окну специальное сообщение, в ответ на которое окно должно сооб-щить системе свой заголовок. Ещё бывают сообщения, которые просто уведомляют программу о начале какого-то действия (например, о начале перетаскивания окна) и предоставляют возможность вмешаться. Но это вмешательство необязательно.

В Delphi для реакции на каждое событие обычно создаётся свой метод. В Windows одна проце-дура, называемая оконной, обрабатывает все сообщения. В языке Си нет понятия <процедура>, поэтому при использовании Паскаля может возникнуть путаница. Дело в том, что то, что называется оконной процедурой, на самом деле является функцией. Тем не менее, я буду использовать общепринятый термин <оконная процедура>. Каждое сообщение имеет свой уни-кальный номер, а оконная процедура обычно целиком состоит из оператора case, и каждому сообщению соответствует своя альтернатива этого оператора. Номера сообщений учить не надо, потому что можно использовать константы, описанные в модуле Messages.dcu. Эти кон-станты начинаются с префикса, указывающего на принадлежность сообщения к какой-то группе. Например, сообщения общего назначения начинаются с WM_: например, WM_Paint, WM_GetTextLength. Сообщения, специфичные, например, для кнопок, начинаются с префикса BM_. Остальные группы сообщений также связаны либо с теми или иными элементами управления, либо со специальными действиями, например, с динамическим обменом данными (dy-namic data exchange, DDE). Обычной программе приходится обрабатывать довольно много сообщений, поэтому оконная процедура бывает, как правило, очень длинной и громоздкой. Оконная процедура описывается программистом как callback функция и указывается при созда-нии оконного класса. Таким образом все окна данного класса имеют одну и ту же оконную процедуру. Впрочем, существует возможность породить так называемый подкласс, то есть новый класс, наследующий все свойства существующего, за исключением оконной процедуры. Несколько подробнее об этом будет сказано далее.

Кроме номера, каждое сообщение содержит два параметра - WParam и LParam. Буквы и означают и , то есть первый параметр 16-разрядный, а второй - 32-разряд-ный. Однако так было только в старых, 16-разрядных версиях Windows. В 32-разрядных вер-сиях оба параметра 32-разрядные, несмотря на их названия. Конкретный смысл каждого пара-метра зависит от сообщения. В некоторых сообщениях один или оба параметра могут вообще не использоваться, в других - наоборот, двух параметров даже не хватает. В этом случае один из параметров (обычно LParam) содержит указатель на дополнительные данные. После обра-ботки сообщения оконная процедура должна вернуть какое-то значение. Обычно это значение просто сигнализирует, что сообщение не нуж-дается в дополнительной обработке, но в некоторых случаях оно более осмысленно, например, WM_SetIcon должно вернуть дескриптор иконки, которая была установлена ранее. Если про-граммист не хочет обрабатывать сообщение самостоятельно, он должен вызвать для его обра-ботки функцию DefWindowProc.

Обработка сообщения требует времени, иногда довольно значительного. За это время окну может быть отправлено ещё несколько сообщений. Чтобы они не пропали, Windows организует так называемую очередь сообщений. Очередь сообщений своя для каждой нити. Нить должна сама выбирать сообщения из этой очереди, транслировать их и затем вызывать функцию Dispatch-Message, чтобы направить это сообщение в нужную оконную процедуру. Всё это лучше не писать самому, а оставить на совести VCL, которая прекрасно с этим справляется. При программировании в Delphi обычно требуется либо нестандартная реакция на сообщение, либо отправка сообщения другому окну.

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

Кроме параметров WParam и LParam, каждому сообщению приписывается время возникновения и координаты курсора в момент возникновения. Эти параметры можно узнать с помощью функций GetMessagePos и GetMessageTime.

Разумеется, что Delphi предоставляет программисту все средства, необходимые для обработки сообщений. Самый простой способ - описать метод для обработки сообщения с директивой message. Это выглядит примерно так


 type
   TSomeForm = class(TForm)
 
 ...
 
 procedure WMSomeMessage(var message: TMessage);
 message WM_SomeMessage;
 
 ...
 
 procedure TSomeForm.WMSomeMessage;
 begin
   ...
   inherited
 end;
 

Стандартная оконная процедура в Delphi устроена так, что она ищет среди методов класса специальные методы для обработки каждого сообщения. Эти методы во многом подобны обыкновенным виртуальным методам. Другими словами, если переопределить такой метод, будет вы-зван именно новый, а не старый вариант. Вообще говоря, в классе-родителе метода для обра-ботки какого-то конкретного сообщения может и не существовать. Это, однако, никак не ска-зывается на синтаксисе (в отличие от обычных виртуальных методов, где приходится писать директиву virtual для вновь созданных и override для перекрытых). Кроме того, при перекрытии методов обработки сообщений не важно имя метода, значение имеет только константа, стоящая после message. Именно поэтому при вызове перекрытого метода для обработки данного сообщения достаточно просто написать inherited, без указания имени метода. Такой способ вызова не приведёт к ошибке даже в том случае, если класс-родитель вообще не имел метода для обработки такого сообщения.

Тип TMessage сделан специально для обработки сообщений. Это запись, содержащая 32-раз-рядные целые поля Msg, WParam, LParam и Result. Первое поле содержит номер сообщения, два следующих - параметры сообщения, а полю Result метод должен присвоить то значение, кото-рое потом вернёт системе оконная процедура. Именно из-за необходимости передавать значе-ние параметр метода обработки сообщения должен быть переменной. При обработке сообще-ний часто приходится сталкиваться с ситуациями, когда один 32-разрядный параметр используется для передачи двух 16-разрядных значений. Чтобы облегчить программисту работу в таких случаях, тип TMessage описан как вариантная запись, поэтому в нём есть поля WParamLo, WParamHi, LParamLo, LParamHi, ResultLo и ResultHi, имеющие тип Word и дающие доступ к старшему и младшему словам соответствующего параметра.

Так как параметры WParam и LParam могут иметь совершенно различный смысл для разных сообщений, не всегда удобно представлять их в виде чисел. Иногда предпочтительнее, чтобы они имели тип Pointer, или LongBool, или ещё какой-либо. Поэтому тип TMessage - не единственный тип, который может иметь параметр метода обработки сообщения. Для многих сооб-щений в модуле Messages.dcu описаны собственные типы. Их названия образованы от названия соответствующих сообщений. Например, для сообщения WM_Paint описан тип TWMPaint, для WM_GetText - TWMGetText, и так далее. В этих типах все поля имеют тот тип, который наи-лучшим образом подходит для обработки именно этого сообщения. Кроме того, поля имеют названия, отражающие их назначения, что делает программу более удобной для чтения. Но такие типы описаны не для всех сообщений, поэтому иногда приходится пользоваться универ-сальным TMessage. Кстати, если по каким-то причинам в методе обработки сообщения потре-буется использовать не тот тип, который используется в соответствующем методе класса-роди-теля, никаких проблем не возникнет: в данном случае приведение типов выполняется автома-тически. Узнать, есть ли специальный тип для данного сообщения, можно двумя способами: либо поискать этот тип в Messages.pas, либо просто проверить, <съест> его компилятор или нет.

Сообщения, определяемые пользователем

Использование сообщений очень удобно в тех случаях, когда нужно заставить окно выполнить какое-то действие. Поэтому Windows предоставляет возможность программисту создавать свои сообщения, которые могут быть локальными или глобальными. Использование локальных со-общений связано с некоторым риском. Дело в том, что эти сообщения должны посылаться только <своим> окнам, то есть тем, оконные процедуры которых написаны так, чтобы пра-вильно интерпретировать это сообщение. Если послать такое сообщение <чужому> окну, его реакция может быть непредсказуемой, потому что человек, писавший его оконную процедуру, мог использовать сообщение с этим же номером для своих целей. Всё это вовсе не значит, что обмен локальными сообщениями возможен только внутри одной программы: если разные про-граммы написаны так, что они правильно понимают одно и то же локальное сообщение, они могут без каких-либо ограничений обмениваться им. Немного повторюсь: важно только чтобы отправитель и получатель сообщения одинаково понимали его. В справочной системе специально указывается, что недопустимо отправлять такие сообщения окнам классов 'BUTTON', 'EDIT', 'LISTBOX' и 'COMBOBOX'.

В Windows (и, соответственно, в модуле Messages.dcu) определена специальная константа WM_User, равная $400 (1024). Впрочем, нет гарантии, что в следующих версиях Windows зна-чение этой константы не изменится. Номера стандартных сообщений лежат в диапазоне от 0 до WM_User-1. Для локальных пользовательских сообщений оставлен диапазон от WM_User до $7FFF (32767). Забегая чуть вперёд, скажу, что для глобальных пользовательских сообщений оставлен диапазон от $C000 до $FFFF (от 49152 до 65535).

Глобальные пользовательские сообщения, называемые также строковыми, предназначены специально для тех случаев, когда локальные сообщения оказываются слишком ненадёжными. Например, может потребоваться написать несколько программ, которые взаимодействуют ме-жду собой. Поиск окон, принадлежащих этим программам, можно осуществлять, посылая всем окнам какое-либо специальное сообщение. Те, которые правильно откликнулись - <свои>. Так как сообщения посылаются всем окнам, <чужие> тоже будут его получать. Нужна гарантия, что они никак не отреагируют на такое сообщение. Для этого существует регистрация сообщений, обеспечивающая уникальный номер каждому, кто в нём нуждается.

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

Неудобство использования таких сообщений очевидно - их номера определяются только после начала выполнения программы, при компиляции они ещё неизвестны. Поэтому обработка та-ких сообщений описанным ранее методом невозможна - мы не знаем, какой номер писать по-сле слова message. Здесь может помочь виртуальный метод WndProc, имеющийся в классе TControl (и в TForm как в его потомке). Этот метод получает все сообщения, поступающие окну. Если перекрыть этот метод, то ничего не мешает сравнивать внутри него номер пришед-шего и определённого пользователем сообщения. Например, так:


 var
   WM_MyUserDemoMessage: Cardinal;
 ...
 
 procedure TForm1.FormCreate(Sender: TObject);
 begin
   WM_MyUserDemoMessage := RegisterWndowMessage('WM_MyUserDemoMessage')
 end;
 
 ...
 
 procedure TForm1.WndProc(var message: TMessage);
 begin
   if message.Msg = WM_MyUserDemoMessage then
   begin
     ...
   end
   else
     inherited WndProc(message)
 end;
 

Метод WndProc <первичнее>, чем методы с директивой message. Он раньше получает сообщения, и он же содержит код, который при необходимости ищет и затем вызывает для каждого сообщения соответствующий метод обработки сообщения. И он же вызывает функцию Win API DefWndProc для стандартной реакции на сообщение. Если при перекрытии не вызывать унасле-дованный метод, то придётся самостоятельно реализовывать эти действия или же подумать, как обойтись без них.

Диапазон номеров сообщений от $8000 (32768) до $BFFF (49151) пока ничем не занят, но зарезервирован Windows для использования в будущем. Авторы Delphi поступили не совсем кор-ректно, использовав верхнюю часть этого диапазона (с адреса $B000 (45046)) для своих собственных сообщений. Именованные константы для этих сообщений находятся в модуле Controls.dcu и начинаются с префикса CM_. Эти сообщения обычно бесполезны для автора готовых программ, но бывают крайне необходимы при написании своих компонентов. Эти сообщения, к сожалению, никак не упомянуты в справке Delphi, поэтому разбираться с ними приходится по исходным файлам VCL.

Особые сообщения

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

Сообщение WM_CopyData используется для передачи блока данных от одного процесса к дру-гому. В 32-разрядных версиях Windows память, выделенная процессу, недоступна для всех ос-тальных процессов. Поэтому просто передать указатель другому процессу нельзя - он не смо-жет получить доступ к этой области памяти. Для сообщения WM_CopyData приходится делать исключение: блок данных временно становится доступным другому процессу. Это требует оп-ределённой синхронности действий от двух процессов, поэтому для отправки этого сообщения можно использовать только SendMessage, прямо вызывающую оконную процедуру. PostMessage использовать нельзя.

Сообщение WM_Paint предназначено для перерисовки клиентской области окна. Если изобра-жение сложное, перерисовка занимает много времени. Чтобы улучшить быстродействие сис-темы, авторы Windows сделали так, что сообщение WM_Paint пропускает все остальные сооб-щения в очереди, и передаётся окну только тогда, когда в очереди не остаётся никаких других сообщений. Если в очереди оказываются несколько сообщений WM_Paint, они объединяются в одно. Просто так послать сообщение WM_Paint невозможно. Для этого надо сначала объявить, что окно или его часть нуждаются в перерисовке (InvalidateRect, InvalidateRgn).

При обработке сообщений от клавиатуры можно использовать функцию GetKeyState, которая возвращает состояние любой клавиши (нажата-отпущена) в момент возникновения данного события. Именно в момент возникновения, а не в момент вызова функции.

Компоненты, влияющие на обработку событий

Так как стандартные средства Delphi не позволяют использовать все инструменты Win API для работы с окнами, иногда приходится писать компоненты, модифицирующие форму. Мне, на-пример, приходилось писать компоненты, при помещении которых на форму она становится непрямоугольной или полупрозрачной. Очень часто таким компонентам приходится обрабаты-вать те сообщения, которые предназначены форме-хозяину. Delphi даёт возможность компо-ненту перехватить сообщения, хотя, на мой взгляд, механизм перехвата оставляет желать луч-шего, потому что он не допускает возможности взаимодействия нескольких перехватчиков.

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

Прежде всего, владелец должен быть окном, поэтому в конструкторе компонента надо прове-рить класс владельца. Это очень полезно ещё и потому, что тогда в остальных методах объекта можно обойтись без такой проверки, что делает код более эффективным. Чтобы предотвратить создание компонента, достаточно в его конструкторе возбудить какое-либо исключение

Метод компонента не может быть оконной процедурой, потому что методу всегда неявно пере-даётся <лишний> параметр Self. Поэтому нужна генерация специального кода входа и выхода для того, чтобы вызывать метод вместо оконной процедуры. Этот код генерируется с помощью специальной функции Delphi, которая создаёт в памяти нужный код и возвращает на него ука-затель. Поэтому компонент должен иметь указатель на этот код (я условно назову этот указа-тель NewWndProc). Сам метод, обрабатывающий события (условно - HookWndProc) должен иметь один параметр-переменную типа TMessage, и может быть как статическим, тик и вирту-альным или динамическим. Кроме того, нужен указатель на старую процедуру, которая была до установки компонента (OldWndProc). Далее, компонент должен содержать два метода для пере-хвата и освобождения, которые выглядят так:


 procedure TMyComponent.HookOwner;
 begin
   if Assigned(Owner) then
   begin
     OldWndProc := Pointer(GetWindowLong(TForm(Owner).Handle, GWL_WndProc));
     NewWndProc := MakeObjectInstance(HookWndProc);
     SetWindowLong(TForm(Owner).Handle, GWL_WndProc, LongInt(NewWndProc))
   end
 end;
 
 procedure TMyComponent.UnhookOwner;
 begin
   if Assigned(Owner) and Assigned(OldWndProc) then
     SetWindowLong(TForm(Owner).Handle, GWL_WndProc, LongInt(OldWndProc));
   if Assigned(NewWndProc) then
     FreeObjectInstance(NewWndProc);
   NewWndProc := nil;
   OldWndProc := nil
 end;
 

Функции Win API GetWindowLong и SetWindowLong предназначены для получения и изменения 32-разрядного значения, связанного с данным окном. В данном случае мы с их помощью рабо-таем с 32-разрядным параметром - адресом оконной процедуры. Изменение адреса оконной процедуры с помощью SetWindowLong и есть то самое порождение оконного подкласса, о ко-тором я писал ранее. Функция MakeObjectInstance - это та самая функция, которая превращает метод в оконную процедуру. FreeObjectInstance освобождает память, выделенную для создания кода входа и выхода функцией MakeObjectInstance.

Было бы глупо перехватывать сообщения и при этом не иметь возможности вызвать ту окон-ную процедуру, которая была до перехвата. Если необходимо вызвать её для обработки сооб-щения Msg с параметрами WParam и LParam, нужно воспользоваться следующим кодом:


 CallWindowProc(OldWndProc, TForm(Owner).Handle, Msg, WParam, LParam);
 

Результатом работы этой функции будет число, возвращаемое оконной процедурой.

Вызов процедуры HookOwner я обычно помещаю в самый конец конструктора компонента, Un-hookOwner - в самое начало деструктора. Но в некоторых ситуациях VCL Delphi уничтожает окно и вновь создаёт его с новыми свойствами. Это происходит очень быстро, пользователь ничего не замечает. (Такое <пересоздание> формы может потребоваться при изменении во время выполнения свойств FormStyle, BorderStyle и BorderIcons.) Однако VCL ничего не знает о перехвате и поэтому не может корректно удалить его, а уж о восстановлении его потом и речи быть не может. Чтобы избежать такой ситуации, необходимо обрабатывать сообщение CM_RecreateWnd: перед вызовом унаследованного метода для обработки этого события компо-нент должен снять перехват, после - восстановить его.

Если форма содержит несколько компонентов, перехватывающих сообщения, могут возникнуть конфликты. Снятие и восстановление перехвата через обработку сообщения CM_RecreateWnd безопасно в этом смысле, потому что компоненты обрабатывают это сообщение в порядке, об-ратном порядку создания. Но если приходится удалять компонент-перехватчик, он не исклю-чает себя из цепочки перехватчиков, а просто обрывает её, и все перехватчики, созданные после него, оказываются не у дел. Именно это я и считаю главным недостатком механизма перехвата.

Если есть необходимость перехватывать сообщения не владельца, а родителя, нужно сделать всё то же самое с точностью до замены Owner на Parent. Но владельца компонент в принципе не может поменять, а вот родителя - вполне. Поэтому нужно ещё перекрыть виртуальный метод SetParent, в котором снимается перехватчик со старого родителя, затем вызывается унаследо-ванный SetParent, затем уже ставится обработчик на нового родителя

Графические функции Win API

Та часть Win API, которая служит для работы с графикой, обычно называется GDI (Graphic De-vice Interface). Ключевым в GDI является понятие контекста устройства (Device Context, DC). Кон-текст устройства - это специфический объект, хранящий информацию о возможностях устрой-ства, о способе работы с ним и о разрешённой для изменения области. В Delphi контекст уст-ройства представлен классом TCanvas, свойство Handle которого содержит дескриптор контек-ста устройства. TCanvas универсален в том смысле, что с его помощью рисование в окне, на принтере или в метафайле выглядит одинаково. То же самое справедливо и для контекста уст-ройства. Разница заключается только в том, как получить в разных случаях дескриптор контек-ста.

Большинство методов класса TCanvas являются <калькой> с соответствующих и, в большинстве случаев, одноимённых функций GDI. Но в некоторых случаях (прежде всего в методах вы-вода текста и рисования многоугольников) параметры методов TCanvas имеют более удобный тип, чем функции GDI. Например, метод TCanvas.Polygon требует в качестве параметра от-крытый массив элементов типа TPoint, а соответствующая функция GDI - указатель на та-кой массив и число элементов в нём. Это означает, что для массива до вызова функции надо выделить память, а потом - освободить её. Ещё нужен код, который заполнит эту область па-мяти нужными значениями. И ни в коем случае нельзя ошибаться в количестве элементов мас-сива. Если зарезервировать память для одного числа точек, а при вызове функции указать дру-гое, программа будет работать неправильно. Но для простых функций работа через GDI ничуть не сложнее, чем через TCanvas.

Для получения дескриптора контекста устройства существует много функций. Только для того, чтобы получить дескриптор контекста обычного окна, существуют три функции: BeginPaint, GetDC, GetWindowDC и GetDCEx. Первая из них может использоваться только при обработке сообщения WM_Paint. Вторая даёт контекст клиентской области окна. Третья позволяет полу-чить контекст всего окна, вместе с неклиентской частью. Последняя же позволяет получить контекст определённой области клиентской части окна.

После того, как дескриптор контекста получен, можно воспользоваться преимуществами класса TCanvas. Для этого надо создать экземпляр такого класса, и присвоить его свойству Handle по-лученный дескриптор. Освобождение ресурсов нужно проводить в следующем порядке: сначала свойству Handle присваивается нулевое значение, затем уничтожается экземпляр класса TCanvas, затем с помощью подходящей функции GDI освободить контекст устройства.

Разумеется, можно вызывать функции GDI при работе через TCanvas. Для этого им просто надо передать в качестве дескриптора контекста Canvas.Handle. Коротко пере-числю те возможности GDI, которые разработчики Delphi почему-то не сочли нужным включать в TCanvas: установка прозрачного фона у текста без изменения кисти; рисование кри-вых Безье; работа с регионами; выравнивание текста по любому углу или по центру; установка собственной координатной системы; получение детальной информации об устройстве; исполь-зование геометрических карандашей; вывод текста под углом к горизонтали.

Использование кистей, карандашей и шрифтов в GDI принципиально отличается от того, что привычно в Delphi. Класс TCanvas имеет свойства Brush, Pen и Font, изменение атрибутов которых приводит к выбору того или иного карандаша, шрифта, кисти. В GDI эти объекты самостоятельны, должны создаваться, получать свой дескриптор, <выбираться> в нужный кон-текст устройства с помощью функции SelectObject и уничтожаться после использования. При-чём удалять можно только те объекты, которые не выбраны ни в одном контексте. Есть также несколько стандартных объектов, которые не надо ни создавать, ни удалять. Их дескрипторы можно получить с помощью функции GetStockObject. Чтобы продемонстрировать это, приведу фрагмент программы, рисующей на контексте с дескриптором DC две линии - синюю и крас-ную. В этом фрагменте используется то, что функция SelectObject возвращает дескриптор объ-екта, родственного выбираемому, который был выбран ранее. Так, при выборе нового карандаша она вернёт дескриптор того карандаша, который был выбран до этого.


 SelectObject(DC, CreatePen(PS_Solid, 1, RGB(255, 0, 0)));
 MoveToEx(DC, 100, 100, nil);
 LineTo(DC, 200, 200);
 DeleteObject(SelectObject(DC, CreatePen(PS_Solid, 1, RGB(0, 0, 255))));
 MoveToEx(DC, 200, 100, nil);
 LineTo(DC, 100, 200);
 DeleteObject(SelectObject(DC, GetStockObject(Black_Pen)));
 

Особым образом следует работать через GDI с растровыми изображениями. Эта тема на-столько сложна, что в таком кратком обзоре не стоит и начинать её. Скажу только, что при ис-пользовании 24-битных изображений лучше не комбинировать Delphi и GDI. Если передать TBitmap.Handle какой-нибудь функции GDII, у этой картинки иногда портятся последние несколько байт. Так как строки в растровом изображении располагаются снизу вверх, то это приводит к порче правого верхнего угла рисунка. Такой глюк я наблюдал в Delphi 3.0, про ос-тальные версии Delphi ничего сказать не могу.

При переходе на 32-разрядную версию Windows многие функции были исключены из GDI и заменены новыми. Список устаревших функций и соответствующих им новых можно найти в справке в разделе 'Graphics Functions'.

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

Существует одна проблема при работе с метафайлами в Windows 95 (возможно, эта же проблема есть в Windows 98 и NT, но я не проверял). Метафайл создаётся с помощью функции Cre-ateEnhMetaFile. Она возвращает дескриптор контекста метафайла, который можно использовать для рисования. Затем вызывается CloseEnhMetaFile, закрывающая метафайл для рисования, освобождающая контекст устройства и возвращающая дескриптор метафайла. После использования метафайл удаляется функцией DeleteEnhMetaFile, которая освобождает память, связанную с метафайлом, и его дескриптор. Одна из функций, освобождающих дескрипторы, работает неправильно, и дескриптор не освобождается. Если программе часто приходится создавать и уничтожать метафайлы, это быстро приводит к тому, что все дескрипторы оказываются заняты, и система перестаёт работать корректно. Бороться с этим, пользуясь классами TMetafile и TMetafileCanvas, нельзя, потому что они работают через эти же функции.

Работа со строками в Win API

Функции Win API не поддерживают тип string, принятый в Delphi. Они работают со строками, оканчивающимися на #0 (нуль-терминированные строки, null-terminated strings). Это означает, что строкой называется указатель на цепочку символов. Признаком конца такой цепочки явля-ется символ #0. Раньше для таких строк использовали термин ASCIIZ. ASCII - обозначение кодировки, Z - zero. Сейчас кодировка ASCII заменена на ANSI, поэтому этот термин больше не применяется, хотя это те же самые по своей сути строки. Обычно программисту приходится работать с кодировкой ANSI, но это не единственная кодировка, поддерживаемая Windows.

В Delphi определён тип PChar, содержащий указатель на такую строку. Если один из параметров функции Win API имеет такой тип, то можно либо передать ему строковую константу, заклю-чённую в одинарные кавычки, как если бы это был тип string, либо выражение PChar(S), где S - параметр типа string, возможно, сложное выражение. Ещё один способ - воспользоваться функ-циями модуля SysUtils.dcu для работы с нуль-терминированными строками и самостоятельно сформировать строку типа PChar. При этом надо будет самостоятельно выделять и освобождать память для цепочки символов, что обычно приводит только к лишним проблемам. Обычно го-раздо проще работать с типом string, и лишь при вызове соответствующей функции преобразо-вать его к типу PChar. Для любителей оптимизации кода замечу, что такое преобразование не расходует ни память, ни процессорное время, потому что тип string - сам по себе указатель, он указывает именно на строку, завершающуюся нулём, а дополнительная информация, специфическая для типа string, имеет отрицательное смещение относительно этого указателя. Поэтому выражение PChar(S) не приводит к генерации кода, а лишь разрешает компилятору использовать этот указатель в качестве PChar.

Получить строку от функции Win API несколько сложнее, чем передать её. Обычно это делается в несколько этапов. Сначала с помощью функций Win API выясняется, какова длина строки. Затем резервируется место для неё. А только затем вызывается та функция, которая копирует строку в приготовленный буфер. Например, для получения заголовка окна нужно использовать функции GetWindowTextLength и GetWindowText. В некоторых случаях можно облегчить себе жизнь, если существует ограничение на максимальную длину строки. Например, атом не может быть длиннее 255-ти символов. Поэтому можно выделить буфер размером 256 символов (один - для завершающего нуля), и сразу копировать туда атом. В любом случае полученная строка будет нуль-терминированной. Чтобы преобразовать её к обычной, используйте функцию StrPas. Или же можно просто выполнить присвоение S := P, где S - типа string, P - PChar.

Другой тип кодировки, поддерживаемый в Windows, называется Wide. В отличие от ANSI в нём для представления одного символа используется не один, а два байта. Все функции, работающие со строками, написаны в двух модификациях - для ANSI и для Wide. Например, если посмотреть модуль user32, в котором, как утверждает справка, описана функция GetWindowText, то видно, что там нет такой функции. Там есть две другие функции - GetWindowTextA и GetWindowTextW, работающие каждая с соответствующей кодировкой. И это относится ко всем функциям, работающим со строками. К тому имени функции, которое указано в справке, необходимо добавить 'A' или 'W', в зависимости от используемой кодировки.

Разработчики Delphi при написании Windows.pas использовали маленькую хитрость, помогающую начинающему программисту не запутаться. Вот, например, цитата из этого модуля:


 function GetWindowTextA(hWnd: HWND; lpString: PAnsiChar;
 nMaxCount: Integer): Integer; stdcall;
 function GetWindowTextW(hWnd: HWND; lpString: PWideChar;
 nMaxCount: Integer): Integer; stdcall;
 function GetWindowText(hWnd: HWND; lpString: PChar;
 nMaxCount: Integer): Integer; stdcall;
 { Это написано в интерфейсной части модуля }
 ...
 function GetWindowTextA; external user32 name 'GetWindowTextA';
 function GetWindowTextW; external user32 name 'GetWindowTextW';
 function GetWindowText; external user32 name 'GetWindowTextA';
 { А это - в разделе реализации }
 

Видно, что функция GetWindowTextA импортируется дважды - один раз под своим настоящим именем, а второй раз - под именем GetWindowText (это и есть тот случай, когда имя функции в библиотеке и то имя, под которым она становится известна компилятору, не совпадают). Поэтому программисту в Delphi нет разницы, писать или , потому что единственное различие у них - тип параметра lpString. Но из исходного текста всё того же модуля видно, что это на самом деле один и тот же тип. По такой же схеме импортируются и все остальные строковые функции Win API.

Заключение

Функции Win API - не такая уж сложная штука. Они часто используют идеологию, не похожую ни на какую другую, но и с этим легко разобраться. Проблема только в том, где и как получить по ним информацию. Будем откровенны: в нашей стране далеко не все, мягко говоря, используют честно купленные программные продукты. Лицензионный Windows сейчас не в диковинку только потому, что его часто устанавливают на новые компьютеры. Лицензионный Delphi приобретают некоторые фирмы. Но много ли людей в России может похвастаться, что они видели документацию по Win API фирмы Microsoft? А эту документацию на русском языке? А ведь авторы западных книг по программированию обычно предполагают, что читателю есть куда заглянуть для справки по этим функциям, и поэтому особенно их не разбирают. Так что нашему программисту доступны следующие пути: по крупицам вытаскивать информацию из тех книг, где Win API упоминается; читать Win32 Develpoer's References; изучать исходные файлы RTL и VCL Delphi; искать информацию в интернете (могу посоветовать сайт http://delphi.vitpc.com). Всё. Если человек не готов часами и даже днями искать информацию о нужной функции, лучше ему не становиться программистом. Главная цель этой статьи - облегчить начало этого поиска. Но дальше человек должен идти сам.




Windows 95 или Windows NT для Delphi 1.

Автор: Peter Below

Билл Гейтс получил Нобелевскую премию за то, что первый научился продавать гемморой за деньги. На следующий год Линус Торвальдс так же получил Нобелевскую премию за то, был первым, у которого бесплатно забирали гемморой.

Я не могу понять каким образом моя 16-битная программа может различить Win95 и WinNT.


 Const WF_WINNT = $4000;
 IsNT := (GetWinFlags and WF_WINNT) <> 0;
 




TListView и TTreeView - Windows Explorer

Автор: Ray Konopka

Когда ваш компьютер говорит "Вставьте диск #2", не торопитесь, сначала выньте диск номер один... даже если вы уверены, что сможете засунуть туда оба.

У меня есть TTreeView и TListView, размещенные точно так же, как это сделано в Windows Explorer (фактически я хочу им придать и то же функциональное назначение). Как мне сделать следующее:

При двойном щелчке на элементе ListView узнать его индекс? Затем, как мне 'открыть' ветку и папку в компоненте TreeView, являющегося 'родителем' данного элемента? (В точном соответствии с функциональностью Проводника, к этому моменту родительский узел TreeView должен уже быть выбран - поэтому, я понимаю, необходимо правильно определить дочерний узел - но я чего-то запутался в синтаксисе).

Ниже приведен пример кода, показывающий как выбрать правильный узел дерева, по которому произведен двойной щелчок.

Как вы можете здесь видеть, ключем здесь является функция NodeAtIndex. Данный пример подразумевает наличие дочерних узлов и индексов, начиная с нуля. Так, если мы подразумеваем что был выбран родительский узел списка элементов, (что является безопасным предположением), то мы можем использовать данный узел как отправной пункт. Методы GetFirstChild и GetNextSibling "отправляют" вас к желаемому узлу.


 function TFrmTipExplorer.NodeAtIndex(Index: Integer): TTreeNode;
 var
   I: Integer;
 begin
   Result := TreeView1.Selected.GetFirstChild;
   for I := 0 to Index - 1 do
     Result := Result.GetNextSibling;
 end;
 
 procedure TFrmTipExplorer.ListView1DblClick(Sender: TObject);
 begin
   TreeView1.Selected.Expand(False);
   { Выбираем узел дерева, соответствующий "щелканному" элементу списка }
   NodeAtIndex(ListView1.Selected.Index).Selected := True;
 end;
 




Узнать о завершении работы Windows


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

Если текст в Memo1 был изменен, то программа не разрешает завершения сеанса Windows.


 ...
 private
   procedure WMQueryEndSession(var Msg: TWMQueryEndSession);
   message WM_QUERYENDSESSION;
 ...
 procedure TForm1.WMQueryEndSession(var Msg: TWMQueryEndSession);
 begin
   Msg.Result := integer(not Memo1.Modified);
 end;
 




Вызвать диалог завершения работы с Windows


По окончании инсталляции программ Microsoft очень часто можно прочесть - "Мы долго и трудно работали. Наслаждайтесь!" После работы с некоторыми программами Microsoft хочется изменить эту надпись таким образом: "Мы долго и трудно работали. Теперь... ваша очередь!"


 procedure TForm1.Button1Click(Sender: TObject);
 begin
   SendMessage(FindWindow('Progman', 'Program Manager'), WM_CLOSE, 0, 0);
 end;
 




Узнать версию Windows

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


 type
   TWinVersion = (wvUnknown, wv95, wv98, wvME, wvNT3, wvNT4, wvW2K, wvXP);
 
 function DetectWinVersion: TWinVersion;
 var
   OSVersionInfo: TOSVersionInfo;
 begin
   Result := wvUnknown;
   OSVersionInfo.dwOSVersionInfoSize := sizeof(TOSVersionInfo);
   if GetVersionEx(OSVersionInfo) then
   begin
     case OSVersionInfo.DwMajorVersion of
       3: Result := wvNT3;
       4: case OSVersionInfo.DwMinorVersion of
           0: if OSVersionInfo.dwPlatformId = VER_PLATFORM_WIN32_NT then
               Result := wvNT4
             else
               Result := wv95;
           10: Result := wv98;
           90: Result := wvME;
         end;
       5: case OSVersionInfo.DwMinorVersion of
           0: Result := wvW2K;
           1: Result := wvXP;
         end;
     end;
   end;
 end;
 
 function DetectWinVersionStr: string;
 const
   VersStr: array[TWinVersion] of string = (
     'Unknown',
     'Windows 95',
     'Windows 98',
     'Windows ME',
     'Windows NT 3',
     'Windows NT 4',
     'Windows 2000',
     'Windows XP');
 begin
   Result := VersStr[DetectWinVersion];
 end;
 
 procedure TForm1.Button1Click(Sender: TObject);
 begin
   Ver := DetectWinVersion;
   Label1.Caption := IntToStr(Ord(DetectWinVersion));
   Label2.Caption := DetectWinVersionStr;
 end;
 




Текущая позиция окна

Автор: Mike Scott

Текущую позицию можно получить от холста, используя Windows API функцию GetCurrentPosition:


 CurrentX := LoWord( GetCurrentPosition( Canvas.Handle ) ) ;
 CurrentY := HiWord( GetCurrentPosition( Canvas.Handle ) ) ;
 




Можно ли заблокировать обновление определенного окна

Автор: Олег Кулабухов


 LockWindowUpdate(Memo1.Handle);
 .
 .
 LockWindowUpdate(0);
 




Окно без заголовка

Билл Гейтс плохо учился в школе. Бывало, только смотрит в окно и ничего не делает. Любил он окна.

Для создания окна без заголовка с любым стилем контура сделайте следующее:

Добавьте объявление процедуры


 procedure CreateParams(var Params: TCreateParams); override;
 

и ее реализацию:


 procedure TForm1.CreateParams(var Params: TCreateParams);
 begin
   inherited CreateParams(Params);
   with Params do
     Style := (Style OR WS_POPUP) AND NOT WS_DLGFRAME;
 end;
 

Установите BorderStyle в bsSizeable.




Запуск внешней программы


 procedure TForm1.Button1Click(Sender: TObject);
 var
   w1: Word;
   p1, p2: array[0..100] of Char;
 begin
   StrPcopy(p1, 'CALC');
   if GetModuleHandle(p1) = 0 then
   begin
     StrPcopy(p2, 'C:\windows\Calc.exe');
     w1 := WinExec(p2, SW_Restore);
   end;
 end;
 




WinWord через DDE

Автор: GPM

Вы много смотрите нового русского кино, если знаете, что:
- Любая информация (особенно данные из баз данных) на экране компьютера представлена в виде Word`овского файла - других программ режиссеры, видимо, просто не знают.

Кто-нибудь пробовал использовать WinWord в качестве DDE-сервера? Поделитесь результатами, если они, конечно, успешны.

Опыт 1

Пара других пользователей также задавала на этой неделе аналогичный вопрос, но у меня не было доступа к машине, где установлена Delphi. К несчастью я затер их адреса, но надеюсь они увидят это сообщение. Нижеприведенный код является "экстрактом" моей технологии, которую я успешно применил для создания DDEPokes и DDEExecutes с WinWord в качестве сервера. Обратите внимание на то, что я использовал методы DDE, требующие PChar вместо строк, поскольку строки имеют дополнительные символы и при DDE-преобразованиях WinWord'у плохеет.


 function TfrmLetter.CreateLetter: Boolean;
 var
   szCommand: array[0..2048] of char;
   sCommand: string;
   BmkNames: array[0..3] of string;
   idx: ShortInt;
   DDEOK: Boolean;
   Buffer, ParMark: PChar;
   BufSize: Integer;
   hWord: hWnd;
 begin
   CreateLetter := False;
   DDEOK := True; {Флаг проверки результатов DDE-операций}
   DDEClient.SetLink('winword', WordDoc);
     {WordDoc содержит имя документа winword, необходимого для связи}
   {DDEClient - элемент управления DDE client}
   if DDEClient.OpenLink = False then
     Exit;
 
   hWord := FindWindow('OpusApp', nil);
   LockWindowUpdate(hWord); {Блокируем обновление экрана winword}
 
   {Убедитесь, что нужный документ является активным окном Word}
   sCommand := '[If FileName$() <> "' + WordDoc + '" Then]';
   sCommand := sCommand + '[While (idx < CountWindows()) and (FileName$() <> "';
   sCommand := sCommand + WordDoc + '")][NextWindow][idx = idx + 1]';
   sCommand := sCommand + '[Wend][Activate WindowName$()][End If]';
   StrPLCopy(szCommand, sCommand, SizeOf(szCommand) - 1);
   DDEOK := DDEOK and DDEClient.ExecuteMacro(szCommand, False);
 
   {Сбрасываем баннер}
   sCommand := '[EditGoto "Banner"]';
   if GetWinwordVersion = 2 then
     {GetWinword - простая функция пользователя, использующая GetModuleHandle
     для определения номера версии запущенного Word: Word 2 или Word 6}
     sCommand := sCommand + '[EditGlossary "Banner"]'
   else if GetWinwordVersion = 6 then
     sCommand := sCommand + '[EditAutoText "Banner"]';
   sCommand := sCommand + '[EditGoto "Date"][UpdateFields][LockFields]';
   StrPLCopy(szCommand, sCommand, SizeOf(szCommand) - 1);
   DDEOK := DDEOK and DDEClient.ExecuteMacro(szCommand, False);
   Application.ProcessMessages;
 
   {Вставляем Имя отправителя, Прямой номер абонента и пр.}
   BmkNames[0] := 'DirectDialNumber';
   BmkNames[1] := 'EMailAddress';
   BmkNames[2] := 'AuthorName';
   BmkNames[3] := 'Personal';
   for idx := 0 to 3 do
     if CheckInclude[idx].Checked = True then
     begin
       BufSize := TextInclude[idx].GetTextLen;
       Inc(BufSize);
       GetMem(Buffer, BufSize);
       TextInclude[idx].GetTextBuf(Buffer, BufSize);
       DDEOK := DDEOK and DDEClient.PokeData(BmkNames[idx], Buffer);
       FreeMem(Buffer, BufSize);
     end
     else
       DDEOK := DDEOK and DDEClient.PokeData(BmkNames[idx] + '2', '');
 

и так далее.

Опыт 2

Автор: Jean Yves

Вот еще очень простой пример DDE-связи с WinWord 6. Это работает.

В Word вы должны иметь заранее созданный файл (в нашем примере DDETEST.DOC) и закладку с именем "Bm1".


 {------------------- полный исходный код --------------------------}
 unit Unit1;
 
 interface
 
 uses
 
   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
   Forms, Dialogs, StdCtrls, DdeMan;
 
 type
 
   TForm1 = class(TForm)
     DdeConv: TDdeClientConv;
     Word: TButton;
     procedure WordClick(Sender: TObject);
   private
     { Private-declarations }
   public
     { Public-declarations }
   end;
 
   {  Свойства DdeConv:       }
   {  ConnectMode : ddeManual }
   {  DdeService : [None]     }
   {  DdeTopic    : [None]    }
   {  FormatChars : False     }
   {  Name        : DdeConv   }
 
 var
 
   Form1: TForm1;
 
 implementation
 
 {$R *.DFM}
 
 procedure TForm1.WordClick(Sender: TObject);
 begin
 
   if DdeConv.SetLink('WINWORD', 'D:\WINWORD\DDETEST') and
     DdeConv.OpenLink then
   begin
     ShowMessage('Установлена связь с WinWord !')
       { убедимся в наличии соединения }
     DdeConv.PokeData('Bm1', 'Данные из Delphi !')
       { вставляем 'Данные из Delphi' в документ word }
     DdeConv.CloseLink;
   end;
 end;
 
 end.
 {------------------- конец исходного кода --------------------}
 

Но только сделав это хотя бы раз своими руками, вы сможете разобраться в этой технологии!




Создание Аккаунта в Windows, используя ADSI (Активные директории)


Встречаются два программиста. Первый: - Слушай, одкуда у тебя такой классный велик?- - Да не поверишь. Сижу вчера на берегу, обдумываю новую программу, тут подъезжает ко мне такая красивая девушка на велосипеде, снимает с себя все и говорит:"Бери все, что хочешь.". Ну, я и взял велосипед, а на хрена мне ее одежда?.

Чтобы создавать пользовательские аккаунты в Windows на Delphi можно использовать ADSI (Active Directory Services Interface) от Microsoft. Вы думаете, что ADSI это новая примочка для Windows 2000 (судя по названию) , но оказывается ADSI доступна для всех платформ Win32. Для этого Вам потребуется всего навсего скачать ADSI для Windows (более полная информация на http://www.microsoft.com/adsi ). Ну и конечно же ADSI входит в поставку Windows 2000.

ADSI довольно большой предмет для изучения. В данном примере я затрону этот предмет поверхностно. ADSI - это своего рода основа для различных сервисов (обычно основанных на директориях) оперционной системы. Например, стандартными ADSI сервисами можно назвать (COM интерфейсы, которые можно использовать в программах) WinNT, IIS, LDAP и NDS. WinNT сервис может тем самым использоваться для создания пользовательских аккаунтов, модификации их или модификации групп.

Следующий небольшой пример показывает необходимые шаги для создания пользовательского аккаунта в NT/2000, используя ADSI:

Во первых Вам прийдётся импортировать Библиотеку Типов ADSI (Menu Project/Import Type Library). Библиотеку Типов можно найти в поддирректории system32 (Например C:\WINNT\system32\activeds.tlb). Требуемый файл называется 'activeds.tlb'. Если такого файла нет, то проверьте, правильно ли вы установили ADSI. После успешного импортирования Библиотеки Типов Вы найдёте новый файл в дирректории ипортов Delphi, файл будет называться "activeds_tlb.pas" (..\Delphi5\Imports\activeds_tlb.pas). Чтобы приступить к программированию ADSI в Delphi, необходимо включить этот файл в Ваш проект.

Далее в примере, необходимо заменить [computername] на фактическое имя компьютера, с которым Вы работаете. То же надо проделать с [accountname]. Пример тестировался на WindowsNT 4.0 и Windows 2000.


 ...
 
 uses ActiveX, // используется для COM Moniker stuff...
 ActiveDs_TLB, // созданная библиотека типов
 ComObj;       // используется для OleCheck и других функций COM
 
 implementation
 
 procedure TForm1.BtnCreateUserClick(Sender: TObject);
 var
   Usr: IADsUser;
   Comp: IADsContainer;
 begin
   try
     Comp := GetObject('WinNT://[computername],computer') as IADsContainer;
     Usr := Comp.Create('user', '[accountname]') as IADsUser;
     Usr.SetInfo;
   except
     on E: EOleException do
     begin
       ShowMessage(E.message);
     end;
   end;
 end;
 
 procedure TForm1.BtnSetPasswordClick(Sender: TObject);
 var
   Usr: IADsUser;
 begin
   try
     Usr := GetObject('WinNT://[computername]/[accountname],user') as IADsUser;
     Usr.SetPassword('thenewpassword');
   except
     on E: EOleException do
     begin
       ShowMessage(E.message);
     end;
   end;
 end;
 
 // GetObject использует вызов VB GetObject
 // Данный код (GetObject) был найден в Usenet.
 
 // GetObject позволяет связаться с существующим ADSI сервисом
 // используя 'ADSIPath' (например WinNT://.... или
 // IIS://localhost).
 
 function TForm1.GetObject(const name: string): IDispatch;
 var
   Moniker: IMoniker;
   Eaten: integer;
   BindContext: IBindCtx;
   Dispatch: IDispatch;
 begin
   OleCheck(CreateBindCtx(0, BindContext));
   OleCheck(MkParseDisplayName(BindContext, PWideChar(WideString(name)), Eaten, Moniker));
   OleCheck(Moniker.BindToObject(BindContext, nil, IDispatch, Dispatch));
 
   Result := Dispatch;
 end;
 
 end.
 

Через ADSI Вы так же можете изменять параметры пользовательских аккаунтов. Следующий код изменяет флаг 'Password never expires' нужного аккаунта:


 procedure TFormMain.ButtonNeverExpiresClick(Sender: TObject);
 var
   Usr: IADsUser;
 begin
   try
     Usr := GetObject('WinNT://[computername]/[acccoutname],user') as IADsUser;
 
     // Проверяем состояние чекбоксов...
     if CheckBoxPasswordNeverExpires.Checked then
       Usr.Put('UserFlags', Usr.Get('UserFlags') or 65536)
     // 65536 объявлено как UF_DONT_EXPIRE_PASSWORD в iads.h
     // в ADSI SDK от Microsoft
     else
       Usr.Put('UserFlags', Usr.Get('UserFlags') xor 65536);
 
     Usr.SetInfo;
 
   except
     on E: EOleException do
     begin
       ShowMessage(E.message);
     end;
   end;
 end;
 

В завершении...

Чтобы использовать большие возможности ADSI , необходимо проверить, поддерживаются ли такие сервисы как IADsUser или IADsContainer.

Я рекомендую поработать с ADSI SDK от Microsoft и более детально изучить Библиотеку Типов.

Некоторые ADSI компоненты я постараюсь выложить на своей домашней страничке http://www.jespersen.ch. Так что, если интересно, то заходите и мыльте на philip@jespersen.ch




Узнать версию Windows и DOS

- Вы работаете в ДОС или Windows?
- Нет, я работаю в милиции.

Нужно воспользоваться функцией GetVersion(). Она в старшем слове возвращает версию Dos'a, а в младшем - Windows


 procedure TForm1.Button1Click(Sender: TObject);
 var
   WinVersion, DosVersion: Word;
 begin
   WinVersion := GetVersion and $0000FFFF;
   DosVersion := GetVersion shr 16;
   Label1.Caption:=IntToStr(Hi(DosVersion))+'.'+IntToStr(Lo(DosVersion));
   Label2.Caption:=IntToStr(Lo(WinVersion))+'.'+IntToStr(Hi(WinVersion));
 end;
 




Оповещение всей системы о изменении WIN.INI

Hа pаботе пpопал пpогpамеp. День нету, два. Hа звонки не отвечает. Hу pешили пpовеpить что да как. Пpишли к нему домой, а там в холодной ванне сидит лысый пpогpамист с полупустой бутылкой шампуня в pуке. Отняли у него бутылку и читают инстpукцию:
1. Hанести на влажные волосы. 2. Hамылить. 3. Подождать. 4. Смыть. 5. Повтоpить.

Оповещение приложения (или всей системы) о изменении WIN.INI. При изменении WIN.INI (например, изменении настроек хранителя экрана) необходимо уведомить систему (или конкретное приложение) о том, что WIN.INI изменен. Это можно сделать при помощи передачи приложению сообщения WM_WININICHANGE SendMessage(HANDLE, WM_WININICHANGE, 0, PCHAR(SECT_NAME)); При этом HANDLE равен или HANDLE приложения, или HWND_BROADCAST - рассылка всем приложениям. SECT_NAME задает имя секции WIN.INI, в которой произошли изменения. Если указать пустую строку (#0), то считается, что изменялись все секции, что естественно увеличивает время обработки и нагрузку на систему


 VAR S : ARRAY[0..40] OF Char;
 ...
 StrCopy(S, 'Desktop');
 SendMessage(HWND_BROADCAST, WM_WININICHANGE, 0, LongInt(@S));
 




Сообщения Windows - введение

Вирус детям не игрушка, не товарищ и не друг!

Кто-нибудь может со мной поделиться информацией о работе в Delphi с Windows Messages (системные сообщения)? Все эти сообщения типа WM_*** вызывают у меня нервный тик, поскольку это я не могу понять как это работает.

Список всех системных сообщений Windows доступен в файлах электронной справки Delphi. (Я использую D5, но думаю в будущих версиях все останется на своих местах).

Сообщения WM_ (и другие) играют существенную роль в работе Windows. Все вы хорошо знаете, что Delphi первоначально строится на принципе *управления событиями*; наверняка не один раз вы создавали обработчики событий OnKeyPress, OnThis, OnThat и других. Если у вас есть исходный код VCL, вы легко обнаружите, что механизм работы событий в Delphi основан на обработке конкретных системных соощенияй, посылаемых вашему элементу управления (как раз здесь и заложено главное достоинство объектно-ориентированного программирования, когда вы можете создать новый компонент на основе существующего и "научить" его обрабатывать другие необходимые вам системные сообщения). Windows постоянно посылает сообщения в ответ на действия пользователя и ждет соответствующей реакции от приложений Delphi (и всех остальных приложений Windows), заключающейся в их "приеме" и соответствующей обработке. Delphi имеет оболочки для большинства системных сообщений, создав "механизм оповещения элемента управления о приеме сообщения на его адрес" - события для компонентов, как было описано выше.

Кроме приема сообщений, у вас также существует возможность их отправления. Это возможно двумя способами: SendMessage и PostMessage (обе являются Win API функциями), а также метод Delphi Perform. Первые два требуют в качестве параметра Handle указывать дескриптор компонента, которому вы шлете сообщение, тогда как Perform является методом, принадлежащим самому компоненту. Сообщения передаются в стандартную очередь системных сообщений и обрабатываются подобно другим сообщениям.

Вот тривиальный пример: я хочу (по некоторой причудливой причине) вставлять в TMemo символ 'y' каждый раз после набора цифры '4'. (Обдумайте способ автоматической вставки блока begin-end или заключительной скобки.) Я, конечно, мог бы поработать с Memo-свойством Lines, но это было бы не так красиво и достаточно громоздко. Вот как выглядит наш пример с использованием сообщений:


 procedure TForm1.Memo1KeyPress(Sender: TObject; var Key: Char);
 begin
   if Key = '4' then
     SendMessage(Memo1.Handle, WM_CHAR, Word('y'), 0);
 end;
 

Другой пример демонстрирует работу с компонентом ComboBox. Мы хотим, чтобы он автоматически выпадал при нажатии пользователем какой-либо клавиши. Это поведение, к сожалению, нестандартно. Вот что мы делаем:


 procedure TFormEffortRates.ComboBoxMaterialKeyDown(Sender: TObject; var
   Key: Word; Shift: TShiftState);
 var
   iShowing: integer;
   { какой-то код, затем... }
 begin
   { С помощью сообщения узнаем состояние ("раскрытость") ComboBox'а }
   iShowing := SendMessage((Sender as TComboBox).Handle, CB_GETDROPPEDSTATE, 0, 0);
   if iShowing = 0 then
     { раскрываем ComboBox }
     SendMessage((Sender as TComboBox).Handle, CB_SHOWDROPDOWN, 1,0);
 end;
 

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


 function TMDIChild.GetMemoColumn(const TheMemo : TMemo) : integer;
 begin
   Result := TheMemo.SelStart -
   (SendMessage(TheMemo.Handle, EM_LINEINDEX,
   GetMemoLine(TheMemo), 0));
 end;
 
 function TMDIChild.GetMemoLine(const TheMemo : TMemo) : integer;
 begin
   Result := SendMessage(TheMemo.Handle, EM_LINEFROMCHAR,
   TheMemo.SelStart, 0);
 end;
 

Повторю снова: список и описание всех сообщений приведены в электронной справке по API. Инструкция по их использованию получилась у меня несколько скупой, но я надеюсь что хотя-бы несколько прояснил ситуацию и вы сможете задавать более конкретные вопросы.

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




<< ВЕРНУТЬСЯ В ОГЛАВЛЕНИЕ



Материалы находятся на сайте https://exelab.ru/pro/



Оригинальный DVD-ROM: eXeL@B DVD !


Вы находитесь на EXELAB.rU
Проект ReactOS