Трехмерные формы с изменяющимися размерами

Попробуйте нижеприведенные обработчики событий WMNCPaint и WMNCHitTest.

При этом форма должна иметь свойство BorderStyle равным Sizeable, так как код использует область границ для создания 3D эффекта и предоставляет пользователю возможность изменения размера формы.

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


procedure TForm1.WMNCPaint(var Msg: TWMNCPaint);
var
  DC: HDC;
  Frame_H: Integer;
  Frame_W: Integer;
  Menu_H: Integer;
  Caption_H: Integer;
  Frame: TRect;
  Extra: Integer;
  Canvas: TCanvas;
begin
  { Задаем значения некоторым параметрам окна }
  Frame_W := GetSystemMetrics(SM_CXFRAME);
  Frame_H := GetSystemMetrics(SM_CYFRAME);
  if (Menu <> nil) then
    Menu_H := GetSystemMetrics(SM_CYMENU)
  else
    Menu_H := -1;
  Caption_H := GetSystemMetrics(SM_CYCAPTION);
  GetWindowRect(Handle, Frame);
  Frame.Right := Frame.Right - Frame.Left - 1;
  Frame.Left := 0;
  Frame.Bottom := Frame.Bottom - Frame.Top - 1;
  Frame.Top := 0;
  { Позволяем нарисовать стандартные границы формы }
  inherited;
  { Перерисовываем область границ в 3-D стиле }
  DC := GetWindowDC(Handle);
  Canvas := TCanvas.Create;
  try
    with Canvas do
    begin
      Handle := DC;
      { Левая и верхняя граница }
      Pen.Color := clBtnShadow;
      PolyLine([Point(Frame.Left, Frame.Bottom), Point(Frame.Left, Frame.Top),
        Point(Frame.Right, Frame.Top)]);
      { Правая и нижняя граница }
      Pen.Color := clWindowFrame;
      PolyLine([Point(Frame.Left, Frame.Bottom),
        Point(Frame.Right, Frame.Bottom),
          Point(Frame.Right, Frame.Top - 1)]);
      { Левая и правая граница, 1 пиксел скраю }
      Pen.Color := clBtnHighlight;
      PolyLine([Point(Frame.Left + 1, Frame.Bottom - 1),
        Point(Frame.Left + 1, Frame.Top + 1),
          Point(Frame.Right - 1, Frame.Top + 1)]);
      { Правая и нижняя граница, 1 пиксел скраю }
      Pen.Color := clBtnFace;
      PolyLine([Point(Frame.Left + 1, Frame.Bottom - 1),
        Point(Frame.Right - 1, Frame.Bottom - 1),
          Point(Frame.Right - 1, Frame.Top)]);
      { Разность области изменяемых границ }
      for Extra := 2 to (GetSystemMetrics(SM_CXFRAME) - 1) do
      begin
        Brush.Color := clBtnFace;
        FrameRect(Rect(Extra, Extra, Frame.Right - Extra + 1, Frame.Bottom -
          Extra + 1));
      end;
      { Левая и верхняя граница области заголовка }
      Pen.Color := clBtnShadow;
      PolyLine([Point(Frame_W - 1, Frame_H + Caption_H + Menu_H - 1),
        Point(Frame_W - 1, Frame_H - 1),
          Point(Frame.Right - Frame_W + 1, Frame_H - 1)]);
      { Левая и верхняя граница области заголовка }
      Pen.Color := clBtnHighlight;
      PolyLine([Point(Frame_W - 1, Frame_H + Caption_H + Menu_H - 1),
        Point(Frame.Right - Frame_W + 1, Frame_H + Caption_H + Menu_H - 1),
          Point(Frame.Right - Frame_W + 1, Frame_H - 1)]);
    end;
  finally
    Canvas.Free;
    ReleaseDC(Handle, DC);
  end; { try-finally }
end;

procedure TForm1.WMNCHitTest(var Msg: TWMNCHitTest);
var
  HitCode: LongInt;
begin
  inherited;
  HitCode := Msg.Result;
  if ((HitCode = HTLEFT) or (HitCode = HTRIGHT) or
    (HitCode = HTTOP) or (HitCode = HTBOTTOM) or
    (HitCode = HTTOPLEFT) or (HitCode = HTBOTTOMLEFT) or
    (HitCode = HTTOPRIGHT) or (HitCode = HTBOTTOMRIGHT)) then
  begin
    HitCode := HTNOWHERE;
  end;
  Msg.Result := HitCode;
end;

Добавлено: 22 Февраля 2019 07:41:14 Добавил: Андрей Ковальчук

Функция FlashWindow

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

Вот пример использования этой api-функции:


...  
case wm_timer:  
flashwindow(hwnd, true);  
break;  
...  

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

Параметры у этой функции такие: первый - это hwnd того окна, которое должно мигать. Второй - режим мигания. Если второй параметер установлен в true (как у нас), то заготовок окна сменит свое состояние на противоположное. Ели же он равен false, то состояние окна переключается на первоначальное.

Добавлено: 30 Июля 2018 19:03:05 Добавил: Андрей Ковальчук

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

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

Прежде всего, я хочу сказать, что работа Windows основана на сообщениях. Так Windows посылает любому окну такие сообщения как (WM_PAINT,WM_ACTIVATE,WM_LBUTTONCLICK,…). Вы, вероятно, заметили, что каждое сообщение имеет префикс WM_ (Window Message). Окнами в Windows являются не только формы, но и кнопки, ListBox'ы, ComboBox'ы и т. п. Словом все компоненты, производные от класса TWinControl являются окнами. Сообщения, адресованные кнопкам, начинаются с префикса BM_ (например, BM_CLICK), а к спискам (ListBox) - LB_(LB_GETCOUNT).

Для работы с окнами Windows предоставляет большое количество функций, которые описаны в модуле Windows.pas, и экспортируются из Windows'овских библиотек (DLL - Dynamic Link Library). Конечно, в рамках одной статьи нельзя рассмотреть ВСЕ функции API, поэтому здесь будут рассмотрены только некоторые из них. Вот они:

BringWindowToTop - Выводит окно поверх других по Z-порядку
CloseWindow - Минимизирует (не закрывает) окно
EnableWindow - Делает окно доступным/недоступным
EnumChildWindows - Просматривает все дочерние окна
EnumWindows - Просматривает все главные окна
FindWindow - Ищет окно в системе
FindWindowEx - Ищет дочернее окно
GetClassName - Узнает имя класса заданного окна
GetClassLong - Узнает информацию о данном классе
GetClientRect - Достает Rect клиентской области окна
GetDesktopWindow - Возвращает дескриптор Desktop
GetForegroundWindow - Ищет верхнее окно системы
GetNextWindow - Находит следующее или предыдущее окно
GetWindow - Возвращает дескриптор окна, с заданным положением
GetDC - Ищет дисплейный контекст окна
GetWindowLong - Узнает информацию о заданном окне
GetWindowRect - Достает Rect всего окна
GetWindowText - Возвращает текст окна
GetWindowTextLength - Возвращает длину текста окна
GetWindowThreadProcessId - Узнает процесс, которому принадлежит заданное окно
IsChild - Дочернее ли окно
IsIconic - Свернуто ли окно
IsWindow - Есть ли такое окно в системе
IsWindowVisible - Видимое ли это окно
IsZoomed - Максимизировано ли это окно
MoveWindow - Перемещает окно
OpenIcon - Восстанавливает окно из иконки
SetForegroundWindow - Назначает верхнее окно системы
SetWindowLong - Устанавливает новые параметры окна
SetWindowPos - Устанавливает позицию окна
SetWindowText - Изменяет заголовок окна
ShowWindow - Показывает окно с заданными параметрами
WindowFromPoint - Возвращает окно из заданной позиции

В этой статье подробнее я постараюсь рассмотреть как можно больше функций. Давайте создадим приложение, которое будет использовать большинство из этих функций (При написании статьи я использовал Borland Delphi 6 Enterprise Build 6.163). Для начала создайте новое приложение и сразу сохраните его. Поместите на форму TreeView, и назовите его tvList, и PageControl. В PageControl'e создайте 4 страница с названиями:

Основная
Стиль окна
Расширенные стиль окна
Стиль класса окна
На основной странице будет 16 параметров, которые мы будем узнавать об окне. Вот они:
Заголовок
Класс
Дескриптор
Дескриптор меню
Иконка
HInstance
Заголовок родителя
Дескриптор родителя
Слева
Сверху
Высота
Ширина
Снизу
Справа
Дисплейный контекст
Идентификатор процесса.
Изменяемыми параметрами будут только все координаты, заголовок и иконка, напротив которых нужно поставить Edit'ы (кроме иконки естевственно), а остальные будут неизменяемыми, и напротив них можно поставить метки. Вот как начал я:

(Там где пусто, стоят метки)
На остальных трех страницах поместите ListView, и назовите их соответственно:

LvWndStyle
LvExWndStyle
LvClassStyle

Свойства ListView.CheckBoxes установите в True для каждого ListView.
И ещё, добавьте две кнопки SpeedButton (как на рисунке).
Теперь костяк готов, и можно приступать к самому интересному.

Сначала форма в стадии разработки:


unit UMain;  
  
interface  
  
uses  
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,  
Dialogs, Buttons, ComCtrls, StdCtrls, ExtCtrls, ExtDlgs, Menus;  
  
type  
TfmWinapi = class(TForm)  
btnRefresh: TSpeedButton;  
Label1: TLabel;  
Label2: TLabel;  
pcWndInfo: TPageControl;  
tsMain: TTabSheet;  
tsWndStyle: TTabSheet;  
tsExWndStyle: TTabSheet;  
tsClassStyle: TTabSheet;  
Label3: TLabel;  
Label4: TLabel;  
Label5: TLabel;  
Label6: TLabel;  
Label7: TLabel;  
Label8: TLabel;  
Label9: TLabel;  
Label10: TLabel;  
Label11: TLabel;  
Label12: TLabel;  
Label13: TLabel;  
Label14: TLabel;  
Label15: TLabel;  
Label16: TLabel;  
Label17: TLabel; //Метки параметров  
Bevel1: TBevel;  
edWText: TEdit;  
lbWClass: TLabel;  
lbWHandle: TLabel;  
lbWHMenu: TLabel;  
imWIcon: TImage;  
Bevel2: TBevel;  
Bevel3: TBevel;  
Bevel4: TBevel;  
Bevel5: TBevel;  
Bevel6: TBevel;  
Bevel7: TBevel;  
Bevel8: TBevel;  
Bevel9: TBevel;  
Bevel10: TBevel;  
Bevel11: TBevel;  
Bevel12: TBevel;  
Bevel13: TBevel;  
Bevel14: TBevel;  
Bevel18: TBevel;//Разделители  
lbWHinst: TLabel;  
edPWText: TEdit;  
lbPWHandle: TLabel;  
edWWidth: TEdit;  
EdWHeight: TEdit;  
edWTop: TEdit;  
edWLeft: TEdit;  
edWBottom: TEdit;  
lbWProcId: TLabel;  
lbWDC: TLabel;  
edWRight: TEdit;  
Label18: TLabel;  
Bevel15: TBevel;  
lvWndStyle: TListView;  
lvExWndStyle: TListView;  
lvClassStyle: TListView;  
odIcon: TOpenPictureDialog;  
btnApply: TSpeedButton;  
tvList: TTreeView;  
pmWIcon: TPopupMenu;  
pmSave: TMenuItem;  
sdIcon: TSavePictureDialog;  
MainMenu1: TMainMenu;  
N1: TMenuItem;  
N2: TMenuItem;  
N3: TMenuItem;  
N4: TMenuItem;  
N5: TMenuItem;  
N6: TMenuItem;  
N7: TMenuItem;  
N8: TMenuItem;  
N9: TMenuItem;  
N10: TMenuItem;  
N11: TMenuItem;  
procedure btnRefreshClick(Sender: TObject);  
procedure FormCreate(Sender: TObject);  
procedure tvListCustomDrawItem(Sender: TCustomTreeView;  
Node: TTreeNode; State: TCustomDrawState; var DefaultDraw: Boolean);  
procedure tvListDblClick(Sender: TObject);  
procedure pcWndInfoChanging(Sender: TObject; var AllowChange: Boolean);  
procedure imWIconClick(Sender: TObject);  
procedure btnApplyClick(Sender: TObject);  
procedure pmSaveClick(Sender: TObject);  
procedure N2Click(Sender: TObject);  
procedure N3Click(Sender: TObject);  
procedure N4Click(Sender: TObject);  
procedure N6Click(Sender: TObject);  
procedure N7Click(Sender: TObject);  
procedure N10Click(Sender: TObject);  
procedure N11Click(Sender: TObject);  
procedure N5Click(Sender: TObject);  
procedure N9Click(Sender: TObject);  
private  
{ Private declarations }  
public  
procedure BuildTree;  
procedure GetWindowParams(Wnd: HWND);  
procedure GetWindowExParams(Wnd: HWND);  
end;  
  
var  
fmWinapi: TfmWinapi;  
tnCurrent: TTreeNode;  
SelWindow: HWND;  
  
implementation  
var  
SelDC: HDC;  
  
NewStyle: LongInt;  
NewExStyle: LongInt;  
NewClassStyle: LongInt;  
  
{$R *.dfm}  
  
function GetIcon(wnd:hwnd):TIcon; //Достать иконку по хэндлу если это возможно  
begin  
result:=TIcon.Create; //Создаем иконку  
result.Handle:=GetClassLong(wnd,GCL_HICON); //Пытаемся достать  
end;  
  
procedure SetIcon(wnd:hwnd; icon:TIcon); //Меняет иконку у окна  
begin  
postmessage(wnd,wm_seticon,0,icon.Handle);//Посылаем сообщение окну, содержащее  
//хэндл иконки  
end;  
  
function GetText(wnd:hwnd):string; //Возвращает заголовок окна  
var p:array [0..256] of char;  
begin  
with fmWinAPi do  
GetWindowText(wnd,p,255);  
result:=strpas(p);  
end;  
  
procedure TfmWinapi.GetWindowParams(Wnd: HWND); //Возвращает стили окна  
var  
I, WL: LongInt;  
  
begin  
WL:= GetWindowLong(wnd, GWL_STYLE); //Достаем стиль окна  
for I:= 0 to lvWndStyle.Items.Count -1 do  
if ((LongInt(lvWndStyle.Items[i].Data)) and WL) <> 0 then  
lvWndStyle.Items[i].Checked:= True else lvWndStyle.Items[i].Checked:= False;  
{Помечаем ту или иную птичку}  
  
WL:= GetWindowLong(wnd, GWL_EXSTYLE); //Достаем расширенный стиль окна  
for I:= 0 to lvExWndStyle.Items.Count -1 do  
if ((LongInt(lvExWndStyle.Items[i].Data)) and WL) <> 0 then  
lvExWndStyle.Items[i].Checked:= True else lvExWndStyle.Items[i].Checked:= False;  
  
WL:= GetClassLong(wnd, GCL_STYLE); //Достаем стиль класса  
for I:= 0 to lvClassStyle.Items.Count -1 do  
if ((LongInt(lvClassStyle.Items[i].Data)) and WL) <> 0 then  
lvClassStyle.Items[i].Checked:= True else lvClassStyle.Items[i].Checked:= False;  
end;  
  
  
procedure TfmWinapi.GetWindowExParams(Wnd: HWND);  
var  
PParam: array[0..127] of Char;  
ProcId: LongInt;  
hInst: THandle;  
Rct: TRect;  
Begin  
{Заполняем основную страницу}  
edWText.Text:= GetText(wnd); //Заголовок  
GetClassName(wnd, PParam, 128); //Класс  
lbWClass.caption:= StrPas(PParam);  
lbWHandle.caption:= IntToStr(wnd); //Дескриптор  
lbWHmenu.caption:=IntToStr(GetMenu(wnd));// Дескриптор меню  
ImWIcon.Picture.Icon:=GetIcon(wnd); //Иконка  
GetWindowText(GetParent(wnd), PParam, 127);//Заголовок родителя  
EdPWText.text:= StrPas(PParam);  
lbPWHandle.caption:= IntToStr(GetParent(wnd));Дескриптор родителя  
GetWindowRect(Wnd, Rct);..Координаты  
edWLeft.text:= IntToStr(Rct.Left);  
edWTop.text:= IntToStr(Rct.Top);  
edWWidth.text:= IntToStr(Rct.Right-Rct.Left);  
edWHeight.text:= IntToStr(Rct.Bottom-Rct.Top);  
edWRight.text:= IntToStr(Rct.Right);  
edWBottom.text:= IntToStr(Rct.Bottom);  
lbWDC.Caption:= IntToStr(SelDC); //Дисплейный контекст(DC или Canvas.Handle)  
hInst:= GetWindowLong((wnd), GWL_HINSTANCE);//HInstance  
lbWHinst.Caption:= IntToStr(hInst);  
GetWindowThreadProcessId(wnd, @ProcId);//Идентификатор процесса  
lbWProcId.Caption:= IntToStr(ProcId);  
  
end;  
  
function ChildTree(Handle: HWND; Info: Pointer): BOOL; stdcall;  
{Функция для построения дерева дочерних окон}  
var  
Text: array [0..256] of Char;  
tnParent: TTreeNode;  
begin  
GetWindowText(handle, text, 200);  
if Text <> '' then  
tnParent:= fmWinapi.tvList.Items.AddChildObject(tnCurrent, StrPas(Text),  
TObject(Handle))  
else begin  
GetClassName(Handle,text,255);  
tnParent:= fmWinapi.tvList.Items.AddChildObject(tnCurrent,text,  
TObject(Handle));  
end;  
tnParent.ImageIndex:= 1;  
tnParent.SelectedIndex:= 1;  
Result:= True;  
end;  
  
function ParentTree(Handle: HWND; Info: Pointer): BOOL; stdcall;  
{А это то же самое для родителей}  
var  
Text: array [0..256] of Char;  
tnParent: TTreeNode;  
begin  
GetWindowText(handle, text, 200);  
if (Text <> '') then  
tnParent:= fmWinapi.tvList.Items.AddObject(nil, StrPas(Text),  
TObject(Handle))  
else begin  
GetClassName(Handle,text,255);  
tnParent:= fmWinapi.tvList.Items.AddObject(nil, text,  
TObject(Handle));  
end;  
tnParent.ImageIndex:= 0;  
tnParent.SelectedIndex:= 0;  
Result:= True;  
end;  
  
procedure TfmWinapi.BuildTree; //Собственно сама процедура построения дерева  
var  
i: integer;  
begin  
tvList.Items.Clear;  
EnumWindows(@ParentTree, 0);  
for i:= 0 to tvList.Items.Count do begin  
tnCurrent:= tvList.Items[i];  
EnumChildWindows(Integer(tvList.Items[i].Data), @ChildTree, 0);  
end;  
end;  
  
//Клик на кнопку "Обновить список"  
procedure TfmWinapi.btnRefreshClick(Sender: TObject);  
begin  
BuildTree;  
end;  
  
procedure TfmWinapi.FormCreate(Sender: TObject);  
var  
ListItem: TListItem;  
Begin  
btnRefresh.Click;  
//Здесь мы заполняем ListView. Можно было сделать это в Инспекторе объектов, кроме  
//ListItem.Data. Поэтому я предпочел делать здесь  
ListItem:= lvWndStyle.Items.Add; ListItem.Caption:= 'WS_POPUP';  
ListItem.Data:= TObject($80000000);  
ListItem:= lvWndStyle.Items.Add; ListItem.Caption:= 'WS_CHILD';  
ListItem.Data:= TObject($40000000);  
ListItem:= lvWndStyle.Items.Add; ListItem.Caption:= 'WS_MINIMIZE';  
ListItem.Data:= TObject($20000000);  
ListItem:= lvWndStyle.Items.Add; ListItem.Caption:= 'WS_VISIBLE';  
ListItem.Data:= TObject($10000000);  
ListItem:= lvWndStyle.Items.Add; ListItem.Caption:= 'WS_DISABLED';  
ListItem.Data:= TObject($8000000);  
ListItem:= lvWndStyle.Items.Add; ListItem.Caption:= 'WS_CLIPSIBLINGS';  
ListItem.Data:= TObject($4000000);  
ListItem:= lvWndStyle.Items.Add; ListItem.Caption:= 'WS_CLIPCHILDREN';  
ListItem.Data:= TObject($2000000);  
ListItem:= lvWndStyle.Items.Add; ListItem.Caption:= 'WS_MAXIMIZE';  
ListItem.Data:= TObject($1000000);  
ListItem:= lvWndStyle.Items.Add; ListItem.Caption:= 'WS_CAPTION';  
ListItem.Data:= TObject($C00000);  
ListItem:= lvWndStyle.Items.Add; ListItem.Caption:= 'WS_BORDER';  
ListItem.Data:= TObject($800000);  
ListItem:= lvWndStyle.Items.Add; ListItem.Caption:= 'WS_DLGFRAME';  
ListItem.Data:= TObject($400000);  
ListItem:= lvWndStyle.Items.Add; ListItem.Caption:= 'WS_VSCROLL';  
ListItem.Data:= TObject($200000);  
ListItem:= lvWndStyle.Items.Add; ListItem.Caption:= 'WS_HSCROLL';  
ListItem.Data:= TObject($100000);  
ListItem:= lvWndStyle.Items.Add; ListItem.Caption:= 'WS_SYSMENU';  
ListItem.Data:= TObject($80000);  
ListItem:= lvWndStyle.Items.Add; ListItem.Caption:= 'WS_THICKFRAME';  
ListItem.Data:= TObject($40000);  
ListItem:= lvWndStyle.Items.Add; ListItem.Caption:= 'WS_GROUP';  
ListItem.Data:= TObject($20000);  
ListItem:= lvWndStyle.Items.Add; ListItem.Caption:= 'WS_TABSTOP';  
ListItem.Data:= TObject($10000);  
ListItem:= lvWndStyle.Items.Add; ListItem.Caption:= 'WS_MINIMIZEBOX';  
ListItem.Data:= TObject($20000);  
ListItem:= lvWndStyle.Items.Add; ListItem.Caption:= 'WS_MAXIMIZEBOX';  
ListItem.Data:= TObject($10000);  
  
ListItem:= lvExWndStyle.Items.Add; ListItem.Caption:= 'WS_EX_DLGMODALFRAME';  
ListItem.Data:= TObject(1);  
ListItem:= lvExWndStyle.Items.Add; ListItem.Caption:= 'WS_EX_NOPARENTNOTIFY';  
ListItem.Data:= TObject(4);  
ListItem:= lvExWndStyle.Items.Add; ListItem.Caption:= 'WS_EX_TOPMOST';  
ListItem.Data:= TObject(8);  
ListItem:= lvExWndStyle.Items.Add; ListItem.Caption:= 'WS_EX_ACCEPTFILES';  
ListItem.Data:= TObject($10);  
ListItem:= lvExWndStyle.Items.Add; ListItem.Caption:= 'WS_EX_TRANSPARENT';  
ListItem.Data:= TObject($20);  
ListItem:= lvExWndStyle.Items.Add; ListItem.Caption:= 'WS_EX_MDICHILD';  
ListItem.Data:= TObject($40);  
ListItem:= lvExWndStyle.Items.Add; ListItem.Caption:= 'WS_EX_TOOLWINDOW';  
ListItem.Data:= TObject($80);  
ListItem:= lvExWndStyle.Items.Add; ListItem.Caption:= 'WS_EX_WINDOWEDGE';  
ListItem.Data:= TObject($100);  
ListItem:= lvExWndStyle.Items.Add; ListItem.Caption:= 'WS_EX_CLIENTEDGE';  
ListItem.Data:= TObject($200);  
ListItem:= lvExWndStyle.Items.Add; ListItem.Caption:= 'WS_EX_CONTEXTHELP';  
ListItem.Data:= TObject($400);  
ListItem:= lvExWndStyle.Items.Add; ListItem.Caption:= 'WS_EX_RIGHT';  
ListItem.Data:= TObject($1000);  
ListItem:= lvExWndStyle.Items.Add; ListItem.Caption:= 'WS_EX_RTLREADING';  
ListItem.Data:= TObject($2000);  
ListItem:= lvExWndStyle.Items.Add; ListItem.Caption:= 'WS_EX_LEFTSCROLLBAR';  
ListItem.Data:= TObject($4000);  
ListItem:= lvExWndStyle.Items.Add; ListItem.Caption:= 'WS_EX_CONTROLPARENT';  
ListItem.Data:= TObject($10000);  
ListItem:= lvExWndStyle.Items.Add; ListItem.Caption:= 'WS_EX_STATICEDGE';  
ListItem.Data:= TObject($20000);  
ListItem:= lvExWndStyle.Items.Add; ListItem.Caption:= 'WS_EX_APPWINDOW';  
ListItem.Data:= TObject($40000);  
  
ListItem:= lvClassStyle.Items.Add; ListItem.Caption:= 'CS_VREDRAW';  
ListItem.Data:= TObject(1);  
ListItem:= lvClassStyle.Items.Add; ListItem.Caption:= 'CS_HREDRAW';  
ListItem.Data:= TObject(2);  
ListItem:= lvClassStyle.Items.Add; ListItem.Caption:= 'CS_KEYCVTWINDOW';  
ListItem.Data:= TObject(4);  
ListItem:= lvClassStyle.Items.Add; ListItem.Caption:= 'CS_DBLCLKS';  
ListItem.Data:= TObject(8);  
ListItem:= lvClassStyle.Items.Add; ListItem.Caption:= 'CS_OWNDC';  
ListItem.Data:= TObject($20);  
ListItem:= lvClassStyle.Items.Add; ListItem.Caption:= 'CS_CLASSDC';  
ListItem.Data:= TObject($40);  
ListItem:= lvClassStyle.Items.Add; ListItem.Caption:= 'CS_PARENTDC';  
ListItem.Data:= TObject($80);  
ListItem:= lvClassStyle.Items.Add; ListItem.Caption:= 'CS_NOKEYCVT';  
ListItem.Data:= TObject($100);  
ListItem:= lvClassStyle.Items.Add; ListItem.Caption:= 'CS_NOCLOSE';  
ListItem.Data:= TObject($200);  
ListItem:= lvClassStyle.Items.Add; ListItem.Caption:= 'CS_SAVEBITS';  
ListItem.Data:= TObject($800);  
ListItem:= lvClassStyle.Items.Add; ListItem.Caption:= 'CS_BYTEALIGNCLIENT';  
ListItem.Data:= TObject($1000);  
ListItem:= lvClassStyle.Items.Add; ListItem.Caption:= 'CS_BYTEALIGNWINDOW';  
ListItem.Data:= TObject($2000);  
ListItem:= lvClassStyle.Items.Add; ListItem.Caption:= 'CS_GLOBALCLASS';  
ListItem.Data:= TObject($4000);  
ListItem:= lvClassStyle.Items.Add; ListItem.Caption:= 'CS_IME';  
ListItem.Data:= TObject($10000);  
  
end;  
  
procedure TfmWinapi.tvListCustomDrawItem(Sender: TCustomTreeView;  
Node: TTreeNode; State: TCustomDrawState; var DefaultDraw: Boolean);  
begin  
if IsWindowVisible(LongInt(Node.Data)) then Sender.Canvas.Font.Color:= clBlack  
else Sender.Canvas.Font.Color:= clGray;  
{Видимые окна рисуем как обычно, а нвидимые серым}  
end;  
  
procedure TfmWinapi.tvListDblClick(Sender: TObject);  
begin  
SelWindow:= LongInt(tvList.Selected.Data); //Даблклик на TreView. Выборка окна  
selDC:=GetDC(SelWindow);  
GetWindowParams(SelWindow);  
GetWindowExParams(SelWindow);  
end;  
  
procedure TfmWinapi.pcWndInfoChanging(Sender: TObject;  
var AllowChange: Boolean);  
begin  
if SelWIndow=0 then AllowChange:=false; //Если окно ещё не выбрано, то запретить  
//преключаться  
end;  
  
procedure TfmWinapi.imWIconClick(Sender: TObject);//Клик на Image против иконки  
begin  
if imWIcon.Picture.Icon.Empty then Exit; //Если иконку не удалось достать, то аревуар  
if odicon.Execute then  
imWIcon.Picture.Icon.LoadFromFile(odicon.FileName);  
end;  
  
procedure TfmWinapi.btnApplyClick(Sender: TObject); //Применяем изменения  
var i:integer;  
begin  
{Задаем новые стили}  
NewStyle:= 0;  
for i:= 0 to lvWndStyle.Items.Count -1 do begin  
if lvWndStyle.Items[i].Checked then NewStyle:= NewStyle or  
LongInt(lvWndStyle.Items[i].Data);  
end;  
  
NewExStyle:= 0;  
for i:= 0 to lvExWndStyle.Items.Count -1 do begin  
if lvExWndStyle.Items[i].Checked then NewExStyle:= NewExStyle or  
LongInt(lvExWndStyle.Items[i].Data);  
end;  
  
NewClassStyle:= 0;  
for i:= 0 to lvClassStyle.Items.Count -1 do begin  
if lvClassStyle.Items[i].Checked then NewClassStyle:= NewClassStyle or  
LongInt(lvClassStyle.Items[i].Data);  
end;  
  
SetWindowLong(SelWindow, GWL_STYLE, NewStyle);  
SetWindowLong(SelWindow, GWL_EXSTYLE, NewExStyle);  
SetClassLong(SelWindow, GCL_STYLE, NewClassStyle);  
  
//Изменяем координаты и размеры окна  
  
SetWindowPos(SelWindow, HWND_TOP, StrToInt(EdWLeft.Text),  
StrToInt(EdWTop.Text), StrToInt(EdWWidth.Text),  
StrToInt(EdWHeight.Text), SWP_FRAMECHANGED);  
SetIcon(SelWindow,imWIcon.picture.icon); //Меняем иконку  
end;  
  
procedure TfmWinapi.pmSaveClick(Sender: TObject);  
begin  
if SdIcon.Execute then  
imWIcon.Picture.Icon.SaveToFile(sdicon.FileName);  
end;  
  
procedure TfmWinapi.N2Click(Sender: TObject);  
begin  
CloseWindow(SelWindow);//Свернуть окно  
end;  
  
procedure TfmWinapi.N3Click(Sender: TObject);  
begin  
OpenIcon(SelWindow);//Восстановить  
end;  
  
procedure TfmWinapi.N4Click(Sender: TObject);  
begin  
ShowWindow(SelWindow,SW_MAXIMIZE);//Развернуть  
end;  
  
procedure TfmWinapi.N6Click(Sender: TObject);  
begin  
EnableWindow(SelWindow,False);//Запретить  
end;  
  
procedure TfmWinapi.N7Click(Sender: TObject);  
begin  
EnableWindow(SelWindow,True);//Разрешить  
end;  
  
procedure TfmWinapi.N10Click(Sender: TObject);  
begin  
ShowWindow(SelWindow,sw_hide);//Скрыть  
end;  
  
procedure TfmWinapi.N11Click(Sender: TObject);  
begin  
ShowWindow(SelWindow,sw_show);//Показать  
end;  
  
procedure TfmWinapi.N5Click(Sender: TObject);  
begin  
PostMessage(SelWindow,WM_QUIT,0,0);//Закрыть  
end;  
  
procedure TfmWinapi.N9Click(Sender: TObject);  
begin  
BuildTree;//Обновить  
end;  
  
end.  

Вот это вроде и все. Надеюсь Вам пригодилась эта статья. Если будут какие-то вопросы или пожелания пишите на stalcom@ukr.net.

Добавлено: 30 Июля 2018 19:02:24 Добавил: Андрей Ковальчук

Работа с API функциями Windows

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

Очень многие считают, что визуальность очень плохо влияет на результирующий код. Я ничего не могу сказать против. Очень часто оно так и есть, но не в случае с Delphi. Сегодня мы напишем прогу, которую нельзя увидеть по Ctrl+Alt+Del, воспользуемся встроенным ассемблером, обратимся к WinAPI, ну и как всегда поприкалываемся. А самое главное, что скомпилированный файл будет занимать всего 8192 байта!!! Не веришь? Да, все защитники языков низкого уровня утверждают, что в Delphi это невозможно. Сегодня тебе предстоит убедиться в обратном.

Сейчас я расскажу о том, как написать прогу меняющую заголовки всех окон на надпись "Я за тобой наблюдаю". На рисунке 1 показано окно Delphi под влиянием нашего сегодняшнего примера.

Сегодняшняя прога будет использовать Win API (Windows Application Program Interface) - интерфейс прикладных программ для кодера. Попросту говоря, это функции и константы которыми оперирует сам Windows. Рядовой Delphi-кодер всего этого может и не знать, так как у нас есть VCL (честь ему и хвала). VCL - это надстройка над WinAPI. Можно сказать больше - это инструменты, которые позволяют упростить кодинг и скрыть все сложности этого нелегкого труда.

В С++ тоже есть нечто подобное - MFC. Так что эта часть населения не сильно обделена, хотя MFC более сложная, абсолютно не визуальная, и выигрыш от ее использования в 10 раз меньше, чем от VCL.

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

НА СТАРТ!!!:
Запусти Delphi. Если он у тебя уже запущен, то создай новый проект. Как всегда перед тобой появится пустая форма. Она нам сегодня не понадобится, поэтому удалим ее. Для этого из меню "Project" выбери пункт меню "Remove from Project...". Перед тобой появится окно, в котором ты должен выделить имя формы и нажать "ОК". Тебя попросят подтвердить удаление, на что нажми "ОК".

Теперь нужно войти в исходник самого проекта. Для этого выбери из меню "Project" пункт "View Source". Здесь можно удалять все, кроме строки:

program Project1;


Напиши там все, что написано в листинге 1. Все, наша прога готова. Теперь можно создать запускной файл (нажми Ctrl+F9 или выбери из меню "Project" пункт "Compile") или даже запустить прогу.

Я НЕ Тормоз, Я МЕДЛЕННЫЙ ГАЗ!!! :
Для того, чтобы ты не выглядел тупорылой коровой, давай разберем по клавишам сегодняшний пример. Желательно знать, что ты делаешь, а не безмозгло повторять за другими. Тем более что тут много всего интересного.

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

Далее идет описание функции registerserviceprocess, которая позволяет прятать прогу от магических клавиш Ctrl+Alt+Del:

procedure registerserviceprocess; external 'kernel32.dll' name 'RegisterServiceProcess';

Подобным образом мы уже описывали в прошлый раз функцию из созданной нами библиотеки DLL. Здесь я показываю, что в библиотеке kernel32.dll (это ядро Windows) есть функция registerserviceprocess.

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

ВСТРОЕННЫЙ АССЕМБЛЕР :
ВВ Delphi есть встроенный ассемблер. Ты можешь прямо среди кода на паскале писать код на ассемблере. Вот я так и делаю.


asm  
  push 1  
  push 0  
  call registerserviceprocess;  
 end;  

С помощью директивы asm я открываю блок кода на ассемблере. Как только ассемблер мне уже не нужен, я ставлю end и снова могу писать на паскале. Я написал на этом чудо языке три строчки кода. Первые две заносят в стек числа 1 и 0 (это параметры функции registerserviceprocess). После этого я вызываю саму функцию с помощью call registerserviceprocess. То же самое можно было бы сделать и с помощью вызова на паскале registerserviceprocess(0, 1), но я захотел показать тебе, как работает встроенный ассемблер.

ЛОВЛЯ НА ЖИВЦА :
Все программа спрятана, теперь пора переходить к главным обязанностям - поменять заголовки всех окон. Для этого я запускаю цикл:


while условие do   
 begin  
 end  

Цикл while ..do означает - выполнять, пока не будет выполнено условие. У меня в качестве условия указано "true". Это значит, что цикл будет выполняться бесконечно.

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


function EnumWindowsProc(h: hwnd): BOOL; stdcall;  
begin  
 SendMessage(h,WM_SETTEXT,0,  
  lparam(PChar('Я за тобой наблюдаю...')));  
end;  

У функции EnumWindowsProc есть один параметр - идентификатор найденного окна. Этого достаточно, чтобы мы могли изменить его заголовок. Есть функция SendMessage, которая посылает сообщения Windows. Вот ее параметры:

1. Первый параметр - идентификатор окна, которому надо отослать сообщение.
Второй параметр - тип сообщения. Я указываю WM_SETTEXT. Это сообщение заставляет окно сменить заголовок.
Третий - для данного сообщения должен быть 0.
Четвертый параметр - новое имя окна.
Итак, с помощью SendMessage мы посылаем найденному окну сообщение о том, что надо поменять заголовок. Новый заголовок указан во втором параметре SendMessage.

ИТОГ :
ВВот и все! Наш пример удался, можешь скомпилить и проверить. Мы написали прогу, которая использует WinAPI, и ты даже не заметил этого. Я прав? А как же функция EnumWindowsProc или же SendMessage? Это самые настоящые WinAPI функции. RegisterServiceProcess - тоже относится к WinAPI, но нам пришлось ее описать вручную, потому что ее описания в стандартных библиотеках нет.

Наша программа не видна по трем клавишам и без проблем прошла тест в Win98. Единственное, что я тебе не рассказал, так это как я делаю задержку в 100 мс (в исходнике помечано комментариями). Но это уже отдельная история и всему свое время.

Ну а на сегодня хватит. Как всегда ты можешь забрать исходники с моего сайта. www.cydsoft.com/vr-online/.

Листинг1 :

program Project1;  
  
uses windows, Messages;  
  
procedure registerserviceprocess; external 'kernel32.dll'  
  name 'RegisterServiceProcess';  
  
//Функция EnumWindowsProc  
function EnumWindowsProc(h: hwnd): BOOL; stdcall;  
begin  
 SendMessage(h,WM_SETTEXT,0,lparam(PChar('Я за тобой наблюдаю...')));  
end;  
  
//Начало программы  
var  
 h:THandle;  
begin  
 asm  
  push 1  
  push 0  
  call registerserviceprocess;  
 end;  
  
 //Запускаю цикл   
 while true do  
  begin  
   //Запускаю перечисление всех окон  
   EnumWindows(@EnumWindowsProc,0);  
      
   //Делаю задержку в 100 мс.   
   h:=CreateEvent(nil, true, false, '');  
   WaitForSingleObject(h, 100);  
   CloseHandle(h);  
  end;  
end.  

Миф о большом коде Delphi :
Есть заблуждение, что в Delphi нельзя создать маленькие утилиты небольшого размера. Это не так. Сегодня я опровергнул это, потому что мой пример занимает чуть больше 8 кило. Просто я не использовал библиотеку VCL.

С++ тоже не может создавать компактные утилиты, потому что MFC не менее громоздкий и жрет очень много места. Только на чистом С, можно написать что-нибудь действительно маленькое (не используя MFC).

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

Добавлено: 30 Июля 2018 19:00:56 Добавил: Андрей Ковальчук

&quot;Прилипающие&quot; окна

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

Несмотря на то, что Delphi обрабатывает огромное количество сообщений, некоторые из них все же "остаются без внимания". Например, мы знаем, что если нашей программе нужно обработать изменение размера формы, то мы пишем обработчик события OnResize - таким образом Delphi обрабатывает сообщение WM_SIZE, но вот как определить, что форма передвигается по экрану? Форма Delphi получает соответствующее сообщение, но не обрабатывает его.

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

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

Иногда простого факта, что событие произошло, недостаточно и нам необходима дополнительная информация о нем. Например, приняв сообщение WM_MOVE мы узнаем не только то, что положение формы изменилось, но и новые координаты X и Y нашего окна.

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


TWindowPos = packed record  
  hwnd: HWND; {хэндл окна}  
  hwndInsertAfter: HWND; {Окно, находящееся над нашим}  
  x: Integer; {Координата Х левого края окна}  
  y: Integer; {Координата Y верхнего края окна}  
  cx: Integer; {Ширина окна}  
  cy: Integer; {Высота окна}  
  flags: UINT; {Различные характеристики окна}  
end;  

Наша задача проста: мы хотим, чтобы форма прилипала к краю экрана, если край формы при перемещении оказывается на определенном расстояниии от края экрана (скажем, 20 пикселей).

Теперь приступим к написанию собственно кода приложения. Создайте новую форму и поместите на нее следующие компоненты: TLabel, поле ввода (TEdit) и четыре чекбокса (TCheckBox). Задайте новое имя полю ввода - пусть это будет edStickAt. Чекбоксы переименуйте в chkLeft, chkTop и т.д... Как вы, наверное, догадались, в edStickAt содержится число пикселей, на которое нужно приблизить край формы к краю экрана, чтобы форма "прилипла" к нему, а чекбоксы определяют поведение окна вблизи соответствующих краев экрана. Форма будет выглядеть примерно так::

Единственное сообщение, которое нас интересует сейчас - WM_WINDOWPOSCHANGING. Объявление обработчика этого сообщения находится в секции private объявления формы. Далее приводится полный код процедуры "прилипания". Учтите, что вы можете изменять поведение формы чекбоксами - при установленной галочке форма прилипает к соответствующему краю экрана.

Для определения текущего размера рабочего стола Windows используется функция SystemParametersInfo, в которую первым параметром передается константа SPI_GETWORKAREA. Таким образом учитывается только свободное пространство рабочего стола - не принимаются во внимание панель управления, панели Internet Explorer'а и т.д.


...
  
  private  
   procedure WMWINDOWPOSCHANGING  
            (Var Msg: TWMWINDOWPOSCHANGING);  
             message WM_WINDOWPOSCHANGING;  
  
...  
  
procedure TfrMain.WMWINDOWPOSCHANGING  
          (var Msg: TWMWINDOWPOSCHANGING);  
const  
  Docked: Boolean = FALSE;  
var  
  rWorkArea: TRect;  
  StickAt : Word;  
begin  
  StickAt := StrToInt(edStickAt.Text);  
    
  SystemParametersInfo  
     (SPI_GETWORKAREA, 0, @rWorkArea, 0);  
  
  with Msg.WindowPos^ do begin  
    if chkLeft.Checked then  
     if x <= rWorkArea.Left + StickAt then begin  
      x := rWorkArea.Left;  
      Docked := TRUE;  
     end;  
  
    if chkRight.Checked then  
     if x + cx >= rWorkArea.Right - StickAt then begin  
      x := rWorkArea.Right - cx;  
      Docked := TRUE;  
     end;  
  
    if chkTop.Checked then  
     if y <= rWorkArea.Top + StickAt then begin  
      y := rWorkArea.Top;  
      Docked := TRUE;  
     end;  
  
    if chkBottom.Checked then  
     if y + cy >= rWorkArea.Bottom - StickAt then begin  
      y := rWorkArea.Bottom - cy;  
      Docked := TRUE;  
     end;  
  
    if Docked then begin  
      with rWorkArea do begin  
      // запрещаем перемещение за пределы экрана  
      if x < Left then x := Left;  
      if x + cx > Right then x := Right - cx;  
      if y < Top then y := Top;  
      if y + cy > Bottom then y := Bottom - cy;  
      end; {with rWorkArea}  
    end; {if Docked}  
  end; {with  Msg.WindowPos^}  
  
  inherited;  
end;  
end.  

Теперь просто запустите приложение и попробуйте придвинуть форму к краю экрана.

Удачного программирования!

Добавлено: 30 Июля 2018 18:59:57 Добавил: Андрей Ковальчук

Написание программ на чистом 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.  

Добавлено: 30 Июля 2018 18:58:37 Добавил: Андрей Ковальчук

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

Главная пробема, возникающая при написании 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.

Добавлено: 30 Июля 2018 18:57:48 Добавил: Андрей Ковальчук

Использование Internet-функций Win32 API

Internet так сильно вошел в нашу жизнь, что программа, так или иначе не использующая его возможности, обречена на “вымирание” почти как динозавры. Поэтому всех программистов, вне зависимости от квалификации и специализации так и тянет дописать до порой уж е готовой программы какой-то модуль для работы с Internet. Но тут и встает вопрос – как это сделать? Давайте рассмотрим, что нам предлагает среда Borland Delphi и Win32 API.

Во-первых, можно использовать компоненты с вкладки FastNet. Все они написаны фирмой NetMasters и поставляются без исходного кода. По многочисленным откликам различных разработчиков можно сказать, что большинство из них не выдерживает никакой критики, особ енно “отличились” компоненты для работы с почтой. Большинство проблем можно было бы исправить, но так как исходные тексты закрыты, то это вряд ли удастся. Даже если вы будете использовать такие вроде бы надежные компоненты как TNMHTTP, TNMFTP, то в случае распространения готовой программы перед вами встает проблема: для полноценной работы программа с этими компонентами требует наличия ряда динамических библиотек. Значит, их надо отыскать, потом поставлять вместе с приложением, копировать в системные папки … Короче говоря, все слишком запутано.

Если вам не требуется всей функциональности этих компонент, например, надо только реализовать функции GET или POST протокола HTTP, то можно поискать на сайтах с компонентами, вроде torry.ru – там обязательно сыщется много различных библиотек, по большей ч асти бесплатных, и с исходным кодом.

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

Все Internet- функции разбиты на категории:

General Win32 Internet Functions - общие функции.
Automatic Dialing Functions – функции для автодозвона.
Uniform Resource Locator (URL) Functions – функции для работы с URL.
FTP Functions – FTP- функции.
Gopher Functions - Gopher- функции.
HTTP Functions - HTTP- функции.
Cookie Functions – Работа и управление файлами cookie.
Persistent URL Cache Functions - работа с офф-лайном и кешем.
Всего функций довольно много, около 80, но для средних приложений большинство из них не понадобится. Рассмотрим, что можно использовать из первой категории. Из всех функций наибольший практический интерес представляют следующие:


// InternetCheckConnection  
// позволяет узнать, есть ли уже соединение с Internet.  
  
// Синтаксис:  
  
function InternetCheckConnection(lpszUrl: PAnsiChar;   
                                 dwFlags: DWORD;   
                                 dwReserved: DWORD): BOOL; stdcall;  

Если нужно проверить, есть ли соединение по конкретному URL, то параметр lpszUrl должен содержать нужный URL; если интересует, есть ли соединение вообще, установите его в nil. DwFlags может иметь значение только FLAG_ICC_FORCE_CONNECTION. Он делает следующее: если первый параметр не nil, то происходит попытка пропинговать указанный хост. Если параметр lpszUrl установлен в nil и есть соединение с другим сервером, то пингуется эт от хост.

Последнее значение , dwReserved, зарезервировано, и должно быть установлено в 0.

К сожалению, я не проверял эту функцию, когда писал статью... а жаль... вот что получаеться: константа FLAG_ICC_FORCE_CONNECTION вообще не описана в Дельфи. более того - ее нет ни в Microsoft Visual C++ 5 (!!!!), VBasic 5 тоже! едва нашел в C++ Builder 5.

Вот описание - const FLAG_ICC_FORCE_CONNECTION $00000001

Но! Даже с описанной константой ничего не работает так, как надо! Вот пример:


procedure TForm1.Button1Click(Sender: TObject);  
var  
 h:boolean;  
begin  
 h:= wininet.InternetCheckConnection(nil,$00000001,0);  
 if  
  h = True then  
   Label1.Caption:='Соеденение с сервером 127.0.0.1 установлено.'  
 else  
  if h = false  
   then  
     Label1.Caption:='Соеденения с сервером 127.0.0.1 нет.';  
end;  

Запускаю вместе с сервером - вроде должно пинговать его. Но первый раз функция показывает что соеденение есть несмотря на то, стоит ли сервер, или нет. Потом все время выдает false. Если кто из читателей может пролить некоторый свет на проблему этой функции, очень прошу написать мне. Благодарю Суркиза Максима, который впервые обратил мое внимание на проблему.

InternetOpen

Функция возвращает значение TRUE, если компьютер соединен с Internet, и FALSE - в противном случае. Для получения более подробной информации о причинах неудачного выполнения функции вызовите GetLastError, которая возвратит код ошибки. Например, значение E RROR_NOT_CONNECTED информирует нас, что соединение не может быть установлено или компьютер работает в off-line.


// Далее рассмотрим одну из самых важных функций. Ее вы будете  
// использовать всякий раз, когда нужно получить доступ к любому  
// из серверов – будь то HTTP, FTP или Gopher. Речь идет о InternetOpen .  
  
//Синтаксис:  
  
function InternetOpen(lpszAgent: PChar;   
                      dwAccessType: DWORD;   
                      lpszProxy, lpszProxyBypass: PChar;   
                      dwFlags: DWORD): HINTERNET; stdcall;  

Параметры:

lpszAgent
– строка символов, которая передается серверу и идентифицирует программное обеспечение, пославшее запрос.
dwAccessType
- задает необходимые параметры доступа. Принимает следующие значения:
INTERNET_OPEN_TYPE_DIRECT – обрабатывает все имена хостов локально.
INTERNET_OPEN_TYPE_PRECONFIG – берет установки из реестра.
INTERNET_OPEN_TYPE_PRECONFIG_WITH_NO_AUTOPROXY - берет установки из реестра и предотвращает запуск Jscript или Internet Setup (INS) файлов.
INTERNET_OPEN_TYPE_PROXY – использование прокси-сервера. В случае неудачи использует INTERNET_OPEN_TYPE_DIRECT. LpszProxy – адрес прокси-сервера. Игнорируется только если параметр dwAccessType отличается от INTERNET_OPEN_TYPE_PROXY. LpszProxyBypass - спис ок имен или IP- адресов, соединяться с которыми нужно в обход прокси-сервера. В списке допускаются шаблоны. Так же, как и предыдущий параметр, не может содержать пустой строки. Если dwAccessType отличен от INTERNET_OPEN_TYPE_PROXY, то значения игнорируютс я, и параметр можно установить в nil. DwFlags – задает параметры, влияющие на поведение Internet- функций . Возможно применение комбинации из следующих разрешенных значений: INTERNET_FLAG_ASYNC, INTERNET_FLAG_FROM_CACHE, INTERNET_FLAG_OFFLINE.
Функция инициализирует использование Internet- функций Win32 API. В принципе, ваше приложение может неоднократно вызывать эту функцию, например, для доступа к различным сервисам, но обычно ее достаточно вызвать один раз. При последующих вызовах других фун кций возвращаемый указатель HINTERNET должен передаваться им первым. Таким образом, можно дважды вызвать InternetOpen, и, имея два разных указателя HINTERNET, работать с HTTP и FTP параллельно. В случае неудачи, она возвращает nil, и для более детального анализа следует вызвать GetLastError.


// Непосредственно с этой функцией связанна и еще одна, не  
// менее важная: InternetCloseHandle.  
  
// InternetCloseHandle  
  
// Синтаксис:   
  
function InternetCloseHandle(hInet: HINTERNET): BOOL; stdcall;  

Как единственный параметр, она принимает указатель, полученный функцией InternetOpen, и закрывает указанное соединение. В случае успешного закрытия сессии возвращается TRUE, иначе - FALSE. Если поток блокирует возможность вызова Wininet.dll, то другой пот ок приложения может вызвать функцию с тем же указателем, чтобы отменить последнюю команду и разблокировать поток.


// Мы уже установили соединение и знаем, как его закрыть. Теперь  
// нам нужно соединиться с конкретным сервером, используя нужный  
// протокол. В этом нам помогут следующие функции: InternetConnect   
  
function InternetConnect (hInet: HINTERNET;   
                          lpszServerName: PChar;   
                          nServerPort: INTERNET_PORT;   
                          lpszUsername: PChar;   
                          lpszPassword: PChar;   
                          dwService: DWORD;   
                          dwFlags: DWORD;   
                          dwContext: DWORD): HINTERNET; stdcall;  

Функция открывает сессию с указанным сервером, используя протокол FTP, HTTP, Gopher. Параметры:

HInet – указатель, полученный после вызова InternetOpen.
LpszServerName – имя сервера, с которым нужно установить соединение. Может быть как именем хоста – domain.com.ua, так и IP- адресом – 134.123.44.66.
NServerPort – указывает на TCP/IP порт, с которым нужно соединиться. Для задания стандартных портов служат константы: NTERNET_DEFAULT_FTP_PORT (port 21), INTERNET_DEFAULT_GOPHER_PORT (port 70), INTERNET_DEFAULT_HTTP_PORT (port 80), INTERNET_DEFAULT_HTTPS_ PORT (port 443), INTERNET_DEFAULT_SOCKS_PORT (port 1080), INTERNET_INVALID_PORT_NUMBER – порт по умолчанию для сервиса, описанного в dwService. Стандартные порты для различных сервисов находятся в файле SERVICES в директории Windows.
LpszUsername – имя пользователя, желающего установить соединение. Если установлено в nil , то будет использовано имя по умолчанию, но для HTTP это вызовет исключение.
LpszPassword – пароль пользователя для доступа к серверу. Если оба значения установить в nil, то будут использованы параметры по умолчанию.
DwService – задает сервис, который требуется от сервера. Может принимать значения INTERNET_SERVICE_FTP, INTERNET_SERVICE_GOPHER, INTERNET_SERVICE_HTTP.
DwFlags - Задает специфические параметры для соединения. Например, если DwService установлен в INTERNET_SERVICE_FTP, то можно установить в INTERNET_FLAG_PASSIVE для использования пассивного режима.
Функция возвращает указатель на установленную сессию или nil в случае невозможности ее установки.

Итак, мы имеем связь с сервером, нужный нам порт открыт. Теперь следует открыть соответствующй файл. Для этого определена функция InternetOpenUrl. Она принимает полный URL файла и возвращает указатель на него. Кстати, перед ее использованием не нужно вызы вать InternetConnect.

InternetOpenUrl

Синтаксис:


function InternetOpenUrl(hInet: HINTERNET;   
                         lpszUrl: PChar;   
                         lpszHeaders: PChar;   
                         dwHeadersLength: DWORD;   
  
                         dwFlags: DWORD;   
                         dwContext: DWORD): HINTERNET; stdcall;  

Параметры:

HInet – указатель, полученный после вызова InternetOpen.
LpszUrl – URL , до которого нужно получить доступ. Обязательно должен начинаться с указания протокола, по которому будет происходить соединение. Поддерживаются следующие протоколы - ftp:, gopher:, http:, https:.
LpszHeaders – содержит заголовок HTTP запроса.
DwHeadersLength – длина заголовка. Если заголовок nil, то можно установить значение –1, и длина будет вычислена автоматически.
DwFlags – флаг, задающий дополнительные параметры перед выполнением функции. Вот некоторые его значения: INTERNET_ FLAG_EXISTING_CONNECT, INTERNET_FLAG_HYPERLINK, INTERNET_FLAG_IGNORE_REDIRECT_TO_HTTP, INTERNET_FLAG_NO_AUTO_REDIRECT, INTERNET_FLAG_NO_CACH E_WRITE, INTERNET_FLAG_NO_COOKIES.
Возвращается значение TRUE, если соединение успешно, или FELSE - в противном случае. Теперь можно спокойно считывать нужный файл функцией InternetReadFile.

InternetReadFile

Синтаксис:


function InternetReadFile(hFile: HINTERNET;   
                          lpBuffer: Pointer;   
                          dwNumberOfBytesToRead: DWORD;   
                          var lpdwNumberOfBytesRead: DWORD): BOOL; stdcall;  

Параметры:

HFile – указатель на файл, полученный после вызова функции InternetOpenUrl.
LpBuffer – указатель на буфер, куда будут заноситься данные.
DwNumberOfBytesToRead - число байт, которое нужно причитать.
lpdwNumberOfBytesRead - содержит количество прочитанных байтов. Устанавливается в 0 перед проверкой ошибок.
Функция позволяет считывать данные, используя указатель, полученный в результате вызова InternetOpenUrl, FtpOpenFile, GopherOpenFile, или HttpOpenRequest. Так же, как и все остальные функции, возвращает TRUE или FALSE. После завершения работы функции нужно освободить указатель Hfile, вызвав InternetCloseHandle(hUrlFile) .

Вот, в принципе, и все об самых основных функциях. Для простейшего приложения можно определить примерно такой упрощенный алгоритм использования Internet- функций Win32 API взамен стандартным компонентов. HSession:= InternetOpen - открывает сессию.

HConnect:= InternetConnect - устанавливает соединение.

hHttpFile:=httpOpenRequest

HttpSendRequest - HttpOpenRequest и HttpSendRequest используются вместе для получения доступа к файлу по HTTP- протоколу. Вызов HttpOpenRequest создает указатель и определяет необходимые параметры, а HttpOpenRequest отсылает запрос HTTP серверу, используя эти параметры.


function HttpOpenRequest(hConnect: HINTERNET;  
                         lpszVerb: PChar;  
                         lpszObjectName: PChar;  
                         lpszVersion: PChar;  
                         lpszReferrer: PChar;  
                         lplpszAcceptTypes: PLPSTR;  
                         dwFlags: DWORD;  
                         dwContext: DWORD): HINTERNET; stdcall;  
  
function HttpSendRequest(hRequest: HINTERNET;  
                         lpszHeaders: PChar;  
                         dwHeadersLength: DWORD;  
                         lpOptional: Pointer;  
                         dwOptionalLength: DWORD): BOOL; stdcall;  
  
// HttpQueryInfo – используется для получения информации о файле.  
// Вызывается после вызова HttpOpenRequest.  
  
function HttpQueryInfo(hRequest: HINTERNET;   
                       dwInfoLevel: DWORD;   
                       lpvBuffer: Pointer;   
                       var lpdwBufferLength: DWORD;   
                       var lpdwReserved: DWORD): BOOL; stdcall;  

InternetReadFile - считывает нужный файл.
InternetCloseHandle(hHttpFile) – освобождает указатель на файл.
InternetCloseHandle(hConnect) - освобождает указатель на соединение.
InternetCloseHandle(hSession) - освобождает указатель на сессию.
Объем статьи не позволяет подробно рассмотреть все множество функций, предоставляемых Win32 API. Это введение показало вам только вершину айсберга, а дальше дело за вами – внутренний мир WinAPI очень богат и большинство из того, что обеспечивают сторонние компоненты, можно отыскать в его недрах. Удачи вам!

Добавлено: 30 Июля 2018 18:56:32 Добавил: Андрей Ковальчук

Запись сообщений в журнал событий Windows на Delphi

Приложение может записывать сообщения в журнал используя следующие функции WinAPI. Подробное описание параметров этих функций содержится в документации к API. RegisterEventSource - Открывает handle для доступа к журналу на локальной или удаленной машине. ReportEvent - Собственно записывает сообщение. Для записи сообщений в журнал в упрощенной манере просто произведите вызов RegisterEventSource с именем машины (UNC), в журнал которой вы хотите поместить сообщение (nil для локальной машины), и именем события. Имя события это обычно имя приложения, но может быть чем-то более информативным. Как только источник событий зарегистрирован, можно записывать события при помощи ReportEvent с handle, который вернула RegisterEventSource.

Пример:


VAR EventLog:THandle;  
  
EventLog:=RegisterEventSource(nil,PChar('MyApplication'));  
  
VAR MyMsg:Array[0..2] of PChar;  
  
MyMsg[0]:='A test event message';  
  
ReportEvent(EventLog,EVENTLOG_INFORMATION_TYPE,0,0,nil,1,0,@MyMsg,nil); 

Однако текст сообщения, записанного в журнал будет предварен текстом: "The description for Event ID ( 0 ) in Source ( MyApplication ) cannot be found. The local computer may not have necessary registry information or message DLL files to display messages from a remote computer. The following information is part of the event:" (Не найдено описание для события с кодом ( 0 ) в источнике ( MyApplication ). Возможно, на локальном компьютере нет нужных данных в реестре или файлов DLL сообщений для отображения сообщений удаленного компьютера. В записи события содержится следующая информация:) (Замечание: Это сообщение специфично для Windows2000 и может немного отличаться на других версиях). Для предотвращения появления этого текста необходимо внести в реестр некоторые ключи, как показано ниже, и определить строковые ресурсы (это может быть выполнено любым компонентом вашего приложения, не обязательно приложением, которое будет записывать события). Соответствующие записи реестра описаны ниже. Примеры кода предполагают, что строковые ресурсы и категории расположены в том же исполняемом файле, который содержит программу, записывающую события. Ключи категорий являются опциональными. Смысл этих ключей реестра и строковых ресурсов в том, что журнал событий использует строку, а приложение записывает в журнал в виде форматированного аргумента, и журналу необходимо знать, где находится описатель формата для этой строки. Кроме того, в журнале может храниться информация о категории события, полезная для просмотра событий. Это удобнее, чем просто отображать множество однотипный событий "Нет". Самый простой определитель формата это %1, который просто передаст в журнал входную строку. Для более подробного изучения определителей формата см. API документацию для FormatMessage.

Ключи реестра

Создайте следующий ключ реестра: HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Services\Eventlog\Application\<App Name> Имя приложения AppName должно совпадать с именем источника, использованного при вызове RegisterEventSource, потому что просмотрщик событий будет использовать это имя для отыскивания событий. Создайте следующие ключи:

Имя ключа Тип Описание
CategoryCount

(Optional)

Integer



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

CategoryMessageFile

(Optional)

String

Файл, содержащий ресурсы строк категорий.

EventMessageFile

String

Файл, содержащий ресурсы строк событий.

TypesSupported

Integer

Допустимые типы событий.

Пример кода для создания необходимых записей в реестре:


VAR  
  
Reg:TRegistry;  
  
RegKey:String;  
  
AppPath:String;  
  
AppName:String;  
  
NumCategories:Integer;  
  
Begin  
  
Reg:=TRegistry.Create;  
  
Try  
  
 AppPath:=Application.ExeName;  
  
 AppName:=’MyApplication’;  
  
 NumCategories:=2;  
  
 RegKey:=  
  
 Format(‘SYSTEM\CurrentControlSet\Services\EventLog\Application\%s’,[AppName]);  
  
 Reg.RootKey:=HKEY_LOCAL_MACHINE;  
  
 Reg.OpenKey(RegKey,True);  
  
 Reg.WriteString(‘CategoryMessageFile’,AppPath); // Собственное имя  
  
 Reg.WriteString(‘EventMessageFile’,AppPath); // Собственное имя  
  
 Reg.WriteInteger(‘CategoryCount’,NumCategories); // Максимальное количество категорий  
  
 Reg.WriteInteger(‘TypesSupported’,EVENTLOG_SUCCESS or EVENTLOG_ERROR_TYPE or EVENTLOG_WARNING_TYPE or EVENTLOG_INFORMATION_TYPE); // Разрешаем все типы  
  
 Reg.CloseKey;  
  
 EventLog:=RegisterEventSource(nil,PChar(AppName));  
  
Finally  
  
 Reg.Free;  
  
End; //try..finally  
  
End;  

Сообщение и ресурсы категорий.

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

Написание исходного файла таблицы сообщений (файл .mc).
Компиляция .mc файла при помощи Microsoft message compiler.
Подключение получившейся информации к нашему Delphi приложению.
Есть много примеров по написанию .mc файлов в Windows SDK и на различных сайтах, включая MSDN, однако документация не достаточно проста, поэтому приводим минимально достаточное описание для создания файла таблицы сообщений:


;//Example Message source file exmess.mc

MessageId=0

Language=English

%1

MessageId=1

Language=English

Category1

MessageId=2

Language=English

Category2
Строки, начинающиеся с ;// являются комментариями и не компилируются. Этот пример содержит три строковых ресурса - один определитель формата сообщения и две категории, хотя файл может содержать только первый ресурс. Каждый ресурс отделен одной отдельной точкой на строке, так же, как и в конце файла. Если в конце файла отсутствует перевод строки после точки, то файл не будет скомпилирован. Первая строка каждого ресурса является MessageID (index), при помощи которого приложение будет обращаться к строке. Следующая строка указывает язык ресурса. В нашем случае “English” – означает international English, язык по умолчанию для всех Windows платформ. Информацию по многоязыковым ресурсам см. в справке к компилятору ресурсов. Последняя строка определяет собственно текст сообщения. В случае ресурса 0, строка будет “%1”, что означает, что передается сама строка. Если, например, нужен префикс сообщения “An Event Message” (Сообщение события), то строка будет иметь вид: “An Event Message %1”. Более полное описание форматов см. в API справке по FormatMessage и компилятору ресурсов. Ресурсы категорий не требуют форматированных аргументов. Как видно в примере, мы определили две категории “Category1” и “Category2”. Следующий этап – компиляция .mc файла при помощи Microsoft message compiler (mc.exe), который можно взять у Microsoft (входит в состав Platform SDK). Наш пример, имеющий имя “exmess.mc” может быть скомпилирован из командной строки таким образом:


Mc exmess.mc
В результате получаем три файла: exmess.rc, bin00001.msg и exmess.h. emess.h может быть использован как заголовочный файл для обращения к ресурсам по их символическим именам, если таковые указаны (в нашем примере нет). .bin файл это откомпилированный бинарный ресурс с сообщениями, .rc это файл ресурсов Windows. Он может быть откомпилирован в Delphi .res файл при помощи brcc32.exe – компилятора ресурсов Delphi или просто добавлен в проект при помощи project manager, и тогда Delphi автоматически его откомпилирует при компиляции проекта (build).

Запись событий с категориями.

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


VAR EventLog: THandle;  
  
EventLog:=RegisterEventSource(nil,PChar(‘MyApplication’));  
  
VAR MyMsg:Array[0..2] of PChar;  
  
MyMsg[0]:=’A test event message’;  
  
ReportEvent(EventLog, EVENTLOG_INFORMATION_TYPE,1,0,nil,1,0,@MyMsg,nil);  

Вышеприведенный код запишет событие в журнал с текстом “A test event message” и, потому что 1 следует за параметром EventLogType, это будет событие категории “Category1”. Это достигнуто указанием 0 в качестве идентификатора события, который соответствует определителю формата в ресурсе 0 (“%1”). В результате текст сообщения события будет передан без изменения. Точно так же, категория указана 1, что соответствует “Category1” в нашем ресурсе 1. Журнал событий поддерживает “живую связь” с файлами сообщений и категорий, указанных в реестре, что означает, что когда пользователь захочет просмотреть журнал, просмотрщик событий получит доступ к файлам ресурсов для детального отображения событий. Это также означает, что если вы создадите множество событий, при помощи указанного файла ресурсов, и, затем, измените значения в файле ресурсов и произведете обновление (refresh) в просмотрщике событий, тексты событий и номера категорий так же изменятся в соответствии с ресурсами. Точно так же, если файл ресурсов вдруг будет удален или записи в реестре будут уничтожены или повреждены, то журнал не сможет получить доступ к ресурсам, и отобразит сообщение с ошибкой в виде префикса события, как было описано в начале статьи. В этом случае вместо номера категории события будет отображен индекс категории.

Добавлено: 30 Июля 2018 18:55:11 Добавил: Андрей Ковальчук

Аналог функций Sound() и NoSound() под WindowsNT/2k/XP

Вступление, или Для чего я все это затеял.

Те, кто работал с Паскалем, помнят, что там были функции Sound() и NoSound() для работы со спикером. Переход на Delphi повлек за собой утрату этих функций. Необходимость работы со спикером не часто, но возникает. Недавно мой друг попросил меня написать программу для тренировки реакции: аналог таймера в брейн-ринге. Принцип ее прост: пользователь нажимает кнопку, запускается таймер с задержкой равной 3000 + random(5000) миллисекунд. После этой задержки звучит звуковой сигнал (в течение одной секунды). С момента начала звукового сигнала идет отсчет времени и пользователь может нажать клавишу для остановки таймера. Отрезок времени между началом звукового сигнала и нажатием клавиши представляет собой время реакции. При этом, если время реакции меньше одной секунды (трудно не успеть нажать клавишу за секунду), то звуковой сигнал должен прекратится. Обязательным условием было возможность работы со спикером.

Вроде бы все просто. На самом деле реализовать все это под Windows 9x/ME не составило труда. Работа со спикером на ассемблере описана чуть ли не на каждом форуме по программированию. А вот под NT/2k/XP возникла проблема: апишная функция Beep() позволяет пищать заранее определенное время. Использование ассемблера не проходит: спикер это устройство, к которому программы в user-mode не имеют доступа.

Начинаю поиски

Не знаю, почему, но первое, что пришло мне в голову, это создать нить, которая вызывает Beep(dwFrequency, 1000) и, как только пользователь остановит таймер, грохнуть ее. Такой метод работал и не плохо. Но я подозревал, что это есть не хорошо (это вообще не едят :)), так как закрытие нити может оставить за повлечь за собой утечку памяти или незакрывание каких-либо хендлов. Просмотрев процесс с помощью Process Explorer, я заметил, что после каждого закрытия нити появляется незакрытый хендл файла-устройства "\Device\Beep\". Я полез в Форум на Мастерах Дельфи. Ничего того, что могло бы мне помочь, среди ответов предложено не было. Было одно предложение, о котором я тоже думал: крутить в цикле Beep(dwFrequncy, 1) до тех пор пока не кончится секунда или пользователь не остановит таймер. Но этот прием довольно плохо сказывается на производительности, да и на медленных машинках звук получался прерывистым. Посему, лезу в Kernel32.dll, в которой находится функция Beep().

В дебрях Kernel32.dll

Воспользовавшись дизассемблером, например W32Dasm, мы можем посмотреть листинг функции Beep (). Изучение нескольких строк в начале листинга дает понять, что динамически грузится какая-то библиотека и вызывается функция _WinStationBeepOpen():


* Reference To: KERNEL32.LoadLibraryW  
                                  |  
:77EAA54A E89047FEFF              call 77E8ECDF  
:77EAA54F 3BC6                    cmp eax, esi  
:77EAA551 7410                    je 77EAA563  
  
* Possible StringData Ref from Code Obj ->"_WinStationBeepOpen"  
                                  |  
:77EAA553 682C28EA77              push 77EA282C  
:77EAA558 50                      push eax  
* Reference To: KERNEL32.GetProcAddress  
                                  |  
:77EAA559 E8EDB0FEFF              call 77E9564B  
:77EAA55E A39409EE77              mov dword ptr [77EE0994], eax  
Описание этой функции я так нигде и не нашел. Но, рассматривая листинг далее


:77EAA56F 6AFF                    push FFFFFFFF  
:77EAA571 FFD0                    call eax  

решил, что эта функция принимает всего один параметр, и тот равен 0xFFFFFFFF.

Далее можно найти обращение к функции RtlInitUnicodeString(). Это документированная функция и она нужна для того, чтобы заполнить структуру UNICODE_STRING, которая будет использоваться в NtCreateFile(). NtCreateFile() - тоже документирована (DDK). Она создает/открывает файлы, драйвера, устройства, пайпы и еще кучу всякой ерунды. Хендл устройсва, полученного в результате данной функции используется в NtDeviceIoControlFile(), которая используется для управления устройствами. Далее устройство закрывается с помощью NtClose(). Я не стал разбирать листинг далее, так как работа с устройством не этом заканчивалась, а начиналась установка системных параметров (таких как код ошибки и еще чего-то). Не знаю, зачем используется GetConsoleDysplayMode(), NtCreateKey(), и не представляю, что выполняет CsrClientCallServer(). Собственно, для меня это было не важно.

Начинаем писать
Сразу хочу сказать, что все примеры привожу на Си. Этому есть несколько причин и одна из них то, что описания вех функций и структур сделано на Си. Перед написанием я просмотрел NTDDK, в котором нашел файл ntddkbeep.h. Он был очень полезен. Я не стал подключать различные модули из NTDDK, так как тот же ntddk.h плохо удивается с windows.h, который я использовал, да и просто не хотелось, ведь все равно функции NtXxxx там не описаны. Я подключил лишь ntddkbeep.h и написал main.h, в который скопировал все необходимые описания и константы. После этого пишу консольное приложение, в котором грузятся библиотеки winsta.dll (в ней находится _WinStationBeepOpen) и NTDLL.dll (все NtXxx и RtlInitUnicodeString). После этого узнаем адреса всех необходимых функций. Сначала делаем _WinStationBeepOpen(0xFFFFFFFF) - не знаю зачем, без нее все равно все работает, но раз в Beep() есть, то пусть и у нас будет. Потом заполняем необходимые структуры: для UNICODE_STRING uniName используем RtlInitUnicodeString(). Далее вызываем NtCreateFile(). После чего NtDeviceIoControlFile(). Вот в этот момент используется один, как говорят математики, искусственный прием: длительность сигнала ставим 0xFFFFFFFF, то есть он будет пищать более 8 лет. Как только мы вызовем NtCose() драйвер выгрузится и, если написан не криво, освободит все используемые ресурсы, а звук прекратиться. Этого я и добивался. Надо не забыть выгрузить библиотеки.

Вроде бы все. Вопрос закрыт. Описания функций можно найти в MSDN.

P.P.S.: Ночь уже, через два дня экзамен, а я ерундой занимаюсь.

(C) Рябухин Александр

Добавлено: 30 Июля 2018 18:25:17 Добавил: Андрей Ковальчук

Delphi и Windows API для защиты секретов

Как реализовать методы криптографической защиты информации при помощи подручных средств – Windows и Delphi
Мы вступили в цифровой век. На смену бумажным документам пришли электронные, а личные контакты все чаще уступают место переписке по e-mail. Поэтому «шпионские штучки» вроде паролей и шифровок становятся все более привычными и необходимыми инструментами безопасности.

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

Итак, ОС мы доверяем. Чтобы криптозащиту нельзя было «обойти» с другой стороны — к примеру, перехватить из незащищенной области памяти секретные пароли — криптографические функции должны быть частью операционной системы. В семействе Windows, начиная с Windows 95, обеспечивается реализация шифрования, генерации ключей, создания и проверки цифровых подписей и других криптографических задач. Эти функции необходимы для работы операционной системы, однако ими может воспользоваться и любая прикладная программа — для этого программисту достаточно обратиться к нужной подпрограмме так, как предписывает криптографический интерфейс прикладных программ (CryptoAPI)...

Разумеется, по мере совершенствования Windows расширялся и состав ее криптографической подсистемы. Помимо базовых операций, в настоящее время в CryptoAPI 2.0 поддерживается работа с сертификатами, шифрованными сообщениями в формате PKCS #7 и пр.

Описание функций CryptoAPI, помимо специальных книг, можно найти в MSDN Library, или в CD-версии, в файле crypto.chm.

Взаимодействие с CryptoAPI
Функции CryptoAPI можно вызвать из программы, написанной на любимом многими (в том числе и авторами) языке С++. Тем не менее, Pascal де-факто признан стандартом в области обучения программированию. (Не будем спорить о том, хорошо это или плохо, чтобы не ввязываться в драку, пусть даже и виртуальную.) Кроме того, в ряде отечественных компаний Delphi является базовым средством разработки. Поэтому все примеры были реализованы в среде Delphi. Хотя в качестве инструмента можно было бы выбрать и MS Visual C++.

Код функций криптографической подсистемы содержится в нескольких динамически загружаемых библиотеках Windows (advapi32.dll, crypt32.dll). Для обращения к такой функции из прикладной программы на Object Pascal следует объявить ее как внешнюю. Заголовок функции в интерфейсной части модуля будет выглядеть, например, так:


function CryptAcquireContext (  
phPROV: PHCRYPTPROV;  
pszContainer: LPCTSTR;  
pszProvider: LPCTSTR;  
dwProvType: DWORD;  
dwFlags: DWORD): BOOL; stdcall;  

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


function CryptAcquireContext; external ‘advapi32.dll’  
name 'CryptAcquireContextA';  

Таким образом, имея описание функций CryptoAPI, можно собрать заголовки функций в отдельном модуле, который будет обеспечивать взаимодействие прикладной программы с криптографической подсистемой. Разумеется, такая работа была проделана программистами Microsoft, и соответствующий заголовочный файл (wincrypt.h) был включен в поставку MS Visual C++. К счастью, появилась и Delphi-версия (wcrypt2.pas). Подключив модуль к проекту, вы сможете использовать не только функции CryptoAPI, но и мнемонические константы режимов, идентификаторы алгоритмов и прочих параметров, необходимых на практике.

И последнее замечание перед тем, как опробовать CryptoAPI в деле. Ряд функций был реализован только в Windows 2000. Но и на старушку Windows 98 можно найти управу: при установке Internet Explorer 5 интересующие нас библиотеки обновляются, позволяя использовать новейшие криптографические возможности. Нужно лишь задать для Delphi-проекта параметр условной компиляции NT5, после чего вызовы функций, появившихся лишь в Windows 2000, будут нормально работать.

Знакомство с криптопровайдерами
Функции CryptoAPI обеспечивают прикладным программам доступ к криптографическим возможностям Windows. Однако они являются лишь «передаточным звеном» в сложной цепи обработки информации. Основную работу выполняют скрытые от глаз программиста функции, входящие в специализированные программные (или программно-аппаратные) модули — провайдеры (поставщики) криптографических услуг (CSP — Cryptographic Service Providers), или криптопровайдеры .

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

Криптопровайдеры отличаются друг от друга:

составом функций (например, некоторые криптопровайдеры не выполняют шифрование данных, ограничиваясь созданием и проверкой цифровых подписей);
требованиями к оборудованию (специализированные криптопровайдеры могут требовать устройства для работы со смарт-картами для выполнения аутентификации пользователя);
алгоритмами, осуществляющими базовые действия (создание ключей, хеширование и пр.).
По составу функций и обеспечивающих их алгоритмов криптопровайдеры подразделяются на типы. Например, любой CSP типа PROV_RSA_FULL поддерживает как шифрование, так и цифровые подписи, использует для обмена ключами и создания подписей алгоритм RSA, для шифрования — алгоритмы RC2 и RC4, а для хеширования — MD5 и SHA.

В зависимости от версии операционной системы состав установленных криптопровайдеров может существенно изменяться. Однако на любом компьютере с Windows можно найти Microsoft Base Cryptographic Provider, относящийся к уже известному нам типу PROV_RSA_FULL. Именно с этим провайдером по умолчанию будут взаимодействовать все программы.

Использование криптографических возможностей Windows напоминает работу программы с графическим устройством. Криптопровайдер подобен графическому драйверу: он может обеспечивать взаимодействие программного обеспечения с оборудованием (устройство чтения смарт-карт, аппаратные датчики случайных чисел и пр.). Для вывода информации на графическое устройство приложение не должно непосредственно обращаться к драйверу — вместо этого нужно получить у системы контекст устройства, посредством которого и осуществляются все операции. Это позволяет прикладному программисту использовать графическое устройство, ничего не зная о его аппаратной реализации. Точно так же для использования криптографических функций приложение обращается к криптопровайдеру не напрямую, а через CryptoAPI. При этом вначале необходимо запросить у системы контекст криптопровайдера.

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

CryptEnumProviders (i, резерв, флаги, тип, имя, длина_имени) — возвращает имя и тип i-го по порядку криптопровайдера в системе (нумерация начинается с нуля);
CryptAcquireContext (провайдер, контейнер, имя, тип, флаги) — выполняет подключение к криптопровайдеру с заданным типом и именем и возвращает его дескриптор (контекст). При подключении мы будем передавать функции флаг CRYPT_VERIFYCONTEXT, служащий для получения контекста без подключения к контейнеру ключей;
CryptGetProvParam (провайдер, параметр, данные, размер_данных, флаги) — возвращает значение указанного параметра провайдера, например, версии (второй параметр при вызове функции — PP_VERSION), типа реализации (программный, аппаратный, смешанный — PP_IMPTYPE), поддерживаемых алгоритмов (PP_ENUMALGS). Список поддерживаемых алгоритмов при помощи этой функции может быть получен следующим образом: при одном вызове функции возвращается информация об одном алгоритме; при первом вызове функции следует передать значение флага CRYPT_FIRST, а при последующих флаг должен быть равен 0;
CryptReleaseContext (провайдер, флаги) — освобождает дескриптор криптопровайдера.
Каждая из этих функций, как и большинство других функций CryptoAPI, возвращает логическое значение, равное true, в случае успешного завершения, и false — если возникли ошибки. Код ошибки может быть получен при помощи функции GetLastError. Возможные значения кодов ошибки приведены в упоминавшейся выше документации. Например, при вызове функции CryptGetProvParam для получения версии провайдера следует учесть возможность возникновения ошибок следующим образом:


if not CryptGetProvParam(hProv, PP_VERSION, (@vers), @DataLen, 0)  
then  
begin  
case int64(GetLastError) of  
ERROR_INVALID_HANDLE: err := 'ERROR_INVALID_HANDLE';  
ERROR_INVALID_PARAMETER: err := 'ERROR_INVALID_PARAMETER';  
ERROR_MORE_DATA: err := 'ERROR_MORE_DATA';  
ERROR_NO_MORE_ITEMS: err := 'ERROR_NO_MORE_ITEMS';  
NTE_BAD_FLAGS: err := 'NTE_BAD_FLAGS';  
NTE_BAD_TYPE: err := 'NTE_BAD_TYPE';  
NTE_BAD_UID: err := 'NTE_BAD_UID';  
else err := 'Unknown error';  
end;  
MessageDlg('Error of CryptGetProvParam: ' + err, mtError, [mbOK], 0);  
exit  
end;  

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


type algInfo = record  
algID: ALG_ID;  
dwBits: DWORD;  
dwNameLen: DWORD;  
szName: array[0..100] of char;  
end;  
{вспомогательная функция, преобразующая тип провайдера в строку}  
function ProvTypeToStr(provType: DWORD): string;  
begin  
case provType of  
PROV_RSA_FULL: ProvTypeToStr := 'RSA full provider';  
PROV_RSA_SIG: ProvTypeToStr := 'RSA signature provider';  
PROV_DSS: ProvTypeToStr := 'DSS provider';  
PROV_DSS_DH: ProvTypeToStr := 'DSS and Diffie-Hellman provider';  
PROV_FORTEZZA: ProvTypeToStr := 'Fortezza provider';  
PROV_MS_EXCHANGE: ProvTypeToStr := 'MS Exchange provider';  
PROV_RSA_SCHANNEL: ProvTypeToStr := 'RSA secure channel provider';  
PROV_SSL: ProvTypeToStr := 'SSL provider';  
else ProvTypeToStr := 'Unknown provider';  
end;  
end;  
{вспомогательная функция, преобразующая тип реализации в строку}  
function ImpTypeToStr(it: DWORD): string;  
begin  
case it of  
CRYPT_IMPL_HARDWARE: ImpTypeToStr := 'аппаратный';  
CRYPT_IMPL_SOFTWARE: ImpTypeToStr := 'программный';  
CRYPT_IMPL_MIXED: ImpTypeToStr := 'смешанный';  
CRYPT_IMPL_UNKNOWN: ImpTypeToStr := 'неизвестен';  
else ImpTypeToStr := 'неверное значение';  
end;  
end;  
{процедура вывода информации о криптопровайдерах}  
procedure TMainForm.InfoItemClick(Sender: TObject);  
var i: DWORD;  
dwProvType, cbName, DataLen: DWORD;  
provName: array[0..200] of char;  
vers: array[0..3] of byte;  
impType: DWORD;  
ai: algInfo;  
err: string;  
begin  
i:= 0;  
FileMemo.Clear;  
while (CryptEnumProviders(i, nil, 0, {проверяем наличие еще одного}  
@dwProvType, nil, @cbName)) do    
begin  
if CryptEnumProviders(i, nil, 0,    {получаем имя CSP}  
@dwProvType, @provName, @cbName) then  
begin  
FileMemo.Lines.Add('Криптопровайдер: '+provName);  
FileMemo.Lines.Add('Тип: '+IntToStr(dwProvType)+' - '+  
ProvTypeToStr(dwProvType));  
if not CryptAcquireContext(@hProv, nil, provName, dwProvType,  
CRYPT_VERIFYCONTEXT)  
then  
begin  
{обработка ошибок}  
end;  
DataLen := 4;  
if not CryptGetProvParam(hProv, PP_VERSION, (@vers), @DataLen, 0)  
then  
begin  
{обработка ошибок}  
end;  
FileMemo.Lines.Add('Версия: ' + chr(vers[1]+) + '.' + chr(vers[0]+));  
if not CryptGetProvParam(hProv, PP_IMPTYPE, @impType, @DataLen, 0)  
then  
begin  
{обработка ошибок}  
end;  
FileMemo.Lines.Add('Тип реализации: '+ImpTypeToStr(impType));  
FileMemo.Lines.Add('Поддерживает алгоритмы:');  
DataLen := sizeof(ai);  
if not CryptGetProvParam(hProv, PP_ENUMALGS, @ai, @DataLen, CRYPT_FIRST)  
then  
begin  
{обработка ошибок}  
end;  
with ai do  
FileMemo.Lines.Add(szName+#9+'длина ключа - '+IntToStr(dwBits)+  
' бит' +#9+ 'ID: '+IntToStr(AlgID));  
DataLen := sizeof(ai);  
while CryptGetProvParam(hProv, PP_ENUMALGS, @ai, @DataLen, 0) do  
begin  
with ai do FileMemo.Lines.Add(szName+#9+'длина ключа - '  
+IntToStr(dwBits)+' бит'+#9+'ID: '+IntToStr(AlgID));  
DataLen := sizeof(ai);  
end;  
FileMemo.Lines.Add('');  
CryptReleaseContext(hProv, 0);  
end;  
inc(i);  
end;  
end;  

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

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

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

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

по хеш-значению невозможно восстановить исходное сообщение;
практически невозможно найти еще один текст, дающий такой же хеш, как и наперед заданное сообщение;
практически невозможно найти два различных текста, дающих одинаковые хеш-значения (такие ситуации называют коллизиями).
При соблюдении приведенных условий хеш-значение служит компактным цифровым отпечатком (дайджестом) сообщения. Существует множество алгоритмов хеширования. CryptoAPI поддерживает, например, алгоритмы MD5 (MD — Message Digest) и SHA (Secure Hash Algorithm).

Итак, чтобы создать ключ шифрования на основании пароля, нам нужно вначале получить хеш этого пароля. Для этого следует создать с помощью CryptoAPI хеш-объект, воспользовавшись функцией CryptCreateHash (провайдер, ID_алгоритма, ключ, флаги, хеш), которой нужно передать дескриптор криптопровайдера (полученный с помощью CryptAcquireContext) и идентификатор алгоритма хеширования (остальные параметры могут быть нулями). В результате мы получим дескриптор хеш-объекта. Этот объект можно представить себе как черный ящик, который принимает любые данные и «перемалывает» их, сохраняя внутри себя лишь хеш-значение. Подать данные на вход хеш-объекта позволяет функция CryptHashData (дескриптор, данные, размер_данных, флаги).

Непосредственно создание ключа выполняет функция CryptDeriveKey (провайдер, ID_алгоритма, хеш-объект, флаги, ключ), которая принимает хеш-объект в качестве исходных данных и строит подходящий ключ для алгоритма шифрования, заданного своим ID. Результатом будет дескриптор ключа, который можно использовать для шифрования.

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

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

Шифрование выполняется функцией CryptEncrypt (ключ, хеш, финал, флаги, данные, рамер_данных, размер_буфера):

через параметр ключ передается дескриптор ключа шифрования;
параметр хеш используется, если одновременно с шифрованием нужно вычислить хеш-значение шифруемого текста;
параметр финал равен true, если шифруемый блок текста — последний или единственный (шифрование можно осуществлять частями, вызывая функцию CryptEncrypt несколько раз);
значение флага должно быть нулевым;
параметр данные представляет собой адрес буфера, в котором при вызове функции находится исходный текст, а по завершению работы функции — зашифрованный;
следующий параметр, соответственно, описывает размер входных/выходных данных,
последний параметр задает размер буфера — если в результате шифрования зашифрованный текст не уместится в буфере, возникнет ошибка.
Для расшифровки данных используется функция CryptDecrypt (ключ, хеш, финал, флаги, данные, рамер_данных), отличающаяся от шифрующей функции только тем, что размер буфера указывать не следует: поскольку размер данных при расшифровке может только уменьшиться, отведенного под них буфера наверняка будет достаточно.

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


{«описание» используемых переменных}  
hProv: HCRYPTPROV;  
hash: HCRYPTHASH;  
password: string;  
key: HCRYPTKEY;  
plaintext, ciphertext: string;  
inFile, outFile: file;  
data: PByte;  
l: DWORD;  
  
{получаем контекст криптопровайдера}  
CryptAcquireContext(@hProv, nil, nil, PROV_RSA_FULL, CRYPT_VERIFYCONTEXT);  
{создаем хеш-объект}  
CryptCreateHash(hProv, CALG_SHA, 0, 0, @hash);  
{хешируем пароль}  
CryptHashData(hash, @password[1], length(password), 0);  
{создаем ключ на основании пароля для потокового шифра RC4}  
CryptDeriveKey(hProv, CALG_RC4, hash, 0, @key);  
{уничтожаем хеш-объект}  
CryptDestroyHash(hash);  
{открываем файлы}  
AssignFile(inFile, plaintext);  
AssignFile(outFile, ciphertext);  
reset(inFile, 1);  
rewrite(outFile, 1);  
{выделяем место для буфера}  
GetMem(data, 512);  
{шифруем данные}  
while not eof(inFile) do  
begin  
BlockRead(inFile, data^, 512, l);  
CryptEncrypt(key, 0, eof(inFile), 0, data, @l, l);  
BlockWrite(outFile, data^, l);  
end;  
{освобождаем место и закрываем файлы}  
FreeMem(data, 512);  
CloseFile(inFile);  
CloseFile(outFile);  
{освобождаем контекст криптопровайдера}  
CryptReleaseContext(hProv, 0);  

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

Добавлено: 30 Июля 2018 18:22:31 Добавил: Андрей Ковальчук