Delphi для профессионалов - Раздел ''Вопрос-ответ''

eServer.ru :: Хостинг без ограничений!

---

Рассылка: Delphi для профессионалов

Количество подписчиков: 2718

---

Вопрос №1: Работа в локальной сети
Как узнать, подключен ли компьютер с известным IP к сети?
Предполагаемое решение: создать программную реализацию утилиты PING и если произошла потеря пакетов посылок, то компьютер не подключен к сети.

Ответ №2: Смотрите статью "Реализация ping с помощью ICMP API" на http://www.3ka.mipt.ru/vlib/books/Programming/Delphi/Ping_With_ICMP_API.htm.

Вопрос №2: Управление устройствами через порты
Можно ли в Дельфи реализовать управление устройствами через порты (СОМ, USB)? Если да, то как? Мож какие ссылки есть по этой теме?
Предполагаемое решение: На сайте www.torry.net я видел компонент управления USB.

Ответ №3 (Roman): Адрес этой компоненты: http://www3.ewebcity.com/troels/delphi.asp.

Вопрос №4: Работа с треем
У меня куча описаний помещения иконки в systray, но я так и не нашел примера иллюстрирующего это действие. Не мог бы кто-нибудь "разжевать" построчно как использовать notifyicondata. Заранее благодарен

Ответ №1 (Женя):

За помещение/удаление/изменение иконки в трее отвечает функция Win32 API Shell_NotifyIcon. Вот её описание из SDK : WINSHELLAPI BOOL WINAPI Shell_NotifyIcon(DWORD dwMessage, PNOTIFYICONDATA pnid); Первый параметр - тип действия (помещение/удаление/изменение). Определены следующие значения: NIM_ADD - добавить иконку NIM_DELETE - удалить -//- NIM_MODIFY - изменить -//- Второй параметр - указатель на структуру NOTIFYICONDATA (TNotifyIconData в делфи, если я не ошибаюсь). Содержание полей этой структуры зависит от того, какое из трёх выше перечисленных действий Вы собираетесь сделать. Вот её описание : typedef struct _NOTIFYICONDATA { DWORD cbSize; HWND hWnd; UINT uID UINT uFlags; UINT uCallbackMessage; HICON hIcon; char szTip[64]; } NOTIFYICONDATA, *PNOTIFYICONDATA; Описание полей : cbSize - размер структуры (sizeof(NOTIFYICONDATA)) hWnd - хэндл вашего окна которое будет принимать windows-сообщение от иконки uID - идентификатор иконки (задаётся Вами). Нужен чтобы различить несколько иконок, созданных одним приложением, друг от друга uFlags - флаги, указывающие какие из полей этой структуры используются. Описаны следующие значения : NIF_ICON - поле hIcon NIF_MESSAGE - поле uCallbackMessage NIF_TIP - поле szTip uCallbackMessage - идентификатор определённого приложением сообщения, посылаемого окну, указанному в поле hWnd, когда происходит клик/перемещение указателя мыши над иконкой hIcon - хэндл иконки szTip - текст всплывающей подсказки для иконки Приведённый Вами компонент является как бы надстройкой над функцией Shell_NotifyIcon, который упрощает(?) работу с треем. Вот пример того, как это можно использовать на практике (в связи с отсутствием под рукой среды делфи это не проверялось на работоспособность, но по идее должно работать :): .... uses windows, .... .... const WM_MY_ICON = WM_USER + 100;//можно добавить любое другое число .... type TForm1 = class(TForm) .... private { Private declarations } //Эта процедура будет обрабатывать наше сообщение от иконки procedure OnMyIconNotify(var Msg: TMessage); message WM_MY_ICON; .... public { Public declarations } .... end; .... //добавляет иконку function AddIcon(hWnd: THandle; uID: Cardinal; hIcon: THandle; uCallbackMessage: Cardinal; szTip: String): boolean; var nid: TNotifyIconData; begin nid.cbSize := sizeof(TNotifyIconData); nid.Wnd := hWnd; nid.uID := uID; nid.uFlags := NIF_MESSAGE or NIF_ICON or NIF_TIP; nid.uCallbackMessage := uCallbackMessage; nid.hIcon := hIcon; //т.к. максимальная длина szTip = 63 символа + ноль, то проверяем, и, если надо, обрезаем if Length(szTip) > 63 then SetLength(szTip, 63); StrPCopy(nid.szTip, szTip); Result := Shell_NotifyIcon(NIM_ADD, @nid); end; //модифицирует иконку function ModifyIcon(hWnd: THandle; uID: Cardinal; hIcon: THandle; uCallbackMessage: Cardinal; szTip: String): boolean; var nid: TNotifyIconData; begin nid.cbSize := sizeof(TNotifyIconData); nid.Wnd := hWnd; nid.uID := uID; nid.uFlags := NIF_MESSAGE or NIF_ICON or NIF_TIP; nid.uCallbackMessage := uCallbackMessage; nid.hIcon := hIcon; if Length(szTip) > 63 then SetLength(szTip, 63); StrPCopy(nid.szTip, szTip); Result := Shell_NotifyIcon(NIM_MODIFY, @nid); end; //удаляет иконку function DeleteIcon(hWnd: THandle; uID: Cardinal): boolean; var nid: TNotifyIconData; begin nid.cbSize := sizeof(TNotifyIconData); nid.Wnd := hWnd; nid.uID := uID; Result := Shell_NotifyIcon(NIM_DELETE, @nid); end; //здесь обрабатываем нужные нам сообщения от иконки procedure TForm1.OnMyIconNotify(var Msg: TMessage); begin //Msg.wParam содержит идентификатор иконки //Msg.lParam содержит сообщение мыши от иконки case msg.lParam of //левая кнопка WM_LBUTTONDBLCLK: ; WM_LBUTTONDOWN: ; WM_LBUTTONUP: ; //правая WM_RBUTTONDBLCLK: ; WM_RBUTTONDOWN: ; WM_RBUTTONUP: ; //средняя WM_MBUTTONDBLCLK: ; WM_MBUTTONDOWN: ; WM_MBUTTONUP: ; //передвижение указателя над иконкой WM_MOUSEMOVE: ; end; end; .... Возникнут вопросы/возражения - пишите.

Вопрос №5: Шифрование базы IB
...есть ли надстройки или прочие возможности позволяющие шифровать IB базу?
Можно ли как простейшую альтернативу шифрованию защитить базу тем, что при создании указывать для каждой базы отдельного пользователя и пароль.
Мне необходимо защитить IB базу от вскрытия в случае кражи.

Ответ №1 (Denis Alexandrovich Ivanov): В IB безопасность определяется не на уровне БД, а для сервера БД.
Для каждого сервера БД есть central security database isc4.gdb, которая содержит списки пользователей, permissions итд.
Т.о. если твою БД физически стырят, то вся информация БД будет доступна злодею.
Защитится от этого можно путем шифрования данных при помощи внешнего ПО, которого сейчас много разного.
В том числе можно использовать средства шифрования и криптозащиты КриптоПро.

Проблема заключается в другом: в индексированных поисках по зашифрованным данным в базе.
Это сделать можно, но разработка нетривиальная, трудоемкость высокая и стоимость разработки соответствующая.
Если заказчик пойдет на это- почему бы не написать если хочется.
Это конечно, смотря у кого какие цели, но я считаю, что целесообразнее защищать файлы БД средствами ОС (Unix например- достаточно серьезная защита).

Ответ №2 (Denis Alexandrovich Ivanov): В дополнении к предыдущему письму выжимки из документации (OpGuide.pdf): Protecting your databases
There are several steps that you can take to increase the security of your databases and other files on your system:
1. UNIX systems: Before starting the InterBase server, log in as the user "interbase" (or "interbas"), rather than "root."
This restricts the power of users to accidentally or intentionally access or overwrite sensitive files such as the password file.
2. Because anyone can restore a backed up database, it is wise to keep your backup files in a directory with restricted access if they are on a UNIX or NT platform.
If they are on a Windows 95/98 platform and security is an issue, you can either move them to physical media such as tape or high-density removable drives and store these securely or move the backup files to a UNIX or NT platform where they can be kept in a secure directory.

Ответ №3 (Anton): Есть 2 способа:
1. Поставить сложный пароль администратора и, при наличии раздела NTFS, зашифровать файл.
Такой атрибут есть в свойствах файла.
2. Аппаратная защита. Далее следует не реклама, а опыт.
Программа фирмы Alladin шифрует раздел диска "на лету", а ключ хранится на USB брелке, причем у системы очень много возможностей.
Взломать нереально. Ключ стоит около 100 баксов. Советую почитать, вам понравится.
Есть серверный вариант за 1000 баксов, который стирает ключ при срабатывании сигнализации или просто с кнопки.
Расшифровка диска если нет USB ключа(для особо любопытных :-)) закончится когда солнце превратится в сверхновую.

Ответ №4 (Alexandr Belayev): Ставь Interbase на сервак 2000, клади базу на NTFS раздел, и включай там шифрование. Самое простое что можно сделать.

Ответ №5 (Igor Spivak): V svoyo vremia ya toze pytalsa reshit etu problemu. Dlia Interbase 5.5 sdelal tak:
1. Sozdat svoego USER so vsemi pravami na nuznuyu basu.
2. Udalit vse permissions dlia uzer SYSDBA s etoy bazy (script dlia vseh TABLE, SP, TRIG, VIEW, v tom chisle i system tables)
3. Udalit user SYSDBA Posle etogo, esli perenesti bazu na druguyu mashinu, to ona ne otkryvaetsa.
Analogichny vopros byl zadan D.Kuzmenko.
Kogda on uvidel eto reshenie, to posovetoval srochno sdelat upgrade Interbase - po ego mneniyu, udalenie SYSDBA - ne luchiy put' :-)
Polnostiyu s nim soglasen, bolee togo, doskonalno ne provirial posledstviya.
Ubedilsa, chto server podnimaetsa (bez SYSDBA) i mozno sdelat CONNECT.
Esli vosstanovit SYSDBA, to bazu snova mozno otkryt (daze posle udaleniya permissions :-().
Ne proboval eto reshenie na FireBird i Interbase 6.0 i vwshe.
Esli est bolee elegantnoe reshenie (ili udastsa modifizirovat moyo), napishite, pls.

Вопрос №6: NT-based списки пользователей
Как узнать список всех пользователей?

Ответ №1 (Cherny Igor): Когда-то я писал небольшую сетевую утилитку и обнаружил что под Delphi большинство необходимых мне ф-й недекларировано. пришлось это сделать самому:

/////////////////////////////////////////////////////////////////////////////// type NETSETUP_NAME_TYPE = ( NetSetupUnknown, NetSetupMachine, NetSetupWorkgroup, NetSetupDomain, NetSetupNonExistentDomain); {$EXTERNALSYM NetUserEnum} function NetUserEnum( servername : LPWSTR; level, filter : DWORD; bufptr : Pointer; prefmaxlen : DWORD; entriesread, totalentries, resume_handle : LPDWORD ) : DWORD; stdcall; external 'NetApi32.dll' Name 'NetUserEnum'; {$EXTERNALSYM NetUserGetInfo} function NetUserGetInfo( servername : LPWSTR; username : LPWSTR; level : DWORD; bufptr : Pointer) : DWORD; stdcall; external 'NetApi32.dll' Name 'NetUserGetInfo'; {$EXTERNALSYM NetWkstaUserGetInfo} function NetWkstaUserGetInfo( reserved : LPTSTR; level : DWORD; bufptr : Pointer): DWORD; stdcall; external 'NetApi32.dll' Name 'NetWkstaUserGetInfo'; {$EXTERNALSYM CreateMailslot} function CreateMailslot( lpname : WideChar; // for NT only; LPCTSTR - 4 W9x nMaxMessageSize: DWORD; lReadTimeout : DWORD; lpSecurityAttributes: Pointer): THandle; stdcall; external 'NetApi32.dll' Name 'CreateMailslot'; {$EXTERNALSYM NetValidateName} function NetValidateName( lpServer : LPTSTR; lpName : LPTSTR; lpAccount : LPTSTR; lpPassword : LPTSTR; NameType : NETSETUP_NAME_TYPE): DWORD; stdcall; external 'NetApi32.dll' Name 'NetValidateName'; // {$EXTERNALSYM NetServerEnum} //function NetServerEnum( // servername: LPCWSTR; // level : DWORD; // bufptr : Pointer): DWORD; stdcall; //external 'NetApi32.dll' Name 'NetServerEnum'; function NetApiBufferFree( Buffer : Pointer{LPVOID} ) : DWORD; stdcall; external 'NetApi32.dll' Name 'NetApiBufferFree'; //------------------------------------------------------------------------------ // все пользователи хоста //------------------------------------------------------------------------------ procedure GetLocalUserList(ulist: TStringList); const NERR_SUCCESS = 0; FILTER_TEMP_DUPLICATE_ACCOUNT = $0001; FILTER_NORMAL_ACCOUNT = $0002; FILTER_PROXY_ACCOUNT = $0004; FILTER_INTERDOMAIN_TRUST_ACCOUNT = $0008; FILTER_WORKSTATION_TRUST_ACCOUNT = $0010; FILTER_SERVER_TRUST_ACCOUNT = $0020; type TUSER_INFO_10 = record usri10_name, usri10_comment, usri10_usr_comment, usri10_full_name : PWideChar; end; PUSER_INFO_10 = ^TUSER_INFO_10; var dwERead, dwETotal, dwRes, res : DWORD; inf : PUSER_INFO_10; info : Pointer; p : PChar; i : Integer; begin if ulist=nil then Exit; ulist.Clear; info := nil; dwRes := 0; res := NetUserEnum( nil, 10, FILTER_NORMAL_ACCOUNT, @info, 65536, @dwERead, @dwETotal, @dwRes); if (res<>NERR_SUCCESS) or (info=nil) then Exit; p := PChar(info); for i:=0 to dwERead-1 do begin inf := PUSER_INFO_10 ( p + i*SizeOf(TUSER_INFO_10) ); ulist.Add('Name:'+ WideCharToString( PWideChar((inf^).usri10_name) )+ '; Fullname:' + WideCharToString( PWideChar((inf^).usri10_full_name) )); end;

Ответ №2 (Виталий Джангл):

Type USER_INFO_10 = Record usri10_name: LPWSTR; usri10_comment: LPWSTR; usri10_usr_comment: LPWSTR; usri10_full_name: LPWSTR; End; PUSER_INFO_10 = ^USER_INFO_10; Function NetUserEnum ( Servername: LPCWSTR; Level: DWORD; Filter: DWORD; Buf: PUSER_INFO_10; prefmaxlen: DWORD; entriesread: LPDWORD; Totalentries: LPDWORD; resume_handle: LPDWORD ): DWORD; stdcall; external 'netapi32.dll'; Function NetApiBufferFree ( Buffer: Pointer ): DWORD; stdcall; external 'netapi32.dll'; Procedure GetUserList; Var Buffer, tmpBuffer: Pointer; prefmaxlen: Integer; resume_handle: DWORD; entriesread: DWORD; totalentries: DWORD; I, Size: Integer; NickName: String; FullName: String; Comment:String; PSrvr : PWideChar; Begin UsrList.Clear; Try Size := Length (Comp.text); GetMem(PSrvr,Size*SizeOf(WideChar)+1); StringToWideChar(Comp.Text,PSrvr,Size+1); UsrList.Columns:=3; UsrList.TabWidth:=UsrList.Width div 4 -20; prefmaxlen := -1; entriesread := 0; totalentries := 0; resume_handle := 0; // Получаем список пользователей if NetUserEnum (PSrvr, 10, $0002, @Buffer, prefmaxlen, @entriesread, @totalentries, @resume_handle) = S_OK Then begin tmpBuffer := Buffer; For I := 0 To totalentries - 1 Do Begin NickName := PUSER_INFO_10 (tmpBuffer).usri10_name; FullName := PUSER_INFO_10 (tmpBuffer).usri10_full_name; Comment:=PUSER_INFO_10(tmpBuffer).usri10_comment; resume_handle := 0; // Выводим список пользователей в UsrList типа TListBox UsrList.Items.Add (NickName+^I+FullName+^I+Comment); tmpBuffer := Pointer (DWORD (tmpBuffer) + SizeOf (USER_INFO_10)); end; End; Finally NetApiBufferFree (Buffer); End; FreeMem(PSrvr); End;

Вопрос №8: Process Handle
Как могу я получить Дескриптор Процесса с помощью WinAPI, если известно его название?
Предполагаемое решение: Это поволяет сделать функция FindWindow из WinAPI.

Ответ №1 (Victor Stolbovoy): Используйте ToolHelp API. Вот пример из Рихтера, который несложно переписать для Delphi:

CToolhelp thProcesses(TH32CS_SNAPPROCESS); PROCESSENTRY32 pe = { sizeof(pe) }; BOOL fOk = thProcesses.ProcessFirst(&pe); for (; fOk; fOk = thProcesses.ProcessNext(&pe)) { TCHAR sz[1024]; PCTSTR pszExeFile = _tcsrchr(pe.szExeFile, TEXT('\\')); if (pszExeFile == NULL) pszExeFile = pe.szExeFile; else pszExeFile++; // Skip over the slash // pszExeFile - имя процесса, сравните его с вашим // В pe.th32ProcessID лежит соответсткенно ProcessId // HANDLE hProcess = OpenProcess(желаемый_доступ,FALSE,pe.th32ProcessID)

 

Ответ №2 (Anton): Примерчик в х возвращает handle и в n всех его childов:

x:=findwindow('tform2',nil); n:=GettopWindow(x); n:=GettopWindow(n); repeat n:=GetnextWindow( n,GW_HWNDNEXT); until n<>0;

Ответ №3 (Женя): Неправильно. Функция FindWindow действительно возвращает дескриптор, но не процесса, а окна с указанным либо заголовком (caption) либо типом окна. Вот кусок кода. Даёшь полный путь к экзешнику, и, если он запущен, эта функция вернёт дескриптор первого найденного процесса. Надеюсь он Вам поможет :

function GetProcessHandle(ProcessExeFullPath: String): THandle; var hSnapShot, hProcess: THandle; pe32: TProcessEntry32; begin Result := 0; hSnapShot := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0); if (hSnapShot = 0) then exit; pe32.dwSize := sizeof(TProcessEntry32); if Process32First(hSnapShot, @pe32) then begin repeat if pe32.szExeFile = ProcessExeFullPath then begin hPocess := OpenProcess(PROCESS_ALL_ACCESS, false, pe32.th32ProcessID); Result := hProcess; CloseHandle(hSnapShot); exit; end; until Process32Next(hSnapshot, @pe32); end; CloseHandle(hSnapShot); end;

Ответ №4 (Женя): Исправлено. Вариант 1. Получение дескриптора процесса по хэндлу окна :

uses windows, ...... .......... hWnd := FindWindow(nil, "Window Caption"); if hWnd = 0 then exit; idProcess := GetWindowThreadProcessId(hWnd, @dwProcessID); hProcess := OpenProcess(PROCESS_ALL_ACCESS, false, dwProcessID); ..........

Вариант 2. Даёшь полный путь к экзешнику, и, если он запущен, эта функция вернёт дескриптор первого найденного процесса (работает в Win9х). Надеюсь он Вам поможет :

uses ...., windows, tlhelp32, .... ......... function GetProcessHandle(ProcessExeFullPath: String): THandle; var hSnapShot, hProcess: THandle; pe32: TProcessEntry32; begin Result := 0; hSnapShot := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0); if (hSnapShot = 0) then exit; pe32.dwSize := sizeof(TProcessEntry32); if Process32First(hSnapShot, @pe32) then begin repeat if pe32.szExeFile = ProcessExeFullPath then begin hPocess := OpenProcess(PROCESS_ALL_ACCESS, false, pe32.th32ProcessID); Result := hProcess; CloseHandle(hSnapShot); exit; end; until Process32Next(hSnapshot, @pe32); end; CloseHandle(hSnapShot); end;

Т.к. делфи у меня сейчас не стоит, то писал по памяти, по этому могут быть ошибки. Но идея, я надеюсь, ясна. Возникнут вопросы/возражения - пишите.

Ответ №5 (Korol): Поможет следующий код:

var procID:DWORD; ProcIDz:^DWORD; hProcess:THandle; pr:pointer; z:DWORD; h:THandle; begin h:=FindWindow(nil,'ИМЯ ОКНА'); new(procidz); pr:=procidz; GetWindowThreadProcessID(H,pr); procID:=ProcIDz^; dispose(procidz); hprocess:=openprocess(PROCESS_ALL_ACCESS,true,procID); z:=getlasterror; if z<>0 then showmessage('OpenProcess failed: '+syserrormessage(z)); showmessage('ProcessID = '+IntToStr(hprocess)); end;

 

Новые вопросы

Вопрос №9: GetProcessMemoryInfo
Хотел бы задать важный для меня вопрос. Как под Windows 9x можно определить сколько памяти занимает некоторый процесс? Под Windows NT существует для этих целей функция GetProcessMemoryInfo, импортируемая из библиотеки Psapi.dll посредством юнита psapi.pas. Для Win9x я, увы, подобную функцию не нашел. Говорят, что подобную проблему решить нельзя, но ведь в Norton Utilites реализована "моя" затея?
Предложить свой вариант решения можно здесь или воспользовавшись формой обратной связи (для HTML-формата).

Вопрос №10: Многострочный CheckBox
Подскажите, как можно отобразить в стандартном CheckBox-е более одной строки текста? Где-то такое встречал в продуктах MS.
Предложить свой вариант решения можно здесь или воспользовавшись формой обратной связи (для HTML-формата).

Вопрос №11: Работа с реестром в Delphi
Как с помощью Delphi записать в реестр данные бинарного вида??? Насколько я знаю для этого используется функция "WriteBinaryData". Если можно приведите пример использования этой функции: записать в ключ "HKey_Locale_Machine/Software" значение "Value" бинарного типа с параметром "01 00 00 00".
Предполагаемое решение:

var
  Reg: TRegistry;
  buf : array [0..4] of byte;
  i: Integer;
begin
  Reg := TRegistry.Create;
  try
    Reg.RootKey := HKEY_CURRENT_USER;
    if Reg.OpenKey('\Software', True) then begin
      for i:=1 to 4 do buf[i]:=0;
      buf[0]:=1;
      Reg.WriteBinnaryData('Value', buf, sizeof(buf));
      Reg.CloseKey;
    end;
  finally
    Reg.Free;
    inherited;
  end;
{...}
end;

Предложить свой вариант решения можно здесь или воспользовавшись формой обратной связи (для HTML-формата).

Вопрос №12: Глобальные переменные
У меня такой вопрос как и где описать переменную чтобы сней можно было работать во всех формах. С Уважением Александр.
Предполагаемое решение: Я делал следующим образом: создаем новый модуль UConsts.pas, например, опысываем там все ГЛОБАЛЬНЫЕ переменные и посе этого используем его во всех формах.
Предложить свой вариант решения можно здесь или воспользовавшись формой обратной связи (для HTML-формата).

Вопрос №13: Определение скорости подключения
Подскажите, каким образом определить скорость подключения к Интернет? Советуют копаться в библиотеке RASAPI32.DLL, но это занятие ИМХО утомительное. Нет ли каких-то более конкретных идей в решении этого вопроса?
Предложить свой вариант решения можно здесь или воспользовавшись формой обратной связи (для HTML-формата).

Вопрос №14: Шкала загрузки
Пожалуйста опубликуйте мой вопрос, я просто в безисходности... Как сделать чтобы в Gauge при 100% автоматически открывалась следущая форма?
Предложить свой вариант решения можно здесь или воспользовавшись формой обратной связи (для HTML-формата).

Вопрос №15: Массив объектов
Скажите пожалуйста, как создать массив объектов во время выполнения программы? Например, мне нужно создать n кнопок на форме, где n указывает пользователь. Эти кнопки по одной создавать получается, но вот в массиве - уже нет...
Предложить свой вариант решения можно здесь или воспользовавшись формой обратной связи (для HTML-формата).