pubfun.~pas

用delphi实现的一个酒店管理系统框架

unit PubFun;

interface
uses Windows,Winsock,SysUtils,Forms;
Function GetCPUSpeed:Real; // measure time in ms
function GetIP(var s:string):string;
Function GetCpuId(var s:string):Cardinal;
function GetIdeSerialNumber(n:integer=0):string;
procedure ReplaceMe1(exename:PChar);
Function Msg1(Txt:string;Cap:string='警告!';uType:UINT=MB_OK):integer;
Function ConStr(Serv,DBN,sa,pw:string;Local:Boolean=True):string;
Function NewDBFail(Serv,DBN,F1,F2,sa:string):integer;

implementation

Function GetCPUSpeed:Real; // measure time in ms
const DelayTime=500;
var TimerHi,TimerLo:DWORD;PriorityClass,Priority:Integer;//引用Windows
begin
 PriorityClass:=GetPriorityClass(GetCurrentProcess);
 Priority:=GetThreadPriority(GetCurrentThread);
 SetPriorityClass(GetCurrentProcess,REALTIME_PRIORITY_CLASS);
 SetThreadPriority(GetCurrentThread,THREAD_PRIORITY_TIME_CRITICAL);
 Sleep(10);
 asm
  dw 310Fh // rdtsc
  mov TimerLo, eax
  mov TimerHi, edx
 end;
 Sleep(DelayTime);
 asm
  dw 310Fh // rdtsc
  sub eax, TimerLo
  sbb edx, TimerHi
  mov TimerLo, eax
  mov TimerHi, edx
 end;
 SetThreadPriority(GetCurrentThread, Priority);
 SetPriorityClass(GetCurrentProcess, PriorityClass);
 Result:=TimerLo/(1000.0*DelayTime);
end;

function GetIP(var s:string):string;
type//函数返回IP,参数返回计算机名称 //Winsock,SysUtils
TaPInAddr=array [0..10] of PInAddr;PaPInAddr=^TaPInAddr;
var phe:PHostEnt;pptr:PaPInAddr;Buffer:array [0..63] of char;
I:Integer;GInitData:TWSADATA;
begin
WSAStartup($101,GInitData);Result:='';
GetHostName(Buffer,SizeOf(Buffer));
s:=buffer;
phe:=GetHostByName(buffer);if phe=nil then Exit;
pptr:=PaPInAddr(Phe^.h_addr_list);I:=0;
while pptr^[I]<>nil do
begin result:=StrPas(inet_ntoa(pptr^[I]^));Inc(I);end;
WSACleanup;
end;

Function GetCpuId(var s:string):Cardinal;
var R:array[0..19] of Char;CpuID,i:Cardinal;
begin  
   FillChar(R,20,0);
   asm
       mov  eax,  0
       db  0fh,  0a2h  
       mov  dword  ptr R[0],ebx
       mov  dword  ptr R[4],edx
       mov  dword  ptr R[8],ecx
       mov  eax,1
       db  0fh,0a2h
       mov  CpuID,edx
   end;s:='';//s:=R;
for i:=0 to 19 do if R[i]>=' ' then s:=s+R[i] else break;
result:=CpuID;
end;

function GetIdeSerialNumber(n:integer=0):string;
const IDENTIFY_BUFFER_SIZE=512;
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;//驱动器状态
  bBuffer:array[0..0] of BYTE;//用于保存从驱动器读出的数据的缓冲区，实际长度由cBufferSize决定
 end;
var
  hDevice:THandle;cbBytesReturned:DWORD;SCIP:TSendCmdInParams;
  aIdOutCmd:array[0..(SizeOf(TSendCmdOutParams)+IDENTIFY_BUFFER_SIZE-1)-1] of Byte;
  IdOutCmd:TSendCmdOutParams absolute aIdOutCmd;s,s0:string;i:integer;
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//Windows NT,Windows 2000
//提示!改变名称可适用于其它驱动器，如第二个驱动器：'\\.\PhysicalDrive1\'
 hDevice:=CreateFile(pchar('\\.\PhysicalDrive'+inttostr(n)),GENERIC_READ or
  GENERIC_WRITE,FILE_SHARE_READ or FILE_SHARE_WRITE,nil,OPEN_EXISTING,0,0)
else//Version Windows 95 OSR2,Windows 98
 hDevice:=CreateFile('\\.\SMARTVSD',0,0,nil,CREATE_NEW,0,0);
if hDevice=INVALID_HANDLE_VALUE then
begin {showmessage('无效硬盘');}Exit;end;
try
 FillChar(SCIP,SizeOf(TSendCmdInParams)-1,#0);
 FillChar(aIdOutCmd,SizeOf(aIdOutCmd),#0);
 cbBytesReturned:=0;
 with SCIP do//Set up data structures for IDENTIFY command.
 begin
  cBufferSize:=IDENTIFY_BUFFER_SIZE;//bDriveNumber := 0;
  with irDriveRegs do
   begin
    bSectorCountReg:=1;
    bSectorNumberReg:=1;//if Win32Platform=VER_PLATFORM_WIN32_NT then bDriveHeadReg := $A0
    bDriveHeadReg:=$A0;//else bDriveHeadReg := $A0 or ((bDriveNum and 1) shl 4);
    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;
  s:=Pchar(@sSerialNumber);s0:='';
  for i:=1 to length(s) do  //
  if (s[i]>#32) then s0:=s0+s[i];
  Result:=s0;//Pchar(@sSerialNumber);
 end;
end;

function GetShortName(sLongName:PChar):PChar; //转换长文件名为短文件名
var  sShortName:string;nShortNameLen:integer;
begin
SetLength(sShortName,MAX_PATH);
nShortNameLen:=GetShortPathName(sLongName,PChar(sShortName),MAX_PATH-1);
if (0=nShortNameLen) then  begin  end; // handle errors...
SetLength(sShortName,nShortNameLen);
Result:=PChar(sShortName);
end;//-------------------------------------------------
procedure ReplaceMe1(exename:PChar);
var Selfname,BatFilename,s1,s2,cd:string;BatchFile,B2:TextFile;
begin
if Length(exename)<4 then exit;cd:=GetCurrentDir();
SetCurrentDir(ExtractFileDir(ExeName));
Selfname:=(Extractfilename(exename));//取EXE文件自己的名称
BatFilename:=ExtractFilePath(ExeName)+ '$$up$$.bat';//批处理文件名称
S1:='@del '+Selfname;
S2:='if exist '+Selfname+' goto pp';
assignfile(BatchFile,BatFilename);//文件名与文件指针对应
rewrite(BatchFile);//重写方式
writeln(BatchFile,':pp');//写第一行
writeln(BatchFile,S1);//删除可执行文件
writeln(BatchFile,S2);//如果还存在可执行文件转第一行
writeln(BatchFile,':pp2');//写一行
S1:='ren new.exe '+Selfname;
writeln(BatchFile,s1);//将new.exe改为新考试系统
S2:='if exist new.exe goto pp2';
writeln(BatchFile,S2);//如果还存在new.exe转pp2
writeln(BatchFile,'@del %0');//删除批处理自己
closefile(BatchFile);//写完批处理文件
winexec(GetShortName(pchar(BatFilename)),sw_hide);//隐藏窗口运行a.bat sw_hide

s1:=ExtractFilePath(ExeName)+ '$$b$$.bat';//批处理文件名称
assignfile(B2,s1);//文件名与文件指针对应
rewrite(B2);//重写方式
writeln(B2,':pp');//写第一行
S2:='if exist $$up$$.bat goto pp';
writeln(B2,S2);//如果还存在new.exe转pp2
writeln(B2,'@'+Selfname);//执行新考试系统
writeln(B2,'@del %0');//删除批处理自己
closefile(B2);//写完批处理文件
winexec(GetShortName(pchar(s1)),0);//隐藏窗口运行a.bat sw_hide

SetCurrentDir(cd);//application.Terminate;//退出程序，
end;//winexec()调用批处理文件必须用短文件名
//-----------------------------------------------------------

Function Msg1(Txt:string;Cap:string='警告!';uType:UINT=MB_OK):integer;
Begin
Msg1:=Application.MessageBox(PChar(Txt),PChar(Cap),uType);
End;

Function ConStr(Serv,DBN,sa,pw:string;Local:Boolean=True):string;
Begin//形成并返回SQL登录方式连接字符串
if Local then begin
result:='Provider=SQLOLEDB.1;Integrated Security=SSPI';
result:=result+';Initial Catalog='+DBN+';Data Source='+Serv;
end else
Begin
result:='Provider=SQLOLEDB.1;Password='+pw+';User ID='+sa;
result:=result+';Initial Catalog='+DBN+';Data Source='+Serv;
End;
End;

Function NewDBFail(Serv,DBN,F1,F2,sa:string):integer;
Begin
sa:='用户"'+sa+'"无法在"'+Serv+'"服务器上创建"'+DBN;
sa:=sa+'"数据库(文件名为:'+F1+'和'+F2+')。'#13#10#13#10;
sa:=sa+'可能原因:'#13#10'(1)用户非系统管理员;(2)服务器未启动;(3)服务器未安装。';
sa:=sa+#13#10#13#10'解决相应问题的方法：'#13#10'(1)设置用户为系统管理员方法:';
sa:=sa+#13#10'进入SQL企业管理器->安全性->登录->用户->属性->服务器角色';
sa:=sa+'->将"System Administrators"打勾。'#13#10'(2)启动SQL服务器方法:';
sa:=sa+#13#10'单击开始菜单->程序->Microsoft SQL Server->服务管理器。';
NewDBFail:=Application.MessageBox(PChar(sa),'数据库连接异常警告!',0);
Application.Terminate;
End;

end.