hardwareinfo.pas

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

            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;
          if s2[Length(s2)] = #0 then
            setlength(s2, Length(s2) - 1);
          result := s_all + s3 + s + s1 + s2;
        end
        else
          result := '';

      end;
    3: //获取 CPU厂商
      begin
        asm                //asm call to the CPUID inst.
          mov eax,0         //sub. func call
          db $0F,$A2         //db $0F,$A2 = CPUID instruction
          mov _ebx,ebx
          mov _ecx,ecx
          mov _edx,edx
        end;
        for i := 0 to 3 do //extract vendor id
        begin
          b := lo(_ebx);
          s := s + chr(b);
          b := lo(_ecx);
          s1 := s1 + chr(b);
          b := lo(_edx);
          s2 := s2 + chr(b);
          _ebx := _ebx shr 8;
          _ecx := _ecx shr 8;
          _edx := _edx shr 8;
        end;
        result := s + s2 + s1;
      end;
  else
    result := '错误的信息标识!';
  end;

end;

//-----------------------------------------------------------------------
//获取硬盘驱动器信息
//-----------------------------------------------------------------------
//参数：
// Drive 驱动器盘符 如C、D、E，不要带 :\
// InfoID =1 获取驱动器序列号  InfoID =2 获取卷标
//-----------------------------------------------------------------------

function THardwareInfo.GetIDEDiskDriveInfo(Drive: Char; InfoID: Byte): string;
var
  NotUsed: DWORD;
  VolumeFlags: DWORD;
  VolumeInfo: array[0..MAX_PATH] of Char;
  VolumeSerialNumber: DWORD;
begin
  try
    GetVolumeInformation(PChar(Drive + ':\'),
      VolumeInfo, SizeOf(VolumeInfo), @VolumeSerialNumber, NotUsed,
      VolumeFlags, nil, 0);
    case InfoID of
      1: Result := Format('%8.8X', [VolumeSerialNumber]);
      2: Result := VolumeInfo;
    else
      result := '错误的信息标识!';
    end;
  except on E: Exception do
      result := '执行错误!';
  end;
end;

//-----------------------------------------------------------------------
//获取硬盘物理序列号
//-----------------------------------------------------------------------
function THardwareInfo.GetIDEDiskSerialNumber: PChar;
  var hDevice : THandle;
      cbBytesReturned : DWORD;
//      ptr : PChar;
      SCIP : TSendCmdInParams;
      aIdOutCmd : Array [0..(SizeOf(TSendCmdOutParams)+IDENTIFY_BUFFER_SIZE-1)-1] of Byte;
      IdOutCmd  : TSendCmdOutParams absolute aIdOutCmd;
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;
  //      bDriveNumber := 0;
        with irDriveRegs do begin
          bSectorCountReg  := 1;
          bSectorNumberReg := 1;
  //      if Win32Platform=VER_PLATFORM_WIN32_NT then bDriveHeadReg := $A0
  //      else bDriveHeadReg := $A0 or ((bDriveNum and 1) shl 4);
          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 THardwareInfo.GetIDEDiskSerialNumber: string;
var
  hDevice: THandle;
  cbBytesReturned: DWORD;
  pInData: PSendCmdInParams;
  pOutData: Pointer; // PSendCmdOutParams
  Buffer: array[0..BufferSize - 1] of Byte;
  srbControl: TSrbIoControl absolute Buffer;
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));
    Result := TRIM(Result);
  end;
end;
}
function THardwareInfo.GetMACAddress(LanaNum: Byte; MACAddress: PMACAddress):
  Byte;
var
  AdapterStatus: PAdapterStatus;
  StatNCB: PNCB;
begin
  New(StatNCB);
  ZeroMemory(StatNCB, SizeOf(TNCB));
  StatNCB.ncb_length := SizeOf(TAdapterStatus) + 255 * SizeOf(TNameBuffer);
  GetMem(AdapterStatus, StatNCB.ncb_length);
  try
    with StatNCB^ do
    begin
      ZeroMemory(MACAddress, SizeOf(TMACAddress));
      ncb_buffer := PChar(AdapterStatus);
      ncb_callname := '*              ' + #0;
      ncb_lana_num := Char(LanaNum);
      ncb_command := Char(NCBASTAT);
      NetBios(StatNCB);
      Result := Byte(ncb_cmd_cplt);
      if Result = NRC_GOODRET then
        MoveMemory(MACAddress, AdapterStatus, SizeOf(TMACAddress));
    end;
  finally
    FreeMem(AdapterStatus);
    Dispose(StatNCB);
  end;
end;

//枚举当前安装的网络适配器

function THardwareInfo.GetLanaEnum(LanaEnum: PLanaEnum): Byte;
var
  LanaEnumNCB: PNCB;
begin
  New(LanaEnumNCB);
  ZeroMemory(LanaEnumNCB, SizeOf(TNCB));
  try
    with LanaEnumNCB^ do
    begin
      ncb_buffer := PChar(LanaEnum);
      ncb_length := SizeOf(TLanaEnum);
      ncb_command := Char(NCBENUM);
      NetBios(LanaEnumNCB);
      Result := Byte(ncb_cmd_cplt);
    end;
  finally
    Dispose(LanaEnumNCB);
  end;
end;

function THardwareInfo.ResetLana(LanaNum, ReqSessions, ReqNames: Byte;
  LanaRes: TNBLanaResources): Byte;
var
  ResetNCB: PNCB;
begin
  New(ResetNCB);
  ZeroMemory(ResetNCB, SizeOf(TNCB));
  try
    with ResetNCB^ do
    begin
      ncb_lana_num := Char(LanaNum); // Set Lana_Num
      ncb_lsn := Char(LanaRes); // Allocation of new resources
      ncb_callname[0] := Char(ReqSessions); // Query of max sessions
      ncb_callname[1] := #0; // Query of max NCBs (default)
      ncb_callname[2] := Char(ReqNames); // Query of max names
      ncb_callname[3] := #0; // Query of use NAME_NUMBER_1
      ncb_command := Char(NCBRESET);
      NetBios(ResetNCB);
      Result := Byte(ncb_cmd_cplt);
    end;
  finally
    Dispose(ResetNCB);
  end;
end;

procedure THardwareInfo.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;

end.