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

ВИДЕОКУРС ВЗЛОМ
выпущен 10 декабря!


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

БОЛЬШОЙ FAQ ПО DELPHI



Окно по рисунку


Разбойному нападению сотрудников фирмы "Майкрософт" подверглась штаб-квартира компании "Sun". Хулиганы вышибли в здании все двери и взамен установили окна.


 TStretchHandle = class(TCustomControl)
   private
     procedure WMEraseBkgnd(var message: TWMEraseBkgnd); message WM_ERASEBKGND;
     procedure WMGetDLGCode(var message: TMessage); message WM_GETDLGCODE;
   protected
     procedure Paint; override;
     property Canvas;
   public
     procedure CreateParams(var Params: TCreateParams); override;
 end;
 
 procedure TStretchHandle.CreateParams(var Params: TCreateParams);
 begin
   { set default Params values }
   inherited CreateParams(Params);
   { then add transparency }
   Params.ExStyle := Params.ExStyle + WS_EX_TRANSPARENT;
 end;
 
 procedure TStretchHandle.WMGetDLGCode(var message: TMessage);
 begin
   { completely fake erase, don't call inherited, don't collect $200 }
   message.Result := DLGC_WANTARROWS;
 end;
 
 procedure TStretchHandle.WMEraseBkgnd(var message: TWMEraseBkgnd);
 begin
   { completely fake erase, don't call inherited, don't collect $200 }
   message.Result := 1;
 end;
 
 procedure TStretchHandle.Paint;
 begin
   inherited Paint;
   with Canvas do
   begin
     // рисуете что нужно -
     // где не рисовали, там будет "прозрачно"
   end;
 end;
 




Как корректно перехватить сигнал выгрузки операционной системы, если в моей программе нет окна

Автор: Nomadic

Про Линукс:
Сынишка подходит с дискеткой к папашке-линуксоиду и говорит:
- Пап, а проиграй как мне этот .wav-ик...
- Ща сынок, только в ядро поддержку саунда вкомпилю...

Используй GetMessage(), в качестве HWND окна пиши NULL (на Паскале - 0). Если в очереди сообщений следующее - WM_QUIT, то эта функция фозвращает FALSE. Если ты пишешь программу для Win32, то запихни это в отдельный поток, организующий выход из программы.




Без иконки в панели задач

Автор: Neil J. Rubenking

"Святой Отец Вындоуз - я продал твои иконы!!!"

Если вы не хотите, чтобы ваше приложение имело иконку в панели задач, добавьте следующие строки в исходный код проекта:


 Application.CreateHandle;
 ShowWindow(Application.Handle, SW_HIDE);
 Application.ShowMainForm := FALSE;
 

Да, чуть не забыл, есть еще одна вещь. При нормальном поведении TApplication создает дескриптор и показывает окно прежде, чем далее начнет что-то "происходить". Чтобы избежать этого, вам необходимо создать модуль, содержащий единственную строчку в секции initialization:


 IsLibrary := True;
 

... и поместить этот модуль ПЕРВЫМ в .DPR-файле в списке используемых модулей. Этим мы "одурачиваем" TApplication, и оно думает что оно запущено из DLL, тем самым изменяя свое обычное поведение.




Как можно обойтись без TTimer и наиболее рационально использовать ресурсы системы

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


 procedure Delay(ms: longint);
 var
   TheTime: LongInt;
 begin
   TheTime := GetTickCount + ms;
   while GetTickCount < TheTime do
     Application.ProcessMessages;
 end;
 
 procedure TForm1.Button1Click(Sender: TObject);
 begin
   ShowMessage('Start Test');
   Delay(2000);
   ShowMessage('End Test');
 end;
 




Записываем в Access используя ADO


 // Читаем Access`овскую базу используя ADO 
 // Проверяе являеться ли файл .mdb Access
 // Записываем запись в базу 
 // Нужны компаненты- 
 //    TADOtable,TDataSource,TOpenDialog,TDBGrid, 
 //    TBitBtn,TTimer,TEditTextBox 
 program ADOdemo;
 
 uses Forms, uMain in 'uMain.pas' {frmMain};
 
 {$R *.RES}
 
 begin
   Application.Initialize;
   Application.CreateForm(TfrmMain, frmMain);
   Application.Run;
 end.
 /////////////////////////////////////////////////////////////////// 
 unit uMain;
 
 interface
 uses
   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
   Db, DBTables, ADODB, Grids, DBGrids, ExtCtrls, DBCtrls, StdCtrls, Buttons,
   ComObj;
 
 type
   TfrmMain = class(TForm)
     DBGridUsers: TDBGrid;
     BitBtnClose: TBitBtn;
     DSource1: TDataSource;
     EditTextBox: TEdit;
     BitBtnAdd: TBitBtn;
     TUsers: TADOTable;
     BitBtnRefresh: TBitBtn;
     Timer1: TTimer;
     Button1: TButton;
     procedure FormCreate(Sender: TObject);
     procedure ConnectToAccessDB(lDBPathName, lsDBPassword: string);
     procedure ConnectToMSAccessDB(lsDBName, lsDBPassword: string);
     procedure AddRecordToMSAccessDB;
     function CheckIfAccessDB(lDBPathName: string): Boolean;
     function GetDBPath(lsDBName: string): string;
     procedure BitBtnAddClick(Sender: TObject);
     procedure BitBtnRefreshClick(Sender: TObject);
     procedure Timer1Timer(Sender: TObject);
     function GetADOVersion: Double;
     procedure Button1Click(Sender: TObject);
   private
     { Private declarations }
   public
     { Public declarations }
   end;
 
 var
   frmMain: TfrmMain;
   Global_DBConnection_String: string;
 const
   ERRORMESSAGE_1 = 'No Database Selected';
   ERRORMESSAGE_2 = 'Invalid Access Database';
 
 implementation
 
 {$R *.DFM}
 
 procedure TfrmMain.FormCreate(Sender: TObject);
 begin
   ConnectToMSAccessDB('ADODemo.MDB', '123'); // DBName,DBPassword 
 end;
 
 procedure TfrmMain.ConnectToMSAccessDB(lsDBName, lsDBPassword: string);
 var
   lDBpathName: string;
 begin
   lDBpathName := GetDBPath(lsDBName);
   if (Trim(lDBPathName) <> '') then
   begin
     if CheckIfAccessDB(lDBPathName) then
       ConnectToAccessDB(lDBPathName, lsDBPassword);
   end
   else
     MessageDlg(ERRORMESSAGE_1, mtInformation, [mbOK], 0);
 end;
 
 function TfrmMain.GetDBPath(lsDBName: string): string;
 var
   lOpenDialog: TOpenDialog;
 begin
   lOpenDialog := TOpenDialog.Create(nil);
   if FileExists(ExtractFileDir(Application.ExeName) + '\' + lsDBName) then
     Result := ExtractFileDir(Application.ExeName) + '\' + lsDBName
   else
   begin
     lOpenDialog.Filter := 'MS Access DB|' + lsDBName;
     if lOpenDialog.Execute then
       Result := lOpenDialog.FileName;
   end;
 end;
 
 procedure TfrmMain.ConnectToAccessDB(lDBPathName, lsDBPassword: string);
 begin
   Global_DBConnection_String :=
     'Provider=Microsoft.Jet.OLEDB.4.0;' +
     'Data Source=' + lDBPathName + ';' +
     'Persist Security Info=False;' +
     'Jet OLEDB:Database Password=' + lsDBPassword;
 
   with TUsers do
   begin
     ConnectionString := Global_DBConnection_String;
     TableName        := 'Users';
     Active           := True;
   end;
 end;
 
 // Check if it is a valid ACCESS DB File Before opening it. 
 
 function TfrmMain.CheckIfAccessDB(lDBPathName: string): Boolean;
 var
   UnTypedFile: file of Byte;
   Buffer: array[0..19] of Byte;
   NumRecsRead: Integer;
   i: Integer;
   MyString: string;
 begin
   AssignFile(UnTypedFile, lDBPathName);
   reset(UnTypedFile,1);
   BlockRead(UnTypedFile, Buffer, 19, NumRecsRead);
   CloseFile(UnTypedFile);
   for i := 1 to 19 do MyString := MyString + Trim(Chr(Ord(Buffer[i])));
   Result := False;
   if Mystring = 'StandardJetDB' then
     Result := True;
   if Result = False then
     MessageDlg(ERRORMESSAGE_2, mtInformation, [mbOK], 0);
 end;
 
 procedure TfrmMain.BitBtnAddClick(Sender: TObject);
 begin
   AddRecordToMSAccessDB;
 end;
 
 procedure TfrmMain.AddRecordToMSAccessDB;
 var
   lADOQuery: TADOQuery;
   lUniqueNumber: Integer;
 begin
   if Trim(EditTextBox.Text) <> '' then
   begin
     lADOQuery := TADOQuery.Create(nil);
     with lADOQuery do
     begin
       ConnectionString := Global_DBConnection_String;
       SQL.Text         :=
         'SELECT Number from Users';
       Open;
       Last;
       // Generate Unique Number (AutoNumber in Access) 
       lUniqueNumber := 1 + StrToInt(FieldByName('Number').AsString);
       Close;
       // Insert Record into MSAccess DB using SQL 
       SQL.Text :=
         'INSERT INTO Users Values (' +
         IntToStr(lUniqueNumber) + ',' +
         QuotedStr(UpperCase(EditTextBox.Text)) + ',' +
         QuotedStr(IntToStr(lUniqueNumber)) + ')';
       ExecSQL;
       Close;
       // This Refreshes the Grid Automatically 
       Timer1.Interval := 5000;
       Timer1.Enabled  := True;
     end;
   end;
 end;
 
 procedure TfrmMain.BitBtnRefreshClick(Sender: TObject);
 begin
   Tusers.Active := False;
   Tusers.Active := True;
 end;
 
 procedure TfrmMain.Timer1Timer(Sender: TObject);
 begin
   Tusers.Active  := False;
   Tusers.Active  := True;
   Timer1.Enabled := False;
 end;
 
 function TfrmMain.GetADOVersion: Double;
 var
   ADO: OLEVariant;
 begin
   try
     ADO    := CreateOLEObject('adodb.connection');
     Result := StrToFloat(ADO.Version);
     ADO    := Null;
   except
     Result := 0.0;
   end;
 end;
 
 procedure TfrmMain.Button1Click(Sender: TObject);
 begin
   ShowMessage(Format('ADO Version = %n', [GetADOVersion]));
 end;
 
 end.
 




Работа с другим приложением без Hook и DLL на примере GetFocus

Автор: SottNick

На стандартной форме (Form1):

Form1.FormStyle=fsStayOnTop - форма поверх остальных окон

Объекты:

  1. ТАЙМЕР (Timer1) с периодом 1000 или меньше,
  2. 3 метки (Label1, Label2, Label3). назначение их см. в тексте процедуры
  3. У таймера событие OnTimer. а вот для нее обработчик:

 procedure TForm1.Timer1Timer(Sender: TObject);
 var
   dwTargetOwner: DWORD; //указатель на подключаемый процесс
   dwThreadID: DWORD; //указатель на текущий процесс
   Result: longbool;
 begin
   {В первой метке отображается Handle активного окна}
   Label1.Caption := IntToStr(GetForegroundWindow);
     //указатель на подключаемое приложение
 
   // Подключение потока другого окна
   // Указатель на подключаемый процесс
   dwTargetOwner := GetWindowThreadProcessId(GetForegroundWindow, nil);
   dwThreadID := GetCurrentThreadId(); //указатель на текущий процесс
   if (dwTargetOwner <> dwThreadID) then // если не один и тот же процесс
     Result := AttachThreadInput(dwThreadID, dwTargetOwner, TRUE); //подключение
 
   {Во второй метке отображается Handle объекта 'в фокусе' в активном окне}
   Label2.Caption := IntToStr(GetFocus); //фокус в другом приложении
 
   if (Result) then
     AttachThreadInput(dwThreadID, dwTargetOwner, FALSE); //отключение
 
   {В третей метке отображается Handle объекта 'в фокусе' в активном окне,
   но если это окно другого приложения, то Handle будет равен нулю,
   т.к. попытка получения Handle происходит после отключения потока}
   Label3.Caption := inttostr(GetFocus); //проверка после отключения
 
   {Эффект можно посмотреть, если запустить полученное приложение
   и сделать активным другое приложение}
   {Ясно, что полученный Handle объекта можно использовать
   по своему разумению. Например, считать из объекта текст и т.п.}
 
   // (C) SottNick 2000
 end;
 




Как преобразовать WMF в BMP


 procedure ConvertWMF2BMP
   (const WMFFileName, BMPFileName: TFileName);
 var
   MetaFile: TMetafile;
   Bitmap: TBitmap;
 begin
   Metafile := TMetaFile.Create;
   Bitmap := TBitmap.Create;
   try
     MetaFile.LoadFromFile(WMFFileName);
     with Bitmap do
     begin
       Height := Metafile.Height;
       Width := Metafile.Width;
       Canvas.Draw(0, 0, MetaFile);
       SaveToFile(BMPFileName);
     end;
   finally
     Bitmap.Free;
     MetaFile.Free;
   end;
 end;
 
 // Использование:
 ConvertWMF2BMP('c:\mypic.wmf', 'c:\mypic.bmp')
 




WM_ACTIVATE

Сообщение посылается, когда окно переводится в активное или неактивное состояние. Сначала посылается окну, переходящему в неактивное состояние, а потом - активируемому.

Параметры:

  • Active - показывает состояние, приобретаемое окном, а именно активизируется или деактивизируется окно. Тип параметра Word
    • WA_ACTIVE - окно активизируется не щелчком мыши
    • WA_CLICKACTIVE - окно активизируется щелчком мыши
    • WA_INACTIVE - окно деактивизируется
  • ActiveWindow - дескриптор, который указывает на окно, из которого фокус переключился на данное окно, если оно активируется, или на окно, в которое передается управление, если данное окно деактивируется. Тип параметра HWND
  • Result - возвращаемое значение. Если приложение обрабатывает это сообщение, оно должно возвращать нуль. Тип параметра Integer
  • Minimized - свидетельствует о том, что окно минимизировано. Тип параметра WordBool

Действие по умолчанию

Если активируемое окно не свернуто, то оно получает фокус.

Примечания

Если окно активируется щелчком мыши, оно получает также сообщение WM_MOUSEACTIVATE.

Давайте рассмотрим пример использования этого сообщения. Например у нас есть GroupBox собственного производства. Его состав таков: на заднем плане находится панель (компонент класса TPanel). Его свойство BevelOuter установлено в bvLowered, а свойство BevelInner равно bvRaised - в итоге получается такая вогнутая каемка, как показана на рисунке. Сверху на эту панель была вынесена ещё одна, которая является заголовочной и по сценарию её цвет должен меняться вместе с заголовочной полосой, в зависимости от того становиться ли главное окно приложения активным или неактивным. У этой панели свойство BevelOuter установлено в bvRaised, а свойство BevelInner равно bvNone. На эту панель выносится метка (компонент TLabel), её свойству Align присваиваем alClient, а свойству Alignment - taCenter, чтобы метка выравнилась по всей области панели, а её заголовок находился в центре.

Как же заставить панель изменять цвет?

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


 private
   { Private declarations }
   procedure wmActivate (var Msg:TWMACTIVATE);
   message wm_Activate;
 

В области реализации (implementation) её нужно описать так


 procedure TForm1.WMActivate (var Msg:TWMActivate);
 begin
   {если окно получило фокус ввода по щелчку мыши или как иначе...}
   if (Msg.Active = WA_ACTIVE) or (Msg.Active = WA_CLICKACTIVE)then
   begin
     {...тогда цвет панели делаем равным цвету активной заголовочной полосы окна}
     Panel1.Color := clActiveCaption
   {иначе...}
   else
     {...цвет панели будет соответствовать НЕактивной заголовочной полосе окна}
     Panel1.Color := clInactiveCaption;
   inherited;
 end;
 

Если из главного окна вызывается другое, и мы хотим в тот момент, когда оно теряет фокус ввода - минимизировать его, нужно код реализации процедуры немного изменить:


 procedure TForm1.WMActivate (var Msg:TWMActivate);
 begin
   if (Msg.Active = WA_ACTIVE) or (Msg.Active = WA_CLICKACTIVE)then
   begin
     Panel1.Color := clActiveCaption;
     {сворачиваем второстепенное окно, когда оно теряет фокус ввода}
     ShowWindow(Msg.ActiveWindow, sw_minimize);
   end
   else
   begin
     Panel1.Color := clInactiveCaption;
     {восстанавливаем второстепенное окно, когда оно активизируется}
     ShowWindow(Msg.ActiveWindow, sw_restore);
   end;
   inherited;
 end;
 

Обратите внимание на ключевое слово inherited, которое позволяет посланное сообщение обработать процедуре класса предка.




WM_ACTIVATEAPP

Сообщение посылается при переходе активности от окна одного приложения к окну другого приложения. Сообщения посылаются обоим окнам.

Параметры:

  • Active - значение true означает, что окно становится активным, а false - что окно теряет активность. Тип параметра LongBool
  • ThreadId - указывает сторонний процесс, который теряет или приобретает активность. Тип параметра Integer
  • Result - возвращаемое значение. Если приложение обрабатывает это сообщение, оно должно возвращать нуль. Тип параметра Integer



WM_CANCELMODE

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

Параметры:

Параметры отсутствуют.

Возвращаемое значение

Если приложение обрабатывает это сообщение, оно должно возвращать нуль.

Действие по умолчанию

Внутренний процесс завершается и мышь освобождается.




WM_CLOSE

Сигнализирует, что окно или приложение закрывается.

Параметры

Параметры отсутствуют.

Возвращаемое значение

Если приложение обрабатывает это сообщение, оно должно возвращать нуль.

Действие по умолчанию

Вызывается функция DestroyWindow, уничтожающая окно.

Примечания

Приложение при обработке этого сообщения может запросить пользователя о необходимости закрывать окно и вызвать функцию DestroyWindow только при положительном ответе.




Перетаскивать файлы в свою программу - WM_DROPFILES

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

  • Подключаем модуль ShellAPI в области uses
  • По созданию окна [событие OnCreate] пишем такой код:

 DragAcceptFiles(Handle, true);
 

  • Когда вы перетаскиваете файл на своё приложение и отпускаете кнопку мыши, Windows посылает этому окну сообщение wm_DropFiles. Сообщение сопровождается именем файла. Обработчик этого сообщения нужно включить в раздел protected класса формы. Вставьте следующий код:

 protected
   procedure WMDropFiles (var Msg: TMessage); message wm_DropFiles;
 

  • Далее обрабатываем сообщение:

 procedure TForm1.WMDropFiles(var Msg: TMessage);
 var
   FileName: array[0..256] of char;
 begin
   DragQueryFile(THandle(Msg.WParam), 0, FileName, SizeOf(Filename));
   Memo1.Lines.LoadFromFile(FileName);
   DragFinish(THandle(Msg.WParam));
 end;
 

или так:


 procedure TForm1.WMDROPFILES(var Msg: TMessage);
 var
   i, amount, size: integer;
   Filename: PChar;
 begin
   inherited;
   Amount := DragQueryFile(Msg.WParam, $FFFFFFFF, Filename, 255);
   for i := 0 to (Amount - 1) do
   begin
     size := DragQueryFile(Msg.WParam, i, nil, 0) + 1;
     Filename := StrAlloc(size);
     DragQueryFile(Msg.WParam, i, Filename, size);
     listbox1.items.add(StrPas(Filename));
     StrDispose(Filename);
   end;
   DragFinish(Msg.WParam);
 end;
 




WM_GETMINMAXINFO

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

Параметры

MinMaxInfo - указывает на структуру типа MINMAXINFO, содержащую принятые по умолчанию пределы изменения размеров и координат положения окна. Описание этой структуры:


 typedef struct tagMINMAXINFO{
   POINT ptReserved;
   POINT ptMaxSize;
   POINT ptMaxPosition;
   POINT ptMinTrackSize;
   POINT ptMaxTrackSize;
 } MINMAXINFO;
 

Поля структуры означают следующее:

  • ptReserved - Зарезервировано и пока не используется
  • ptMaxSize - Поле типа Point определяет ширину (Point.x) и высоту (Point.y) развернутого окна
  • ptMaxPosition - Поле типа Point определяет положения левого (Point.x) и верхнего (Point.y) краев развернутого окна
  • ptMinTrackSize - Поле типа Point определяет минимальную ширину (Point.x) и минимальную высоту (Point.y) окна при изменении пользователем размеров его рамки
  • ptMaxTrackSize - Поле типа Point определяет максимальную ширину (Point.x) и максимальную высоту (Point.y) окна при изменении пользователем размеров его рамки

Возвращаемое значение

Если приложение обрабатывает это сообщение, оно должно вернуть 0.

Пример:

Сначала нужно в частных объявлениях (после слова private) объявить процедуру обработки данного сообщения


 private
   { Private declarations }
   procedure WMGETMINMAXINFO (var Msg:TWMGETMINMAXINFO); message WM_GETMINMAXINFO;
 

В области реализации (implementation) её нужно описать так:


 procedure TForm1.WMGetMinMaxInfo(var Msg:TWMGetMinMaxInfo);
 begin
   with Msg.MinMaxInfo^ do
   begin
     ptMinTrackSize.x:=308;             { минимальная ширина окна }
     ptMinTrackSize.y:=180;             { минимальная высота окна }
     ptMaxTrackSize.x:=400;             { максимальная ширина окна }
     ptMaxTrackSize.y:=250;             { максимальная высота окна }
     ptMaxPosition.x:=BoundsRect.Left;  { максимальная позиция окна по оси Х после максимизации }
     ptMaxPosition.y:=BoundsRect.top;   { максимальная позиция окна по оси У после максимизации }
     ptMaxSize.x:=308;                  { максимальная ширина окна после максимизации }
     ptMaxSize.y:=180;                  { максимальная высота окна после максимизации }
   end;
   inherited;
 end;
 




Перемещение окна вне заголовка

- Чем компьютер лучше девушки?
- Мама твоего компьютера не претендует стать твоей тёщей.

Нужно объявить три глобальные переменные в публичных объявлениям (после ключевого слова Public):


 public
   { Public declarations }
   Draging: Boolean;
   X0, Y0: integer;
 

  • Draging - для обозначение того периода времени когда пользователь перемещает мышь с зажатой кнопкой мыши,
  • X0 и Y0 - координаты точки, над которой была зажата кнопка мыши

Далее описываем события формы OnMouseDown, OnMouseMove и OnMouseUp:


 procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
 Shift: TShiftState; X, Y: Integer);
 begin
   Draging := true;
   x0 := x;
   y0 := y;
 end;
 
 procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
 Shift: TShiftState; X, Y: Integer);
 begin
   Draging := false;
 end;
 
 procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
 Y: Integer);
 begin
   if Draging = true then
   begin
     Form1.Left := Form1.Left + X - X0;
     Form1.top := Form1.top + Y - Y0;
   end;
 end;
 




Перемещение окна вне заголовка 2

Нужно объявить процедуру в частных объявлениям (после ключевого слова Private):


 private
   { Private declarations }
   procedure WMNCHitTest (var M: TWMNCHitTest); message wm_NCHitTest;
 

В области implementation описываем процедуру так:


 implementation
 {$R *.DFM}
 
 procedure TForm1.WMNCHitTest (var M:TWMNCHitTest);
 begin
   inherited;
   if M.Result = htClient then
     M.Result := htCaption;
 end;
 

Мы выдаём клиентскую область окна за заголовочную область.




Перемещение окна вне заголовка 3

Хочу показать еще один способ перемещения окна за его тело Обрабатываем OnMouseDown:


 ReleaseCapture;
 Perform(WM_SYSCOMMAND, $F012, 0);
 




Обработка WM_SysCommand

Автор: Neil J. Rubenking

Системное меню в приложениях Delphi ведет двойную жизнь - когда основная форма активна, работает системное меню главной формы, но когда приложение минимизировано, работает системное меню объекта Applictaion. Этот код может оказаться полезным:


 CONST
   SC_UDF = $EFF0;   {должен быть < $F000 и делиться на 16}
 
 procedure TForm1.FormCreate(Sender: TObject);
 begin
   AppendMenu(GetSystemMenu(Handle, False), MF_STRING, SC_UDF, 'Всегда на&верху');
   AppendMenu(GetSystemMenu(Application.Handle, False), MF_STRING, SC_UDF, 'Всегда на&верху');
   Application.OnMessage := AppOnMessage;
 end;
 
 procedure TForm1.AppOnMessage(VAR Msg: TMsg; VAR Handled: Boolean);
 BEGIN
   IF Msg.Message <> WM_SYSCOMMAND THEN
     Exit;
   IF Msg.wParam AND $FFF0 <> SC_UDF THEN
     Exit;
 ... здесь вы можете включить код для обработки системного сообщения ...
 END;
 




Узнать, когда пользователь или программа изменили системное время - WM_TIMECHANGE

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

Когда меняется системное время всем окнам верхнего уровня рассылается сообщение WM_TIMECHANGE, нужен только обработчик этого сообщения.


 unit Unit1;
 
 interface
 
 uses
   Windows, Messages, SysUtils, Classes, Graphics, Controls,
   Forms, Dialogs, StdCtrls, ExtCtrls;
 
 type
   TForm1 = class(TForm)
     Timer1: TTimer;
   private
     { Private declarations }
     { Объявляем процедуру обработки сообщения }
     procedure WMTIMECHANGE(var message: TWMTIMECHANGE);
     message WM_TIMECHANGE;
   public
     { Public declarations }
   end;
 
 var
   Form1: TForm1;
 
 implementation
 {$R *.DFM}
 
 { реализация процедуры обработки сообщения }
 procedure TForm1.WMTIMECHANGE(var message: TWMTIMECHANGE);
 begin
   {например, по возникновению события уведомим об этом пользователя,
   отобразив в заголовке окна соответствующую надпись}
   Form1.Caption := 'Time has changed';
 end;
 
 end.
 




WordBasic через OLE

Попробуйте следующее:


 MsWord := CreateOleObject('Word.Basic');
 MsWord.FileNewDefault;
 MsWord.TogglePortrait;
 




Wordbasic с параметрами из Delphi

Имевшая место дискуссия двух начинающих программистов-школьников. Повод - спор, кто больше операторов Бейсика назовет. Перебрали почти все им известные, долго думают. Первый (радостно): LINE!
Второй (спокойно): LINE INPUT!
Первый (с досадой): ГНИДА!
Второй (спокойно): ГНИДА INPUT!

Привожу некоторый Delphi код для работы с Word 95. Я протестировал его под Word 97 и, как оказалось, потребовалось внести некоторые исправления - он не захотел работать под ним, но что самое неприятное - после исправлений ошибок выяснилось, что Word 97 работает значительно медленнее, чем Word 95. SendKeys был применен от отчаяния.


 function TAutoMerge.ProcessMerge(FSource, FData, FOutput: string):
   boolean;
 var
   MSWord: Variant;
   i, NumDocs: integer;
   Found: boolean;
   s, LastOLECommand: string;
 begin
   ProcessMerge := False;
   try
     LastOLECommand := 'Creating OLE Object.';
     MSWord := CreateOLEObject('Word.Basic');
     LastOLECommand := 'Show MS Word.';
     MSWord.AppShow;
     Application.ProcessMessages;
 
     LastOLECommand := 'Open document file >' + FSource + '<.';
     MSWord.FileOpen(Name := FSource, ConfirmConversions := 0,
       ReadOnly := 1, AddToMru := 0, PasswordDoc := '',
       PasswordDot := '', Revert := 0,
       WritePasswordDoc := '',
       WritePasswordDot := '');
     LastOLECommand := 'Screen updating = false.';
     MSWord.ToolsOptionsSpelling(AutomaticSpellChecking := 0);
     LastOLECommand := 'Set background printing to off.';
     MSWord.ToolsOptionsPrint(Background := 0);
 
     Application.ProcessMessages;
     LastOLECommand := 'Open Data file >' + FData + '<.';
     MSWord.MailMergeOpenDataSource(Name := FData, ConfirmConversions := 0,
       ReadOnly := 1, LinkToSource := 1,
       AddToMru := 0,
       PasswordDoc := '', PasswordDot := '',
       WritePasswordDoc := '', WritePasswordDot := '',
       Connection := '', SQLStatement := '',
       SQLStatement1 := '',
       Revert := 1);
 
     LastOLECommand := 'Start the Mail Merge.';
     MSWord.MailMerge(CheckErrors := 2, Destination := 1,
       MergeRecords := 0,
       From := '', to := '', Suppression := 0,
       MailSubject := '',
       MailAsAttachment := 0, MailAddress := '');
 
     LastOLECommand := 'Set up for SendKeys to select printer.';
     Application.ProcessMessages;
     MSWord.AppShow;
     s := '{home}%l{enter}{home}%n' + FOutput + '{tab}{enter}{home}{enter}';
     // sdd 1.1
     MSWord.SendKeys(s, -1);
     MSWord.MailMergeToPrinter;
     Application.ProcessMessages;
 
     ProcessMerge := True;
     LastOLECommand := 'All done with merge.';
   except
     on EOleException do
     begin
       inc(TotalOLEErrors);
       lblStatus.caption := LastOLECommand;
       if (TotalOLEErrors >= TOTALOLEERRORS_MAX) then
       begin
         s := 'Имеется по крайней мере одна ошибка OLE (' +
           IntToStr(TotalOLEErrors) +
 
         '), последней ошибкой было >' + LastOLECommand + '<.';
         ShowMessage(s);
       end;
     end
   end;
 end;
 




Как WordDocument разбить на страницы

Автор: AME


 // Одна страница
 ...
 var
   a: OleVariiant;
 begin
   a := wdPageBreak;
   WordApplication1.Selection.InsertBreak(a);
 ...
 // Следующая страница
 




Управление Word-ом из Delphi

Здесь мы рассмотрим пример того, как управлять объектами Word-а (Excel - аналогично) из программ на Delphi. Исходный код примера можно скачать на страничке 'DownLoad'

Для чего это нужно

Задачи могут быть самые разные, в общем случае это использование возможностей Word-а в своей программе, н-р: проверка текста на орфографию; печать текста, графики; экспорт отчетов в Word или изначальное создание их там и т.д.

Подготовительные работы

На самом деле существует несколько способов сделать это, мы рассмотрим только один (пример кроме Delphi 5, в Delphi5 для этого есть компоненты на закладке Servers переименуете в программе типы на соответствующие компоненты, дальше так же). Для начала начнем новый проект File, New Application; File, Save All. Создадим отдельную папку для проекта и сохраним Unit1 как Main, а Project1 как WordWriter. Далее для работы с Word-ом нам потребуется библиотека типов Word-а, это делается так: Project, Import Type Library, Add, далее переходим в папку, где стоит Word ( у меня это - "c:\program files\microsoft office) , заходим в папку Office и выбираем файл - msword8.olb (цифра -? версии Word-а - у Вас может отличаться ) или excel8.olb (для Excel).Нажимаем Оk. Delphi создаст 2 файла - Word_tlb.pas и Office_tlb.pas, их надо включить в раздел uses модуля Main нашего проекта:


 uses
   Office_Tlb, word_tlb;
 

Теперь займемся непосредственно программированием

В разделе var опишем следующие переменные:


 // класс приложения ворда
 WordApp: Word_tlb.Application_;
 // класс чего-то типа выделения,
 // т.е. говоришь - выделить ячейку с ... по, а результат скидываешь
 // в эту перем и работаешь с этими ячейками как с 1 объектом
 ARange, TempRange: Range;
 // массив документов
 Docs: documents;
 // 1 документ
 Doc: document;
 // массив параграфов
 pars: Paragraphs;
 // 1 параграф
 par: Paragraph;
 // параметры для передачи
 Template, temp, OpenAsTemplate: olevariant;
 // массив таблиц
 tabls: Tables;
 // 1 таблица
 tabl: Table;
 // рабочая переменная
 i: integer;
 

Далее проектируем форму:

  1. Поместим вверх нашей формы кнопку - button1 типа tbutton, поменяем заголовок (св-во Caption) на 'Старт'.
  2. Под кнопкой разместим панель - panel1 типа tpanel. Внутри панели поместим компонент - bevel1 типа tbevel, поменяем св-во Align на alClient (при этом рамка растянется на всю панель).
  3. Сверху панели (далее все компоненты будут размещаться внутри этой панели) разместим метку - label1 типа tlabel, поменяем значение св-ва Caption на 'Передать в ячейку':
  4. Ниже слева поместим метку - label1 типа tlabel, св-во Caption поменяем на 'X='
  5. Правее метки помещаем компонент Edit1 типа tEdit, св-во Text меняем на '1'
  6. По правой границе Edit1 помещаем компонент UpDown1 типа tUpDown, в списке св-ва 'Associate' выбираем Edit1, св-во 'Position' приравниваем '1'
  7. Чуть отступаем вправо и повторяем шаги 4-6 , заменив Edit1 на Edit2, UpDown1 на UpDown2, Label1 на Label2 соответственно.
  8. Ниже размещаем еще одну метку - label4 типа tlabel, меняем св-во 'Caption' на 'Новое значение ячейки:'
  9. Ниже размещаем компонент Edit3 типа tEdit, св-во Text меняем на '0'
  10. И, наконец, в самом низу панели размещаем кнопку BitBtn1 типа tBitBtn, меняем св-во 'Kind' на 'bkOk'.

Теперь напашем обработчики - именно в них и заключается вся функциональность программы:

Назначим обработчик OnClick компоненту Button1.


 procedure TForm1.Button1Click(Sender: TObject);
 begin
   // если заголовок 'Выход', то закрываем программу
   if button1.caption='Выход' then
   begin
     Application.Terminate;
     exit;
   end
   // иначе (при первом начатии, когда у нас заголовок 'Старт')
   //переименовываем заголовок в 'Выход'
   else
     button1.caption:='Выход';
 
   panel1.Visible:=true;
   // создаем экземпляр ворда
   WordApp:=CoApplication_.Create;
   // делаем его видимым
   WordApp.Visible:=true;
   // шаблон
   template:='Normal';
   // создать шаблон
   OpenAsTemplate:=false;
   // что-то типа оператора with, можно было и напрямую обратиться
   Docs:=WordApp.Documents;
   // добавляем документ
   Doc:=Docs.Add(template,OpenAsTemplate);
 
   // выделить все
   ARange:=Doc.Range(EmptyParam,EmptyParam);
   // массив параграфов
   pars:=doc.Paragraphs;
   // переменная - параметр
   template:=arange;
   // новый параграф
   par:=pars.Add(template);
   // цвет зеленный
   par.Range.Font.ColorIndex:=11;
   // вставляем текст
   par.Range.InsertBefore('Привет !!!');
   // переменная - параметр
   template:=par.Range;
   // новый параграф, чтобы таблица не потерла текст
   par:=pars.Add(template);
   // цвет черный
   par.Range.Font.ColorIndex:=0;
   // вставляем текст
   par.Range.InsertBefore('Переключившись в программу, ' +
   'можно программно менять текст ячеек !');
   // переменная - параметр
   template:=par.Range;
   // новый параграф, чтобы таблица не потерла текст
   par:=pars.Add(template);
   // выделяем параграф
   arange:=par.Range;
 
   // шрифт - жирный
   ARange.Font.Bold:=1;
   // шрифт - рукописный
   ARange.Font.Italic:=1;
   // получить массив таблиц
   tabls:=aRange.Tables;
   // добавляем новую таблицу размером 5 на 5
   tabl:=tabls.Add(arange,5,5);
   // в цикле
   for i := 1 to 5 do
     // задаем значение ячеек
     tabl.Cell(i,1).Range.Text := inttostr(i);
 end;
 

Зададим обработчик формы:


 procedure TForm1.FormDestroy(Sender: TObject);
 var
   // для параметров
   SaveChanges: olevariant;
 begin
   // если Word не закрыт
   if not VarIsEmpty(WordApp) then
   begin
     { а можно сохранить автоматом:
     // имя файла в оле
     template:='Имя.doc';
     // если не сохранен, то
     if doc.Saved=false then
     // сохраняем
     Doc.SaveAs(template, EmptyParam, EmptyParam, EmptyParam, EmptyParam,
     EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam);
 
     короче, пишешь имя объекта, ставишь точку и нажимаешь
     'ctrl'+' ' и изучаешь существующие методы и св-ва
     }
     //изменения не сохранять
     SaveChanges:=false;
     // то закрыть сначала документ
     Doc.Close(SaveChanges,EmptyParam,EmptyParam);
     // а потом и ворд
     WordApp.Quit(SaveChanges,EmptyParam,EmptyParam)
   end;
 end;
 

Назначим обработчик OnClick компоненту Bitbtn1:


 procedure TForm1.BitBtn1Click(Sender: TObject);
 begin
   // в соотв ячейку ставим соотв значение,
   // а можно и наоборот - получать значение из ячейки в переменную
   tabl.Cell(UpDown2.Position,UpDown1.Position).Range.Text:=Edit3.Text;
 end;
 

В общем-то, это все ...

Дополнительная информация:

  • Справка Word-а (по Visual Basic, по умолчанию она не ставится - запустите заново Setup и поставте в соотв. месте галочку)
  • Книги:
    • Чарльз Калверт "Энциклопедия пользователя Delphi4" (издательство - DiaSoft)
    • Марко Кэнту "Delphi4 для профессионалов" (издательство - Питер)

Если у Вас другая версия Word-а:

Параметры ф-ций могут отличаться - обратитесь к справке (см выше) или если у Вас версия Delphi 3 и выше, то используем универсальный метод - пишешь имя объекта, ставишь точку (если нужно посмотреть список параметров у функции , то после открывающей скобки ) , нажимаешь 'ctrl'+'пробел' и изучаешь существующие методы и св-ва.




Запуск Word без автостартующего (AutoStart) макроса

Для деактивации автостартующего макроса вы должны выполнить следующую команду:


 WordBasic.DisableAutoMacros
 

Перед выполнением команды не забудьте создать сам объект WordBasic.




Как в Word макросом удалить символы возврата каретки

- Папа! А что значать цифры у Windows: 3.11, 95, 98, 2000?
- Сколько каждая метров!
2. Solaris - экранизация Linux.
3. "Майн Герц", - сказала "мама" вибратору.
4. Tampax - жалкий аналог Recycle Bin.
5. Alldays и Allways с крылышками - модифициронные прокладки для "мыши".


 Sub Макрос1()
 '
 ' Макрос1 Макрос
 '
     Selection.Find.ClearFormatting
     Selection.Find.Replacement.ClearFormatting
     With Selection.Find
         .Text = "^p^p"
         .Replacement.Text = "#@$%%$"
         .Forward = True
         .Wrap = wdFindContinue
         .Format = False
         .MatchCase = False
         .MatchWholeWord = False
         .MatchWildcards = False
         .MatchSoundsLike = False
         .MatchAllWordForms = False
     End With
     Selection.Find.Execute Replace:=wdReplaceAll
     With Selection.Find
         .Text = "^p"
         .Replacement.Text = ""
         .Forward = True
         .Wrap = wdFindContinue
         .Format = False
         .MatchCase = False
         .MatchWholeWord = False
         .MatchWildcards = False
         .MatchSoundsLike = False
         .MatchAllWordForms = False
     End With
     Selection.Find.Execute Replace:=wdReplaceAll
     Selection.Find.ClearFormatting
     Selection.Find.Replacement.ClearFormatting
     With Selection.Find
         .Text = "#@$%%$"
         .Replacement.Text = "^p"
         .Forward = True
         .Wrap = wdFindContinue
         .Format = False
         .MatchCase = False
         .MatchWholeWord = False
         .MatchWildcards = False
         .MatchSoundsLike = False
         .MatchAllWordForms = False
     End With
     Selection.Find.Execute Replace:=wdReplaceAll
 End Sub
 




Получить даты с понедельника по пятницу текущей недели


 {
   Data sometimes have to be filtered regarding to working
   days (Mo.-Fri.) of the current Week. Following procs set
   your TDateTimePicker automatically.
 }
 
 
 function GetMonday(RefDay: TDate): TDate;
 var
   DoW: Integer;
   DateOffset: Integer;
 begin
   DoW := DayOfWeek(RefDay);
   // Montag der Woche 
   if DoW = 1 then DateOffset := -6
   else
     DateOffset := Dow - 2;
   Result := RefDay - DateOffset;
 end;
 
 function GetFriday(RefDay: TDate): TDate;
 var
   DoW: Integer;
   DateOffset: Integer;
 begin
   DoW := DayOfWeek(RefDay);
      {
      Friday of current week
      Freitag der Woche
      }
   if DoW = 1 then DateOffset := -2
   else
     DateOffset := Dow - 6;
   Result := RefDay - DateOffset;
 end;
 
 procedure SetWorkingDaysFilter(S, E: TDateTimePicker);
 var
   N: TDate;
 begin
   N      := Now;
   S.Date := GetMonday(N);
   E.Date := GetFriday(N);
 end;
 
 {Just as short as simple}
 {Einfach und kurz}
 
 
 type
   TForm1 = class(TForm)
     DStart: TDateTimePicker;
     DEnd: TDateTimePicker;
     btSetFilter: TButton;
     procedure btSetFilterClick(Sender: TObject);
   end;
 
 procedure TForm1.btSetFilterClick(Sender: TObject);
 begin
   SetWorkingDaysFilter(DStart, DEnd);
 end;
 




Заставить Delphi работать с достаточно большим массивом данных

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


 procedure TForm1.Button1Click(Sender: TObject);
   type
     TMyRec = record
     i1, i2, i3: Integer;
   end;
   TMyArr = array[1..20000000] of TMyRec;
   PMyArr=^TMyArr;
 var
   A: PMyArr;
 begin
   GetMem(A, SizeOf(TMyArr));
   A^[1].i1 := 100;
   ShowMessage('Ok' + IntToStr(A^[1].i1));
   FreeMem(A);
 end;
 




Как работать с битами

Есть два способа.

Низкоуровневый подход обеспечивается логическими операциями :


 var
   I : integer;
   N : integer;                       // Номер бита в диапазоне от 0..SizeOf(TYPE)*8 - 1
 begin
   I := I or (1 shl N);               // установка бита
   I := I and not (1 shl N);          // сброс бита
   I := I xor (1 shl N);              // инверсия бита
   if (i and (1 shl N)) <> 0 then...  // проверка установленного бита
 end;
 

Высокоуровневый подход опирается на представление числа в виде множества:


 type
   TIntegerSet = set of 0..SizeOf(Integer)*8 - 1;
 var
   I : Integer;
   N : Integer;
 begin
   Include(TIntegerSet(I), N);     // установили N-ный бит в 1
   Exclude(TIntegerSet(I), N);     // сбросили N-ный бит в 0
   if N in TIntegerSet(I) then...  // проверили N-ный бит
 end;
 




Как удобнее работать с буфером обмена как с последовательностью байт

Автор: Alexey Mahotkin
WEB-сайт: ftp://ftp.nf.ru/pub/alexm


 unit ClipStrm;
 
 {
 This unit is Copyright (c) Alexey Mahotkin 1997-1998
 and may be used freely for any purpose. Please mail
 your comments to
 E-Mail: alexm@hsys.msk.ru
 FidoNet: Alexey Mahotkin, 2:5020/433
 
 This unit was developed during incorporating of TP Lex/Yacc
 into my project. Please visit ftp://ftp.nf.ru/pub/alexm
 or FREQ FILES from 2:5020/433 or mail me to get hacked
 version of TP Lex/Yacc which works under Delphi 2.0+.
 }
 
 interface
 
 uses
   Classes, Windows;
 
 type
   TClipboardStream = class(TStream)
   private
     FMemory: pointer;
     FSize: longint;
     FPosition: longint;
     FFormat: word;
   public
     constructor Create(fmt: word);
     destructor Destroy; override;
 
     function read(var Buffer; Count: Longint): Longint; override;
     function write(const Buffer; Count: Longint): Longint; override;
     function Seek(Offset: Longint; Origin: Word): Longint; override;
 end;
 
 implementation
 
 uses
   SysUtils;
 
 constructor TClipboardStream.Create(fmt: word);
 var
   tmp: pointer;
   FHandle: THandle;
 begin
   FFormat := fmt;
   OpenClipboard(0);
   FHandle := GetClipboardData(FFormat);
   FSize := GlobalSize(FHandle);
   FMemory := AllocMem(FSize);
   tmp := GlobalLock(FHandle);
   MoveMemory(FMemory, tmp, FSize);
   GlobalUnlock(FHandle);
   FPosition := 0;
   CloseClipboard;
 end;
 
 destructor TClipboardStream.Destroy;
 begin
   FreeMem(FMemory);
 end;
 
 function TClipboardStream.read(var Buffer; Count : longint) : longint;
 begin
   if FPosition + Count > FSize then
     Result := FSize - FPosition
   else
     Result := Count;
   MoveMemory(@Buffer, PChar(FMemory) + FPosition, Result);
   Inc(FPosition, Result);
 end;
 
 function TClipboardStream.write(const Buffer; Count : longint) : longint;
 var
   FHandle: HGlobal;
   tmp: pointer;
 begin
   ReallocMem(FMemory, FPosition + Count);
   MoveMemory(PChar(FMemory) + FPosition, @Buffer, Count);
   FPosition := FPosition + Count;
   FSize := FPosition;
   FHandle := GlobalAlloc(GMEM_MOVEABLE or GMEM_SHARE or GMEM_ZEROINIT, FSize);
   try
     tmp := GlobalLock(FHandle);
     try
       MoveMemory(tmp, FMemory, FSize);
       OpenClipboard(0);
       SetClipboardData(FFormat, FHandle);
     finally
       GlobalUnlock(FHandle);
     end;
     CloseClipboard;
   except
     GlobalFree(FHandle);
   end;
   Result := Count;
 end;
 
 function TClipboardStream.Seek(Offset : Longint; Origin : Word) : Longint;
 begin
   case Origin of
     0 : FPosition := Offset;
     1 : Inc(FPosition, Offset);
     2 : FPosition := FSize + Offset;
   end;
   Result := FPosition;
 end;
 
 end.
 




Как работать с компонентами по их индексу

Меняем заголовки меткам [TLabel] с первой по пятую:


 procedure TForm1.Button1Click(Sender: TObject);
 var
   i: byte;
   Lab: TComponent;
 begin
   for i := 1 to 5 do begin
     Lab := FindComponent('Label' + IntToStr(i));
     (Lab as TLabel).Caption := IntToStr(i);
   end;
 end;
 




Работа с директориями в Delphi

Автор: Михаил Христосенко
WEB сайт: http://mihandelphi.narod.ru

После сытного завтрака муж уселся перед компьютером и окунулся в интернетовские порносайты.
- Ты что?! - удивилась жена. - Не идёшь сегодня на работу?
- Ой, господи! А я решил, что уже давно там...

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

Для начала начнем с простой функции для создания новой папки. Общий вид функции такой:


 function CreateDir(const Dir: string): Boolean;
 

То есть если папка успешно создана функция возвращает true. Сразу же простой пример ее использования:


 procedure TForm1.Button1Click(Sender: TObject);
 begin
   if createdir('c:\TestDir') = true then
     showmessage('Директория успешно создана')
   else
     showmessage('При создании директории произошла ошибка');
 end;
 

При нажатии на кнопку программа пытается создать папку с именем TestDir на диске C: и если попытка увенчалась успехом, то выводится соответствующее сообщение. Следует отметить, что если вы не указываете имя диска, на котором хотите создавать папку, то функция будет создавать папку в той же директории, где находится сама программа.

Объявления:


 createdir(edit1.text);
 

и


 createdir(extractfilepath(paramstr(0)) + edit1.text);
 

приведут к одному и тому же результату.

Теперь рассмотрим функцию для удаления папок. Ее объявление выглядит так:


 function RemoveDir(const Dir: string): Boolean;
 

Сразу же хочу предупредить, что данная функция способна удалять только пустые папки, и если там что-нибудь будет, то произойдет ошибка! Но выход есть!!! Здесь нам на помощь придет пользовательская функция с простым названием MyRemoveDir. Вот описание функции:


 function MyRemoveDir(sDir: string): Boolean;
 var
   iIndex: Integer;
   SearchRec: TSearchRec;
   sFileName: string;
 begin
   Result := False;
   sDir := sDir + '\*.*';
   iIndex := FindFirst(sDir, faAnyFile, SearchRec);
 
   while iIndex = 0 do
   begin
     sFileName := ExtractFileDir(sDir)+'\'+SearchRec.name;
     if SearchRec.Attr = faDirectory then
     begin
       if (SearchRec.name <> '' ) and
          (SearchRec.name <> '.') and
          (SearchRec.name <> '..') then
         MyRemoveDir(sFileName);
     end
     else
     begin
       if SearchRec.Attr <> faArchive then
         FileSetAttr(sFileName, faArchive);
       if not DeleteFile(sFileName) then
         ShowMessage('Could NOT delete ' + sFileName);
     end;
     iIndex := FindNext(SearchRec);
   end;
 
   FindClose(SearchRec);
 
   RemoveDir(ExtractFileDir(sDir));
   Result := True;
 end;
 

Копируете это все в Вашу программу, а затем эту функцию можно вызвать например так:


 if not MyRemoveDir('C:\TestDir') then
   ShowMessage('Не могу удалить эту директорию');
 

Теперь маленько отстранимся от непосредственной работы с папками и рассмотрим волнующий многих вопрос. Как вызвать диалог выбора папки (как при установке программ)?? ПРОСТО!!!

Подключаем в uses модуль Filectrl.pas (то есть uses FileCtrl;). Теперь ставим на форму еще кнопочку (чтобы не путаться :) и пишем такой код:


 procedure TForm1.Button3Click(Sender: TObject);
 const
   SELDIRHELP = 1000;
 var
   Dir: string;
 begin
   Dir := 'C:\windows';
   if SelectDirectory(Dir, [sdAllowCreate, sdPerformCreate, sdPrompt],SELDIRHELP) then
     Caption := Dir;
 end;
 

При выборе директории в заголовке формы отобразиться ее название!

Теперь рассмотрим следующую процедуру. К примеру Вам надо создать папку Dir1 по адресу: C:\MyDir\Test\Dir1, но при этом папок MyDir и Test на Вашем компьютере не существует. Функция CreateDir здесь не сработает, поэтому воспользуемся процедурой ForceDirectories. Ее общий вид таков:


 procedure ForceDirectories(Dir: string);
 

Пример ее использования (как всегда я поставил на форму новую кнопку, а там написал)


 procedure TForm1.Button4Click(Sender: TObject);
 var
   Dir: string;
 begin
   Dir := 'C:\MyDir\Test\Dir1';
   ForceDirectories(Dir);
 end;
 

Ну и напоследок приведу функцию для проверки: существует ли директория или нет. Ее общий вид такой:


 function DirectoryExists(name: string): Boolean;
 

Если директория указанная в параметре Name существует - то функция возвратит true.

Надеюсь, что помог Вам описанием данных функций и процедур. Сразу хочется дать совет: почаще заглядывайте в HELP, там много интересной и полезной информации!




Как работать со всеми фреймами, отображёнными в данный момент в WebBrowser

Автор: Peter Friese

- Тук-тук!
- Кто там?
- Это я, Веб-браузер!
- А фреймы поддерживаешь?
- Не-е-а!
- Тогда и за веревочку не дергай!

Данный пример показывает как определить в каких фреймах разрешена команда 'copy':


 procedure TForm1.Button1Click(Sender: TObject);
 var
   i: integer;
 begin
   for i := 0 to (WebBrowser1.OleObject.Document.frames.Length - 1) do
     if WebBrowser1.OleObject.Document.frames.item(i).document.queryCommandEnabled('Copy') then
       ShowMessage('copy command is enabled for frame no.' + IntToStr(i));
 end;
 




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

Автор: Михаил Христосенко
WEB сайт: http://mihandelphi.narod.ru

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

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

Теперь начнем разбираться с этими инифайлами. Для начала создайте новое приложение. Добавьте в секцию uses слово inifiles. Сохраните и откомпилируйте ваше приложение. Теперь сделаем, чтобы при каждом открытии программы форма имела такие размеры, какие установил пользователь последний раз. Для начала нам надо создать объект типа Inifile. Создается он методом Create(Filename:string); причем если в переменной Filename не указан путь к фалу, то он создаться в директории Windows, что не очень-то удобно. Поэтому мы создадим этот файл в директории нашей программы. Напишем это в обработчик события OnDestroy для формы:


 procedure TForm1.FormDestroy(Sender: TObject);
 var
   Ini: Tinifile; //необходимо создать объект, чтоб потом с ним работать
 begin
   //создали файл в директории программы
   Ini:=TiniFile.Create(extractfilepath(paramstr(0))+'MyIni.ini');
   Ini.WriteInteger('Size','Width',form1.width);
   Ini.WriteInteger('Size','Height',form1.height);
   Ini.WriteInteger('Position','X',form1.left);
   Ini.WriteInteger('Position','Y',form1.top);
   Ini.Free;
 end;
 

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

Вот файл MyIni.ini после завершения работы программы (у вас естественно значения будут другими):

 [Size]
 Width=188
 Height=144
 
 [Position]
 X=14
 Y=427
 

Теперь подробно разберемся как записывать информацию в инифайлы: После того, как вы создали инифайл, в него можно записывать три вида переменных: Integer, String, Boolean, это осуществляется соответствующими процедурами: WriteInteger, WriteString, WriteBool. У всех этих процедур одинаковые параметры. В общем объявление этих процедур выглядит так:

 Ini.WriteInteger(const Section: string, const  Ident:string, Value: Integer);
 

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

Ident - это название параметра, которому будет присваиваться какое-нибудь значение.

Value - это собственно значение, которое будет присвоено параметру. В файле оно стоит после знака равно.

Теперь напишем обработчик события OnCreate для формы, в котором будем считывать значения из файла и изменять размеры формы в соответствии с полученными значениями. Код должен иметь такой вид:


 procedure TForm1.FormCreate(Sender: TObject);
 var
   Ini: Tinifile;
 begin
   //открываем файл
   Ini:=TiniFile.Create(extractfilepath(paramstr(0))+'MyIni.ini');
   Form1.Width:=Ini.ReadInteger('Size','Width',100);
   //последнее значение (100) это значение по умолчанию (default)
   Form1.Height:=Ini.ReadInteger('Size','Height',100);
   Form1.Left:=Ini.ReadInteger('Position','X',10);
   Form1.Top:=Ini.WriteInteger('Position','Y',10);
   Ini.Free;
 end;
 

В этом коде все просто: открыли файл, прочитали из соответствующих секций необходимые параметры и присвоили их форме. Чтение значений из инифайла по сути ничем не отличается от записи в них. Указываете секцию, где хранится необходимый параметр, указываете параметр и читаете его значение. Как вы видите все просто!

Теперь я отвечу еще на один вопрос, который может появиться - почему не обычные текстовые файлы и не реестр? Отвечаю: из текстового файла очень сложно получить и обработать необходимую информацию. Многие рекомендуют для Win95/98/2000/Me, короче для всех 32-разрядных ОС использовать именно реестр, но лично я считаю, что инифайлы удобнее, так как при при переносе программы на другой компьютер, нужно перенести только один инифайл, а во-вторых, если вы что-нибудь в реестре случайно удалите, то может случиться каюк.




Работа с JPEG-изображениями

Автор: Михаил Христосенко
WEB сайт: http://mihandelphi.narod.ru

Для этих целей в Дельфи предусмотрено два класса TJpegImage и TJpegData. Мы будем использовать первый, он описан в модуле JPEG (его надо подключить в uses).

Теперь попробуем реализовать такую вещь. Сделаем конвертер картинок в формате *.bmp в формат *.jpeg. Для этого нам понадобится такие компоненты: TImage (для просмотра картинок), две кнопки TButton (для открытия диалога выбора картинок и для запуска процесса), TTrackBar (для того чтобы устанавливать качество картинки), TCheckBox (чтобы устанавливать или убирать флаг " Оттенки серого" ) и TOpenDialog.

Обработчик события OnClick для первой кнопки может иметь такой вид:


 procedure TForm1.Button1Click(Sender: TObject);
 begin
   if opendialog1.execute then
     image1.Picture.LoadFromFile(opendialog1.filename);
 end;
 

Кстати не забудьте настроить фильтр для OpenDialog1, чтобы можно было открывать только картинки в формате *.bmp.

Теперь непосредственно займемся написанием основной части программы, то есть создание jpeg-изображения. Все действия будем производить по щелчку на второй кнопке. Нам необходимо будет создать объект типа TJpegImage, провести с ним необходимые действия, а потом с помощью метода Compress, упаковать изображение и остается только сохранить изображение в файл. Еще необходимо настроить свойства TrackBar'a: свойство Max надо сделать равным 100 и свойство Position равным также 100. Итак, обработчик нажатия на вторую кнопку может быть таким:


 procedure TForm1.Button2Click(Sender: TObject);
 var
   jpg: TJpegImage;
 begin
   {создаем экземпляр объекта}
   jpg:=TJpegImage.Create;
   {присваиваем ему изображение}
   jpg.Assign(image1.picture.graphic);
   {устанавливаем степень сжатия (качество) 1..100}
   jpg.CompressionQuality:=TrackBar1.Position;
   {если установлен флаг " Оттенки серого" , то пусть картинка будет серой:)}
   jpg.Grayscale:=checkbox1.Checked;
   {Упаковываем графику}
   jpg.Compress;
   {и сохраняем ее куда вам захочется}
   jpg.SaveToFile('D:\first.jpg');
   {уничтожаем экземпляр объекта}
   jpg.free;
 end;
 

Как вы видите все очень просто! На всякий случай приведу полный код приложения:


 unit Unit1;
 
 interface
 
 uses
 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
 ComCtrls, ExtCtrls, StdCtrls,JPEG;
 
 type
 TForm1 = class(TForm)
 Button1: TButton;
 Button2: TButton;
 Image1: TImage;
 TrackBar1: TTrackBar;
 OpenDialog1: TOpenDialog;
 CheckBox1: TCheckBox;
 procedure Button1Click(Sender: TObject);
 procedure Button2Click(Sender: TObject);
 private
 { Private declarations }
 public
 { Public declarations }
 end;
 
 var
 Form1: TForm1;
 
 implementation
 
 {$R *.DFM}
 
 procedure TForm1.Button1Click(Sender: TObject);
 begin
 if opendialog1.execute then
 image1.Picture.LoadFromFile(opendialog1.filename);
 end;
 
 procedure TForm1.Button2Click(Sender: TObject);
 var jpg:TJpegImage;
 begin
 {создаем экземпляр объекта}
 jpg:=TJpegImage.Create;
 {присваиваем ему изображение}
 jpg.Assign(image1.picture.graphic);
 {устанавливаем степень сжатия (качество) 1..100}
 jpg.CompressionQuality:=TrackBar1.Position;
 {если установлен флаг " Оттенки серого" , то пусть картинка будет серой:)}
 jpg.Grayscale:=checkbox1.Checked;
 {Упаковываем графику}
 jpg.Compress;
 {и сохраняем ее куда вам захочется}
 jpg.SaveToFile('D:\first.jpg');
 {уничтожаем экземпляр объекта}
 jpg.free;
 end;
 
 end.
 

Для обратного преобразования из Jpg в Bmp необходимо воспользоваться методом DibNeeded.




Работа с OpenGL - Введение

Лежат два програмиста на берегу моря один дрегому:
- Смотри какие облака.
- Да это они умеют!

Введение

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

Когда я начинал изучение этого, у меня не было ни одного примера использования OpenGL в Delphi, только ворох программ на C и C++, поэтому пришлось начинать с того, чтобы перекладывать эти программы на Delphi. Затем появились и полностью собственные проекты. Моя основная работа связана с преподаванием в вузе, после того, как я включил в учебные курсы изучение основ OpenGL, студенты с моей помощью смогли создать ряд интересных проектов.

Я решил опубликовать некоторые из проектов моей коллекции, озаглавил набор "ЖиЛистая Delphi" и предложил сайту "Королевство Delphi". На сайте мне предложили дополнить эти проекты серией статей по вопросам использования OpenGL в Delphi. Данная статья является первой статьей этого цикла.

Статьи я предполагаю писать на уровне, доступном для самой широкой аудитории - от новичков в программировании для Windows до умудренных профессионалов. Я постараюсь придерживаться краткости в своих рассуждениях, освещая только суть рассматриваемых вопросов. Многие вопросы, освещаемые здесь, ясно проиллюстрированы в проектах "ЖиЛистой Delphi".

OpenGL - стандартный для большинства платформ и операционных систем набор низкоуровневых функций двумерной и трехмерной графики, библиотека, широко используемая в промышленных CAD-системах и играх.

Поставляется в составе операционной системы Windows, начиная с версии OSR2 в виде двух DLL-файлов - opengl32.dll и glu32.dll. Первая из этих библиотек и есть собственно набор функций OpenGL, вторая содержит дополнительный набор функций, упрощающих кодирование, но построенных и выполняемых с подключением opengl32.dll и являющаяся надстройкой.

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

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

Для более подробной информации о OpenGL Вы можете обратиться на сайт http://www.opengl.org

Вместе с Delphi, начиная с третьей версии, поставляется файл помощи по OpenGL фирмы MicroSoft и заголовочный файл opengl.pas, позволяющий использовать эту графическую библиотеку в приложениях, написанных на Delphi.

Есть также альтернативные версии заголовочных файлов независимых разработчиков и компоненты, использующие OpenGL, упрощающие доступ к его функциям и использующие ООП подход. Некоторые из этих файлов и компонентов могут использовать версию OpenGL для Windows фирмы SGI, имеющую собственное расширение функций и имеющую более высокие скоростные показатели. Одна из самых полных систем, реализующая набор функций всех версий OpenGL - это библиотека разработчика MGL фирмы SciTechSoft.

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

Итак, Delphi в стандартной поставке позволяет использовать OpenGL в разрабатываемых приложениях, но как это сделать, плохо понятно из файла помощи, а готовыми примерами использования OpenGL Delphi не сопровождается (по крайней мере, на сегодня). Поэтому начинающим часто тяжело самостоятельно разобраться, как же работать с OpenGL в Delphi. Рассмотрению вопросов использования OpenGL вообще и использованию в Delphi и будет посвящен данный курс статей.

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

Для понимания смысла этих действий желательно понимать смысл основных понятий операционной системы Windows - ссылка, контекст, сообщение, в проектах Delphi не всегда активно используемых программистами. Желательно иметь хотя бы минимальные знания о роли динамических библиотек в этой операционной системе. Хотя, конечно, можно успешно использовать OpenGL и без глубоких знаний в этой области, используя готовые шаблоны приложений и сосредоточившись собственно на функциях OpenGL.

Важно также отметить то, что чаще всего приложения, активно использующие графику, нуждаются от Delphi только в создании окна приложения, таймере и обработчике манипуляций с клавиатурой и мышью. Для таких приложений чаще всего и не требуется богатство библиотеки VCL. и крайне важны скорость работы и "профессиональная" миниатюрность откомпилированного модуля. Поскольку мы вынуждены с самого начала рассматривать и разбирать темы уровнем ниже RAD-технологий, то нам становится по силам и написание программ без визуальных средств вообще, программ, использующих только функции Windows API, стремительно компилируемых и занимающих после компиляции миниатюрные размеры (порядка двух десятков килобайт).

Итак, наш разговор приходится начинать с вопросов, напрямую вроде бы не связанных с OpenGL.

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

Событие. Сообщение. Контекст.

Начнем наш разговор с понятий "событие" и "сообщение".

Очень часто это синонимы одного и того же термина операционной системы, общающейся с приложениями посредством посылки сообщений. Код, написанный в проекте Delphi как обработчик события OnCreate, выполняется при получении приложением сообщения WM_CREATE, сообщению WM_PAINT соответствует событие OnPaint, и т.д..Такие события использует мнемонику, сходную с мнемоникой сообщений.

Как операционная система различает окна для осуществления диалога с ними? Все окна при своем создании регистрируются в операционной системе и получают уникальный идентификатор, называемый "ссылка на окно". Тип этой величины в Delphi - HWND (WiNDow Handle, ссылка на окно).

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

Попробуем проиллюстрировать смысл ссылки на окно на несложном примере.

Откомпилируйте минимальное приложение Delphi и начните новый проект. Форму назовите Form2, разместите на форме кнопку, обработчик события OnClick кнопки приведите к следующему виду:


 procedure TForm2.Button1Click(Sender: TObject);
 var
   H: HWND;
 begin
   H := FindWindow ('TForm1', 'Form1');
   if H <> 0 then
     ShowMessage ('Есть Form1!')
   else
     ShowMessage ('Нет Form1!')
 end;
 

Теперь при щелчке на кнопке выдается сообщение, есть ли запущенное приложение, класс окна которого зарегистрирован в операционной системе как 'TForm1', в заголовке которого записано 'Form1'. То есть если одновременно запустить обе наши программы, при нажатии на кнопку выдается одно сообщение, если окно с заголовком 'Form1' закрыть, при щелчке на кнопку выдается другое сообщение.

Здесь мы используем функцию API FindWindow, возвращающую величину типа HWND - ссылку на найденное окно либо ноль, если такое окно не найдено.

Итак, ссылка на окно однозначно определяет окно. Свойство Handle формы и есть эта ссылка, значение которой форма получает при выполнении функции API CreateWindow - создании окна. Имея ссылку на окно, операционная система общается с окном путем посылки сообщений-сигналов о том, что произошло какое-либо событие, имеющее отношение именно к этому окну. Если окно имеет намерение отреагировать на это событие, операционная система имеет это в виду и вместе с окном осуществляет эту реакцию. Окно может и не имея фокус получать сообщения и реагировать на них.

Проиллюстрируем это на примере.

Обработчик события OnMouseMove формы приведите к виду:


 procedure TForm2.FormMouseMove(Sender: TObject;
 Shift: TShiftState; X, Y: Integer);
 begin
   Caption := 'x=' + IntToStr (X) + ', y=' + IntToStr (Y);
 end;
 

В заголовок формы выводятся координаты указателя мыши.

Запустите два экземпляра программы и обратите внимание, что окно, не имеющее фокус ("неактивное"), тоже реагирует на перемещение указателя по его поверхности.

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

Изменим код обработки щелчка кнопки:


 procedure TForm2.Button1Click(Sender: TObject);
 var
   H: HWND;
 begin
   H := FindWindow ('TForm1', 'Form1');
   if H <> 0 then
     SendMessage(H, WM_CLOSE, 0, 0);
 end;
 

Если имеется окно класса 'TForm1' с заголовком 'Form1', наше приложение посылает ему сообщение WM_CLOSE - пытается закрыть окно.

Точно также, если необходимо нарисовать что-либо на поверхности чужого окна, необходимо получить ссылку на это окно.

Для начала попробуем рисовать на поверхности родного окна.

Разместите еще одну кнопку, обработку щелчка которой приведите к виду:


 procedure TForm2.Button2Click(Sender: TObject);
 var
   dc: HDC;
 begin
   dc := GetDC (Handle);
   Rectangle (dc, 10, 10, 110, 110);
   ReleaseDC (Handle, dc);
 end;
 

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

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


 procedure TForm2.Button2Click(Sender: TObject);
 var
   dc: HDC;
   Window: HWND;
 begin
   Window := FindWindow ('TForm1', 'Form1');
   if Window <> 0 then
   begin
     dc := GetDC (Window);
     Rectangle (dc, 10, 10, 110, 110);
     ReleaseDC (Handle, dc);
   end
 end;
 

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

Замечу, что если закрыть Project1.exe и загрузить в Delphi соответствующий ему проект, при щелчке на кнопке прямоугольник будет рисоваться на поверхности окна формы, что будет выглядеть необычно.

Функции Windows для воспроизведения нуждаются в специальной величине типа HDC (Handle Device Context, ссылка на контекст воспроизведения), для задания значения которой необходимо иметь величину типа HWND - ссылка на окно, уникальный идентификатор всех зарегистрированных в системе окон. В зависимости от версии Delphi ссылки имеют тип либо Integer, либо LongWord.

Графическая система OpenGL, как и любое другое приложение Windows, также нуждается в ссылке на окно, на котором будет осуществляться воспроизведение - специальной ссылке на контекст воспроизведения - величина типа HGLRC (Handle openGL Rendering Context, ссылка на контекст воспроизведения OpenGL). Для получения этого контекста OpenGL нуждается в величине типа HDC (контекст воспроизведения) окна, на который будет осуществляться вывод.

Поэтому наши примеры имеют следующие строки в разделе private описания формы:


 DC: HDC;
 hrc: HGLRC;
 

А обработчик события OnCreate формы начинается со следующих строк:


 DC := GetDC(Handle);
 SetDCPixelFormat;
 hrc := wglCreateContext(DC);
 wglMakeCurrent(DC, hrc);
 

То есть мы получаем контекст воспроизведения Windows, задаем желаемый формат пикселей, создаем контекст воспроизведения OpenGL и делаем его текущим, чтобы вызываемые функции OpenGL могли работать с этим окном.

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

Во-первых, величину типа HDC мы получаем при создании окна, в обработчике события OnCreate, или, другими словами, в обработчике сообщения WM_CREATE. Это является обычным и традиционном для Windows-программ.

Некоторые программисты сделали мне замечание, что получение контекста воспроизведения при создании окна является несколько некорректным для Windows 9X и более правильным было бы получение контекста в обработчике событий OnShow или OnPaint. Возможно, это так и есть, и в некоторых ситуациях может сказаться на корректности работы приложения. Вы должны учитывать это при написании ответственных приложений.

Во-вторых, контекст воспроизведения Windows и контекст воспроизведения OpenGL обычно освобождаются приложением. То есть, команды вывода OpenGL обычно обрамляются следующими строками:


 dc := BeginPaint(Window, ps);
 wglMakeCurrent(DC, hrc);
 
 wglMakeCurrent(0, 0);
 EndPaint (Window,ps);
 ReleaseDC (Window, dc);
 

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

В наших примерах контекст воспроизведения OpenGL мы занимаем сразу же при его получении, в обработчике события OnCreate, а освобождаем в конце работы приложения, в обработчике события OnDestroy.

Еще одно замечание - команды и функции OpenGL имеют префикс gl для размещенных в библиотеке opengl32.dll и glu для размещенных в библиотеке glu32.dll. Прототипы этих функций находятся в модуле opengl.pas. Функции OpenGL, имеющие отношение только к реализации OpenGL под Windows, имеют префикс wgl, как, например, wglCreateContext, а некоторые вообще не имеют префикса, например, SwapBuffers. Их прототипы описаны в модуле windows.pas.

Если понятия "сообщение" и "контекст" Вами поняты, сейчас Вы можете разобрать проекты WinMin.dpr и Paint.dpr в каталоге Beginer/0. В списке uses данных проектов перечислены всего два модуля - Windows и Messages (SysUtils в проекте Paint не используется). Это означает, что данные проекты не используют библиотеку VCL Delphi. После компиляции этих проектов Вы получите 16-ти килобайтные приложения. Приложения эти иллюстративные, умеют делать немногое, но для нас важен код проектов, возвращающий во времена старого доброго Borland Pascal-я, громоздкий, плохочитаемый, но эффективный для наших задач. Эти проекты помогают понять новичкам, какую каторожную работу выполняет за нас Delphi, и как в действительности работают Windows-приложения. Проекты я постарался хорошо откомментировать, чтобы Вам было легче разобраться.

Если Вы разберетесь, как рисовать функциями GDI на поверхности своего окна, Вы яснее сможете понять, как машина OpenGL рисует на поверхности чужого окна.




Работа с OpenGL - Минимальная программа

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

Содержимое контекста

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

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

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

Мы знаем, что ссылка на контекст устройства - величина типа HDC, для получения которой вызываем функцию GetDC. Ссылке на контекст устройства в Delphi соответствует свойство Canvas.Handle формы, принтера и некоторых компонентов. Теоретически всюду в наших примерах в строках, использующих величину DC типа HDC, вместо DC можно использовать Canvas.Handle. В первых примерах для начинающих это так и сделано. Каков же все-таки смысл контекста устройства, если он и так связан с однозначно определенным объектом - окном, областью памяти или принтером, и зачем передавать дополнительно какую-то информацию об однозначно определенном объекте?

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

Строки:


 Form1.Canvas.Ellipse (0, 0, 100, 100);
 

и


 Printer.BeginDoc;
 Printer.Canvas.Ellipse (0,0,100,100);
 Printer.EndDoc;
 

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

Win32 Programmer's Reference фирмы MicroSoft о контексте устройства сообщает следующее:

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

Термин "структура", встретившийся здесь, соответствует записи в терминологии Delphi. Контекст устройства Windows содержит информацию, относящуюся к графическим компонентам GDI, контекст воспроизведения содержит информацию, относящуюся к OpenGL, то есть играет такую же роль, что и контекст устройства для GDI. В частности, эти контексты являются хранилищами состояния системы, например, хранят информацию о текущем цвете карандаша.

Формат пикселя

Итак, ссылка на контекст устройства содержит характеристики устройства и средства отображения. Именно он знает, как выводить на конкретно это устройство. Упрощенно говоря, получив ссылку на контекст устройства, мы берем в руки простой либо цветной карандаш, или кисточку с палитрой в миллионы оттенков. Сервер OpenGL, прежде чем приступать к работе, также должен определиться, на каком оборудовании ему придется работать. Это может быть скромная персоналка, а может быть и мощная графическая станция. Прежде чем получить контекст воспроизведения, сервер OpenGL должен получить детальные характеристики используемого оборудования. Эти характеристики хранятся в специальной структуре, тип которой - TPixelFormatDescriptor (описание формата пикселя). Формат пикселя определяет конфигурацию буфера цвета и вспомогательных буферов.

Самый частый вопрос, который я получаю в связи с моими уроками, заключается в просьбе указать источники подробной информации об OpenGL на русском. К сожалению, если такие и есть, то мне они неизвестны. Главным нашим подручным станет поставляемый в составе Delphi файл помощи по OpenGL. Систему помощи Delphi для получения хороших результатов необходимо настраивать, если в помощи Delphi найти раздел по OpenGL, он не порадует обилием информации. В разных версиях Delphi настройка помощи выполняется по-разному, потребуются некоторые несложные манипуляции, но мы не будем тратить на это время. Будем использовать самый простой способ - контекстную помощь. Наберите в тексте модуля фразу "PixelFormatDescriptor", нажмите клавишу F1 и Вы получите подробную помощь об этом типе. Точно также мы будем получать помощь обо всех терминах, функциях и командах OpenGL.

Итак, мы получили обширное описание структуры PixelFormatDescriptor. Обращаю внимание, что мы видим раздел помощи MicroSoft, рассчитанной на программистов С и С++, поэтому описание использует термины и стилистику именно этих языков. Так, по традиции Delphi имена типов начинаются с префикса T, но нам не удастся найти помощь по термину TPixelFormatDescriptor. К сожалению, это не единственное неудобство, которое нам придется испытывать. Например, если сейчас мы заглянем в файл windows.pas и найдем описание записи TPixelFormatDescriptor, мы обнаружим, что в файле помощи не указаны некоторые константы, а именно: PFD_SWAP_LAYER_BUFFERS, PFD_GENERIC_ACCELERATED и PFD_DEPTH_DONTCARE. А константа, названная PFD_DOUBLE_BUFFER_DONTCARE, по-видимому, соответствует константе, описанной в модуле windows.pas как PFD_DOUBLEBUFFER_DONTCARE. Наверное, более поздние версии помощи и заголовочного файла исправят этот и другие неточности.

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

В каталоге Beginner/1 Вы найдете проект OpenGL_min.dpr, в котором я привел описание всех полей структуры TPixelFormatDescriptor на русском, в момент их первоначального заполнения. Делается это в процедуре SetDCPixelFormat, вызываемой между получением ссылки на контекст устройства и созданием контекста воспроизведения OpenGL. Посмотрим подробнее, что там делается. Полям структуры присваиваются желаемые значения, затем вызовом функции ChoosePixelFormat осуществляется запрос системе, поддерживается ли на данном рабочем месте выбранный формат пикселя, и вызовом функции SetPixelFormat устанавливаем формат пикселя в контексте устройства. Функция ChoosePixelFormat возвращает индекс формата пикселя, который нам нужен в качестве аргумента функции SetPixelFormat.

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

Обратим внимание на поле структуры "битовые флаги" - dwFlags. То, как мы зададим значение флагов, существенно может сказаться на работе нашего приложения, и наобум задавать эти значения не стоит. Тем более, что некоторые флаги совместно ужиться не могут, а некоторые могут присутствовать только в паре с другими. В этом примере флагам я присвоил значение PFD_DRAW_TO_WINDOW or PFD_SUPPORT_OPENGL, то есть сообщаю системе, что я собираюсь осуществлять вывод в окно, и что моя система в принципе поддерживает OpenGL. Я ограничился всего двумя константами из обширного списка, приведенного в модуле windows.pas, по каждой из которых в файле помощи приведено детальное описание.

Так, константа PFD_DOUBLEBUFFER включает режим двойной буферизации, когда вывод осуществляется не на экран, а в память, затем содержимое буфера выводится на экран. Это очень полезный режим, если в любом примере на анимацию убрать режим двойной буферизации и все команды, связанные с этим режимом, хорошо будет видно мерцание при выводе кадра. Константу PFD_GENERIC_ACCELERATED имеет смысл устанавливать в случае, если компьютер оснащен графическим акселератором. Флаги, заканчивающиеся на "DONTCARE" , сообщают системе, что соответствующий режим может иметь оба значения, то есть PFD_DOUBLE_BUFFER_DONTCARE - запрашиваемый формат пикселя может иметь оба режима - одинарной и двойной буферизации. Со всеми остальными полями и константами я предоставляю Вам возможность разобраться самостоятельно, только замечу, что поле iLayerType, описанное в windows.pas типа Byte, может, согласно помощи, иметь три значения: PFD_MAIN_PLANE, PFD_OVERLAY_PLANE и PFD_UNDERLAY_PLANE, однако константа PFD_UNDERLAY_PLANE имеет значение -1, так что установить такое значение не удастся.

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

В примере битовым флагам задаем все возможные значения одновременно, числовым полям задаем заведомо нереальное значение 64, и смотрим на выбор формата пикселя, сделанным OpenGL. Результат, который Вы получите - выбранный формат пикселя, я предсказать не смогу - он индивидуален для каждой конкретной конфигурации машины и текущих настроек. Возможно, Вы получите в результате, что режим двойной буферизации не будет установлен - напоминаю, многие флаги устанавливаются только в комбинации с другими определенными. Наше приложение позволяет менять параметры формата пикселя и устанавливать его заново. Чтобы видеть, что происходит воспроизведение, небольшая площадка на экране при каждом тестировании окрашивается случайным цветом, используя функции OpenGL. Поэкспериментируйте с этим приложением, например, определите комбинацию флагов для установления режима двойной буферизации. Посмотрите значение числовых полей формата при различной палитре экрана - 16, 24, 32 бита, но не 256 цветов. О выводе при палитре экрана в 256 цветов - отдельный разговор. Это приложение, в частности, дает ответ на вопрос - как определить, оснащен ли компьютер графическим акселератором. Повозившись с этим приложением, Вы найдете ответ на вопрос, на который я Вам ответить не смогу - как надо заполнить структуру TPixelFormatDescriptor для Вашего компьютера. Обратите внимание, что в коде я установил несколько проверок на отсутствие контекста воспроизведения, который может быть потерян по ходу работы любого приложения, использующего OpenGL - редкая, но возможная ситуация в штатном режиме работы системы и очень вероятная ситуация если, например, по ходу работы приложения менять настройки экрана.

Минимальная программа OpenGL

Теперь мы знаем все, что необходимо для построения минимальной программы, использующей OpenGL. Я привел два варианта этой программы - одна построена исключительно на функциях Windows API, другая использует библиотеку классов Delphi (проекты каталогов Beginner/1 и Beginner/2 соответственно).

Взглянем на головной модуль второго проекта. При создании формы задаем формат пикселя, в качестве ссылки на контекст устройства используем значение Canvas.Handle формы. Создаем контекст воспроизведения OpenGL и храним в переменной типа HGLRC. При обработке события OnPaint устанавливаем контекст воспроизведения, вызываем функции OpenGL и освобождаем контекст. При завершении работы приложения удаляем контекст воспроизведения. Для полной академичности можно включить строки, проверяющие, получен ли контекст воспроизведения, и не теряется ли он по ходу работы. Признаком таких ситуаций является нулевое значение переменной hrc. В минимальной программе я просто окрашиваю окно в желтоватый оттенок. Получив помощь по команде glClearColor, Вы можете узнать, что аргументы ее - тройка вещественных чисел в интервале [0;1], задающих долю красного, зеленого и синего составляющих в цвете и еще один, четвертый аргумент, о котором мы поговорим чуть позднее. Этому аргументу я в примере задал значение 1.0. Вообще то, аргументы glClearColor, согласно помощи, имеют неведомый тип GLclampf. Для того, чтобы разобраться с этим типом, отсылаю к строке


 GLclampf = Single;
 

модуля opengl.pas.

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

Строку нашей программы


 glClear(GL_COLOR_BUFFER_BIT);
 

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

Проект, построенный только на функциях API, надеюсь, сейчас стал более понятным. Вместо Canvas.Handle используем собственную переменную dc, в обработчике события WM_PAINT реализуем действия, которые Delphi при обычном подходе выполняет за нас. Напоминаю, что для лучшей устойчивости работы обработчик WM_PAINT следовало бы написать так:


 dc := BeginPaint (Window, MyPaint);
 wglMakeCurrent (dc, hrc);
 glClearColor (0.85, 0.75, 0.5, 1.0);
 glClear (GL_COLOR_BUFFER_BIT);
 wglMakeCurrent (dc, 0);
 EndPaint (Window, MyPaint);
 ReleaseDC (Window, dc);
 

А в обработчике WM_DESTROY следует перед PostQuitMessage добавить строку:


 DeleteDC (dc);
 

То есть все используемые ссылки необходимо освобождать, а после того, как они стали не нужны - удалять.

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

Во всех своих примерах я приписал рекомендацию не запускать проекты, использующие OpenGL под управлением среды Delphi. Дело в том, что часто в таких ситуациях программа аварийно прерывается, выдавая сообщение "access violation -". Это происходит и в случае самой аккуратной работы с контекстами, и не связано с небрежностью работы программы. Некоторые программисты вину за это возлагают на софтверные драйверы и рекомендуют обновить их. Некоторые утверждают, что дело в Windows 9X, и под NT этого не происходит. Возможно, Вы тоже ничего такого не замечали и не можете взять в толк, о чем я сейчас веду речь. У меня такие окошки вылетают через раз на одном и том же проекте, хотя откомпилированный модуль работает превосходно. Я полагаю, что если драйверы не "глюкуют", когда приложение работает без среды Delphi, дело не только в драйверах.

Вывод на поверхность компонентов

Теоретически функциями OpenGL возможно осуществлять вывод не только на поверхность формы, а и на поверхность любого компонента, если у него имеется свойство Canvas.Handle, для чего при получении контекста воспроизведения необходимо указывать именно его ссылку на контекст устройства, например, Image1.Canvas.Handle. Однако чаще всего это приводит к неустойчивой работе, вывод "то есть, то нет", хотя контекст воспроизведения присутствует и не теряется. Я советую Вам всегда пользоваться выводом исключительно на поверхность окна. OpenGL прекрасно уживается с визуальными компонентами, как видно из примера TestPFD, если же необходимо ограничить размер области вывода, для этого есть стандартные методы, о которых мы обязательно будем беседовать в будущем.

Просто ради интереса приведу пример, когда вывод OpenGL осуществляется на поверхность панели, то есть компонента, не имеющего свойства Canvas. Для этого мы пользуемся тем, что панель имеет отдельное окно, вызываем функцию GetDC с аргументом Panel1.Handle.

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

Для вывода на компонент класса TImage можете записать:


 dc := Image1.Canvas.Handle;
 

и удалить строки BeginPaint и EndPaint, поскольку TImage не имеет свойства Handle, то есть не создает отдельного окна. Однако вывод на такие компоненты как раз отличается полной неустойчивостью, так что я не гарантирую Вам надежного положительного результата.

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

В конце сегодняшнего разговора я хочу привести еще несколько проектов, появившихся за это время из под моего пера и дополняющих "ЖиЛистую Delphi".




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

Автор: Nomadic

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

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

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


 ...
 type
 
   // Процедурные типы для хранения ссылок на функции плагинов
   TGetNProc = function: shortstring;
   TGetSProc = function: integer;
   TProcessProc = procedure(config: pointer; request: PRequest; var reply:
     PReply);
   TConfigProc = procedure(defcfg: PSysConfig; var config: pointer);
   TSaveLoadProc = procedure(inifile: pointer; var config: pointer);
 
   // Информация об отдельном плагине
   TPlugin = record
     Name: shortstring; // Полное название
     Filename: shortstring; // Имя файла
     Handle: integer; // Хэндл загруженной DLL
     CFGSize: integer; // Размер конфигурации в RAM
     ProcessProc: TProcessProc; // Адрес процедуры обработки
     ConfigProc: TConfigProc; // Адрес процедуры настройки
     LoadCFG, SaveCFG: TSaveLoadProc; // Адреса процедур чтения/записи cfg
   end;
   PPlugin = ^TPlugin;
 
   // Список загруженных плагинов
   TPlugins = class(TList);
 
   ...
 
 var
   Plugins: TPlugins;
   sr: TSearchRec;
   lib: integer;
   pgetn: TGetNProc;
   pgets: TGetSProc;
   plugin: PPlugin;
 
   ...
 
 // Читаем плагины и создаем их список.
 Plugins := TPlugins.Create;
 if FindFirst('*.dll', faAnyFile, sr) <> 0 then
 begin
 
   ShowMessage('Hе найдено подключаемых модулей.');
   Close;
 end;
 repeat
 
   lib := LoadLibrary(PChar(sr.Name));
   if lib <> 0 then
   begin
     @pgetn := GetProcAddress(lib, 'GetPluginName');
     if @pgetn = nil then
       FreeLibrary(lib) // Hе плагин
     else
     begin
       New(plugin);
       @pgets := GetProcAddress(lib, 'GetCFGSize');
       plugin.Name := pgetn;
       plugin.Filename := sr.Name;
       plugin.CFGSize := pgets;
       plugin.Handle := lib;
       plugin.ConfigProc := GetProcAddress(lib, 'Configure');
       plugin.ProcessProc := GetProcAddress(lib, 'Process');
       plugin.SaveCFG := GetProcAddress(lib, 'SaveCFG');
       plugin.LoadCFG := GetProcAddress(lib, 'LoadCFG');
       Plugins.Add(plugin);
     end;
   end;
 until FindNext(sr) <> 0;
 FindClose(sr);
 ...
 




Работа с портами под Windows, обзор и теория

Вступление

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

Проблема

Под MS-DOS приложение управляет всем компьютером. Это развязывало программисту руки. Достижение максимальной скорости работы осуществлялось непосредственным доступом к аппаратным средствам.

Под Windows 3.x эта свобода отчасти была ограничена. К примеру вы уже не имели полный доступ к экрану. Проблема объясняется легко: с тех пор, как пользователь мог запускать любое количество приложений, не было никакой гарантии, что приложения не получали одновременно те же самые аппаратные средства.

Другая проблема - вы уже должны были считаться с параллельно запущенными задачами, а не требовать у компьютера в свое распоряжение все ресурсы. Win 3.x осуществляет кооперацию параллельных задач, означая, что каждое приложение должно исходить из концепции совместного существования и не монополизировать ресурсы, а пользоваться услугами специализированного диспетчера. Захват CPU на длительное время здесь не приветствуется.

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

Факт, но тенденция отбивания рук от прямого доступа к железу победила на платформе Win32 (Windows NT и Windows 95). Это операционные системы с истинной многозадачностью. Каждый поток (выполняемый модуль) получает определенный квант процессорного времени. Когда лимит процессорного времени исчерпан, или появляется поток с более высоким приоритетом, система прекращает обслуживать первый поток, даже в случае, если он не завершен. Это переключение между потоками может произойти между двумя ассемблерными инструкциями, нет никакой гарантии, что поток сможет завершить определенное количество инструкций, прежде чем у него отнимут процессорное время, к тому же неизвестно как долго ждать следующей порции процессорного времени.

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


 mov dx, AddressPort
 mov al, Address
 out dx, al
 jmp Wait
 Wait:
 mov dx, DataPort
 in al, dx
 

Состояние всех регистров при переключении потоков сохраняется, состояние I/O портов (последовательные порты, порты ввода/вывода) - нет. Так, велика вероятность что другие приложения производят другие операции с I/O портом, в то время как вы "застряли" между инструкциями 'out' и 'in'.

Документированный путь

Для решения этой проблемы мы должны как-то сообщить всем другим приложениям, что "К настоящему времени MyProg использует порт 546, и всем оставаться на своих местах до моего особого распоряжения." В этом случае подешел бы мьютекс. К сожалению, для использования созданного мьютекса все приложения должны знать его имя. Но даже если бы это было возможно, вы легко можете наткнуться на другие заковыристые проблемы. Рассмотрим два приложения - App1 и App2. Оба пытаются выполнить вышеприведенный код. К несчастью, они созданы разными программистами с разным взглядом на технологию доступа, поэтому App1 сначала требует AddressPortMutex, в то время как App2 требует DataPortMutex. И, по печальному совпадению, когда App1 получает AddressPortMutex, система переключается на App2, которое захватывает DataPortMutex и получается праздник смертельного объятия. App2 не может получить адрес порта, т.к. его захватило App1. App1 не может получить данные порта, т.к. это захватило App2. И все чего-то ждут...

Правильное решение - создание драйвера устройства, которой единолично владеет портами/памятью. Доступ к аппаратным средствам осуществляется посредством API. Вот типичный вызов:


 GetIOPortData(AddressPort, DataPort : word) : Byte;
 

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

Создание драйвера устройства дело нелегкое. Он должен быть создать с помощью ассемблера или C и невероятно труден в отладке. Более того, из-за соображений безопасности драйверы устройств для Windows 95 (VxD) не совместимы с драйверами для Windows NT (VDD, virtual device driver - виртуальный драйвер устройства). Говорят, что в будущих версиях они будут совместимы, и Windows NT 6.0 и Windows 2000 будут использовать одни и те же драйвера, но пока разработчики вынуждены заниматься созданием двух различных версий.

Для получения более подробной информации рекомендую обратиться к следующим ресурсам:

Microsoft Windows 95 Device Driver Kit

Microsoft Windows NT Device Driver Kit

Microsoft Press "Systems Programming for Windows 95" автора Walter Oney

Также вы можете ознакомиться с библиотекой Vireo VtoolsD на предмет написания VxD в C, расположенной по адресу http://www.vireo.com.

Недокументированный путь

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

К счастью, в Windows 95 заложена совместимость с Windows 3.x. Это означает, что директивное использование I/O портов также возможно, поскольку до сих пор находятся в эксплуатации множество 16-битных программ, которые просто не могут работать по другому. Просто в этом случае при кодировании вам придется спуститься до уровня ассемблера. Автор следующего кода Arthur Hoornweg:


 function getport(p:word):byte; stdcall;
 begin
   asm
     push edx
     push eax
     mov  dx,p
     in   al,dx
     mov  @result,al
     pop  eax
     pop  edx
   end;
 end;
 
 
 
 Procedure Setport(p:word;b:byte);Stdcall;
 begin
   asm
     push edx
     push eax
     mov dx,p
     mov al,b
     out dx,al
     pop  eax
     pop  edx
   end;
 end;
 

François Piette также предлагает свое решение прямого доступа к портам I/O на страничке http://rtfm.netline.be/fpiette/portiofr.htm

Как насчет NT?

Но все вышесказанное под Windows NT работать не будет. NT более "прочная" операционная система, поэтому если она позволит в любое время кому попало обращаться к любым аппаратным средствам, она не была бы такой устойчивой. Кроме того, NT является кроссплатформенной системой, поэтому доступ к I/O портам может кардинально различаться при работе на различных процессорах.

Но тем не менее даже под NT можно добраться непосредственно до I/O портов, правда только на x86 процессорах. Это не является документированной особенностью, и, вероятно, исчезнет в будущих версиях этой операционной системы.

Я не обладаю достаточно полной информацией по этому вопросу, но интересующая нас статья D. Roberts в майском номере журнала Dr. Dobb's Journal за 1996 год так и называется "Direct Port I/O and Windows NT." К сожалению, я так и не нашел времени проверить приведенный там код. Статью и посвященный ей флейм вы можете почитать по адресу http://www.ddj.com.

Также рекомендую ознакомиться с опубликованной в Windows Developer Journal статьей "Port I/O under Windows." Опубликована Karen Hazzah в июне 1996 года. Статью и посвященный ей флейм вы можете найти по адресу http://www.wdj.com.

Ресурсы

(Примечание, я не очень много знаю об этих ресурсах, проверьте их пожалуйста сами.)

Существуют новостные группы, посвященные написанию VxD и VDD:

comp.os.ms-windows.programmer.nt.kernel-mode (VDD)

comp.os.ms-windows.programmer.vxd (VxD)

Dejanews (http://www.dejanews.com) выдает достаточно много результатов, если для поиска задать фразу 'device driver direct I/O access 95'.

Компания BlueWater Systems разработала OCX, осуществляющее прямой доступ к I/O портам, памяти и прерываниям, работающее под всеми Win32 платформами. Они также, кажется, предлагают изготовление драйверов устройств под заказ. Посмотрите их сервер по адресу http://www.bluewatersystems.com.

Я сляшал, что какая-то другая компания также рекламировала свои услуги в области разработчики VxD, но я не нашел их адреса.




Работа с принтером


Звонок в фирму, которая занимается ремонтом компьютеров:
- Мой принтер начал плохо печатать!
- Вероятно его надо просто почистить. Это стоит $50. Но для Вас будет лучше, если Вы прочтете инструкцию и выполните эту работу сами.
Клиент, удивленный такой откровенностью спрашивает:
- А Ваш босс знает, что Вы таким образом препятствуете бизнесу?
- На самом деле, это его идея. Мы получаем куда больше прибыли, когда позволяем нашим клиентам сначала самим попытаться что-то отремонтировать.

Delphi имеет стандартный объект для доступа к принтеру - TPRINTER, находящийся в модуле PRINTERS. В этом модуле имеется переменная Printer:Tpinter, что избавляет от необходимости описывать свою. Он позволяет выводить данные на печать и управлять процессом печати. Правда, в некоторых версиях Delphi 1 он имеет "глюк" - не работают функции Draw и StrethDraw. Но эта проблема поправима - можно использовать функции API. Далее приведены основные поля и методы объекта Printers :

СВОЙСТВА

  • Aborted: boolean - Показывает, что процесс печати прерван
  • Canvas: Tcanvas - Стандартный Canvas, как у любого графического объекта. Он позволяет рисовать на листе бумаге графику, выводить текст ... . Тут есть несколько особенностей, они описаны после описания объекта.
  • Fonts: Tstrings - Возвращает список шрифтов, поддерживаемых принтером
  • Handle: HDS - Получить Handle на принтер для использования функций API (см. Далее)
  • Orientation: TprinterOrientation - Ориентация листа при печати : (poPortrait, poLandscape)
  • PageHeight: integer - Высота листа в пикселах
  • PageNumber: integer - Номер страницы, увеличивается на 1 при каждом NewPage
  • PageWidth: integer - Ширина листа в пикселах
  • PrinterIndex: integer - Номер используемого принтера по списку доступных принтеров Printers
  • Printers: TStrings - Список доступных принтеров
  • Printing: boolean - Флаг, показывающий, что сейчас идет процесс печати
  • Title: String - Имя документа или приложения. Под этим именем задание на печать регистрируется в диспетчере печати

МЕТОДЫ

  • AssignPrn(f: TextFile) - Связать текстовый файл с принтером. Далее вывод информации в этот файл приводит к ее печати. Удобно в простейших случаях.
  • Abort - Сбросить печать
  • BeginDoc - Начать печать
  • NewPage - Начать новую страницу
  • EndDoc - Завершить печать.

Пример:


 procedure TForm1.Button1Click(Sender: TObject);
 begin
   with Printer do
   begin
     BeginDoc; { Начало печати }
     Canvas.Font:=label1.font; { Задали шрифт }
     Canvas.TextOut(100,100,'Это тест принтера !!!'); { Печатаем текст }
     EndDoc; { Конец печати }
   end;
 end;
 

Особенности работы с TPrinter

  1. После команды BeginDoc шрифт у Canvas принтера сбрасывается и его необходимо задавать заново
  2. Все координаты даны в пикселах, а для нормальной работы необходимы миллиметры (по двум очевидным причинам: очень трудно произвести разметку страницы в пикселах (особенно если необходима точность), и , главное, при изменении разрешающей способности принтера будет изменяться число точек на дюйм, и все координаты "поедут".
  3. У TPrinter информация о принтере, по видимому, определяются один раз - в момент запуска программы (или смены принтера). Поэтому изменение настроек принтера в процессе работы программы может привести к некорректной работе, например, неправильной печать шрифтов True Type.

Определение параметров принтера через API

Для определения информации о принтере (плоттере, экране) необходимо знать Handle этого принтера, а его можно узнать объекта TPrinter - Printer.Handle.

Далее вызывается функция API (unit WinProcs):


 GetDevice(Handle:HDC; Index:integer):integer;
 

Index - код параметра, который необходимо вернуть.

Для Index существует ряд констант :

  • DriverVersion - вернуть версию драйвера
  • Texnology - Технология вывода, их много, основные
  • dt_Plotter - плоттер
  • dt_RasPrinter - растровый принтер
  • dt_Display - дисплей
  • HorzSize - Горизонтальный размер листа (в мм)
  • VertSize - Вертикальный размер листа (в мм)
  • HorzRes - Горизонтальный размер листа (в пикселах)
  • VertRes - Вертикальный размер листа (в пикселах)
  • LogPixelX - Разрешение по оси Х в dpi (пиксел /дюйм)
  • LogPixelY - Разрешение по оси Y в dpi (пиксел /дюйм)

Кроме перечисленных еще около сотни, они позволяют узнать о принтере практически все. Параметры, возвращаемые по LogPixelX и LogPixelY очень важны - они позволяют произвести пересчет координат из миллиметров в пиксели для текущего разрешения принтера.

Пример таких функций:


 { Получить информацию о принтере }
 procedure TForm1.GetPrinterInfo;
 begin
   PixelsX:=GetDeviceCaps(printer.Handle, LogPixelsX);
   PixelsY:=GetDeviceCaps(printer.Handle, LogPixelsY);
 end;
 
 { переводит координаты из мм в пиксели }
 function TForm1.PrinterCoordX(x: integer): integer;
 begin
   PrinterCoordX:=round(PixelsX/25.4*x);
 end;
 
 { переводит координаты из мм в пиксели }
 function TForm1.PrinterCoordY(Y: integer): integer;
 begin
   PrinterCoordY:=round(PixelsY/25.4*Y);
 end;
 
 GetPrinterInfo;
 Printer.Canvas.TextOut(PrinterCoordX(30), PrinterCoordY(55),
 'Этот текст печатается с отступом 30 мм от левого края и '+
 '55 мм от верха при любом разрешении принтера');
 

Данную методику можно с успехом применять для печати картинок - зная размер картинки можно пересчитать ее размеры в пикселах для текущего разрешения принтера, масштабировать, и затем уже распечатать. Иначе на матричном принтере (180 dpi) картинка будет огромной, а на качественном струйнике (720 dpi) - микроскопической.

Я производил печать следующим образом:


 procedure TForm6.SpeedButton1Click(Sender: TObject);
 var
   PRect: Trect;
   PBitMap: TBitmap;
 begin
   PBitmap:=TBitMap.Create;
   PBitmap.LoadFromFile('C:\1.bmp');
   with PRect do
   begin
     left:=0;
     top:=0;
     right:=Printer.PageWidth;
     Bottom:=Printer.PageHeight;
   end;
   with printer do
   begin
     BeginDoc;
     font.name:='Times New Roman';
     Canvas.StretchDraw(PRect,Bitmap);
     EndDoc;
   end;
   PBitmap.Free;
 end;
 




Работа с последовательными портами


 //{$DEFINE COMM_UNIT}
 
 //Простой пример работы с последовательными портами
 //Код содержит интуитивно понятные комментарии и строки на шведском языке,
 //нецелесообразные для перевода.
 //Compiler maakt Simple_Comm.Dll of Simple_Com.Dcu afhankelijk van 1e Regel
 (COMM_UNIT)
 
 {$IFNDEF COMM_UNIT}
 library Simple_Comm;
 {$ELSE}
 unit Simple_Comm;
 interface
 {$ENDIF}
 
 uses Windows, Messages;
 
 const
   M_BaudRate = 1;
 const
   M_ByteSize = 2;
 const
   M_Parity = 4;
 const
   M_Stopbits = 8;
 
 {$IFNDEF COMM_UNIT}
 {$R Script2.Res} //versie informatie
 {$ENDIF}
 
 {$IFDEF COMM_UNIT}
 function Simple_Comm_Info: PChar; StdCall;
 function
   Simple_Comm_Open(Port: PChar; BaudRate: DWORD; ByteSize, Parity, StopBits:
     Byte; Mas
   k: Integer; WndHandle: HWND; WndCommand: UINT; var Id: Integer): Integer;
     StdCall;
 function Simple_Comm_Close(Id: Integer): Integer; StdCall;
 function
   Simple_Comm_Write(Id: Integer; Buffer: PChar; Count: DWORD): Integer; StdCall;
 function Simple_Comm_PortCount: DWORD; StdCall;
 
 const
   M_None = 0;
 const
   M_All = 15;
 
 implementation
 {$ENDIF}
 
 const
   InfoString = 'Simple_Comm.Dll (c) by E.L. Lagerburg 1997';
 const
   MaxPorts = 5;
 
 const
   bDoRun: array[0..MaxPorts - 1] of boolean
   = (False, False, False, False, False);
 const
   hCommPort: array[0..MaxPorts - 1] of Integer = (0, 0, 0, 0, 0);
 const
   hThread: array[0..MaxPorts - 1] of Integer = (0, 0, 0, 0, 0);
 const
   dwThread: array[0..MaxPorts - 1] of Integer = (0, 0, 0, 0, 0);
 const
   hWndHandle: array[0..MaxPorts - 1] of Hwnd = (0, 0, 0, 0, 0);
 const
   hWndCommand: array[0..MaxPorts - 1] of UINT = (0, 0, 0, 0, 0);
 const
   PortCount: Integer = 0;
 
 function Simple_Comm_Info: PChar; stdcall;
 begin
 
   Result := InfoString;
 end;
 
 //Thread functie voor lezen compoort
 
 function Simple_Comm_Read(Param: Pointer): Longint; stdcall;
 var
   Count: Integer;
 
   id: Integer;
   ReadBuffer: array[0..127] of byte;
 begin
 
   Id := Integer(Param);
   while bDoRun[id] do
   begin
     ReadFile(hCommPort[id], ReadBuffer, 1, Count, nil);
     if (Count > 0) then
     begin
       if ((hWndHandle[id] <> 0) and
         (hWndCommand[id] > WM_USER)) then
 
         SendMessage(hWndHandle[id], hWndCommand[id], Count,
           LPARAM(@ReadBuffer));
 
     end;
   end;
   Result := 0;
 end;
 
 //Export functie voor sluiten compoort
 
 function Simple_Comm_Close(Id: Integer): Integer; stdcall;
 begin
 
   if (ID < 0) or (id > MaxPorts - 1) or (not bDoRun[Id]) then
   begin
     Result := ERROR_INVALID_FUNCTION;
     Exit;
   end;
   bDoRun[Id] := False;
   Dec(PortCount);
   FlushFileBuffers(hCommPort[Id]);
   if not
     PurgeComm(hCommPort[Id], PURGE_TXABORT + PURGE_RXABORT + PURGE_TXCLEAR +
       PURGE_RXCL
     EAR) then
 
   begin
     Result := GetLastError;
     Exit;
   end;
   if WaitForSingleObject(hThread[Id], 10000) = WAIT_TIMEOUT then
     if not TerminateThread(hThread[Id], 1) then
     begin
       Result := GetLastError;
       Exit;
     end;
 
   CloseHandle(hThread[Id]);
   hWndHandle[Id] := 0;
   hWndCommand[Id] := 0;
   if not CloseHandle(hCommPort[Id]) then
   begin
     Result := GetLastError;
     Exit;
   end;
   hCommPort[Id] := 0;
   Result := NO_ERROR;
 end;
 
 procedure Simple_Comm_CloseAll; stdcall;
 var
   Teller: Integer;
 begin
 
   for Teller := 0 to MaxPorts - 1 do
   begin
     if bDoRun[Teller] then
       Simple_Comm_Close(Teller);
   end;
 end;
 
 function GetFirstFreeId: Integer; stdcall;
 var
   Teller: Integer;
 begin
 
   for Teller := 0 to MaxPorts - 1 do
   begin
     if not bDoRun[Teller] then
     begin
       Result := Teller;
       Exit;
     end;
   end;
   Result := -1;
 end;
 
 //Export functie voor openen compoort
 
 function
   Simple_Comm_Open(Port: PChar; BaudRate: DWORD; ByteSize, Parity, StopBits:
     Byte; Mas
   k: Integer; WndHandle: HWND; WndCommand: UINT; var Id: Integer): Integer;
     stdcall;
 
 var
   PrevId: Integer;
   ctmoCommPort: TCOMMTIMEOUTS; //Lees specificaties voor de compoort
   dcbCommPort: TDCB;
 begin
 
   if (PortCount >= MaxPorts) or (PortCount < 0) then
   begin
     result := error_invalid_function;
     exit;
   end;
   result := 0;
   previd := id;
   id := getfirstfreeid;
   if id = -1 then
   begin
     id := previd;
     result := error_invalid_function;
     exit;
   end;
   hcommport[id] := createfile(port, generic_read or
     generic_write, 0, nil, open_existing, file_attribute_normal, 0);
 
   if hcommport[id] = invalid_handle_value then
   begin
     bdorun[id] := false;
     id := previd;
     result := getlasterror;
     exit;
   end;
   //lees specificaties voor het comm bestand
   ctmocommport.readintervaltimeout := maxdword;
   ctmocommport.readtotaltimeoutmultiplier := maxdword;
   ctmocommport.readtotaltimeoutconstant := maxdword;
   ctmocommport.writetotaltimeoutmultiplier := 0;
   ctmocommport.writetotaltimeoutconstant := 0;
   //instellen specificaties voor het comm bestand
   if not setcommtimeouts(hcommport[id], ctmocommport) then
   begin
     bdorun[id] := false;
     closehandle(hcommport[id]);
     id := previd;
     result := getlasterror;
     exit;
   end;
   //instellen communicatie
   dcbcommport.dcblength := sizeof(tdcb);
   if not getcommstate(hcommport[id], dcbcommport) then
   begin
     bdorun[id] := false;
     closehandle(hcommport[id]);
     id := previd;
     result := getlasterror;
     exit;
   end;
   if (mask and m_baudrate <> 0) then
     dcbCommPort.BaudRate := BaudRate;
   if (Mask and M_ByteSize <> 0) then
     dcbCommPort.ByteSize := ByteSize;
   if (Mask and M_Parity <> 0) then
     dcbCommPort.Parity := Parity;
   if (Mask and M_Stopbits <> 0) then
     dcbCommPort.StopBits := StopBits;
   if not SetCommState(hCommPort[Id], dcbCommPort) then
   begin
     bDoRun[Id] := FALSE;
     CloseHandle(hCommPort[Id]);
     Id := PrevId;
     Result := GetLastError;
     Exit;
   end;
   //Thread voor lezen compoort
   bDoRun[Id] := TRUE;
 
   hThread[Id] := CreateThread(nil, 0, @Simple_Comm_Read, Pointer(Id), 0,
     dwThread[Id]
     );
 
   if hThread[Id] = 0 then
   begin
     bDoRun[Id] := FALSE;
     CloseHandle(hCommPort[Id]);
     Id := PrevId;
     Result := GetLastError;
     Exit;
   end
   else
   begin
     SetThreadPriority(hThread[Id], THREAD_PRIORITY_HIGHEST);
     hWndHandle[Id] := WndHandle;
     hWndCommand[Id] := WndCommand;
     Inc(PortCount);
     Result := NO_ERROR;
   end;
 end;
 
 //Export functie voor schrijven naar compoort;
 
 function
   Simple_Comm_Write(Id: Integer; Buffer: PChar; Count: DWORD): Integer; stdcall;
 var
   Written: DWORD;
 begin
 
   if (Id < 0) or (id > Maxports - 1) or (not bDoRun[Id]) then
   begin
     Result := ERROR_INVALID_FUNCTION;
     Exit;
   end;
   if not WriteFile(hCommPort[Id], Buffer, Count, Written, nil) then
   begin
     Result := GetLastError();
     Exit;
   end;
   if (Count <> Written) then
     Result := ERROR_WRITE_FAULT
   else
     Result := NO_ERROR;
 end;
 
 //Aantal geopende poorten voor aanroepende applicatie
 
 function Simple_Comm_PortCount: DWORD; stdcall;
 begin
 
   Result := PortCount;
 end;
 
 {$IFNDEF COMM_UNIT}
 exports
 
   Simple_Comm_Info Index 1,
   Simple_Comm_Open Index 2,
   Simple_Comm_Close Index 3,
   Simple_Comm_Write Index 4,
   Simple_Comm_PortCount index 5;
 
 procedure DLLMain(dwReason: DWORD);
 begin
 
   if dwReason = DLL_PROCESS_DETACH then
     Simple_Comm_CloseAll;
 end;
 
 begin
 
   DLLProc := @DLLMain;
   DLLMain(DLL_PROCESS_ATTACH); //geen nut in dit geval
 end.
 
 {$ELSE}
 initialization
 finalization
 
   Simple_Comm_CloseAll;
 end.
 {$ENDIF}
 
 Другое решение: создание модуля I / O(ввода / вывода)под Windows 95 / NT.Вот он:
   )
 
 (с TDCB в SetCommStatus вы можете управлять DTR и т.д.)
 (Примечание: XonLim и XoffLim не должны быть больше 600, иначе под NT это
   работает неправильно)
 
 unit My_IO;
 
 interface
 
 function OpenComm(InQueue, OutQueue, Baud: LongInt): Boolean;
 function SetCommTiming: Boolean;
 function SetCommBuffer(InQueue, OutQueue: LongInt): Boolean;
 function SetCommStatus(Baud: Integer): Boolean;
 function SendCommStr(S: string): Integer;
 function ReadCommStr(var S: string): Integer;
 procedure CloseComm;
 
 var
 
   ComPort: Word;
 
 implementation
 
 uses Windows, SysUtils;
 
 const
 
   CPort: array[1..4] of string = ('COM1', 'COM2', 'COM3', 'COM4');
 
 var
 
   Com: THandle = 0;
 
 function OpenComm(InQueue, OutQueue, Baud: LongInt): Boolean;
 begin
 
   if Com > 0 then
     CloseComm;
   Com := CreateFile(PChar(CPort[ComPort]),
     GENERIC_READ or GENERIC_WRITE,
     0, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
   Result := (Com > 0) and SetCommTiming and
     SetCommBuffer(InQueue, OutQueue) and
     SetCommStatus(Baud);
 end;
 
 function SetCommTiming: Boolean;
 var
 
   Timeouts: TCommTimeOuts;
 
 begin
 
   with TimeOuts do
   begin
     ReadIntervalTimeout := 1;
     ReadTotalTimeoutMultiplier := 0;
     ReadTotalTimeoutConstant := 1;
     WriteTotalTimeoutMultiplier := 2;
     WriteTotalTimeoutConstant := 2;
   end;
   Result := SetCommTimeouts(Com, Timeouts);
 end;
 
 function SetCommBuffer(InQueue, OutQueue: LongInt): Boolean;
 begin
 
   Result := SetupComm(Com, InQueue, OutQueue);
 end;
 
 function SetCommStatus(Baud: Integer): Boolean;
 var
 
   DCB: TDCB;
 
 begin
 
   with DCB do
   begin
     DCBlength := SizeOf(Tdcb);
     BaudRate := Baud;
     Flags := 12305;
     wReserved := 0;
     XonLim := 600;
     XoffLim := 150;
     ByteSize := 8;
     Parity := 0;
     StopBits := 0;
     XonChar := #17;
     XoffChar := #19;
     ErrorChar := #0;
     EofChar := #0;
     EvtChar := #0;
     wReserved1 := 65;
   end;
   Result := SetCommState(Com, DCB);
 end;
 
 function SendCommStr(S: string): Integer;
 var
 
   TempArray: array[1..255] of Byte;
   Count, TX_Count: Integer;
 
 begin
 
   for Count := 1 to Length(S) do
     TempArray[Count] := Ord(S[Count]);
   WriteFile(Com, TempArray, Length(S), TX_Count, nil);
   Result := TX_Count;
 end;
 
 function ReadCommStr(var S: string): Integer;
 var
 
   TempArray: array[1..255] of Byte;
   Count, RX_Count: Integer;
 
 begin
 
   S := '';
   ReadFile(Com, TempArray, 255, RX_Count, nil);
   for Count := 1 to RX_Count do
     S := S + Chr(TempArray[Count]);
   Result := RX_Count;
 end;
 
 procedure CloseComm;
 begin
 
   CloseHandle(Com);
   Com := -1;
 end;
 
 end.
 




Работа с последовательными портами 2

Если вам нужно что-то РЕАЛЬНОЕ, то попробуйте это. Можете только добавить проверку на ошибки.

<<Книги>> Serial Communications: A C++ Developer's Guide by Mark Nelson, M&T Books.

Правда, по большей части это про DOS, а Windows посвящена только одна глава. Проверьте это.


 unit Comm;
 interface
 
 uses
   SysUtils, WinTypes, WinProcs, Messages, Classes, Forms;
 
 type
   TCommEvent = procedure(Sender: TObject; Data: Char) of object;
   TCommErrEvent = procedure(Sender: TObject; Error: Integer) of object;
   TComm = class(TComponent)
   private
     Wnd: HWND;
     DCB: TDCB;
     CommID: Integer;
     Buf: array[0..2048] of char;
     NumChars: Integer;
     FOnCommErr: TCommErrEvent;
     FOnCommRecvd: TCommEvent;
     procedure CommWndProc(var Message: TMessage);
   public
     function Send(data: Char): Boolean;
     function Connect: Boolean;
     constructor Create(AOwner: TComponent); override;
     destructor destroy; override;
   published
     property OnCommErr: TCommErrEvent read FOnCommErr write FOnCommErr;
     property OnCommRecvd: TCommEvent read FOnCommRecvd write FOnCommRecvd;
   end;
 procedure Register;
 implementation
 
 constructor TComm.Create(AOwner: TComponent);
 begin
 
   inherited Create(AOwner);
   Wnd := AllocateHwnd(CommWndProc);
 end;
 
 procedure TComm.CommWndProc(var Message: TMessage);
 var
 
   Error, count: Integer;
   Stat: TComStat;
 begin
 
   if Message.Msg = WM_COMMNOTIFY then
   begin
     Message.Result := 0;
     GetCommEventMask(CommId, $3FFF);
     NumChars := ReadComm(CommID, @Buf, 2048);
     Error := GetCommError(CommId, Stat);
     if Error = 0 then
     begin
       if Assigned(FOnCommRecvd) then
       begin
         for count := 0 to NumChars - 1 do
           FOnCommRecvd(Self, Buf[count]);
       end;
     end
     else
     begin
       if Assigned(FOnCommErr) then
       begin
         FOnCommErr(Self, Error);
       end;
     end;
   end;
 end;
 
 function TComm.Send(data: Char): Boolean;
 var
 
   Error: Integer;
 begin
 
   Error := TransmitCommChar(CommId, data);
   if Error < 0 then
     Result := False
   else
     Result := True;
 end;
 
 function TComm.Connect: Boolean;
 var
 
   Config: array[0..20] of Char;
 begin
 
   CommId := OpenComm('COM2', 2048, 2048);
   StrCopy(Config, 'com2:96,n,8,1'); {Здесь меняем настройки порта}
   BuildCommDCB(Config, DCB);
   DCB.ID := CommId;
   SetCommState(DCB);
   EnableCommNotification(CommID, Wnd, 1, -1);
   SetCommEventMask(CommId, ev_RXChar);
   Result := True;
 end;
 
 destructor TComm.destroy;
 begin
 
   CloseComm(CommID);
   DeallocateHwnd(Wnd);
   inherited destroy;
 end;
 
 procedure Register;
 begin
 
   RegisterComponents('Samples', [TComm]);
 end;
 end.
 




Как работать со всеми ячейками таблицы в WebBrowsere

- Избавиться от интернет-зависимости очень легко! У нас в чате все проделывали это по нескольку раз.

Пример показывает как добавить содержимое каждой ячейки в TMemo:


 procedure TForm1.Button1Click(Sender: TObject);
 var
   i, j: integer;
   ovTable: OleVariant;
 begin
   // Use first table
   ovTable := WebBrowser1.OleObject.Document.all.tags('TABLE').item(0);
 
   for i := 0 to (ovTable.Rows.Length - 1) do
   begin
     for j := 0 to (ovTable.Rows.Item(i).Cells.Length - 1) do
     begin
       Memo1.Lines.Add(ovTable.Rows.Item(i).Cells.Item(j).InnerText;
     end;
   end;
 end;
 
 




Не работает функция Writeln

Для того, чтобы Delphi "увидела" функцию Writeln, включите WinCrt в список используемых модулей.




Пишем свой текст в Меню

Когда играешь во встроенную в Windows игру freecell, то справа в меню постоянно пишется сколько осталось карт. Давайте посмотрим, как это делается.

Перво наперво положим компонент главного меню на форму. Теперь установим свойство OwnerDraw в true. Далее создайте, то что Вы хотите вырисовывать в меню и создайте OnDrawItem. И добавьте в него следующую строку:


 ACanvas.TextOut(1, ARect.Top + 1, 'I''m in the MainMenuDrawbar');
 

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

Если Вы используете Delphi 2,3 пользуйтесь сообщениями WM_MESUREITEM и WM_DRAWITEM, чтобы сделать данный эффект.




Пишем ScreenSaver в Delphi


Пpогpаммеpы квасят на пpиpоде. Идут pазговоpы, тpали-вали... Один pассказывает: - Познакомился тут с девушкой на дискотеке! Бесподобная деваха! И фигуpка, и мозги есть, и танцует хоpошо! Так вот, pешил pickup"нуть ее к себе домой. Пpигласил, она согласилась. Пpишли, выпили винца, поговоpили о том, о сем, музыку послушали. Потом я ее поцеловал, пpиподнял аккуpатно, посадил задницей на клавиатуpу, поднял юбку... Остальные: - Так у тебя компутеp дома стоит?!?! А какой???

В примере описывается создание простейшего скринсейвера, а так же его установка и запуск.

Для написания скринсейвера нам необходимо включить следующие процедуры:

FormShow
скрыть курсор, установка обработки сообщений, начало отображения скринсейвера
FormHide
окончание отображения скринсейвера, отображение курсора
DeactivateScrSaver
обработка сообщений, деактивирование, если нажата мышка или клавиатура

Типичный код для этих процедур показан ниже.

Вы должны быть уверены, что Ваша форма создана со стилем fsStayOnTop. Вы так же должны быть уверены, что только один экземпляр Вашей программы будет запущен в системе. И в заключении Вам необходимо включить директиву компилятора {$D "Programname Screensaver"} в Ваш проект (*.dpr).

После того, как Вы скомпилируете программу, измените расширение файла на SCR и скопируйте его в Вашу системную папку \WINDOWS\SYSTEM .


 var
   crs : TPoint; {первоначально расположение курсора мышки}
 
 procedure TScrForm.FormShow(Sender: TObject);
 {starts the screensaver}
 begin
   WindowState := wsMaximized; {окошко будет на полный экран}
   GetCursorPos(crs); {получаем позицию курсора}
   Application.OnMessage := DeactivateScrSaver; {проверяем мышку/клавиатуру}
   ShowCursor(false); {скрываем курсор}
   {начинаем отображение скринсейвера...}
   //
 end; {процедура TScrForm.FormShow}
 
 procedure TScrForm.FormHide(Sender: TObject);
 {возвращаем управление пользователю}
 begin
   Application.OnMessage := nil; {запрещаем сообщения}
   {останавливаем скринсейвер...}
   //
   ShowCursor(true); {возвращаем курсор назад}
 end; {procedure TScrForm.FormHide}
 
 procedure TScrForm.DeactivateScrSaver(var Msg : TMsg; var Handled : boolean);
 {определение движения мышки или нажатия на клавиатуре}
 var
   done: boolean;
 begin
   if Msg.message = WM_MOUSEMOVE then {сдвинулась мышка}
     done := (Abs(LOWORD(Msg.lParam) - crs.x) > 5) or
     (Abs(HIWORD(Msg.lParam) - crs.y) > 5)
   else {key / mouse нажаты?}
     done := (Msg.message = WM_KEYDOWN) or (Msg.message = WM_KEYUP) or
     (Msg.message = WM_SYSKEYDOWN) or (Msg.message = WM_SYSKEYUP) or
     (Msg.message = WM_ACTIVATE) or (Msg.message = WM_NCACTIVATE) or
     (Msg.message = WM_ACTIVATEAPP) or (Msg.message = WM_LBUTTONDOWN) or
     (Msg.message = WM_RBUTTONDOWN) or (Msg.message = WM_MBUTTONDOWN);
   if done then
     Close;
 end; {procedure TScrForm.DeactivateScrSaver}
 




Написание программ на чистом API


 program SmallPrg;
 
 uses
   Windows, Messages;
 
 const
   WinName = 'MainWClass';
 
 function MainWndProc(Window: HWnd; AMessage, WParam, LParam: Longint): Longint; stdcall;
 begin
   //подпрограмма обработки сообщений
   case AMessage of
     WM_DESTROY:
     begin
       PostQuitMessage(0);
       Result := 0;
       Exit;
     end;
     else
       Result := DefWindowProc(Window, AMessage, WParam, LParam);
   end;
 end;
 
 function InitApplication: Boolean;
 var
   wcx: TWndClass;
 begin
   //Заполняем структуру TWndClass
   // перерисовываем, если размер изменяется
   wcx.style := CS_HREDRAW or CS_VREDRAW;
   // адрес оконной процедуры
   wcx.lpfnWndProc := @MainWndProc;
   wcx.cbClsExtra := 0;
   wcx.cbWndExtra := 0;
   // handle to instance
   wcx.hInstance := hInstance;
   // загружаем стандандартную иконку
   wcx.hIcon := LoadIcon(0, IDI_APPLICATION);
   // загружаем стандартный курсор
   wcx.hCursor := LoadCursor(0, IDC_ARROW);
   // делаем светло-cерый фон
   wcx.hbrBackground := COLOR_WINDOW;
   // пока нет главного меню
   wcx.lpszMenuName := nil;
   // имя класса окна
   wcx.lpszClassName := PChar(WinName);
 
   // Регистрируем наш класс окна.
   Result := RegisterClass(wcx) <> 0;
 end;
 
 function InitInstance: HWND;
 begin
   // Создаем главное окно.
   Result := CreateWindow(
   // имя класса окна
   PChar(WinName),
   // заголовок
   'Small program',
   // стандартный стиль окна
   WS_OVERLAPPEDWINDOW,
   // стандартные горизонтальное, вертикальное положение, ширина и высота
   Integer(CW_USEDEFAULT),
   Integer(CW_USEDEFAULT),
   Integer(CW_USEDEFAULT),
   Integer(CW_USEDEFAULT),
   0,//нет родительского окна
   0,//нет меню
   hInstance, // handle to application instance
   nil); // no window-creation data
 end;
 
 var
   hwndMain: HWND;
   AMessage: msg;
 begin
   if (not InitApplication) then
     MessageBox(0, 'Ошибка регистрации окна', nil, mb_Ok)
   else
   begin
     hwndMain := InitInstance;
     if (hwndMain = 0) then
       MessageBox(0, 'Ошибка создания окна', nil, mb_Ok)
     else
     begin
       // Показываем окно и посылаем сообщение WM_PAINT оконной процедуре
       ShowWindow(hwndMain, CmdShow);
       UpdateWindow(hwndMain);
       while (GetMessage(AMessage, 0, 0, 0)) do
       begin
         TranslateMessage(AMessage);
         DispatchMessage(AMessage);
       end;
     end;
   end;
 
 end.
 




Написание программ на чистом API 2

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

Для этого нам необходимо:


 // 1. Зарегистрировать класс окна для окна главной формы.
 
 function InitApplication: Boolean;
 var
   wcx: TWndClass;
 begin
 //Заполняем структуру TWndClass
     // перерисовываем, если размер изменяется
     wcx.style := CS_HREDRAW or CS_VREDRAW;
     // адрес оконной процедуры
     wcx.lpfnWndProc := @MainWndProc;
     wcx.cbClsExtra := 0;
     wcx.cbWndExtra := 0;
     // handle to instance
     wcx.hInstance := hInstance;
     // загружаем стандандартную иконку
     wcx.hIcon := LoadIcon(0, IDI_APPLICATION);
     // загружаем стандартный курсор
     wcx.hCursor := LoadCursor(0, IDC_ARROW);
     // делаем светло-cерый фон
     wcx.hbrBackground := COLOR_WINDOW;
     // пока нет главного меню
     wcx.lpszMenuName :=  nil;
     // имя класса окна
     wcx.lpszClassName := PChar(WinName);
 
     // Регистрируем наш класс окна.
     Result := RegisterClass(wcx) <> 0;
 end;
 
 // 2. Написать подпрограмму обработки оконных сообщений.
 
 function MainWndProc(Window: HWnd; AMessage, WParam,
                     LParam: Longint): Longint; stdcall; export;
 begin
   //подпрограмма обработки сообщений
   case AMessage of
     WM_DESTROY: begin
       PostQuitMessage(0);
       Exit;
     end;
     else
        Result := DefWindowProc(Window, AMessage, WParam, LParam);
   end;
 end;
 
 // 3. Создать главное окно приложения.
 
 function InitInstance: HWND;
 begin
   // Создаем главное окно.
   Result := CreateWindow(
    // имя класса окна
    PChar(WinName),
    // заголовок
    'Small program',
    // стандартный стиль окна
    WS_OVERLAPPEDWINDOW,
    // стандартные горизонтальное, вертикальное положение, ширина и высота
    Integer(CW_USEDEFAULT),
    Integer(CW_USEDEFAULT),
    Integer(CW_USEDEFAULT),
    Integer(CW_USEDEFAULT),
    0,//нет родительского окна
    0,//нет меню
    hInstance, // handle to application instance
    nil);      // no window-creation data
 end;
 
 // 4. Написать тело программы.
 
 var
   hwndMain: HWND;
   AMessage: msg;
 begin
     if (not InitApplication) then
     begin
       MessageBox(0, 'Ошибка регистрации окна', nil, mb_Ok);
       Exit;
     end;
     hwndMain := InitInstance;
     if (hwndMain = 0) then
     begin
       MessageBox(0, 'Ошибка создания окна', nil, mb_Ok);
       Exit;
     end
     else
     begin
       // Показываем окно и посылаем сообщение WM_PAINT оконной процедуре
       ShowWindow(hwndMain, CmdShow);
       UpdateWindow(hwndMain);
     end;
     while (GetMessage(AMessage, 0, 0, 0)) do
     begin
       //Запускаем цикл обработки сообщений
       TranslateMessage(AMessage);
       DispatchMessage(AMessage);
     end;
     Halt(AMessage.wParam);
 end.
 // 5. Запустить программу на исполнение. ;)
 

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

Здесь находится полный текст программы.


 program SmallPrg;
 
 uses Windows,  Messages;
 
 const
   WinName = 'MainWClass';
 
 function MainWndProc(Window: HWnd; AMessage, WParam,
                     LParam: Longint): Longint; stdcall; export;
 begin
   //подпрограмма обработки сообщений
   case AMessage of
     WM_DESTROY: begin
       PostQuitMessage(0);
       Exit;
     end;
     else
        Result := DefWindowProc(Window, AMessage, WParam, LParam);
   end;
 end;
 
 function InitApplication: Boolean;
 var
   wcx: TWndClass;
 begin
 //Заполняем структуру TWndClass
     // перерисовываем, если размер изменяется
     wcx.style := CS_HREDRAW or CS_VREDRAW;
     // адрес оконной процедуры
     wcx.lpfnWndProc := @MainWndProc;
     wcx.cbClsExtra := 0;
     wcx.cbWndExtra := 0;
     // handle to instance
     wcx.hInstance := hInstance;
     // загружаем стандандартную иконку
     wcx.hIcon := LoadIcon(0, IDI_APPLICATION);
     // загружаем стандартный курсор
     wcx.hCursor := LoadCursor(0, IDC_ARROW);
     // делаем светло-cерый фон
     wcx.hbrBackground := COLOR_WINDOW;
     // пока нет главного меню
     wcx.lpszMenuName :=  nil;
     // имя класса окна
     wcx.lpszClassName := PChar(WinName);
 
     // Регистрируем наш класс окна.
     Result := RegisterClass(wcx) <> 0;
 end;
 
 function InitInstance: HWND;
 begin
   // Создаем главное окно.
   Result := CreateWindow(
    // имя класса окна
    PChar(WinName),
    // заголовок
    'Small program',
    // стандартный стиль окна
    WS_OVERLAPPEDWINDOW,
    // стандартные горизонтальное, вертикальное положение, ширина и высота
    Integer(CW_USEDEFAULT),
    Integer(CW_USEDEFAULT),
    Integer(CW_USEDEFAULT),
    Integer(CW_USEDEFAULT),
    0,//нет родительского окна
    0,//нет меню
    hInstance, // handle to application instance
    nil);      // no window-creation data
 end;
 
 var
   hwndMain: HWND;
   AMessage: msg;
 begin
     if (not InitApplication) then
     begin
       MessageBox(0, 'Ошибка регистрации окна', nil, mb_Ok);
       Exit;
     end;
     hwndMain := InitInstance;
     if (hwndMain = 0) then
     begin
       MessageBox(0, 'Ошибка создания окна', nil, mb_Ok);
       Exit;
     end
     else
     begin
       // Показываем окно и посылаем сообщение WM_PAINT оконной процедуре
       ShowWindow(hwndMain, CmdShow);
       UpdateWindow(hwndMain);
     end;
     while (GetMessage(AMessage, 0, 0, 0)) do
     begin
       //Запускаем цикл обработки сообщений
       TranslateMessage(AMessage);
       DispatchMessage(AMessage);
     end;
     Halt(AMessage.wParam);
 end.
 




Как писать Win32API приложения на Delphi

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

Главная пробема, возникающая при написании WinAPI приложений - это неудобство ручного создания всех окон приложения. Требуется вызывать функцию CreateWindow для каждого (в том числе и дочернго) окна программы, а затем еще и менять шрифт в некоторых из них. Лучшим на мой взгляд выходом из этой ситуации является использование ресурсов диалоговых окон (dialog box resources) для соэдания всех окон приложения. В этой статье я расскажу как это делается в Delphi на примере простоо приложения с одним главным и двумя (модальными) окнами.

Шаг 1. Создание ресурсов диалоговых окон

Для создания ресурсов я использовал редактор ресурсов из состава Borland C++ 5.02, и поэтому все скриншоты сделаны с него. В Borland Resource Workshop 4.5 все почти аналогично. Создаем главное окно, вот его код:


 500 DIALOGEX 0, 0, 240, 117
 EXSTYLE WS_EX_DLGMODALFRAME | WS_EX_APPWINDOW | WS_EX_CLIENTEDGE
 STYLE DS_MODALFRAME | DS_3DLOOK | DS_CENTER | WS_OVERLAPPED | WS_VISIBLE | WS_CAPTION |
 WS_SYSMENU | WS_MINIMIZEBOX
 class "WndClass1"
 CAPTION "Главное окно приложения"
 MENU 300
 FONT 8, "MS Sans Serif", 400, 0
 LANGUAGE LANG_RUSSIAN , 0
 {
 CONTROL "OK", IDOK, "BUTTON", BS_DEFPUSHBUTTON | BS_CENTER | WS_CHILD | WS_VISIBLE | WS_TABSTOP,
 19, 94, 50, 14, WS_EX_CLIENTEDGE
 CONTROL "Cancel", IDCANCEL, "BUTTON", BS_PUSHBUTTON | BS_CENTER | WS_CHILD | WS_VISIBLE | WS_TABSTOP,
 96, 94, 50, 14, WS_EX_CLIENTEDGE
 CONTROL "Help", IDHELP, "BUTTON", BS_PUSHBUTTON | BS_CENTER | WS_CHILD | WS_VISIBLE | WS_TABSTOP,
 172, 94, 50, 14, WS_EX_CLIENTEDGE
 CONTROL "Группа", -1, "button", BS_GROUPBOX | BS_RIGHT | WS_CHILD | WS_VISIBLE | WS_GROUP,
 20, 9, 100, 76
 CONTROL "Кнопка 1", 105, "button", BS_AUTORADIOBUTTON | WS_CHILD | WS_VISIBLE | WS_TABSTOP,
 28, 21, 60, 12
 CONTROL "Кнопка 2", 106, "button", BS_AUTORADIOBUTTON | WS_CHILD | WS_VISIBLE | WS_TABSTOP,
 28, 37, 60, 12
 CONTROL "Кнопка 3", 107, "button", BS_AUTORADIOBUTTON | WS_CHILD | WS_VISIBLE | WS_TABSTOP,
 28, 53, 60, 12
 CONTROL "ListBox1", 108, "listbox", LBS_NOTIFY | LBS_SORT | LBS_NOINTEGRALHEIGHT | WS_CHILD |
 WS_VISIBLE | WS_BORDER | WS_TABSTOP,
 132, 13, 92, 72
 }
 

Обратите внимание на поле CLASS. В нем должно стоять то же значение, что и в поле lpszClassName записи TWndClassEx основной программы. В редакторе ресурсов значение этого поля можно изменить в окне свойств ресурса. В Borland C++ оно выглядит так:

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

Шаг 2. Основная программа

Текст программы в нашем случае несколько отличается от текста, например, winmin. Регистрация оконного класса:


 wc.cbSize:=sizeof(wc);
 wc.style:=cs_hredraw or cs_vredraw;
 wc.lpfnWndProc:=@WindowProc;
 wc.cbClsExtra:=0;
 wc.cbWndExtra:=DLGWINDOWEXTRA;
 wc.hInstance:=HInstance;
 wc.hIcon:=LoadIcon(hInstance, 'MAINICON');
 wc.hCursor:=LoadCursor(0,idc_arrow);
 wc.hbrBackground:=COLOR_BTNFACE+1;
 wc.lpszMenuName:=nil;
 wc.lpszClassName:='WndClass1';
 
 RegisterClassEx(wc);
 

Обратите внимание, что в поле cbWindowExtra стоит константа DLGWINDOWEXTRA, если бы её там не было, нам не удалось бы создать главное окно, основанное на ресурсе Dialog Box. Кроме того, в поле lpszClassName стоит то же значение, что и в соответствующем поле описания ресурса окна.

Итак, класс создан и зарегистрирован, теперь создаем главное окно из ресурса:


 MainWnd:=CreateDialog(hInstance, '#500', 0, nil);
 

Напоминаю, что '#500' значит имя ресурса окна. Не забудьте подключить откомпилированный файл сценария ресурса к программе при помощи директивы {$r ...}

Шаг 3. Оконная функция

Оконная функция ничем не отличается от обычной:


 function WindowProc(wnd:HWND; Msg : Integer; Wparam:Wparam;
          Lparam: Lparam): Lresult; stdcall;
 var
   nCode, ctrlID, size: word;
   pt: TPoint;
   s: string;
 begin
   case msg of
   wm_command:
   begin
     nCode:=hiWord(wParam);
     ctrlID:=loWord(wParam);
     case ctrlID of
       IDHELP:
       begin
         DialogBox(hInstance,'#501',wnd,@DialogFunc);
       end;
       IDOK:
       begin
         DialogBoxParam(hInstance,'#503',wnd,@DialogFunc2, Integer(pd));
         s := 'Login: '+pd^.login;
         s := s + ' ' + 'Pass: '+pd^.pass;
         ListBox_AddString(lb, s);
       end;
       IDCANCEL:
       begin
         DestroyWindow(wnd);
       end;
     end;
   end;
 
   wm_destroy :
   begin
     Dispose(pd);
     postquitmessage(0); exit;
     Result:=0;
   end;
   else
     Result := DefWindowProc(wnd, msg, wparam, lparam);
   end;
 end;
 

Шаг 4. Цикл сбора сообщений

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


 while GetMessage(Mesg, 0, 0, 0) do
 begin
   if mainWnd<>0 then
     if IsDialogMessage(mainWnd,Mesg) then
       continue;
   TranslateMessage(Mesg);
   DispatchMessage(Mesg);
 end;
 

После нажатия кнопки "ОК" появляется еще одно окно. Если в нем ввести текст и нажать "ОК", этот текст будет добавлен в Listbox.




Что нужно давать WSAAsyncSelect в качестве параметра handle

Автор: Nomadic

Что нужно давать WSAAsyncSelect в качестве параметра handle, если тот запускается и используется в dll (init), и никакой формы (у которой можно было бы взять этот handle) в этой dll не создается?


 const
   WM_ASYNCSELECT = WM_USER + 0;
 
 type
   TNetConnectionsManager = class(TObject)
   protected
     FWndHandle: HWND;
     procedure WndProc(var MsgRec: TMessage);
     ...
   end;
 
 constructor TNetConnectionsManager.Create
 begin
   inherited Create;
   FWndHandle := AllocateHWnd(WndProc);
   ...
 end;
 
 destructor TNetConnectionsManager.Destroy;
 begin
   ...
     if FWndHandle <> 0 then
     DeallocateHWnd(FWndHandle);
   inherited Destroy;
 end;
 
 procedure TNetConnectionsManeger.WndProc(var MsgRec: TMessage);
 begin
   with MsgRec do
     if Msg = WM_ASYNCSELECT then
       WMAsyncSelect(MsgRec)
     else
       DefWindowProc(FWndHandle, Msg, wParam, lParam);
 end;
 

Hо pекомендую посмотpеть WinSock2, в котоpом можно:


 WSAEventSelect( FSocket, FEventHandle, FD_READ or FD_CLOSE );
 WSAWaitForMultipleEvents( ... );
 WSAEnumNetworkEvents( FSocket, FEventHandle, lpNetWorkEvents );
 

То есть, обойтись без окон и без очеpеди сообщений windows, а заодно иметь возможность pаботать и с IPX/SPX, и с netbios.




Включить Drop Shadow Effect окна в XP

- Какая разница между вирусом и Windows XP?
- Вирус стабильнее работает.


 type
   TForm1 = class(TForm)
   protected
     procedure CreateParams(var Params: TCreateParams); override;
   end;
 
 var
   Form1: TForm1;
 
 implementation
 
 {$R *.dfm}
 
 procedure TForm1.CreateParams(var Params: TCreateParams);
 const
   CS_DROPSHADOW = $00020000;
 begin
   inherited;
   Params.WindowClass.Style := Params.WindowClass.Style or CS_DROPSHADOW;
 end;
 




Управляющий протокол SNMP

ICQ - мощное средство международного сношения.

Internet - гигантская сеть. Напрашивается вопрос, как она сохраняет свою целостность и функциональность без единого управления? Если учесть разнородность ЭВМ, маршрутизаторов и программного обеспечения, используемых в сети, само существование Internet представится просто чудом. Так все же как решаются проблемы управления в Internet? Отчасти на этот вопрос уже дан ответ - сеть сохраняет работоспособность благодаря жесткой протокольной регламентации.

"Запас прочности" заложен в самих протоколах. Функции диагностики возложены, на протокол ICMP. Учитывая важность функции управления, для этих целей создано два протокола SNMP ( Simple Network Management Protocol - 1988г. ) и CMOT ( Common Management Information Services and Protocol over TCP/IP). Чаще всего управляющая прикладная программа воздействует на сеть по цепочке SNMP-UDP-IP-физическая_сеть. Наиболее важным объектом управления обычно является внешний порт сети или маршрутизатор. Каждому управляемому объекту присваивается уникальный идентификатор.

Протокол SNMP работает на базе протокола UDP и предназначен для использования сетевыми управляющими станциями. Он позволяет управляющим станциям собирать информацию о положении в сети Internet. Протокол определяет формат данных, их обработка и интерпретация остаются на усмотрение управляющих станций или менеджера сети. SNMP-сообщения не имеют фиксированного формата и фиксированных полей. При работе протокол SNMP использует управляющую базу данных (MIB — Management Information Base, RFC-1213,-1212).

Алгоритмы управления в Internet обычно описывают в нотации ASN.1 (Abstract Syntax Notation). Все объекты в Internet разделены на 10 групп и описаны в MIB: система, интерфейсы, обмены, трансляция адресов, IP, ICMP, TCP, UDP, EGP, SNMP. В группу "система" входит название и версия оборудования, операционной системы, сетевого программного обеспечения и пр. В группу "интерфейсы" входит число поддерживаемых интерфейсов, тип интерфейса, работающего под управлением IP (Ethernet, LAPB и т.д.), размер дейтограмм, скорость обмена, адрес интерфейса. IP-группа включает время жизни дейтограмм, информацию о фрагментации, маски субсетей и т.д. В TCP-группу входит алгоритм повторной пересылки, максимальное число повторных пересылок и пр. Команды SNMP приведены в табл. 1.15. В таблице PDU (Protocol Data Unit) - это тип протокольного сообщения.

Команда SNMP Тип PDU Назначение
get_request 0 Получить значение указанной переменной или информацию о состоянии сетевого элемента
get_next_request 1 Получить значение переменной, не зная точного ее имени (следующий логический идентификатор на дереве MIB)
set_request 2 Присвоить переменной соответствующее значения. Используется для описания действие, которое должно быть выполнено
get_response 3 Отклик на get_request, get_next_request и set_request, Содержит также информацию о состоянии (коды ошибок и другие данные)
trap 4 Отклик сетевого объекта на событие или на изменение состояния
     

Таблица 1.15.

Поле Версия содержит значение, равное номеру версии SNMP минус один. Поле Пароль (community - определяет группу доступа) содержит последовательность символов, которая является пропуском при взаимодействии менеджера и объекта управления. Обычно это поле содержит 6-байтовую строку public. Для запросов get, get-next и set значение поля Идентификатора запроса устанавливается менеджером и возвращается объектом управления в отклике get, что позволяет связывать в пары запросы и отклики. Поле Фирма (enterprise) = sysObjectlD объекта. Поле Статус ошибки характеризуется целым числом, присланным объектом управления (табл.1.16).

В последнее время широкое распространение получила идеология распределенного протокольного интерфейса DPI (Distributed Protocol Interface). Для транспортировки SNMP-запросов используется не только UDP-, но и TCP-протокол. Это дает возможность применять SNMP-протокол не только в локальных сетях. Форматы SNMP-DPI-запросов (версия 2.0) описаны в документе RFC-1592. Пример заголовка SNMP-запроса (изображенные поля образуют единый массив):

Поле Флаг = 0х30 является признаком ASN.1-заголовка. Коды Ln представляют собой длины полей, начинающиеся с байта, который следует за кодом длины, вплоть до конца сообщения-запроса (n — номер поля длины), если не оговорено другое. Так, L1 - длина пакета-запроса от Т1 до конца пакета, a L3 — длина поля пароля. Субполя Tn — поля типа следующего за ними субполя запроса. Так, Т1=2 означает, что поле характеризуется целым числом, а Т2=4 указывает на то, что далее следует пароль (поле community, в приведенном примере Public). Цифры под рамками означают типовые значения субполей. Код ОхА является признаком GET-запроса, за ним следует поле кода PDU (=0...4, см. табл. 1.15). Блок субполей Идентификатора запроса служит для тех же целей, что и другие идентификаторы, — для определения пары запрос-отклик. Собственно идентификатор запроса может занимать один или два байта, что определяется значением Lиз. CO — статус ошибки (СО=0 - ошибки нет); ТМ — тип MIB-переменной (в приведенном примере Ох2В); ИО — индекс ошибки. Цифровой код MIB-переменной отображается последовательностью цифровых субполей, характеризующих переменную. Например, переменная 1.3.6.1.2.1.5 (в символьном выражении iso.org.dod.internet.mgmt.mib.icmp) соответствует последовательности кодов Ох2В 0х06 0х01 0х02 0х01 0х05 0х00.

Статус ошибки Имя ошибки Описание
0 noError Все в порядке
1 tooBig Объект не может уложить отклик в одно сообщение
2 noSuchName В операции указана неизвестная переменная
3 badValue в команде set использована недопустимая величина или неправильный синтаксис
4 readOnly менеджер попытался изменить константу
5 genErr Прочие ошибки
     

Таблица 1.16.

Если произошла ошибка, поле Индекс ошибки характеризует к какой из переменных это относится; индекс ошибки является указателем переменной и устанавливается объектом управления не равным нулю для ошибок badValue. Для команды trap (тип PDU-4 в табл. 1.15) формат сообщения меняется. Значения поля Тип trap приведены в табл. 1.17.

Тип trap Имя trap Описание
0 coldStart Установление начального состояния объекта
1 wannStart Восстановление начального состояния объекта
2 linkDown Интерфейс выключился. Первая переменная в сообщении идентифицирует интерфейс
3 linkUp Интерфейс включился. Первая переменная в сообщении идентифицирует интерфейс
4 authenticationFailure От менеджера получено SNMP-сообщение с Неверным паролем (community)
5 egpNeighborLoss EGP-партнер отключился. Первая переменная в сообщении определяет IP-адрес партнера
6 entrpriseSpeclfic Информация о trap содержится в поле Специальный код
     

Таблица 1.17.

Для поля Тип trap 0…4 поле Специальный код должно быть равно нулю. Поле Временная метка содержит число сотых долей секунды (число тиков) с момента инициации объекта управления. Так, прерывание coldStart выдается объектом через 200 мс после инициализации.

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

Управляющая база данных MIB

Вся управляющая информация для контроля ЭВМ и маршрутизаторов Internet концентрируются в базе данных MIB (Management Information Base, RFC-1213). Именно эти данные используются протоколом SNMP. MIB определяет, например, что программное обеспечение IP должно хранить число всех октетов, которые приняты любым из сетевых интерфейсов, управляющие программы могут только читать эту информацию.

Согласно нормативам MIB управляющая информация делится на 8 категорий (табл. 1.18).

MIB-категория Описание
System Операционная система ЭВМ или маршрутизация
Interfaces Сетевой интерфейс
Addr. trans. Преобразование адреса (напр., с помощью ARP)
Ip Программная поддержка протоколов Internet
Icmp Программное обеспечение протокола ICMP
Tcp Программное обеспечение протокола TCP
Udp Программное обеспечение протокола UDP
egp Программное обеспечение протокола EGP
   

Таблица 1.18.

В табл. 1.19 - 1.24 представлены наиболее важные объекты базы данных MIB, перечисленные в табл. 1.18.

Помимо простых переменных объектами MIB могут быть таблицы. Для каждой таблицы имеется один или несколько индексов.

Системная переменная Описание
SysDescr Текстовое описание объекта
SysObjectID Идентификатор производителя в рамках дерева (1.3.6.1.4.1)
SysUpTime Время с момента последней загрузки системы (TimeTicks)
SysContact Имя системного менеджера и способы связи с ним
SysName Полное имя домена
SysLocation Физическое местоположение системы
sysService Величина, характеризует услуги, предоставляемые узлом (сумма номеров уровней модели OSI)
   

Таблица 1.19.

Переменная описания интерфейсов (ifTable) Тип данных Описание
IfIndex INTEGER Список интерфейсов от 1 до ifNumber
IfDescr DisplayString Текстовое описание интерфейса
IfType INTEGER Тип интерфейса, например, 6 - Ethernet; 9 - 802.5 маркерное кольцо; 23 - PPP; 28 - SLIP
IfNumber INTEGER Число сетевых интерфейсов
IfMtu INTEGER MTU для конкретного интерфейса
IfSpeed Gauge Скорость (бит/с)
IfPhysAddress PhysAddress Физический адрес или строка нулевой длины для интерфейсов без физического адреса (например, последовательный)
IfAdminStatus [1…3] Требуемое состояние интерфейса: 1 - включен; 2 - выключен; 3 - тестируется
IfOperStatus [1…3] Текущее состояние интерфейса: 1, 2, 3
IfLastChange TimeTicks SysUpTime, когда интерфейс оказался в данном состоянии
ifInOctets Counter Полное число полученных байтов
ifInUcastPkts Counter Число пакетов, доставленных на верхний системный уровень (unicast)
ifInDiscads Counter Число полученных, но отвергнутых пакетов
ifInErrors Counter Число пакетов, полученных с ошибкой
ifOutOctets Counter Число отправленных байтов
ifOutUcastPkts Counter Число unicast-пакетов, полученных с верхнего системного уровня
ifOutNUcastPkts Counter Число мультикастинг- и широковещательных пакетов, полученных с верхнего системного уровня
ifOutDiscads Counter Количество отвергнутых пакетов из числа отправленных
ifOutErrors Counter Число отправленных пакетов, содержащих ошибки
ifOutQLen Gauge Число пакетов в очереди на отправку
     

Таблица 1.20.

Переменная ip-группы Тип данных Описание
ipDefaultTTL INTEGER Значение, которое используется IP в поле TTL
ipForwarding [1…2] 1 означает, что система переадресует дейтограммы (2 - нет)
ipInReceives Counter Число полученных дейтограмм
ipForwDatagrams Counter Число переадресованных дейтограмм
ipOutNoRoutes Counter Число неудач при маршрутизации
ipFragOKs Counter Число фрагментированных IP-дейтограмм
ipRoutingTable Таблица IP маршрутов
ipInHdrErrors Counter Число IP-дейтограмм, отвергнутых из-за ошибки в заголовке
ipInAddrErrors Counter Число IP-дейтограмм, отвергнутых из-за неверного адреса места назначения
ipInUnknownProtos Counter Число локально адресованных дейтограмм с неверным кодом протокола
ipInDiscards Counter Число дейтограмм, отвергнутых из-за нехватки места в буфере
ipInDelivers Counter Число доставленных дейтограмм
ipOutRequests Counter Полное число IP-дейтограмм, поступивших для пересылки без учета переадресованных
ipOutDiscards Counter Число отправляемых дейтограмм, потерянных из-за нехватки места в буфере
ipOutNoRoutes Counter Число потерянных IP-дейтограмм из-за отсутствия маршрута их доставки
ipReasmTimeout Counter Максимальное время (в секундах), которое IP-фрагмент может ждать сборки
ipReasmOKs Counter Число IP-дейтограмм, успешно прошедших сборку
ipReasmFails Counter Число случаев, когда алгоритм сборки не сработал
ipFragOKs Counter Число дейтограмм, успешно фрагментированных
ipFragFails Counter Число дейтограмм, которые нуждались в фрагментации, но не могли быть фрагментированы из-за того, что don't fragment_флаг=1
ipFragCreates Counter Число фрагментов, созданных в процессе фрагментации
ipRoutingDiscards Counter Число маршрутных записей, помеченных для ликвидации, хотя они и корректны
IpAdEntAddr Таблица IP-адресов (ipAddrTable), индекс =<ipAdEntAddr>. IpAddress IP-адрес для данного ряда
IpAdEntIfIndex INTEGER Число интерфейсов
IpAdEntNetMask IpAddress Маска субсети для данного IP-адреса
IpAdEntBcastAddr [0…1] Значение младшего бита широковещательного адреса (обычно 1)
IpAdEntReasmMaxSize [0…65535] Размер наибольшей IP-дейтограммы, полученной интерфейсом, которая может быть собрана
     

Таблица 1.21.

Переменная tcp-группы Тип данных Описание
tcpRtoMin INTEGER Минимальное допустимое время повторной передачи TCP-пакетов
tcpRtoMax INTEGER Максимальное значение тайм-аута (в миллисекундах)
tcpMaxConn INTEGER Максимальное допустимое число TCP-соединений
tcpInSegs Counter Полное число полученных TCP-сегментов
tcpRtoAlgorithm INTEGER Алгоритм, используемый для вычисления тайм-аута:
  1. ни один из следующих;
  2. постоянное RTO;
  3. стандарт MIL-STD-1778;
  4. алгоритм Ван Джакобсона
tcpActiveOpens Counter Число переходов из состояния CLOSED в SYN_SENT
tcpPassiveOpens Counter Число переходов из состояния LISTEN в SYN_RCVD
tcpAttemptFails Counter Число переходов из состояния SYN_SENT или SYN_RCVD в CLOSED
tcpEstabResets Counter Число переходов из состояния ESTABLISHED или CLOSE_WAIT в CLOSED
tcpCurrEstab Gauge Число соединений, находящихся в состоянии ESTABLISHED или CLOSE_WAIT
tcpInSegs Counter Полное число полученных сегментов
tcpOutSegs Counter Полное число посланных сегментов, исключая повторно пересылаемые
tcpRetransSegs Counter Полное число повторно пересланных сегментов
tcpInErrs Counter Полное число сегментов, полученных с ошибкой
tcpOutRsts Counter Полное число посланных сегментов с флагом RST=1
tcpConnState [1…12] tcpConnTable TCP-таблица связей. Состояние соединения:
  1. CLOSED;
  2. LISTEN;
  3. SYN_SENT;
  4. SYN_RCVD;
  5. ESTABLISHED;
  6. FIN_WAIT_1;
  7. FIN_WAIT_2;
  8. CLOSE_WAIT;
  9. LAST_ACK;
  10. CLOSING;
  11. TIME_WAIT;
  12. delete TCB.
Только последняя переменная может устанавливаться менеджером, прерывая связь
tcpConnLocalAddress IpAddress Местный IP-адрес 0.0.0.0 означает, что приемник готов установить связь через любой из интерфейсов
tcpConnLocalPort [0…65535] Местный номер порта
tcpConnLocalAddress IpAddress Удаленный IP-адрес
tcpConnRemPort [0…65535] Удаленный номер порта
     

Таблица 1.22.

Переменная icmp-группы Тип данных Описание
icmpInEchos Counter Число полученных ICMP-запросов отклика
icmpInMsgs Counter Полное число полученных ICMP-сообщений
icmpInErrors Counter Число ICMP-сообщений, полученных с ошибками
icmpInDestUnreach Counter Число ICMP-сообщений о недостижимости адресата
icmpInTimeExcds Counter Число ICMP-сообщений об истечении времени
icmpInParmProbs Counter Число полученных ICMP-сообщений о проблемах с параметрами
icmpInSrcQuench Counter Число ICMP-сообщений с требованием сократить или прервать посылку пакетов из-за перегрузки
icmpInRedirects Counter Число ICMP-сообщений о переадресации
icmpInEchoReps Counter Число полученных ICMP-эхо-откликов
icmpInTimestamps Counter Число ICMP-запросов временных меток
icmpInAddrMasks Counter Число ICMP-запросов адресных масок
icmpOutMsgs Counter Число отправленных ICMP-сообщений
icmpOutErrors Counter Число неотправленных ICMP-сообщений из-за проблем (например, нехватка буферов)
icmpOutTimesExcds Counter Число посланных ICMP-сообщений об истечении времени
icmpOutParmProbs Counter Число посланных ICMP-сообщений о проблемах с параметрами
icmpOutQuench Counter Число посланных ICMP-сообщений об уменьшении потока пакетов
icmpOutRedirects Counter Число посланных ICMP-сообщений о переадресации
icmpOutEchos Counter Число посланных ICMP-эхо-запросов
icmpOutEchoReps Counter Число посланных ICMP-эхо-откликов
icmpOutTimestamps Counter Число посланных ICMP-эхо-запросов временных меток
icmpOutAddrMasks Counter Число посланных ICMP-эхо-запросов адресных масок
     

Таблица 1.23.

Переменные at-группы (atTable) Тип данных Описание
atIfIndex INTEGER Число интерфейсов
atPhysAddress PhysAddress Физический адрес. Если эта переменная равна строке нулевой длины, физический адрес отсутствует
atNetAddress NetworkAddress IP-адрес
     

Таблица 1.24.

Каждый протокол (например, IP) имеет свою таблицу преобразования адресов. Для IP это ipNetToMediaTable. Способ пропечатать таблицу преобразования с помощью программы snmpi описан ниже.

В новейшей модификации управляющей базы данных (MIB II) содержатся объекты, принадлежащие к SNMP-группе. Эта группа предоставляет информацию о SNMP-объектах, информационных потоках, статистике ошибок (табл. 1.25).

Название объекта Описание
snmpInPkts Число пакетов, полученных от слоя, расположенного ниже SNMP
snmpOutPkts Число пакетов доставленных от SNMP к нижележащему слою
snmpInBadVersions Индицирует число PDU, полученных с ошибкой в поле Версия
snmpInBadCommunityNames Индицирует число сообщений PDU, полученных с нечитаемым или нелегальным именем community
snmpInASNParsErrs Указывает число PDU, которые не могут быть преобразованы в объекты ASN.1, и наоборот
snmpInBadTypes Указывает число полученных PDU с недешифруемым типом
snmpInTooBigs Указывает число полученных PDU со слишком большим значением поля Статус ошибки
snmpInNoSuchNames Указывает число PDU, полученных с индикацией ошибки в поле NoSuchName (см. табл. 1.16)
snmpInBadValues Указывает число PDU, полученных с индикацией ошибки в поле BadValue (см. табл. 1.16)
snmpInReadOnlys Указывает число PDU, полученных с индикацией ошибки в поле ReadOnly (см. табл. 1.16)
snmpInGenErrs Указывает число PDU, полученных в GenErr-поле (см. табл. 1.16)
snmpInTotalReqVar Указывает число объектов MIB, которые были восстановлены
snmpInTotalSetVars Указывает число объектов MIB, которые были изменены
SnmpInGetRequests
snmpInGetNexts
snmpInSetRequests
snmpInGetResposes
snmpInTraps Указывает число соответствующих PDU, которые были получены
snmpOutTooBig Указывает число посланных PDU с полем TooBig
snmpOutNoSuchNames Указывает число посланных PDU с полем NoSuchName
snmpOutBadValues Указывает число посланных PDU с полем BadValue
snmpOutReadOnlys Указывает число посланных PDU с полем ReadOnly
snmpOutGenErrs Указывает число посланных PDU с полем GenErr
snmpEnableAuthTraps Говорит о том, разрешены или нет ловушки (traps)
SnmpOutGetRequests
snmpOutGetNexts
snmpOutSetRequests
snmpOutGetResposes
snmpOutTraps Указывает число соответствующих посланных PDU
   

Таблица 1.25.

Стандарт на структуру управляющей информации (SMI) требует, чтобы все MIB-переменные были описаны и имели имена в соответствии с ASN.1 (Abstract Syntax Notation 1, формализованный синтаксис). ASN.1 является формальным языком, который обладает двумя основными чертами: нотация в документах легко читаема и понимаема; в компактном кодовом представлении информация может использоваться коммуникационными протоколами. В SMI присутствует неполный набор типов объектов, предусмотренный в ASN.1, разрешены только следующие типы примитивов: INTEGER, OCTET STRING, OBJECT IDENTIFIER и NULL. Практически в протоколе SNMP фигурируют следующие виды данных:

  • INTEGER. Некоторые переменные объявляются целыми (INTEGER) с указанием начального значения или с заданным допустимымы диапазоном значений (в качестве примера можно привести номера UDP- или TCP-портов).
  • OCTET STRING (последовательность байтов). В соответствии с требованиями BER (Basic Encoding Rules, ASN.1) последовательность октетов должна начинаться с числа байтов в этой последовательности (от 0 до N).
  • OBJECT IDENTIFIER (идентификатор объекта). Имя объекта, представляющее собой последовательность целых чисел, разделенных точками. Например, 1.3.6.1.2.1.5.
  • NULL. Указывает, что соответствующая переменная не имеет значения.
  • DisplayString. Строка из 0 или более байтов (но не больше 255), которые являются ASCII-символами. Представляет собой частный случай OCTET STRING.
  • PhysAddress. Последовательность октетов, характеризующая физический адрес объекта (6 байт для Ethernet). Частный случай OBJECT IDENTIFIER.
  • Сетевой адрес. Допускается выбор семейства сетевых протоколов. В рамках ASN.1 этот тип описан как CHOICE, он позволяет выбрать протокол из семейства протоколов. В настоящее время идентифицировано только семейство протоколов Internet.
  • IP-адрес. Этот адрес используется для определения 32-разрядного Интернет - адреса. В нотации ASN.1 - это OCTET STRING.
  • Time Ticks (такты часов). Положительное целое число, которое используется для записи, например, времени последнего изменения параметров управляемого объекта, или времени последней актуализации базы данных (время измеряется в сотых долях секунды).
  • Gauge (масштаб). Положительное целое число в диапазоне 0..232-1, которое может увеличиваться или уменьшаться. Если это число достигнет 232-1, то будет оставаться неизменным до тех пор, пока не будет обнулено командой сброс. Примером может служить переменная tcpCurrEsta, которая характеризует число TCP-соединений, находящихся в состоянии ESTABLISHED или CLOSE_WAIT.
  • Counter (счетчик). Положительное число в диапазоне 0..232-1, которое может только увеличиваться, допуская переполнение.
  • SEQUENCE. Этот объект аналогичен структуре в языке Си. Например, MIB определяет SEQUENCE с именем UdpEntry, содержащую информацию об активных UDP-узлах. В этой структуре содержится две записи:
    1. UdpLocalAddress типа IpAddress; местные IP-адреса;
    2. UdpLocalPort типа INTEGER; номера местных портов.
  • SEQUENCE OF. Описание вектора, все элементы которого имеют один и тот же тип. Элементы могут представлять собой простые объекты, например, типа целое. В этом случае мы имеем одномерный список. Но элементами вектора могут быть объекты типа SEQUENCE, тогда этот вектор описывает двумерный массив.

В MIB Internet каждый объект должен иметь имя (OBJECT IDENTIFIER), синтакс и метод кодировки.

Стандарт ASN.1 определяет форму представления информации и имен. Имена MIB-переменных соответствуют в свою очередь стандартам ISO и CCITT. Структура имен носит иерархический характер.

В табл. 1.26 охарактеризованы четыре простые переменные. Все эти переменные допускают только чтение.

В табл. 1.27 приведено описание таблицы udpTable (index=<udpLocalAddress>,<udpLocalPort>), состоящей из двух простых переменных, предназначенных только для чтения.

Согласно иерархии переменные, соответствующие icmp, должны иметь префикс (идентификатор) 1.3.6.1.2.1.5 или в символьном выражении iso.org.dod.internet.mgmt.mib.icmp. Если вы хотите узнать значение какой-то переменной, следует послать запрос, содержащий соответствующие префикс и суффикс (последний определяет имя конкретной переменной). Для простой переменной суффикс имеет вид .0.

Имя Переменной Тип данных Описание
UdpInDatagrams Counter Число UDP-дейтограмм, присланных процессам пользователя
UdpNoPorts Counter Число полученных UDP-дейтограмм, для которых отсутствует прикладной процесс в порте назначения
UdpInErrors Counter Число не доставленных UDP-дейтограмм (например, ошибка контрольной суммы)
UdpDatagrams Counter Число посланных UDP-дейтограмм
     

Таблица 1.26.

Имя Переменной Тип данных Описание
UdpLocalAddress IpAddress Местный IP-адрес для данного приемника
UdpLocalPort (0...65535) Местный номер порта приемника
     

Таблица 1.27.

Лучшим способом закрепить в памяти все вышесказанное является использование программы snmpi (SNMP initiator или SNMPWALK, NETGUARD, SNMPMAN для PC). Если в вашем распоряжении имеется ЭВМ, работающая под управлением UNIX, например SUN, вы можете попутно узнать много полезного о вашей локальной сети. Синтаксис обращения к snmpi:


 snmpi [-a agent] [-с community] [-f file] [-p portno] [-d] [-v] [-w]
 

Программа snmpi крайне проста. Для того чтобы проверить, работает ли онa, выдайте команду


 % snmpi dump
 

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

  • Опция -a предлагает возможность ввести адрес SNMP-обьекта: имя ЭВМ, IP-адрес или транспортный адрес. По умолчанию это местная ЭВМ. Аналогично опция -р позволяет задать номер UDP-порта. По умолчанию это порт 61.
  • Опция -с позволяет задать групповой пароль (community) для SNMP-запроса. По умолчанию это public, т.е. свободный доступ.
  • Опция -f позволяет выбрать файл, содержащий откомпилированные описания MIB-модулей. По умолчанию это objects.defs.
  • Опция -w включает режим наблюдения, осуществляя выдачу на терминал всех служебных сообщений. Уход из программы - по команде quit (q).

Если вы работаете на IBM PC, и ваша машина подключена к локальной сети, получите допуск к одной из UNIX-машин в сети (если вы его не имели) и приступайте. Можно начать с обращения типа


 Snmpi -a 193.124.224.33
 

(адрес или символьное имя надо взять из вашей локальной сети)

Машина откликнется, отобразив на экране snmpi>. Это означает, что программа имеется и вы можете вводить любые команды.

Начать можно со знакомства с системными переменными системы.


 Snmpi> get sysDescr.0
 Snmpi> sysDescr.0="GS Software (GS3-K), Version 9.1(4) [fc1],
   SOFTWARE Copyright ї 1986-1993 by Cisco Systems, Inc.
   Compiled Thu 25-Mar-93 09:49 by daveu"
 snmpi> get sysObjectID.0
 snmpi> sys0bjectlD.0=1.3.6.1.4.1.9.1.1
 snmpi> get sysUpTime.0
 snmpi> sysUpTime.0=14 days, 7 hours, 0 minutes, 15.27 seconds (123481527 timeticks)
 snmpi> get sysServices.0
 snmpi> sysServices.0=0x6<datalink/subnetwork, internet>
 

Код 0x06 (sysServices.0) представляет собой сумму кодов уровней модели SO, поддерживаемых системой. Для справок: 0х01 - физический уровень; 0х02 связной уровень; 0х04 - Интернет; 0х08 - связь точка-точка; 0х40 - прикладной уровень.

Если вы хотите получить информацию о состоянии интерфейсов на одной из ЭВМ, подключенных к вашей локальной сети (команды вызова snmpi далее не повторяются; в ниже приведенных примерах в круглых скобках помещены комментарии автора), выдайте команды:


 snmpi> nextifTable
 

(команда next в данном случае соответствует запросу get-next, здесь понятие "следующий" подразумевает порядок переменных в MlВ)


 snmpi> iflndex.1=1
 snmpi> get ifDescr.1
 snmpi> ifDescr.1="Ethernet0"
 snmpi> get ifType.1
 snmpi> ifType.1=ethernet-csmacd (6)
 snmpi > get ifMtu.1
 snmpi> IfMtu.1=1500
 snmpi> get ifSpeed.1
 snmpi> ifSpeed.1=10000000 (10М бит/с, Ethernet)
 snmpi> get ifPhysAddress.1
 snmpi> ifPhysAddress.1=0х00:00:0c:02:За:49 (физический адрес интерфейса)
 snmpi> next ifDescr.1 ifType.1 ifMtu.1 ifSpeed.1 ifPhysAddress.1
 snmpi> ifDescr.2="Serial0"
 ifType.2=propPointToPointSerial(22)
 ifMtu.2=1500
 ifSpeed.2=2048000 (2 M бит/с, радиорелейный последовательный канал,
   спутниковый канал был бы охарактеризован точно также)
 

В приведенном примере размеры пересылаемых блоков для Ethernet и радиорелейного последовательного канала идентичны и равны 1500 байт. Помните, что SLIP-канал записан как PointToPointSerial, а не как SLIP. Скорость обмена по SLIP-каналу не сообщается.

Теперь просмотрим некоторые UDP-переменные. Например:


 snmpi> next udp
 snmpi> udpInDatagrams.0=98931
 snmpi> next udpInDatagrams.0 (обратите внимание на суффикс простой переменной)
 snmpi> udpNoPorts. 0=60009
 snmpi> next udpLocalAddress.0
 snmpi> udpLocalAddress.193.124.137.14.7=193.124.137.14 (Идентификатор этого
   объекта 1.3.6.1.2.1.7.5.1.1.193.124.137.14.7)
 snmpi> next udpLocalPort
 snmpi> udpLocalPort.193.124.137.14.7=7
 

Если у вас возникла необходимость просмотреть таблицу, например, udpTable, это также можно сделать, используя snmpi:


 snmpi> next udpTable
 snmpi> udpLocalAddress.193.124.137.14.7=193.124.137.14
 snmpi> next udpLocalAddress.193.124.137.14.7
 snmpi> udpLocalAddress.193.124.224.33.67=193.124.224.33
 snmpi> next udpLocalAddress.193.124.224.33.67
 snmpi> udpLocalAddress.193.124.224.33.161=193.124.224.33
 snmpi> next udpLocalPort.193.124.224.33.67
 snmpi> udpLocalPort.193.124.224.33.161=161
 

Ниже показана методика выяснения алгоритма и параметров задания значения тайм-аута:


 snmpi> get tcpRtoAlgorithm.0 tcpRtoMin.0 tcpRtoMax.0 tcpMaxConn.0
 snmpi> tcpRtoAlgorithm.0=vanj(4) (vanj - алгоритм Ван Джакобсона для расчета времени тайм-аута)
 tcpRtoMin.0=300 (минимальное значение тайм-аута = 300 мс)
 tcpRtoMax.0=60000 (максимальное - 60 с)
 tcpMaxConn.0=-1 (никаких ограничений на число соединений)
 

Чтобы получить информацию о состоянии таблицы адресных преобразований, выдайте команду snmpi -а 193.124.224.33 dump at (процедуры с использование субкоманды dump требуют некоторого времени для своего исполнения). В результате получим:


 AtIfIndex.1.1.193.124.224.33=1
 AtIfIndex.1.1.193.124.224.35=1
 AtIfIndex.3.1.192.148.166.203=3
 AtIfIndex.3.1.192.148.166.205=3
 AtIfIndex.5.1.145.249.30.33=5
 AtIfIndex.5.1.192.148.166.98=5
 AtPhysAddress.1.1.193.124.224.33=0x00:00:0c:02:3a:49
 AtPhysAddress.1.1.193.124.224.35=0x00:00:20:12:1b:b1
 AtPhysAddress.1.1.193.124.224.40=0x00:00:cd:f9:0d:e7
 AtPhysAddress.1.1.193.124.224.50=0x00:00:0c:02:fb:c5
 AtNetAddress.1.1.193.124.224.33=193.124.224.33
 AtNetAddress.1.1.193.124.224.35=193.124.224.35
 AtNetAddress.1.1.193.124.224.40=193.124.224.40
 AtNetAddress.1.1.193.124.224.50=193.124.224.50
 AtNetAddress.1.1.193.124.224.60=193.124.224.60
 

(текст выдачи сокращен)

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

Чтобы получить полный текст адресной таблицы в рамках snmpi достаточно выдать команду


 Snmpi> dump ipAddrTable
 Snmpi> ipAdEntAddr.192.148.166.222=192.148.166.222
 IpAdEntAddr.192.168.1.1=192.168.1.1
 IpAdEntAddr.192.168.1.2=192.168.1.2
 IpAdEntAddr.193.124.224.33=193.124.224.33
 IpAdEntAddr.193.124.224.190=193.124.224.190
 IpAdEntIfIndex.192.148.166.222=3
 IpAdEntIfIndex.192.148.1.1=4
 IpAdEntIfIndex.192.148.1.2=6
 IpAdEntIfIndex.192.148.224.33=1
 IpAdEntIfIndex.192.148.224.190=5
 

(маски субсетей)


 IpAdEntNetMask.192.148.166.222=255.255.255.224
 IpAdEntNetMask.192.148.1.1=255.255.255.0
 IpAdEntNetMask.192.148.1.2=255.255.255.0
 IpAdEntNetMask.192.148.224.33=255.255.255.224
 IpAdEntNetMask.192.148.224.190=255.255.255.224
 IpAdEntBcastAddr.192.148.166.222=1 (все эти субсети используют для широковещательной
   адресации одни и те же биты).
 IpAdEntBcastAddr.192.148.1.1=1
 IpAdEntBcastAddr.192.148.1.2=1
 IpAdEntBcastAddr.192.148.224.33=1
 IpAdEntBcastAddr.192.148.224.190=1
 IpAdEntReasmMaxSize.192.148.166.222=18024 (с точки зрения фрагментации и последующей
   сборки дейтограмм данные субсети эквивалентны).
 IpAdEntReasmMaxSize.192.148.1.1=18024
 IpAdEntReasmMaxSize.192.148.1.2=18024
 IpAdEntReasmMaxSize.192.148.224.33=18024
 IpAdEntReasmMaxSize.192.148.224.190=18024
 

Эта распечатка совместно с приведенной для IfTable позволяет получить достаточно полную картину о данной конкретной локальной сети. Чтобы познакомиться с ARP таблицей, можно воспользоваться командой


 Sun> arp -a
 Itepgw.itep.ru (193.124.224.33) at 0:0:c:2:3a:49
 Nb.itep.ru (193.124.224.60) at 0:80:ad:2:24:b7
 

И дополнить полученные данные с помощью snmpi:


 Snmpi> dump ipNetToMediaTable
 Snmpi> ipNetToMediaIfIndex.1.193.124.224.33=1
 ipNetToMediaIfIndex.1.193.124.224.35=1
 ipNetToMediaIfIndex.3.192.148.166.193=3
 ipNetToMediaIfIndex.3.192.148.166.196=3
 ipNetToMediaIfIndex.3.193.124.226.110=3
 ipNetToMediaIfIndex.5.195.249.30.33=5
 ipNetToMediaIfIndex.5.192.148.166.100=5
 ipNetToMediaPhysAddress.1.193.124.224.33=0x00:00:0c:02:3a:49
 ipNetToMediaPhysAddress.3.192.148.166.196=0xaa:00:04:00:0c:04
 ipNetToMediaPhysAddress.3.192.148.166.198=0xaa:00:04:00:0e:04
 ipNetToMediaPhysAddress.3.192.148.166.203=0x00:00:01:00:54:62
 


 ipNetToMediaPhysAddress.5.195.249.30.33=0x00:00:0c:02:69:7d
 IpNetToMediaPhysAddress.5.192.148.166.100=0x00: 20:af: 15:c1: 61
 IpNetToMediaPhysAddress.5.192.148.166.101=0x00:00:09:42:0d:e8
 IpNetToMediaNetAddress.1.193.124.224.33=193.124.224.33
 IpNetToMediaNetAddress.1.193.124.224.35=193.124.224.35
 IpNetToMediaNetAddress.3.192.148.166.193=192.148.166.193
 IpNetToMediaNetAddress.3.193.124.226.110=193.124.226.110
 IpNetToMediaNetAddress.5.195.249.30.33=195.249.30.33
 IpNetToMediaType.1.193.124.224.33=other(1)
 IpNetToMediaType.1.193.124.224.35=dynamic(3)
 IpNetToMediaType.1.193.124.224.37=dynamic(3)
 IpNetToMediaType.3.192.148.166.195=dynamic(3)
 IpNetToMediaType.3.192.148.166.222= other(1)
 IpNetToMediaType.5.193.124.224.190= other(1)
 IpNetToMediaType.5.193.124.225.33= other(1)
 IpNetToMediaType.5.193.124.225.35=dynamic(3)
 

Синтаксис каждого объекта описывается в рамках ASN.1 и показывает побитовое представление объекта. Кодирование объекта характеризует то, как тип объекта отображается через его синтаксис и передается по телекоммуникационным каналам. Кодирование производится в соответствии с базовыми правилами кодирование ASN.1. Все описания объектов базируются на типовых шаблонах и кодах ASN.1 (см. RFC-1213). Формат шаблона:


 OBJECT (объект):
 

Имя типа объекта с соответствующим ему идентификатором объекта


 (OBJECT IDENTIFIER)
 

Syntax (синтаксис):
ASN.1 описание синтаксиса типа объекта
Definition (Определение)
Текстовое описание типа объекта
Access (доступ)
Опции доступа
Status (состояние)
Статус типа объекта.

Маршруты также являются объектами MIB. Согласно требованиям к MIB, каждому маршруту в этой базе соответствует запись.

Поле Место назначения представляет собой IP-адрес конечной точки маршрута. Поле Индекс интерфейса определяет локальный интерфейс (физический порт), через который можно осуществить следующий шаг по маршруту. Следующие пять полей (Метрика 1…5) характеризует оценку маршрута. В простейшем случае, например для протокола RIP, достаточно было бы одного поля. Но для протокола OSPF необходимо пять полей (разные TOS). Поле Следующий шаг представляет собой IP-адрес следующего маршрутизатора. Поле Тип маршрута имеет значение 4 для опосредованного достижения цели маршрута; 2 для нереализуемого маршрута и 1 для случаев, отличных от вышеперечисленных.

  • Место назначения (ipRouteDept)
  • Индекс интерфейса (ipRouteIfIndex)
  • Метрика 1 (ipRouteMetric1)
  • Метрика 5 (ipRouteMetric5)
  • Следующий шаг (ipRouteNextHop)
  • Тип маршрута (ipRouteType)
  • Протокол маршрутизации (ipRouteProto)
  • Возраст маршрута (ipRouteAge)
  • Маска маршрута (ipRouteMask)
  • Маршрутная информация (ipRouteInfo)

Поле Протокол маршрутизации содержит код протокола. Для RIP этот код равен 8, для OSPF -13, для BGP -14, для ICMP -4, для прочих протоколов -1. Поле Возраст маршрута описывает время (в секундах), прошедшее с момента последней коррекции маршрута. Следующее поле Маска маршрута используется для выполнения логической побитовой операции И над адресом в IP-дейтограмме перед сравнением результата с кодом, хранящимся в первом поле записи ("место назначения"). Последнее поле Маршрутная информация содержит код, зависящий от протокола маршрутизации и обеспечивающий ссылки на соответствующую информацию в базе MIB.




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



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



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


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