unit UDataModule;
interface
uses
Windows,
Messages,
SysUtils,
Classes,
Forms,
Dialogs,
StdCtrls, //TLabel
Grids, //TStringGrid
DB,
ADODB,
IniFiles,
Graphics, ImgList, Controls, IBDatabase, IBCustomDataSet, IBQuery, XPMan,
Winsock;
//TColor
// Windows, Messages, SysUtils,Classes,Dialogs, DB, ADODB, IniFiles, Forms, ExtCtrls;
{new constant definitions}
const
NIF_INFO = $10;
NIF_MESSAGE = 1;
NIF_ICON = 2;
NOTIFYICON_VERSION = 3;
NIF_TIP = 4;
NIM_SETVERSION = $00000004;
NIM_SETFOCUS = $00000003;
NIIF_INFO = $00000001;
NIIF_WARNING = $00000002;
NIIF_ERROR = $00000003;
NIN_BALLOONSHOW = WM_USER + 2;
NIN_BALLOONHIDE = WM_USER + 3;
NIN_BALLOONTIMEOUT = WM_USER + 4;
NIN_BALLOONUSERCLICK = WM_USER + 5;
NIN_SELECT = WM_USER + 0;
NINF_KEY = $1;
NIN_KEYSELECT = NIN_SELECT or NINF_KEY;
{other constants can be found in vs.net---vc7's dir: PlatformSDK\Include\ShellAPI.h}
{define the callback message}
TRAY_CALLBACK = WM_USER + $7258;
{new NotifyIconData structure definition}
type
PNewNotifyIconData = ^TNewNotifyIconData;
TDUMMYUNIONNAME = record
case Integer of
0: (uTimeout: UINT);
1: (uVersion: UINT);
end;
TNewNotifyIconData = record
cbSize: DWORD;
Wnd: HWND;
uID: UINT;
uFlags: UINT;
uCallbackMessage: UINT;
hIcon: HICON;
//Version 5.0 is 128 chars, old ver is 64 chars
szTip: array[0..127] of Char;
dwState: DWORD; //Version 5.0
dwStateMask: DWORD; //Version 5.0
szInfo: array[0..255] of Char; //Version 5.0
DUMMYUNIONNAME: TDUMMYUNIONNAME;
szInfoTitle: array[0..63] of Char; //Version 5.0
dwInfoFlags: DWORD; //Version 5.0
end;
type
Tallowrules = array[0..20] of Bool;
TExecuteModal = procedure(H: HWND; Pars: string);
TFamilyName = function: string;
TPluginName = function: string;
TMenuPosition = function: string;
TDM = class(TDataModule)
IBDatabase: TIBDatabase;
IBQuery: TIBQuery;
IBTransaction: TIBTransaction;
XPManifest1: TXPManifest;
procedure DataModuleCreate(Sender: TObject);
procedure DataModuleDestroy(Sender: TObject);
private
//Èêîíêà â òðåå è âñïëûâàþùèå ïîäñêàçêè
IconData: TNewNotifyIconData;
procedure SysTrayIconMsgHandler(var Msg: TMessage); message TRAY_CALLBACK;
procedure ShowBalloonTips(s: string);
procedure AddSysTrayIcon;
procedure DeleteSysTrayIcon;
public
procedure EditKeyPressDigits(Sender: TObject; var Key: Char);
procedure EditKeyPressDigits1(Sender: TObject; var Key: Char);
end;
function LoadPlugin(PlName: string; H: HWND; Pars: string): string;
function SecondsIdle: DWord;
procedure UnloadPlugin(PluginName: string);
function GetHMODULE(PluginName: string): HMODULE;
procedure WritePluginHandleInArray(PluginName: string; WindowHandle: HWND);
procedure DelPluginFromArray(PluginName: string);
procedure LogOff(Sender: TObject);
procedure StrBreakApart(const S, Delimeter: string; Parts: TStrings);
function RemDoubleS(InputText, s: string): string;
function DoubleQuoting(InputText: string): string;
procedure ClearStringGrid(FRM: TForm; SG: TStringGrid);
procedure FillStringGrid1(FRM: TForm; SG: TStringGrid; LBL: TLabel);
function GetAllowedToLoadPluginNames(employeeid_: cardinal): TStringList;
function GetModuleRights(PluginName: string): Tallowrules;
function Encrypt(const InString: string; StartKey, MultKey, AddKey: Integer):
string;
function Decrypt(const InString: string; StartKey, MultKey, AddKey: Integer):
string;
procedure LoadFormProperties(FRM: TForm);
function GetLocalIP: string;
function GetSystemComputerName: string;
const
MY_MESSAGE = WM_USER + 1;
StartKey = 4275; // Start default key
MultKey = 475683; // Mult default
AddKey = 17973; // Add default key
type
PluginIdNameHandle = record
PluginId: HMODULE;
PluginName: string;
WindowHandle: HWND;
end;
var
DM: TDM;
//Õýíäë ãëàâíîãî îêíà
MainHandle: HWND;
//Ìàññèâ äåñêðèïòîðîâ è íàçâàíèé çàãðóæåííûõ ìîäóëåé
PluginsIdsNamesHandles: array of PluginIdNameHandle;
//Ãëîáàëüíûå ïåðåìåííûå äëÿ ëîãèíà ïîëüçîâàòåëÿ
logemployeeid,
logemployeepersonalid: Cardinal;
logemployeefirstname,
logemployeelastname,
logemployeepatronymic: string;
logonid: Cardinal;
implementation
{$R *.dfm}
uses
ShellAPI;
procedure TDM.SysTrayIconMsgHandler(var Msg: TMessage);
begin
case Msg.lParam of
WM_MOUSEMOVE: ;
WM_LBUTTONDOWN: ;
WM_LBUTTONUP: ;
WM_LBUTTONDBLCLK: ;
WM_RBUTTONDOWN: ;
WM_RBUTTONUP: ;
WM_RBUTTONDBLCLK: ;
//followed by the new messages
NIN_BALLOONSHOW: ;
{Sent when the balloon is shown}
// ShowMessage('NIN_BALLOONSHOW');
NIN_BALLOONHIDE: ;
{Sent when the balloon disappears?Rwhen the icon is deleted,
for example. This message is not sent if the balloon is dismissed because of
a timeout or mouse click by the user. }
// ShowMessage('NIN_BALLOONHIDE');
NIN_BALLOONTIMEOUT: ;
{Sent when the balloon is dismissed because of a timeout.}
// ShowMessage('NIN_BALLOONTIMEOUT');
NIN_BALLOONUSERCLICK: ;
{Sent when the balloon is dismissed because the user clicked the mouse.
Note: in XP there's Close button on he balloon tips, when click the button,
send NIN_BALLOONTIMEOUT message actually.}
// ShowMessage('NIN_BALLOONUSERCLICK');
end;
end;
{AddSysTrayIcon procedure add an icon to notification area}
procedure TDM.AddSysTrayIcon;
begin
IconData.cbSize := SizeOf(IconData);
IconData.Wnd := AllocateHWnd(SysTrayIconMsgHandler);
{SysTrayIconMsgHandler is then callback message' handler}
IconData.uID := 0;
IconData.uFlags := NIF_ICON or NIF_MESSAGE or NIF_TIP;
IconData.uCallbackMessage := TRAY_CALLBACK; //user defined callback message
IconData.hIcon := Application.Icon.Handle; //an Icon's Handle
IconData.szTip := '';
if not Shell_NotifyIcon(NIM_ADD, @IconData) then
ShowMessage('add fail');
end;
{ShowBalloonTips procedure carry out the new feature: Balloon Tips}
procedure TDM.ShowBalloonTips(s: string);
var
TipInfo, TipTitle: string;
begin
IconData.cbSize := SizeOf(IconData);
IconData.uFlags := NIF_INFO;
TipInfo := s;
strPLCopy(IconData.szInfo, TipInfo, SizeOf(IconData.szInfo) - 1);
IconData.DUMMYUNIONNAME.uTimeout := 250;
TipTitle := 'TPMDocs';
strPLCopy(IconData.szInfoTitle, TipTitle, SizeOf(IconData.szInfoTitle) - 1);
IconData.dwInfoFlags := NIIF_INFO; //NIIF_ERROR; //NIIF_WARNING;
Shell_NotifyIcon(NIM_MODIFY, @IconData);
{in my testing, the following code has no use}
IconData.DUMMYUNIONNAME.uVersion := NOTIFYICON_VERSION;
if not Shell_NotifyIcon(NIM_SETVERSION, @IconData) then
ShowMessage('setversion fail');
end;
{here's the deletion procedure}
procedure TDM.DeleteSysTrayIcon;
begin
DeallocateHWnd(IconData.Wnd);
if not Shell_NotifyIcon(NIM_DELETE, @IconData) then
ShowMessage('delete fail');
end;