| Новости | Win API | VCL | Прочее | Железо |
| ... function RegisterServiceProcess(dwProcessID, dwType: Integer): Integer; stdcall; external 'KERNEL32.DLL'; ... implementation ... procedure TForm1.Button1Click(Sender: TObject); begin // скрыть - можно эту процедурку закинуть в OnCreate, // тогда приложение автоматически будет спрятано if not (csDesigning in ComponentState) then RegisterServiceProcess(GetCurrentProcessID, 1); end; procedure TForm1.Button2Click(Sender: TObject); begin // Показать if not (csDesigning in ComponentState) then RegisterServiceProcess(GetCurrentProcessID, 0); end; |
Один из вариантов:
WinExec('calc.exe', SW_SHOWNORMAL); |
| uses MMSystem; // возвращает громкость function GetWaveVolume: DWord; var Woc : TWaveOutCaps; Volume : DWord; begin result:=0; if WaveOutGetDevCaps(WAVE_MAPPER, @Woc, sizeof(Woc)) =MMSYSERR_NOERROR then begin if Woc.dwSupport and WAVECAPS_VOLUME = WAVECAPS_VOLUME then begin WaveOutGetVolume(WAVE_MAPPER, @Volume); Result := Volume; end; end; end; // устанавливает громкость procedure SetWaveVolume(const AVolume: DWord); var Woc : TWaveOutCaps; begin if WaveOutGetDevCaps(WAVE_MAPPER, @Woc, sizeof(Woc)) =MMSYSERR_NOERROR then begin if Woc.dwSupport and WAVECAPS_VOLUME = WAVECAPS_VOLUME then WaveOutSetVolume(WAVE_MAPPER, AVolume); end; end; // проверка (вешаем на батон) procedure TForm1.Button1Click(Sender: TObject); begin Beep; end; // вещаем на батон procedure TForm1.Button2Click(Sender: TObject); var LeftVolume: Word; RightVolume: Word; begin // левый динамик LeftVolume := StrToInt(Edit1.Text); // правый RightVolume := StrToInt(Edit2.Text); SetWaveVolume(MakeLong(LeftVolume, RightVolume)); end; // выводим громкость (вещаем на батон) procedure TForm1.Button3Click(Sender: TObject); begin Label1.Caption := IntToStr(GetWaveVolume); end; |
Добавте в раздел uses модуль ShellApi
| uses ...,ShellApi; ... var Rgn:thandle; ... // многоугольное procedure TForm1.FormCreate(Sender:TObject); const Region : array [0..2] of TPoint =((x:0;y:100),(x:50;y:0),(x:100;y:100)); // Задаем координаты точек региона ( в данном случае - треугольник ) begin rgn:=0; Rgn:=CreatePolygonRgn(Region,3,0); // число 3 - кол-во точек региона if rgn<>0 then SetWindowRgn(Handle,Rgn,true); end; |
или
uses ...,ShellApi; |
Так же можно испольсовать следущие
фунуции Win32 API для создания регионов:
CreateEllipticRgn, CreateEllipticRgnIndirect, CreatePolygonRgn,
CreatePolyPolygonRgn, CreateRectRgn, CreateRectRgnIndirect, CreateRoundRectRgn,
ExtCreateRegion - они описаны в справке по Win32 API.
Созданные регионы можно комбинировать
- CombineRgn (перед вызовом SetWindowRgn)
Перед выходом обязательно уничтожте
созданные регионы:
procedure TForm1.FormDestroy(Sender:TObject); |
P.S.: если в ваш новый регион не попал участок заголовка, то вам придется самостоятельно определить способы перемещения вашего окна и все кнопки (н-р закрыть), корорые не попадут на форму ...
Для запуска
программы при каждой загрузке Windows надо добавить
в реестре в
HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\
CurrentVersion\Run вашу программу
Чтобы программа запустилась только при
следующей загрузке -
HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\
CurrentVersion\RunOnce
добавте в uses - ShellApi и вызвайте фунуцию
WinApi. Н-р для адреса 13_vlad.mail.ru :
ShellExecute(Handle,'open',PChar('mailto:'+'13_vlad@mail.ru'),'','',SW_Show);
добавте в uses - ShellApi и вызвайте фунуцию
WinApi. Н-р :
ShellExecute(0, Nil,PChar(Label1.Caption), Nil, Nil, SW_NORMAL);
Hаиболее часто задаваемые вопросы по
SystemTray.
Автор - Лев Серебряков (Lev Serebryakov),
2:5030/219.33@fidonet или lev@spb.runnet.ru
Версия 1.1
пример для Дельфи (компонент и пример использования компонента) |
!
для Дельфи надо подключить модуль ShellApi, ! |
1) Что такое System Tray ? О чем идет речь ?
Если Вы в операционной ситеме Windows'95 или Windows NT 4.0 пользуетесь оболочкой Explorer, то справа на TaskBar'е Вы должны были видеть "углубленную" область в которой, обычно, помещаются часы, переключатель клавиатуры, регулятор громкости и некоторые другие утилиты. Они изображаются маленькими иконками и для них существуют ToolTip'ы как для кнопок ToolBar'ов. При щелчке или двойном щелчке по такой иконке программа обычно выполняет действие по умолчанию, а при щелчке правой кнопкой показывает Pop-Up меню. Hа уровне оболочки System Tray это приложение, поддерживающее окно, которое вы видите как "углубленную" область и некоторый сервис для работы с этим окном.
2) Как мне перенести свою программу на Tray ?
Это типичный вопрос программиста, пишущего какую-нибудь утилиту,работающую в Background во время всей работы операционной системы (в DOS такие утилиты делались TSR-программами). Hо вопрос
поставлен не корректно. Обычно задавае этот вопрос программист имеет в виду примерно следующее : "Моя программа работает [почти] все время в минимизированном состоянии и очень жалко места под ее кнопку на
TaskBar'е. Как мне сделать, что бы при минимизации [старте|все время] моя программа представлялась иконкой на System Tray'е и отвечала на сообщения мыши от этой иконки ?"Ответ на этот вопрос состоит из нескольких частей. Смотри следующие вопросы и ответы на них.
3) Что такое иконка на System Tray ?
Ответ на этот вопрос объясняет некорректность вопроса 2. Иконка на Tray'е это просто картинка, а не окно какой-либо программы (исследование системы с помощью Microsoft Spy++ for Windows 95 показывает, что это не окно вообще). System Tray отслеживает события мыши над иконкой и, в случае надобности, показывает ToolTip для этой иконки. Так же он отсылает сообщения о всех действиях мыши над иконкой окну, которое поместило иконку на Tray. Таким образом, нельзя поместить программу на Tray. Любая программа может добавить стоько иконок на Tray, сколько ей необходимо. При этом главное окно программы не обязано исчезать или минимизироватся - примером может служить Microsoft Internet Mail, помещающая иконку "конверт" на Tray в случае появления новых писем.
4) Как добавить иконку на Tray ?
Для работы с SystemTray существует всего одна функция. Вот ее Си-прототип:
WINSHELLAPI BOOL WINAPI Shell_NotifyIcon(DWORD dwMessage, // message identifier
PNOTIFYICONDATA pnid // pointer to structure);
Эта функция описана в заголовочном файле Win32-SDK "shellapi.h", включаемом в программу при включении "windows.h". Параметр dwMessage может принимать одно из трех значений: NIM_ADD, NIM_DELETE, NIM_MODIFY. Для добавления иконки он должен быть установлен в NIM_ADD.
Параметр pnid имеет тип PNOTIFYDATA, который описан как:
typedef struct _NOTIFYICONDATA { // nid
DWORD cbSize;
HWND hWnd;
UINT uID;
UINT uFlags;
UINT uCallbackMessage;
HICON hIcon;
char szTip[64];
} NOTIFYICONDATA, *PNOTIFYICONDATA;
Поля структуры NOTIFYICONDATA имеют следующий смысл:
cbSize - размер структуры, должен быть
sizeof(NOTIFYICONDATA).
hWnd - дескриптор окна, которое будет получать события мыши над иконкой.
uID - уникальный идентификатор иконки. Идентификатор должен быть уникален в пределах окна - обработчика, передаваемого в hWnd.
uFlags - битовое поле, определяющее какое из следующих полей несет действительную информацию.
Может быть одним из следующих значений: NIF_ICON,
NIF_MESSAGE, NIF_TIP или их OR-комбинацией.
uCallbackMessage - сообщение, передаваемое окну - обработчику при событиях мыши. Желательно получать номер сообщения вызовом RegisterWindowMessage(), но допускаются и значения WM_USER+N, где N > 0.
hIcon - дескриптор иконки, помещаемой на Tray.
szTip - текст для ToolTip'а, если szTip[0] = 0x00, то ToolTip'а не будет.
Таким образом, для добавления иконки на Tray необходимо заполнить экземпляр структуры NOTIFYICONDATA и вызвать функцию Shell_NotifyIcon() с параметром NIM_ADD и указателем на
заполненный экземпляр структуры.При добавлении иконки необходимо заполнить поля cbSize, hWnd,
uID, uFlags, uCallbackMessage, hIcon. Поле szTip можно оставить пустым, если вам не нужен ToolTip. Поле uFlags должно содержать как минимум NIF_MESSAGE | NIF_ICON.
5) Я добавил иконку на Tray, а как ее там изменить ?
После добавления иконки на Tray можно менять саму иконку, ToolTip и сообщение, посылаемое окну. Для этого необходимо заполнить экземпляр структуры NOTIFYICONDATA и вызвать функцию Shell_NotifyIcon() с параметром NIM_MODIFY и указателем на заполненный экземпляр структуры. При изменении иконки необходимо заполнить поля cbSize, hWnd, uID, uFlags и поля, отвечающие за параметры иконки, которые вы
хотите менять. При этом uFlags должен содержать комбинацию флагов, описывающую поля, которые необходимо менять.
6) А как удалить иконку с Tray ?
Для удаления иконки вы должны знать ее ID и дескриптор окна-обработчика сообщений.
Для удаления иконки с Tray надо вызвать функцию Shell_NotifyIcon() с параметром NIM_DELETE и указателем на экземпляр структуры NOTIFYICONDATA, у которого должны быть заполнены следующие поля: cbSize, hWnd, uID.
7) Как мне узнать о воздействии мыши на иконку, находящуюся на Tray ?
При добавлении иконки на Tray вы указывали окно - обработчик сообщения и сообщение (CallbackMessage). Теперь окно, указанное вами будет при любых событиях мыши, происходящих над иконкой получать сообщение, указанное при добавлении иконки. При этом параметры lParam и wParam будут задействованы следующим образом: (UINT)wParam - содержит ID иконки, над которой произошло событие
(UINT)lParam - содержит стандартное событие мыши, такое как WM_MOUSEMOVE или WM_LBUTTONDOWN.При этом, информация о клавишах смены регистра, так же как и местоположения события, передаваемые при стандартных "настоящих" сообщениях мыши, теряются. Hо положение курсора можно узнать функцией GetCursorPos(), а состояние клавиш смены регистра - функцией GetKeyState(),
описанных в winuser.h.
8) Многие программы показывают Pop-Up меню при щелчке на их иконке, помещенной на Tray, как этого добиться ?
Вы должны обрабатывать сообщение, указанное вами при добавлении иконки на Tray. При значении (UINT)lParam, равном WM_RBUTTONDOWN (это обычно для Pop-Up меню по правой кнопке), или любому другому необходимому вам, вы должны вызовом функции GetCursorPos() получить позицию курсора в момент события (вряд ли пользователь успеет убрать мышь за время обработки сообщения, особенно если
он ожидает меню), получить дескриптор Pop-Up меню одним из многих способов (LoadMenu(), GetSubMenu(), CreateMenu(), и т.д.) и выполнить следующий код:
SetForegroundWindow(hWnd);
TrackPopupMenuEx(hMenu,TPM_HORIZONTAL|TPM_LEFTALIGN,x, y,hWnd,NULL);
DestroyMenu(hMenu);
PostMessage(hWnd,WM_USER,0,0);
где hWnd - дескриптор окна, которое будет обрабатывать команду
меню, hMenu - дескриптор меню, x и y - позиция курсора. Для
подробностей смотрите Win32 SDK Help по функции TrackPopupMenuEx.
9) Многие программы минимизируясь, оказываются на Tray, как это сделать ?
Hа самом деле, не "программа оказывается на Tray", а только иконка помещается на Tray, а главное окно программы скрывается. Для достижения такого результата вам надо обрабатывать сообщение
WM_SIZE, и при значении wParam, равном SIZE_MINIMIZED вы должны выполнить примерно следующую последовательность действий: добавить иконку на Tray и скрыть окно - вызвать ShowIndow(hWnd, SW_HIDE).
Когда произойдет действие, которое должго активировать вашу программу - WM_LBUTTONDBLCLK или WM_LBUTTONDOWN (или то, что нравится вам), вы должны удалить иконку и вызвать ShowWindow(hWnd,SW_SHOW) или ShowWindow(hWnd,SW_SHOWMAXIMIZED).
| пример скрытия окна программы
для Дельфи: ShowWindow(Application.Handle, sw_Hide); |
10) Всегда ли все вышесказанное будет работать ?
Hет ! Все вышенаписанное работает только при использовании в операционных системах Windows 95 и Windows NT 4.0 оболочки Explorer, и при разрешенном System Tray. В случае, если не происходит запуска systray.exe (запускаетс автоматически Explorer'ом при старте) или используется другая оболочка (DashBoard, Program Manager, File Manager), функция Shell_NotifyIcon() будет возвращать при вызове FALSE и не
выполнять ни каких действий. Еще раз повторю: System Tray - это возможность оболочки, а не
операционной системы !
11) А есть ли официальная информация по System Tray ?
Да, есть. Есть маленький пример в Win32 SDK: SDKRoot\Samples\Win32\Win95\TrayNot\*.*
Hу и конечно описание в документации функции Shell_NotifyIcon()
и структуры NOTIFYICONDATA.
Так же можно посмотреть Microsoft Knowledge Base:
PSS ID Number: Q128129
PSS ID Number: Q134237
PSS ID Number: Q139408
Описание этой функции можно найти в прилагаемой к Дельфи справке - Win32.hlp |
12) Как сделать пункт "по умолчанию" в Pop-Up меню выделенным ?
Вообще-то, это вопрос не относящийся к System Tray, а относящийся к меню. Hо можно ответить и на него.
Устанавливается пункт "по умолчанию" в любом меню функцией API SetMenuDefaultItem(HMENU hMenu, UINT uItem, UINT fByPos), подробности - в Win32 SDK документации. Пункт "По умолчанию" не влияет на работу меню - это чисто интерфейсное выделение пункта меню полужирным (bold) шрифтом.
uses
|
Добавить фонт (.fon, .fot, .fnt, .ttf) в систему можно след. образом:
{$IFDEF WIN32} |
Убрать его по окончании работы:
{$IFDEF WIN32} |
Где my_font_PathName - полный путь к файлу со шрифтом.
Каким образом можно спрятать приложение от показа при нажатии Alt+Tab? |
Пример (работает только в Win'95/98):
var WnHnd : Integer; |
//
Включение режима |
ShowWindow(Application.Handle,SW_HIDE); |
| SendMessage(GetWindow(FindWindow('Shell_TrayWnd',nil), GW_CHILD), WM_LBUTTONDOWN, MK_LBUTTON, LOWORD(5) + HIWORD(20)); |
|
или
LoadKeyboardLayout('00000409',
KLF_ACTIVATE); // английский |
|
// процедура выводит список
запущенных приложений в ListBox1 |
| SetWindowText ('Текущий заголовок', 'Новый заголовок'); |
| procedure DrawOnScreen; var DC:HDC; DesktopCanvas:TCanvas; begin // получили DC экрана DC:=GetDC(0); // (или DC:=GetDC(GetDesktopWindow) для рабочего стола) try DesktopCanvas:=TCanvas.Create; DesktopCanvas.Handle:=DC; .................. // здесь рисуем на Canvas экрана .................. finally ReleaseDC(0,DC); DesktopCanvas.Free; end; end; |
var |
узнать :
| Screen.Width и Screen.Height |
изменить:
procedure
ChangeDisplayResolution(x, y : word); |
Для Дельфи 1-3 обрабатывайте сообщение
WM_MOUSEWHEEL, Дельфи 5 содержит события для
tWinControl - OnMouseWheel, OnMouseWheelDown, OnMouseWheelUp.
Список всех шрифтов находится тут - screen.fonts
//
Пример : procedure TForm1.FormCreate(Sender: TObject); |
Как добавить/удалить/показать папку/программу в меню "Пуск" ? |
Для этого необходимо поместить на форму компонент для посылки DDE запросов - объект типа TDdeClientConv. Для определенности назовем его DDEClient. Затем добавим метод для запросов к PROGMAN:
| function
TForm2.ProgmanCommand(Command:string):boolean; var macrocmd:array[0..88] of char; begin DDEClient.SetLink( 'PROGMAN', 'PROGMAN'); // Устанавливаем связь по DDE DDEClient.OpenLink; // Подготавливаем ASCIIZ строку strPCopy(macrocmd,'['+Command+']'); ProgmanCommand :=DDEClient.ExecuteMacro(MacroCmd,false); // Закрываем связь по DDE DDEClient.CloseLink; end; |
При вызове ProgmanCommand возвращает true, если посылка макроса была успешна. Система команд (основных) приведена ниже:
Create(Имя группы, путь к GRP файлу)
- Создать группу с именем "Имя группы",
причем в нем могут быть пробелы и знаки
препинания. Путь к GRP файлу можно не указывать,
тогда он создастся в каталоге Windows.
Delete(Имя группы) - Удалить группу
с именем "Имя группы"
ShowGroup(Имя группы, состояние)
- Показать группу в окне, причем состояние -
число, определяющее параметры окна:
1-нормальное состояние + активация
2-миним.+ активация
3-макс. + активация
4-нормальное состояние
5-Активация
AddItem(командная строка, имя
раздела, путь к иконке, индекс иконки (с 0), Xpos,Ypos,
рабочий каталог, HotKey, Mimimize) - Добавить
раздел к активной группе. В командной строке,
имени размера и путях допустимы пробелы, Xpos и Ypos -
координаты иконки в окне, лучше их не задавать,
тогда PROGMAN использует значения по умолчанию для
свободного места. HotKey - виртуальный код горячей
клавиши. Mimimize - тип запуска, 0-в обычном окне, <>0
- в минимизированном.
DeleteItem(имя раздела) -
Удалить раздел с указанным именем в активной
группе
Пример использования:
ProgmanCommand('CreateGroup(Комплекс программ для
каталогизации литературы,)');
ProgmanCommand('AddItem('+path+'vbase.hlp,Справка по VBase,'+ path +'
vbase.hlp, 0, , , '+ path + ',,)');
где path - строка типа String, содержащая полный
путь к каталогу ('C:\Catalog\');
Как узнать состояние клавиш Ctrl, Alt, Shift, CapsLock, Insert, NumLuck, ScrollLock ? |
О состоянии клавиатуры дают информацию следующие функции: GetKeyState, GetAsyncKeyState, GetKeyboardState.
| function AltKeyDown : boolean; begin result:=(Word(GetKeyState(VK_MENU)) and $8000)<>0; end; function CtrlKeyDown : boolean; function ShiftKeyDown : boolean; function CapsLock : boolean; function InsertOn : boolean; function NumLock : boolean; function ScrollLock : boolean; |
| uses ShellAPI; function DeleteFileWithUndo( sFileName : string ) : boolean; var fos : TSHFileOpStruct; begin sFileName:= sFileName+#0; FillChar( fos, SizeOf( fos ), 0 ); with fos do begin wFunc := FO_DELETE; pFrom := PChar( sFileName ); fFlags := FOF_ALLOWUNDO or FOF_NOCONFIRMATION or FOF_SILENT; end; Result := ( 0 = ShFileOperation( fos ) ); end; |
| uses ShellAPI, ShlOBJ; procedure AddToStartDocumentsMenu( sFilePath : string ); begin SHAddToRecentDocs( SHARD_PATH, PChar( sFilePath ) ); end; // Например - // AddToStartDocumentsMenu( 'c:\windows\MyWork.txt' ); |
| uses Registry, WinProcs; .... procedure SetWallpaper(sWallpaperBMPPath : String; bTile : boolean ); var reg : TRegIniFile; begin // Изменяем ключи реестра // HKEY_CURRENT_USER // Control Panel\Desktop // TileWallpaper (REG_SZ) // Wallpaper (REG_SZ) reg := TRegIniFile.Create('Control Panel\Desktop' ); with reg do begin WriteString( '', 'Wallpaper', sWallpaperBMPPath ); if ( bTile ) then WriteString('', 'TileWallpaper', '1' ) else WriteString('', 'TileWallpaper', '0' ); end; reg.Free; // Оповещаем всех о том, что мы // изменили системные настройки SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, Nil, SPIF_SENDWININICHANGE ); end; // пример установки WallPaper по центру рабочего стола // SetWallpaper('c:\winnt\winnt.bmp', False); |
Как сделать, что бы при минимизации (свертывании) программа исчезала из таскбара? |
При этом происходит сообщение WM_SYSCOMMAND, его то и надо перехватить
| // Добавте
в описание формы: Type TMain = class(TForm) .... protected Procedure WMGetSysCommand(var Message :TMessage); message WM_SYSCOMMAND; end; ..... // Обработка сообщения WM_SYSCOMMAND //(перехват минимизации окна) Procedure TForm1.WMGetSysCommand(var Message : TMessage) ; Begin if (Message.wParam = SC_MINIMIZE) then form1.Visible:=False Else Inherited; End; |
| // Добавте
в описание формы: Type TMain = class(TForm) .... protected Procedure WMGetSysCommand(var Message :TMessage); message WM_SYSCOMMAND; end; ..... // Обработка сообщения WM_SYSCOMMAND //(перехват минимизации окна) Procedure TForm1.WMGetSysCommand(var Message : TMessage) ; Begin inherited; // если индификатор наш - $F200 if Message.CmdType and $FFF0 = $F200 then // то обрабатываем нажатие ShowMessage('Hello'); End; // в обработчик
FormCreate: |
| type TMainForm = class(TForm) .... public // обработка сообщения WM_NCHITTEST procedure WMNCHitTest(var Message : TWMNCHitTest); message WM_NCHITTEST; end; ... procedure TMainForm.WMNCHitTest(var Message : TWMNCHitTest); begin // проверяем на попадение в заданную область // координаты относительно экpана if (Message.XPos-Left < 100) and (Message.YPos-Top < 100) then // если да, то возвращаем значение - заголовок Message.Result := HTCAPTION else // иначе говорим, что это слиентская область окна Message.Result := HTNOWHERE; end; |
| // функция ShellAPI
функция ShFormatDrive(). // Пример: const SHFMT_DRV_A = 0; const SHFMT_DRV_B = 1; const SHFMT_ID_DEFAULT = $FFFF; const SHFMT_OPT_QUICKFORMAT = 0; const SHFMT_OPT_FULLFORMAT = 1; const SHFMT_OPT_SYSONLY = 2; const SHFMT_ERROR = -1; const SHFMT_CANCEL = -2; const SHFMT_NOFORMAT = -3; function SHFormatDrive(hWnd : HWND; Drive : Word; fmtID : Word; Options : Word) : Longint stdcall; external 'Shell32.dll' name 'SHFormatDrive'; procedure TForm1.Button1Click(Sender: TObject); var FmtRes : longint; begin try FmtRes:= ShFormatDrive(Handle, SHFMT_DRV_A, SHFMT_ID_DEFAULT, SHFMT_OPT_QUICKFORMAT); case FmtRes of SHFMT_ERROR : ShowMessage('Ошибка форматирования диска'); SHFMT_CANCEL : ShowMessage('Отмена форматирования пользователем'); SHFMT_NOFORMAT : ShowMessage('No Format') else ShowMessage('Диск отформатирован'); end; except end; end; |
| // Используйте
функцию Windows API CreateFile() чтобы получить // дескриптор порта, и стандартные функции ввода-вывода для // связи с полученным портом. // Пример: var |
| // ShellApi функция
ExtractAssociatedIcon() // Пример: uses ShellApi; procedure TForm1.Button1Click(Sender: TObject); var Icon : hIcon; IconIndex : word; begin IconIndex := 1; Icon := ExtractAssociatedIcon(HInstance, Application.ExeName, IconIndex); DrawIcon(Canvas.Handle, 10, 10, Icon); end; |
| // Приведенный
пример показывает использование DDE // для вызова диалога 'Найти файлы и паки' Explorerа. // Диалог открывается на каталоге "C:\Download". procedure
TForm1.Button1Click(Sender: TObject); |
Как узнать переменные окружения (environment variable) DOS, например path? |
| // Windows API
- функция // GetDOSEnvironment() для Win16 и // GetEnvironmentStrings() для Win32. procedure TForm1.Button1Click(Sender: TObject); var p : pChar; begin Memo1.Lines.Clear; Memo1.WordWrap := false; {$IFDEF WIN32} p := GetEnvironmentStrings; {$ELSE} p := GetDOSEnvironment; {$ENDIF} while p^ <> #0 do begin Memo1.Lines.Add(StrPas(p)); inc(p, lStrLen(p) + 1); end; {$IFDEF WIN32} FreeEnvironmentStrings(p); {$ENDIF} end; |
| uses ShellAPI; procedure ShowAbout; begin ShellAbout(Form1.Handle, 'Название программы', 'Авторские права на программу', Application.Icon.Handle); end; |
| uses ShellAPI; procedure ShowAbout; begin ShellExecute(Application.Handle, Pchar('Open'),Pchar('C:\Windows\Rundll32.exe'), Pchar('Shell32.dll,SHFormatDrive'), Pchar('C:\Windows'),SW_SHOWNORMAL); end; // автор InSAn |
Как
использовать функцию Shell API SHBrowseForFolder, |
| uses ShellAPI, ShlObj; procedure TForm1.Button1Click(Sender: TObject); var TitleName : string; lpItemID : PItemIDList; BrowseInfo : TBrowseInfo; DisplayName : array[0..MAX_PATH] of char; TempPath : array[0..MAX_PATH] of char; begin FillChar(BrowseInfo, sizeof(TBrowseInfo), #0); BrowseInfo.hwndOwner := Form1.Handle; BrowseInfo.pszDisplayName := @DisplayName; TitleName := 'Please specify a directory'; BrowseInfo.lpszTitle := PChar(TitleName); BrowseInfo.ulFlags := BIF_RETURNONLYFSDIRS; lpItemID := SHBrowseForFolder(BrowseInfo); if lpItemId <> nil then begin SHGetPathFromIDList(lpItemID, TempPath); ShowMessage(TempPath); GlobalFreePtr(lpItemID); end; end; |
Как можно имея полное имя файла, вывести для него стандартный диалог "Свойства"? |
| unit ....; interface uses Windows, Messages, ShlObj, SysUtils, Classes, Forms; const {SHObjectProperties Flags} OPF_PRINTERNAME = $01; OPF_PATHNAME = $02; function SHObjectProperties(Owner: HWND; Flags: UINT; ObjectName: Pointer; InitialTabName: Pointer): LongBool; stdcall; type TShellObjectType = (sdPathObject, sdPrinterObject); TShellObjectTypes = set of TShellObjectType; {MAIN FUNCTION} function ShowObjectPropertiesDialog(ObjectName: TFileName; ObjectType: TShellObjectType; InitialTab: String): Boolean; function ShellObjectTypeEnumToConst(ShellObjectType: TShellObjectType): UINT; function ShellObjectTypeConstToEnum(ShellObjectType: UINT):TShellObjectType; implementation uses Controls, ShellAPI, ActiveX; const Shell32 = 'shell32.dll'; SHObjectProperties_Index = 178; var ShellDLL: HMODULE; function SHObjectProperties; external Shell32 index SHObjectProperties_Index; function ShowObjectPropertiesDialog(ObjectName: TFileName; ObjectType: TShellObjectType; InitialTab: String): Boolean; var ObjectNameBuffer: Pointer; TabNameBuffer: Pointer; begin {Allocate a buffer to hold the object name, long enough for UNICODE if need be.} GetMem(ObjectNameBuffer, (Length(ObjectName) + 1) * SizeOf(WideChar)); try {..finally} {If WinNT, convert object name string to UNICODE. Otherwise, just copy to buffer.} if (SysUtils.Win32Platform = VER_PLATFORM_WIN32_NT) then begin StringToWideChar(ObjectName, PWideChar(ObjectNameBuffer), (Length(ObjectName) + 1)); end {if} else begin StrPCopy(PChar(ObjectNameBuffer), ObjectName); end; {else} {Allocate a buffer to hold the initial tab name, long enough for UNICODE if need be.} GetMem(TabNameBuffer, (Length(InitialTab) + 1) * SizeOf(WideChar)); try {..finally} {If WinNT, convert initial tab name string to UNICODE. Otherwise, just copy to buffer.} if (SysUtils.Win32Platform = VER_PLATFORM_WIN32_NT) then begin StringToWideChar(InitialTab, PWideChar(TabNameBuffer), (Length(InitialTab) + 1)); end {if} else begin StrPCopy(PChar(TabNameBuffer), InitialTab); end; {else} {Execute the dialog and translate the result to the return value.} Result := SHObjectProperties(Application.Handle, ShellObjectTypeEnumToConst(ObjectType), ObjectNameBuffer, TabNameBuffer); {Ensure tab name buffer is freed.} finally FreeMem(TabNameBuffer); end; {try..finally} {Ensure object name buffer is freed.} finally FreeMem(ObjectNameBuffer); end; {try..finally} end; function ShellObjectTypeEnumToConst(ShellObjectType: TShellObjectType): UINT; begin case (ShellObjectType) of sdPathObject: Result := OPF_PATHNAME; sdPrinterObject: Result := OPF_PRINTERNAME; else Result := 0; end; {case} end; function ShellObjectTypeConstToEnum(ShellObjectType: UINT): TShellObjectType; begin case (ShellObjectType) of OPF_PATHNAME: Result := sdPathObject; OPF_PRINTERNAME: Result := sdPrinterObject; else Result := sdPathObject; end; {case} end; initialization {Get a reference to the SHELL32.DLL library} ShellDLL := LoadLibrary(PChar(Shell32)); finalization {Free reference to the SHELL32.DLL library} FreeLibrary(ShellDLL); end. |
| procedure TForm1.Button1Click(Sender: TObject); var FileHandle : THandle; LocalFileTime : TFileTime; DosFileTime : DWORD; LastAccessedTime : TDateTime; FindData : TWin32FindData; begin FileHandle := FindFirstFile('AnyFile.FIL', FindData); if FileHandle <> INVALID_HANDLE_VALUE then begin Windows.FindClose(Handle); if (FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) = 0 then begin FileTimeToLocalFileTime(FindData.ftLastWriteTime, LocalFileTime); FileTimeToDosDateTime(LocalFileTime, LongRec(DosFileTime).Hi,LongRec(DosFileTime).Lo); LastAccessedTime := FileDateToDateTime(DosFileTime); Label1.Caption := DateTimeToStr(LastAccessedTime); end; end; end; |
Малоизвестные
команды Windows 9xx для запуска из командной |
| Можно
использовать из приложения Дельфи с помощью
следующей конструкции: ShellExecute(Application.Handle,Pchar('Open'),Pchar('C:\Windows\Rundll32.exe'), Pchar(команда),Pchar('C:\Windows'),SW_SHOWNORMAL); где: команда - одна из перечисленных ниже Например ShellExecute(Application.Handle, Pchar('Open'),Pchar('C:\Windows\Rundll32.exe'), Pchar('krnl386.exe,exitkernel'), Pchar('C:\Windows'),SW_SHOWNORMAL); - выход из Windows без любых сообщений/вопросов Команды: "rundll32 shell32,Control_RunDLL" - Выводит "Панель управления" "rundll32 shell32,OpenAs_RunDLL" - Выводит окошко - "Открыть с помощью.." "rundll32 shell32,ShellAboutA Info-Box" - Покозать окно "About Windows" "rundll32 shell32,Control_RunDLL desk.cpl" - Открыть "Свойства Экрана" "rundll32 user,cascadechildwindows" - Сортировка окон "Каскадом" (Как в Win 3.x) "rundll32 user,tilechildwindows" - Сместить Окна в низ "rundll32 user,repaintscreen" - Обновить рабочий стол "rundll32 shell,shellexecute Explorer" - Запустить проводник Windows. "rundll32 keyboard,disable" - Вырубить Клавиатуру! (Вот Это я понимаю Заподло!) "rundll32 mouse,disable" - Вырубить Мышь! (У Шефа Будет припадок:))) "rundll32 user,swapmousebutton" - Поменять Местами клавиши Мыша! (Во мля! и этого Дядя Билли не забыл!) "rundll32 user,setcursorpos" - Сместить курсор крысы в левый верхний угол "rundll32 user,wnetconnectdialog" - Вызвать окно "Подключение сетевого диска" "rundll32 user,wnetdisconnectdialog" - Вызвать окно "Отключение сетевого диска" "rundll32 user,disableoemlayer" - Спровоцировать сбой!!! (Знаю, сам сразу не поверил, но это FUсKт...) "rundll32 diskcopy,DiskCopyRunDll" - Показать окно "Copy Disk" "rundll32 rnaui.dll,RnaWizard" - Вывод окна "Установка Связи", с ключем "/1" - без окна "rundll32 shell32,SHFormatDrive" - Окно "Форматирование: Диск3,5(А)" вызвать "rundll32 shell32,SHExitWindowsEx -1" - Перегрузить Explorer "rundll32 shell32,SHExitWindowsEx 1" - Выключение Компутера. "rundll32 shell32,SHExitWindowsEx 0" - Завершить Работу Текущего Пользователя "rundll32 shell32,SHExitWindowsEx 2" Windows-98-PC boot "rundll32 krnl386.exe,exitkernel" - выход из Windows без любых сообщений/вопросов "rundll rnaui.dll,RnaDial "MyConnect" - Вызвать окошко "Установка связи" с соединением "MyConnect" "rundll32 msprint2.dll,RUNDLL_PrintTestPage" - выбрать в появившемся меню принтер и послать, а него тест "rundll32 user,setcaretblinktime" - установить новую частоту мигания курсора "rundll32 user,setdoubleclicktime" - установить новую скорость двойного нажатия "rundll32 sysdm.cpl,InstallDevice_Rundll" - установить non-Plug&Play оборудование из рассылки
"Реестр Windows" |
| {Автор: Dale Berry Данная функция позволяет завершить выполнение любой активной программы по её classname или заголовку окна.} procedure KillProgram(Classname : string; WindowTitle : string); const PROCESS_TERMINATE = $0001; var ProcessHandle : THandle; ProcessID: Integer; TheWindow : HWND; begin TheWindow := FindWindow(Classname, WindowTitle); GetWindowThreadProcessID(TheWindow, @ProcessID); ProcessHandle := OpenProcess(PROCESS_TERMINATE, FALSE, ProcessId); TerminateProcess(ProcessHandle,4); end; {Комментарии Xianguang Li |