S
seeme0526
Unregistered / Unconfirmed
GUEST, unregistred user!
摘自
http://www.wellknow.net/showthread.php?s=&threadid=28
[分享] 非数据库公共文件
ub.pas
源码:--------------------------------------------------------------------------------
{
名称: Pub.pas
说明: 系统相关公共函数和过程}
unit Pub;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Forms, DB, ADODB;
const
C1 = 52845;
C2 = 22719;
{******************* 自定义过程,函数区 声明开始 *************}
//作用: 获取硬盘系列号
function GetIdeSerialNumber: pchar;
//作用: 加密 字符串
function Encrypt(const S: String; Key: Word): String;
//作用: 解密 字符串
function Decrypt(const S: String; Key: Word): String;
//作用: 打开单据类窗体(相同的 Form 只会被开启一次)
procedure OpenForm(sCaption: String;FormClass: TFormClass;var fm;AOwner: TComponent);
//作用: 打开对话框
function OpenDlg(sCaption: String;FormClass: TFormClass;AOwner: TComponent;mr: Boolean): Integer;
//作用: 如果传入的文本 = 指定的文本, 那么 返回另一指定的文本;
function ReplaceText(sInText, sOutText, sSpecText: String): String;
{******************* 自定义过程,函数区 声明结束 *************}
implementation
uses DMu, PubDB;
{******************* 自定义过程,函数区 实现开始 *************}
function GetIdeSerialNumber: pchar;
const
IDENTIFY_BUFFER_SIZE = 512;
//Win98 要 SMARTVSD.VXD 必须安装到 /windows/system/iosubsys 并重启
type
TIDERegs = packed record
bFeaturesReg : BYTE; // Used for specifying SMART "commands".
bSectorCountReg : BYTE; // IDE sector count register
bSectorNumberReg : BYTE; // IDE sector number register
bCylLowReg : BYTE; // IDE low order cylinder value
bCylHighReg : BYTE; // IDE high order cylinder value
bDriveHeadReg : BYTE; // IDE drive/head register
bCommandReg : BYTE; // Actual IDE command.
bReserved : BYTE; // reserved for future use. Must be zero.
end;
TSendCmdInParams = packed record
cBufferSize : DWORD; // Buffer size in bytes
irDriveRegs : TIDERegs; // Structure with drive register values.
bDriveNumber : BYTE; // Physical drive number to send command to (0,1,2,3).
bReserved : Array[0..2] of Byte;
dwReserved : Array[0..3] of DWORD;
bBuffer : Array[0..0] of Byte;// Input buffer.
end;
TIdSector = packed record
wGenConfig : Word;
wNumCyls : Word;
wReserved : Word;
wNumHeads : Word;
wBytesPerTrack : Word;
wBytesPerSector : Word;
wSectorsPerTrack : Word;
wVendorUnique : Array[0..2] of Word;
sSerialNumber : Array[0..19] of CHAR;
wBufferType : Word;
wBufferSize : Word;
wECCSize : Word;
sFirmwareRev : Array[0..7] of Char;
sModelNumber : Array[0..39] of Char;
wMoreVendorUnique : Word;
wDoubleWordIO : Word;
wCapabilities : Word;
wReserved1 : Word;
wPIOTiming : Word;
wDMATiming : Word;
wBS : Word;
wNumCurrentCyls : Word;
wNumCurrentHeads : Word;
wNumCurrentSectorsPerTrack : Word;
ulCurrentSectorCapacity : DWORD;
wMultSectorStuff : Word;
ulTotalAddressableSectors : DWORD;
wSingleWordDMA : Word;
wMultiWordDMA : Word;
bReserved : Array[0..127] of BYTE;
end;
PIdSector = ^TIdSector;
TDriverStatus = packed record
bDriverError : Byte;// 驱动器返回的错误代码，无错则返回0
bIDEStatus : Byte;// IDE出错寄存器的内容，只有当bDriverError为SMART_IDE_ERROR时有效
bReserved : Array[0..1] of Byte;
dwReserved : Array[0..1] of DWORD;
end;
TSendCmdOutParams = packed record
cBufferSize : DWORD;// bBuffer的大小
DriverStatus : TDriverStatus;// 驱动器状态
// 用于保存从驱动器读出的数据的缓冲区，实际长度由cBufferSize决定
bBuffer : Array[0..0] of BYTE;
end;
var hDevice : THandle;
cbBytesReturned : DWORD;
SCIP : TSendCmdInParams;
aIdOutCmd : Array [0..(SizeOf(TSendCmdOutParams) + IDENTIFY_BUFFER_SIZE-1) - 1] of Byte;
IdOutCmd : TSendCmdOutParams absolute aIdOutCmd;
procedure ChangeByteOrder( var Data; Size : Integer );
var ptr : PChar;
i : Integer;
c : Char;
begin
ptr := @Data;
for i := 0 to (Size shr 1)-1 do begin
c := ptr^;
ptr^ := (ptr+1)^;
(ptr+1)^ := c;
Inc(ptr,2);
end;
end;
begin
Result := ''; // 如果出错则返回空串
if SysUtils.Win32Platform=VER_PLATFORM_WIN32_NT then begin// Windows NT, Windows 2000
// 提示! 改变名称可适用于其它驱动器，如第二个驱动器： '//./PhysicalDrive1'
hDevice := CreateFile( '//./PhysicalDrive0', GENERIC_READ or GENERIC_WRITE,
FILE_SHARE_READ or FILE_SHARE_WRITE, nil, OPEN_EXISTING, 0, 0 );
end else // Version Windows 95 OSR2, Windows 98
hDevice := CreateFile( '//./SMARTVSD', 0, 0, nil, CREATE_NEW, 0, 0 );
if hDevice=INVALID_HANDLE_VALUE then Exit;
try
FillChar(SCIP,SizeOf(TSendCmdInParams)-1,#0);
FillChar(aIdOutCmd,SizeOf(aIdOutCmd),#0);
cbBytesReturned := 0;
// Set up data structures for IDENTIFY command.
with SCIP do begin
cBufferSize := IDENTIFY_BUFFER_SIZE;
with irDriveRegs do begin
bSectorCountReg := 1;
bSectorNumberReg := 1;
bDriveHeadReg := $A0;
bCommandReg := $EC;
end;
end;
if not DeviceIoControl( hDevice, $0007c088, @SCIP, SizeOf(TSendCmdInParams)-1,
@aIdOutCmd, SizeOf(aIdOutCmd), cbBytesReturned, nil ) then Exit;
finally
CloseHandle(hDevice);
end;
with PIdSector(@IdOutCmd.bBuffer)^ do begin
ChangeByteOrder( sSerialNumber, SizeOf(sSerialNumber) );
(PChar(@sSerialNumber)+SizeOf(sSerialNumber))^ := #0;
Result := PChar(@sSerialNumber);
end;
end;
//作用: 加密 字符串
function Encrypt(const S: String; Key: Word): String;
var
I: Integer;
begin
Result := S;
for I := 1 to Length(S) do
begin
Result := char(byte(S) xor (Key shr 8));
Key := (byte(Result) + Key) * C1 + C2;
end;
end;
//作用: 解密 字符串
function Decrypt(const S: String; Key: Word): String;
var
I: Integer;
begin
Result := S;
for I := 1 to Length(S) do
begin
Result := char(byte(S) xor (Key shr 8));
Key := (byte(S) + Key) * C1 + C2;
end;
end;
procedure OpenForm(sCaption: String;FormClass: TFormClass;var fm; AOwner: TComponent);
var
i: integer;
Child: TForm;
sFun{功能}: String;
begin
//如果当前 登录用户ID 没有此实例的 显示许可, 则中止 打开 操作
sFun := FormClass.ClassName;//将 窗体类名 -> 功能名称
sFun := Copy(sFun, 2, Length(sFun) - 1);//TfrmStockOrder -> 'frmStockOrder'
//1显示/2新增/3修改/4删除/5打印
HasFunctionsAllow(sFun, 1);
//遍历所有窗体
for i := 0 to Screen.FormCount - 1 do
//如果找到与指定 窗体类 相同的 窗体类
if Screen.Forms.ClassType = FormClass then
begin
Child := Screen.Forms;
//如果此 ChildForm 最小化, 则将其还原
if Child.WindowState = wsMinimized then
ShowWindow(Child.handle, SW_SHOWNORMAL)
else
ShowWindow(Child.handle, SW_SHOWNA);
//如果此 ChildForm 被隐藏, 则将其显示出来
if (not Child.Visible) then Child.Visible := True;
//此时, 将 ChildForm 置前并激活
Child.BringToFront;
Child.Setfocus;
TForm(fm) := Child;
exit;
end;
//分配内存空间给一个对象类型的一个实例，并返回新实例的指针
Child := TForm(FormClass.NewInstance);
TForm(fm) := Child;
Child.Create(AOwner);
Child.Caption := sCaption;
end;
function OpenDlg(sCaption: String;FormClass: TFormClass;AOwner: TComponent;mr: Boolean): Integer;
var
dlg: TForm;
sFun{功能}: String;
tt: TComponent;//TempTComponent
begin
//如果当前 登录用户ID 没有此实例的 显示许可, 则中止 打开 操作
sFun := FormClass.ClassName;//将 窗体类名 -> 功能名称
sFun := Copy(sFun, 2, Length(sFun) - 1);//TdlgStockOrder -> 'dlgStockOrder'
//1显示/2新增/3修改/4删除/5打印
HasFunctionsAllow(sFun, 1);
dlg := FormClass.Create(AOwner);
try
dlg.Caption := sCaption;//给 窗体标题 赋值
if dlg.ShowModal = 1 then//如果按了确定
begin
if mr = True then//需要返回结果
begin
tt := dlg.FindComponent('M');//找到这个组件
if (tt <> nil) and (tt is TAdoQuery) then//然后进行断定
begin
Result := (tt As TAdoQuery).FieldByName('ID').AsInteger;//最后返回结果
end;
end;
end;//if mrOK
finally
dlg.Free;
end;
end;
//作用: 如果传入的文本 = 指定的文本, 那么 返回另一指定的文本;
function ReplaceText(sInText, sOutText, sSpecText: String): String;
begin
Result := sInText;
if sInText = sSpecText then
Result := sOutText
end;
{******************* 自定义过程,函数区 实现结束 *************}
end.
--------------------------------------------------------------------------------
http://www.wellknow.net/showthread.php?s=&threadid=28
[分享] 非数据库公共文件
ub.pas 源码:--------------------------------------------------------------------------------
{
名称: Pub.pas
说明: 系统相关公共函数和过程}
unit Pub;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Forms, DB, ADODB;
const
C1 = 52845;
C2 = 22719;
{******************* 自定义过程,函数区 声明开始 *************}
//作用: 获取硬盘系列号
function GetIdeSerialNumber: pchar;
//作用: 加密 字符串
function Encrypt(const S: String; Key: Word): String;
//作用: 解密 字符串
function Decrypt(const S: String; Key: Word): String;
//作用: 打开单据类窗体(相同的 Form 只会被开启一次)
procedure OpenForm(sCaption: String;FormClass: TFormClass;var fm;AOwner: TComponent);
//作用: 打开对话框
function OpenDlg(sCaption: String;FormClass: TFormClass;AOwner: TComponent;mr: Boolean): Integer;
//作用: 如果传入的文本 = 指定的文本, 那么 返回另一指定的文本;
function ReplaceText(sInText, sOutText, sSpecText: String): String;
{******************* 自定义过程,函数区 声明结束 *************}
implementation
uses DMu, PubDB;
{******************* 自定义过程,函数区 实现开始 *************}
function GetIdeSerialNumber: pchar;
const
IDENTIFY_BUFFER_SIZE = 512;
//Win98 要 SMARTVSD.VXD 必须安装到 /windows/system/iosubsys 并重启
type
TIDERegs = packed record
bFeaturesReg : BYTE; // Used for specifying SMART "commands".
bSectorCountReg : BYTE; // IDE sector count register
bSectorNumberReg : BYTE; // IDE sector number register
bCylLowReg : BYTE; // IDE low order cylinder value
bCylHighReg : BYTE; // IDE high order cylinder value
bDriveHeadReg : BYTE; // IDE drive/head register
bCommandReg : BYTE; // Actual IDE command.
bReserved : BYTE; // reserved for future use. Must be zero.
end;
TSendCmdInParams = packed record
cBufferSize : DWORD; // Buffer size in bytes
irDriveRegs : TIDERegs; // Structure with drive register values.
bDriveNumber : BYTE; // Physical drive number to send command to (0,1,2,3).
bReserved : Array[0..2] of Byte;
dwReserved : Array[0..3] of DWORD;
bBuffer : Array[0..0] of Byte;// Input buffer.
end;
TIdSector = packed record
wGenConfig : Word;
wNumCyls : Word;
wReserved : Word;
wNumHeads : Word;
wBytesPerTrack : Word;
wBytesPerSector : Word;
wSectorsPerTrack : Word;
wVendorUnique : Array[0..2] of Word;
sSerialNumber : Array[0..19] of CHAR;
wBufferType : Word;
wBufferSize : Word;
wECCSize : Word;
sFirmwareRev : Array[0..7] of Char;
sModelNumber : Array[0..39] of Char;
wMoreVendorUnique : Word;
wDoubleWordIO : Word;
wCapabilities : Word;
wReserved1 : Word;
wPIOTiming : Word;
wDMATiming : Word;
wBS : Word;
wNumCurrentCyls : Word;
wNumCurrentHeads : Word;
wNumCurrentSectorsPerTrack : Word;
ulCurrentSectorCapacity : DWORD;
wMultSectorStuff : Word;
ulTotalAddressableSectors : DWORD;
wSingleWordDMA : Word;
wMultiWordDMA : Word;
bReserved : Array[0..127] of BYTE;
end;
PIdSector = ^TIdSector;
TDriverStatus = packed record
bDriverError : Byte;// 驱动器返回的错误代码，无错则返回0
bIDEStatus : Byte;// IDE出错寄存器的内容，只有当bDriverError为SMART_IDE_ERROR时有效
bReserved : Array[0..1] of Byte;
dwReserved : Array[0..1] of DWORD;
end;
TSendCmdOutParams = packed record
cBufferSize : DWORD;// bBuffer的大小
DriverStatus : TDriverStatus;// 驱动器状态
// 用于保存从驱动器读出的数据的缓冲区，实际长度由cBufferSize决定
bBuffer : Array[0..0] of BYTE;
end;
var hDevice : THandle;
cbBytesReturned : DWORD;
SCIP : TSendCmdInParams;
aIdOutCmd : Array [0..(SizeOf(TSendCmdOutParams) + IDENTIFY_BUFFER_SIZE-1) - 1] of Byte;
IdOutCmd : TSendCmdOutParams absolute aIdOutCmd;
procedure ChangeByteOrder( var Data; Size : Integer );
var ptr : PChar;
i : Integer;
c : Char;
begin
ptr := @Data;
for i := 0 to (Size shr 1)-1 do begin
c := ptr^;
ptr^ := (ptr+1)^;
(ptr+1)^ := c;
Inc(ptr,2);
end;
end;
begin
Result := ''; // 如果出错则返回空串
if SysUtils.Win32Platform=VER_PLATFORM_WIN32_NT then begin// Windows NT, Windows 2000
// 提示! 改变名称可适用于其它驱动器，如第二个驱动器： '//./PhysicalDrive1'
hDevice := CreateFile( '//./PhysicalDrive0', GENERIC_READ or GENERIC_WRITE,
FILE_SHARE_READ or FILE_SHARE_WRITE, nil, OPEN_EXISTING, 0, 0 );
end else // Version Windows 95 OSR2, Windows 98
hDevice := CreateFile( '//./SMARTVSD', 0, 0, nil, CREATE_NEW, 0, 0 );
if hDevice=INVALID_HANDLE_VALUE then Exit;
try
FillChar(SCIP,SizeOf(TSendCmdInParams)-1,#0);
FillChar(aIdOutCmd,SizeOf(aIdOutCmd),#0);
cbBytesReturned := 0;
// Set up data structures for IDENTIFY command.
with SCIP do begin
cBufferSize := IDENTIFY_BUFFER_SIZE;
with irDriveRegs do begin
bSectorCountReg := 1;
bSectorNumberReg := 1;
bDriveHeadReg := $A0;
bCommandReg := $EC;
end;
end;
if not DeviceIoControl( hDevice, $0007c088, @SCIP, SizeOf(TSendCmdInParams)-1,
@aIdOutCmd, SizeOf(aIdOutCmd), cbBytesReturned, nil ) then Exit;
finally
CloseHandle(hDevice);
end;
with PIdSector(@IdOutCmd.bBuffer)^ do begin
ChangeByteOrder( sSerialNumber, SizeOf(sSerialNumber) );
(PChar(@sSerialNumber)+SizeOf(sSerialNumber))^ := #0;
Result := PChar(@sSerialNumber);
end;
end;
//作用: 加密 字符串
function Encrypt(const S: String; Key: Word): String;
var
I: Integer;
begin
Result := S;
for I := 1 to Length(S) do
begin
Result := char(byte(S) xor (Key shr 8));
Key := (byte(Result) + Key) * C1 + C2;
end;
end;
//作用: 解密 字符串
function Decrypt(const S: String; Key: Word): String;
var
I: Integer;
begin
Result := S;
for I := 1 to Length(S) do
begin
Result := char(byte(S) xor (Key shr 8));
Key := (byte(S) + Key) * C1 + C2;
end;
end;
procedure OpenForm(sCaption: String;FormClass: TFormClass;var fm; AOwner: TComponent);
var
i: integer;
Child: TForm;
sFun{功能}: String;
begin
//如果当前 登录用户ID 没有此实例的 显示许可, 则中止 打开 操作
sFun := FormClass.ClassName;//将 窗体类名 -> 功能名称
sFun := Copy(sFun, 2, Length(sFun) - 1);//TfrmStockOrder -> 'frmStockOrder'
//1显示/2新增/3修改/4删除/5打印
HasFunctionsAllow(sFun, 1);
//遍历所有窗体
for i := 0 to Screen.FormCount - 1 do
//如果找到与指定 窗体类 相同的 窗体类
if Screen.Forms.ClassType = FormClass then
begin
Child := Screen.Forms;
//如果此 ChildForm 最小化, 则将其还原
if Child.WindowState = wsMinimized then
ShowWindow(Child.handle, SW_SHOWNORMAL)
else
ShowWindow(Child.handle, SW_SHOWNA);
//如果此 ChildForm 被隐藏, 则将其显示出来
if (not Child.Visible) then Child.Visible := True;
//此时, 将 ChildForm 置前并激活
Child.BringToFront;
Child.Setfocus;
TForm(fm) := Child;
exit;
end;
//分配内存空间给一个对象类型的一个实例，并返回新实例的指针
Child := TForm(FormClass.NewInstance);
TForm(fm) := Child;
Child.Create(AOwner);
Child.Caption := sCaption;
end;
function OpenDlg(sCaption: String;FormClass: TFormClass;AOwner: TComponent;mr: Boolean): Integer;
var
dlg: TForm;
sFun{功能}: String;
tt: TComponent;//TempTComponent
begin
//如果当前 登录用户ID 没有此实例的 显示许可, 则中止 打开 操作
sFun := FormClass.ClassName;//将 窗体类名 -> 功能名称
sFun := Copy(sFun, 2, Length(sFun) - 1);//TdlgStockOrder -> 'dlgStockOrder'
//1显示/2新增/3修改/4删除/5打印
HasFunctionsAllow(sFun, 1);
dlg := FormClass.Create(AOwner);
try
dlg.Caption := sCaption;//给 窗体标题 赋值
if dlg.ShowModal = 1 then//如果按了确定
begin
if mr = True then//需要返回结果
begin
tt := dlg.FindComponent('M');//找到这个组件
if (tt <> nil) and (tt is TAdoQuery) then//然后进行断定
begin
Result := (tt As TAdoQuery).FieldByName('ID').AsInteger;//最后返回结果
end;
end;
end;//if mrOK
finally
dlg.Free;
end;
end;
//作用: 如果传入的文本 = 指定的文本, 那么 返回另一指定的文本;
function ReplaceText(sInText, sOutText, sSpecText: String): String;
begin
Result := sInText;
if sInText = sSpecText then
Result := sOutText
end;
{******************* 自定义过程,函数区 实现结束 *************}
end.
--------------------------------------------------------------------------------
