hardwareinfo.pas

本程序功能是将银行系统的月计表转换为所需要的资产负债表

unit HardwareInfo;

interface
uses Windows, SysUtils, Dialogs, Nb30;

type
  TNBLanaResources = (lrAlloc, lrFree);

type
  PMACAddress = ^TMACAddress;
  TMACAddress = array[0..5] of Byte;

  //以下读硬盘号用
  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;
  TDriverStatus = packed record
    // 驱动器返回的错误代码，无错则返回0
    bDriverError : Byte;
    // IDE出错寄存器的内容，只有当bDriverError 为 SMART_IDE_ERROR 时有效
    bIDEStatus   : Byte;
    bReserved    : Array[0..1] of Byte;
    dwReserved   : Array[0..1] of DWORD;
  end;
  TSendCmdOutParams = packed record
    // bBuffer的大小
    cBufferSize  : DWORD;
    // 驱动器状态
    DriverStatus : TDriverStatus;
    // 用于保存从驱动器读出的数据的缓冲区，实际长度由cBufferSize决定
    bBuffer      : Array[0..0] of BYTE;
  end;
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;
  //以上读硬盘号用
type
  THardwareInfo = class

  public
    function GetMACAddress(Num: Byte = 0): string; overload;
    function GetIDEDiskSerialNumber: PChar;
    function GetIDEDiskDriveInfo(Drive: Char; InfoID: Byte = 1): string;
    function GetCPUInfo(InfoID: Byte = 1): string;

  private
    function GetMACAddress(LanaNum: Byte; MACAddress: PMACAddress): Byte;
      overload; //LanaNum 网卡标识
    procedure ChangeByteOrder(var Data; Size: Integer);
    function GetLanaEnum(LanaEnum: PLanaEnum): Byte;
    function ResetLana(LanaNum, ReqSessions, ReqNames: Byte; LanaRes:
      TNBLanaResources): Byte;
  end;

implementation

function THardwareInfo.GetMACAddress(Num: Byte): string;
var
  MACAddress: PMACAddress;
  RetCode, LanaNum: Byte;
  LanaEnum: PLanaEnum;
begin
  //1、获取网卡枚举列表
  New(LanaEnum);
  ZeroMemory(LanaEnum, SizeOf(TLanaEnum));
  try
    if GetLanaEnum(LanaEnum) = NRC_GOODRET then
    begin
      //2、取所要第几块网卡的标识
      if Num > Byte(LanaEnum.length) - 1 then
        Num := Byte(LanaEnum.length) - 1;
      LanaNum := Byte(LanaEnum.lana[Num]);
    end
    else
    begin
      Result := '';
      Exit;
    end;
  finally
    Dispose(LanaEnum);
  end;

  //3、复位
  RetCode := ResetLana(LanaNum, 0, 0, lrAlloc);
  if RetCode <> NRC_GOODRET then
  begin
    Beep;
    Result := '';
    ShowMessage('Reset Error! RetCode = $' + IntToHex(RetCode, 2));
    Exit;
  end;

  Result := 'Error';
  //4、取所选网卡的地址
  New(MACAddress);
  try
    RetCode := GetMACAddress(LanaNum, MACAddress);
    if RetCode = NRC_GOODRET then
    begin
      Result := Format('%2.2x%2.2x-%2.2x%2.2x-%2.2x%2.2x', [MACAddress[0],
        MACAddress[1],
          MACAddress[2], MACAddress[3], MACAddress[4], MACAddress[5]]);
      //Result := Format('%2.2x%2.2x%2.2x%2.2x%2.2x%2.2x', [MACAddress[0],
      //  MACAddress[1],
      //  MACAddress[2], MACAddress[3], MACAddress[4], MACAddress[5]]);
    end
    else
    begin
      Result := '';
      ShowMessage('GetMACAddress Error! RetCode = $' + IntToHex(RetCode, 2));
      Exit;
    end;
  finally
    Dispose(MACAddress);
  end;
end;

//-----------------------------------------------------------------------
//获取CPU硬件信息
//-----------------------------------------------------------------------
//参数：
// InfoID:=1 获取CPU序列号
// InfoID:=2 获取CPU 频率
// InfoID:=3 获取CPU厂商
//-----------------------------------------------------------------------

function THardwareInfo.GetCPUInfo(InfoID: Byte): string;
var
  _eax, _ebx, _ecx, _edx: Longword;
  i: Integer;
  b: Byte;
//  b1: Word;
  s, s1, s2, s3, s_all: string;
begin
  case InfoID of //获取CPU序列号
    1:
      begin
        asm
          mov eax,1
          db $0F,$A2
          mov _eax,eax
          mov _ebx,ebx
          mov _ecx,ecx
          mov _edx,edx
        end;
        s := IntToHex(_eax, 8);
        s1 := IntToHex(_edx, 8);
        s2 := IntToHex(_ecx, 8);
        Insert('-', s, 5);
        Insert('-', s1, 5);
        Insert('-', s2, 5);
        result := s + '-' + s1 + '-' + s2;
      end;
    2: //获取 CPU 频率
      begin
        asm     //execute the extended CPUID inst.
          mov eax,$80000000   //sub. func call
          db $0F,$A2
          mov _eax,eax
        end;
        if _eax > $80000000 then //any other sub. funct avail. ?
        begin
          asm     //get brand ID
            mov eax,$80000002
            db $0F
            db $A2
            mov _eax,eax
            mov _ebx,ebx
            mov _ecx,ecx
            mov _edx,edx
          end;
          s := '';
          s1 := '';
          s2 := '';
          s3 := '';
          for i := 0 to 3 do
          begin
            b := lo(_eax);
            s3 := s3 + chr(b);
            b := lo(_ebx);
            s := s + chr(b);
            b := lo(_ecx);
            s1 := s1 + chr(b);
            b := lo(_edx);
            s2 := s2 + chr(b);
            _eax := _eax shr 8;
            _ebx := _ebx shr 8;
            _ecx := _ecx shr 8;
            _edx := _edx shr 8;
          end;
          s_all := trim(s3 + s + s1 + s2);
          asm
            mov eax,$80000003
            db $0F
            db $A2
            mov _eax,eax
            mov _ebx,ebx
            mov _ecx,ecx
            mov _edx,edx
          end;
          s := '';
          s1 := '';
          s2 := '';
          s3 := '';
          for i := 0 to 3 do
          begin
            b := lo(_eax);
            s3 := s3 + chr(b);
            b := lo(_ebx);
            s := s + chr(b);
            b := lo(_ecx);
            s1 := s1 + chr(b);
            b := lo(_edx);
            s2 := s2 + chr(b);
            _eax := _eax shr 8;
            _ebx := _ebx shr 8;
            _ecx := _ecx shr 8;
            _edx := _edx shr 8;
          end;
          s_all := s_all + s3 + s + s1 + s2;
          asm
            mov eax,$80000004
            db $0F
            db $A2
            mov _eax,eax
            mov _ebx,ebx
            mov _ecx,ecx
            mov _edx,edx
          end;
          s := '';
          s1 := '';
          s2 := '';
          s3 := '';
          for i := 0 to 3 do
          begin
            b := lo(_eax);
            s3 := s3 + chr(b);
            b := lo(_ebx);
            s := s + chr(b);