fun.pas

小管理程序主要管理的小咖啡厅我是从网上下的经测试可用

unit fun;

interface
 uses windows,SysUtils,StrUtils,Classes;
 function split(S, Sep: AnsiString): Tstrings;
 function GetIdeDiskSerialNumber : String;
 function GetRegId:integer;
 function isRegSuc:boolean;
implementation
function split(S, Sep: AnsiString): Tstrings;
var
  I, L: Integer;
  Left: AnsiString;
  MyResult:Tstrings;
begin
  L := Length(Sep);
  I := Pos(Sep, S);
  MyResult:=TStringList.Create;
  while (I > 0) do
    begin
    Left := leftstr(S, I-1);
    MyResult.Add(Left);
    Delete(S, 1, I + L - 1);
    I := Pos(Sep, S);
    end;
  if S <> '' then
  begin
     MyResult.Add(S);
  end;
  split:=MyResult;
end;

function GetIdeDiskSerialNumber : String;
type 
TSrbIoControl = packed record 
HeaderLength : ULONG; 
Signature : Array[0..7] of Char; 
Timeout : ULONG; 
ControlCode : ULONG;
ReturnCode : ULONG; 
Length : ULONG; 
end; 
SRB_IO_CONTROL = TSrbIoControl; 
PSrbIoControl = ^TSrbIoControl; 

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. Must be zero. 
end; 
IDEREGS = TIDERegs; 
PIDERegs = ^TIDERegs; 

TSendCmdInParams = packed record 
cBufferSize : DWORD; 
irDriveRegs : TIDERegs; 
bDriveNumber : Byte; 
bReserved : Array[0..2] of Byte; 
dwReserved : Array[0..3] of DWORD; 
bBuffer : Array[0..0] of Byte; 
end; 
SENDCMDINPARAMS = TSendCmdInParams; 
PSendCmdInParams = ^TSendCmdInParams; 

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 : ULONG; 
wMultSectorStuff : Word; 
ulTotalAddressableSectors : ULONG; 
wSingleWordDMA : Word; 
wMultiWordDMA : Word; 
bReserved : Array[0..127] of Byte; 
end; 
PIdSector = ^TIdSector; 

const 
IDE_ID_FUNCTION = $EC; 
IDENTIFY_BUFFER_SIZE = 512; 
DFP_RECEIVE_DRIVE_DATA = $0007c088; 
IOCTL_SCSI_MINIPORT = $0004d008; 
IOCTL_SCSI_MINIPORT_IDENTIFY = $001b0501; 
DataSize = sizeof(TSendCmdInParams)-1+IDENTIFY_BUFFER_SIZE; 
BufferSize = SizeOf(SRB_IO_CONTROL)+DataSize; 
W9xBufferSize = IDENTIFY_BUFFER_SIZE+16; 
var 
hDevice : THandle; 
cbBytesReturned : DWORD; 
pInData : PSendCmdInParams; 
pOutData : Pointer; // PSendCmdOutParams 
Buffer : Array[0..BufferSize-1] of Byte; 
srbControl : TSrbIoControl absolute Buffer; 

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 := '';
FillChar(Buffer,BufferSize,#0); 
if Win32Platform=VER_PLATFORM_WIN32_NT then 
begin // Windows NT, Windows 2000 
// Get SCSI port handle 
hDevice := CreateFile( '\\.\Scsi0:', 
GENERIC_READ or GENERIC_WRITE, 
FILE_SHARE_READ or FILE_SHARE_WRITE, 
nil, OPEN_EXISTING, 0, 0 ); 
if hDevice=INVALID_HANDLE_VALUE then Exit; 
try 
srbControl.HeaderLength := SizeOf(SRB_IO_CONTROL); 
System.Move('SCSIDISK',srbControl.Signature,8); 
srbControl.Timeout := 2; 
srbControl.Length := DataSize; 
srbControl.ControlCode := IOCTL_SCSI_MINIPORT_IDENTIFY; 
pInData := PSendCmdInParams(PChar(@Buffer) 
+SizeOf(SRB_IO_CONTROL)); 
pOutData := pInData; 
with pInData^ do 
begin 
cBufferSize := IDENTIFY_BUFFER_SIZE; 
bDriveNumber := 0; 
with irDriveRegs do 
begin 
bFeaturesReg := 0; 
bSectorCountReg := 1; 
bSectorNumberReg := 1; 
bCylLowReg := 0; 
bCylHighReg := 0; 
bDriveHeadReg := $A0; 
bCommandReg := IDE_ID_FUNCTION; 
end; 
end; 
if not DeviceIoControl( hDevice, IOCTL_SCSI_MINIPORT, 
@Buffer, BufferSize, @Buffer, BufferSize, 
cbBytesReturned, nil ) then Exit; 
finally 
CloseHandle(hDevice); 
end; 
end 
else 
begin // Windows 95 OSR2, Windows 98 
hDevice := CreateFile( '\\.\SMARTVSD', 0, 0, nil, 
CREATE_NEW, 0, 0 ); 
if hDevice=INVALID_HANDLE_VALUE then Exit; 
try 
pInData := PSendCmdInParams(@Buffer); 
pOutData := @pInData^.bBuffer; 
with pInData^ do 
begin 
cBufferSize := IDENTIFY_BUFFER_SIZE; 
bDriveNumber := 0; 
with irDriveRegs do 
begin 
bFeaturesReg := 0; 
bSectorCountReg := 1; 
bSectorNumberReg := 1; 
bCylLowReg := 0; 
bCylHighReg := 0; 
bDriveHeadReg := $A0; 
bCommandReg := IDE_ID_FUNCTION; 
end; 
end; 
if not DeviceIoControl( hDevice, DFP_RECEIVE_DRIVE_DATA, 
pInData, SizeOf(TSendCmdInParams)-1, pOutData, 
W9xBufferSize, cbBytesReturned, nil ) then Exit; 
finally 
CloseHandle(hDevice); 
end; 
end; 
with PIdSector(PChar(pOutData)+16)^ do 
begin 
ChangeByteOrder(sSerialNumber,SizeOf(sSerialNumber)); 
SetString(Result,sSerialNumber,SizeOf(sSerialNumber)); 
end; 
end;
function GetRegId:integer;
var
  regid,i:integer;
  str1:string;
  begin
    regid:=0;
    str1:=GetIdeDiskSerialNumber;
    for i:=0 to length(str1)-1 do
      begin
        regid:=regid+ord(str1[i]);
      end;
    if (regid div 2)=0 then
      regid:=regid+1357
    else
      regid:=regid+2468;
    result:=regid;
  end;

function isRegSuc:boolean;
var
  zhucefile:Text;
  str,strpass,str1,str2,str3:string;
  path,charset:string;
  iCount,iIdex,intnum,intchu,intshang,intyu,inum:integer;
  charpostion1,charpostion2:integer;
begin
  result:=false;
  charset:='0123456789-';
  path:=ExtractFilePath(ParamStr(0));
  path:=path+'sl.sl';
  if fileexists(path) then
    begin
      AssignFile(zhucefile,path);
      reset(zhucefile);
      Read(zhucefile,str);
      closefile(zhucefile);
      icount:=1;
      while (icount<=length(str)) do
        begin
          strpass:=strpass+chr(strtoint(str[icount]+str[icount+1]));
          icount:=icount+2;
        end;
      inum:=0;
      for iIdex:=1 to length(strpass) do
       begin
      if pos(strpass[iIdex],charset)=0 then
        begin
          exit;
        end;
      if strpass[iIdex]='-' then
       begin
        inc(inum);
        if inum=1 then
           charpostion1:=iIdex;
        if inum=2 then
           charpostion2:=iIdex;
        end;
      end;
      if inum<>2 then
      begin
         exit;
      end;
      str1:=copy(strpass,1,charpostion1-1);
      str2:=copy(strpass,charpostion1+1,charpostion2-charpostion1-1);
      str3:=copy(strpass,charpostion2+1,length(strpass)-charpostion2+1);
      str1:=copy(str1,2,length(str1)-2);//除去首尾的多余字符。
      str3:=copy(str3,1,length(str3)-1);//除去尾部多余字符。
      intNum:=GetRegId;
      intchu:=strtoint(str1);
      intshang:=strtoint(str2);
      intyu:=strtoint(str3);
      if intNum=(intchu*intshang+intyu) then
        result:=true
      else
        result:=false;
    end
  else
    result:=false;
end;
end.