Delphindo on WordPress

by: Bee

Menanggapi beberapa pertanyaan di milis Delphindo tentang cara membaca identitas komputer seperti nomor IP, alamat MAC, serial harddisk, dlsb, berikut adalah unit berisi kumpulan fungsi untuk membaca identitas komputer. Unit ini hanya bekerja di lingkungan OS Windows (win32). Seluruh fungsi2 dalam unit ini diambil dari berbagai sumber di internet. Semoga bermanfaat.

Berikut adalah contoh tampilan aplikasi implementasi unit (aplikasi tidak disertakan)…

Dan berikut adalah kode sumber unit selengkapnya…

unit winhwid;

(******************************************************************************
  Version: 1.0
  Author : Bee
  Email  : bee.ography@gmail.com
  Blog   : http://beeography.wordpress.com
 ******************************************************************************)

interface

uses
  Windows, Registry, SysUtils;

type
  TWindowsType = (winUnknown, win95, win98, winME, win2K, winNT35, winNT40, winXP);
  TMachineID   = (idProcessorType, idProcessorNumber, idProcessorModel, idProcessorName,
                  idHDDeviceModel, idHDDeviceNumber, idHDDriveNumber, idHDVolumeNumber,
                  idNICDeviceNumber, idNICMacAddress, idNICIPAddress, idNICIPNetMask,
                  idWindowsType, idWindowsNumber, idWinUserName, idWinComputerName);

function ReadMachineID(const AMachineID: TMachineID): string;
function WinStrToType(const AWinStr: string): TWindowsType;

implementation

const
  UnknownText = 'UNKNOWN';

// harddisk data structure
const
  IDENTIFY_BUFFER_SIZE = 512;
type
  THDInfoType  = (hdModelNumber, hdSerialNumber);
  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;
  TIDERegs = packed record
    bFeaturesReg     : byte;
    bSectorCountReg  : byte;
    bSectorNumberReg : byte;
    bCylLowReg       : byte;
    bCylHighReg      : byte;
    bDriveHeadReg    : byte;
    bCommandReg      : byte;
    bReserved        : byte;
  end;
  TDriverStatus = packed record
    bDriverError : byte;
    bIDEStatus   : byte;
    bReserved    : array[0..1] of byte;
    dwReserved   : array[0..1] of DWord;
  end;
  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;
  TSendCmdOutParams = packed record
    cBufferSize  : DWord;
    DriverStatus : TDriverStatus;
    bBuffer      : array[0..0] of byte;
  end;

// nic data structure
const
  MAX_ADAPTER_NAME_LENGTH        = 256;
  MAX_ADAPTER_DESCRIPTION_LENGTH = 128;
  MAX_ADAPTER_ADDRESS_LENGTH     = 8;
type
  TNICInfoType = (nicDeviceNumber, nicMacAddress, nicIPAdress, nicIPNetMask);
  TIPAddressString = array[0..15] of char;
  PIPAddrString = ^TIPAddrString;
  TIPAddrString = record
    Next      : PIPAddrString;
    IPAddress : TIPAddressString;
    IPNetMask : TIPAddressString;
    Context   : integer;
  end;
  PIPAdapterInfo = ^TIPAdapterInfo;
  TIPAdapterInfo = record
    Next                : PIPAdapterInfo;
    ComboIndex          : integer;
    AdapterName         : array[0..MAX_ADAPTER_NAME_LENGTH+3] of char;
    Description         : array[0..MAX_ADAPTER_DESCRIPTION_LENGTH+3] of char;
    AddressLength       : integer;
    Address             : array[1..MAX_ADAPTER_ADDRESS_LENGTH] of byte;
    Index               : integer;
    _Type               : integer;
    DHCPEnabled         : integer;
    CurrentIPAddress    : PIPAddrString;
    IPAddressList       : TIPAddrString;
    GatewayList         : TIPAddrString;
    DHCPServer          : TIPAddrString;
    HaveWINS            : LongBool;
    PrimaryWINSServer   : TIPAddrString;
    SecondaryWINSServer : TIPAddrString;
    LeaseObtained       : integer;
    LeaseExpires        : integer;
  end;

function GetAdaptersInfo(AdapterInfo: PIPAdapterInfo; var BufLen: integer): integer;
         stdcall; external 'iphlpapi.dll' name 'GetAdaptersInfo';

function ReadProcessorType: string;
var
  CPUType: array[0..3] of DWord;
  pString: PChar;
begin
  try
    asm
      push ebx
      mov  eax, 0
      dw   $A20F
      mov  dword ptr CPUType,     ebx
      mov  dword ptr CPUType[+4], edx
      mov  dword ptr CPUType[+8], ecx
      pop  ebx
    end;

    CPUType[3] := 0;
    pString := @CPUType;
    Result := pString;
  except
    Result := UnknownText;
  end;
end;

function ReadProcessorNumber: string;
var
  id1, id2, id3, id4: DWord;
begin
  try
    asm
      mov eax, 1
      db  $0F, $A2
      mov id1, eax
      mov id2, ebx
      mov id3, ecx
      mov id4, edx
    end;

    Result := IntToHex(id1,8)+'-'+IntToHex(id2,8)+'-'+
              IntToHex(id3,8)+'-'+IntToHex(id4,8);
  except
    Result := UnknownText;
  end;
end;

function ReadProcessorModel: string;
var
  reg: TRegistry;
begin
  try
    reg := TRegistry.Create;
    try
      reg.RootKey := HKEY_LOCAL_MACHINE;
      reg.OpenKey('\Hardware\Description\System\CentralProcessor\0', true);

      Result := reg.ReadString('Identifier');
    except
      Result := UnknownText;
    end;
  finally
    reg.Free;
  end;
end;

function ReadProcessorName: string;
var
  reg: TRegistry;
begin
  try
    reg := TRegistry.Create;
    try
      reg.RootKey := HKEY_LOCAL_MACHINE;
      reg.OpenKey('\Hardware\Description\System\CentralProcessor\0', true);

      Result := reg.ReadString('ProcessorNameString');
    except
      Result := UnknownText;
    end;
  finally
    reg.Free;
  end;
end;

procedure ChangeByteOrder(var Data; Size: integer);
var
  pc: PChar;
  i: integer;
  c: char;
begin
  pc := @Data;
  for i := 0 to (Size shr 1)-1 do
  begin
    c := pc^;
    pc^ := (pc+1)^;
    (pc+1)^ := c;
    Inc(pc, 2);
  end;
end;

function ReadHDDeviceInfo(const HDInfoType: THDInfoType; const HDIndex: integer = 0): string;
var
  aIdOutCmd: array[0..(SizeOf(TSendCmdOutParams)+IDENTIFY_BUFFER_SIZE-1)-1] of byte;
  IdOutCmd: TSendCmdOutParams absolute aIdOutCmd;
  SCIP: TSendCmdInParams;
  cbBytesReturned : DWord;
  hDevice: THandle;
begin
  Result := UnknownText;

  // open device
  if Win32Platform = VER_PLATFORM_WIN32_NT then
    // winNT, win2K, and winXP provides internal device access
    hDevice := CreateFile(PChar('\\.\PhysicalDrive'+IntToStr(HDIndex)),
                          GENERIC_READ or GENERIC_WRITE,
                          FILE_SHARE_READ or FILE_SHARE_WRITE,
                          nil, OPEN_EXISTING, 0, 0)
  else
    // win95 and win98 requires SMARTVSD.VXD device driver
    hDevice := CreateFile('\\.\SMARTVSD', 0, 0, nil, CREATE_NEW, 0, 0);

  // exit on device open failed
  if hDevice = INVALID_HANDLE_VALUE then Exit;

  try
    FillChar(SCIP, SizeOf(TSendCmdInParams)-1, #0);
    FillChar(aIdOutCmd, SizeOf(aIdOutCmd), #0);
    cbBytesReturned := 0;

    // set up structures for command
    with SCIP do
    begin
      cBufferSize  := IDENTIFY_BUFFER_SIZE;

      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
    case HDInfoType of
      hdModelNumber:
      begin
        ChangeByteOrder(sModelNumber, SizeOf(sModelNumber));
        (PChar(@sModelNumber)+SizeOf(sModelNumber))^ := #0;
        Result := Trim(PChar(@sModelNumber));
      end;
      hdSerialNumber:
      begin
        ChangeByteOrder(sSerialNumber, SizeOf(sSerialNumber));
        (PChar(@sSerialNumber)+SizeOf(sSerialNumber))^ := #0;
        Result := Trim(PChar(@sSerialNumber));
      end;
    end;

    if Result = '' then Result := UnknownText;
  end;
end;

function ReadHDDriveNumber(const DriveLetter: string = 'C'): string;
var
  pVolumeNumber : pDWord;
  maxCompLength, flagFile : DWord;
begin
  New(pVolumeNumber);
  GetVolumeInformation(PChar(DriveLetter+':\'),nil,0,pVolumeNumber,maxCompLength,flagFile,nil,0);
  Result := IntToStr(pVolumeNumber^);
  Dispose(pVolumeNumber);

  if Result = '0' then Result := UnknownText;
end;

function ReadHDVolumeNumber(const DriveLetter: string = 'C'): string;
var
  volumeNumber : DWord;
  maxCompLength, flagFile : DWord;
begin
  GetVolumeInformation(PChar(DriveLetter+':\'),nil,0,@volumeNumber,maxCompLength,flagFile,nil,0);
  Result := IntToHex(HiWord(volumeNumber),4)+'-'+IntToHex(LoWord(volumeNumber), 4);

  if Result = '-' then Result := UnknownText;
end;

function MacToStr(ByteArr: PByte; Len: integer) : string;
begin
  Result := '';
  while (Len > 0) do
  begin
    Result := Result + IntToHex(ByteArr^, 2) + ':';
    ByteArr := Pointer(integer(ByteArr) + SizeOf(Byte));
    Dec(Len);
  end;
  SetLength(Result, Length(Result)-1);
end;

function ReadNICDeviceInfo(const ANICInfoType: TNICInfoType; const NICIndex: integer = 0): string;
var
  adapterInfo: PIPAdapterInfo;
  size, res, i: integer;
begin
  size := 5120;
  GetMem(adapterInfo, size);
  res := GetAdaptersInfo(adapterInfo, size);

  if (res <> ERROR_SUCCESS) then
  begin
    SetLastError(res);
    RaiseLastOSError;
  End;

  if NICIndex > 0 then
    for i := 0 to NICIndex-1 do
      adapterInfo := adapterInfo^.Next;

  case ANICInfoType of
    nicDeviceNumber:
    begin
      Result := adapterInfo^.AdapterName;
    end;
    nicMacAddress:
    begin
      Result := MacToStr(@adapterInfo^.Address, adapterInfo^.AddressLength);
    end;
    nicIPAdress:
    begin
      Result := adapterInfo^.IPAddressList.IPAddress;
    end;
    nicIPNetMask:
    begin
      Result := adapterInfo^.IPAddressList.IPNetMask;
    end;
  end;

  adapterInfo := nil;
  FreeMem(adapterInfo);

  if Result = '' then Result := UnknownText;
end;

function ReadWindowsType: string;
begin
  try
    if Win32MinorVersion = 0  then Result := 'Windows 95'
    else
    if Win32MinorVersion = 10 then Result := 'Windows 98'
    else
    if Win32MinorVersion = 90 then Result := 'Windows ME'
    else
    if Win32MinorVersion = 0  then Result := 'Windows 2000'
    else
    if Win32MinorVersion = 3  then Result := 'Windows NT 3.5'
    else
    if Win32MinorVersion = 4  then Result := 'Windows NT 4.0'
    else
    if Win32MinorVersion = 1  then Result := 'Windows XP';
  except
    Result := UnknownText;
  end;
end;

function ReadWindowsNumber: string;
var
  reg: TRegistry;
begin
  try
    reg := TRegistry.Create;
    try
      reg.RootKey := HKEY_LOCAL_MACHINE;
      reg.OpenKey('\Software\Microsoft\Windows\CurrentVersion', true);
      Result := reg.ReadString('ProductID');
    except
      Result := UnknownText;
    end;
  finally
    reg.Free;
  end;
end;

function ReadWinUserName: string;
var
  buffer: string;
  buffSize: DWord;
Begin
  buffsize := 128;
  Setlength(buffer, buffSize);
  GetUserName(Pchar(buffer), buffSize);
  Result := Trim(buffer);
  if Result = '' then Result := UnknownText;
end;

function ReadWinComputerName: string;
var
  buffer: string;
  buffSize: DWord;
Begin
  buffsize := 128;
  Setlength(buffer, buffSize);
  GetComputerName(Pchar(buffer), buffSize);
  Result := Trim(buffer);
  if Result = '' then Result := UnknownText;
end;

function ReadMachineID(const AMachineID: TMachineID): string;
begin
  case AMachineID of
    idProcessorType:   Result := ReadProcessorType;
    idProcessorNumber: Result := ReadProcessorNumber;
    idProcessorModel:  Result := ReadProcessorModel;
    idProcessorName:   Result := ReadProcessorName;
    idHDDeviceModel:   Result := ReadHDDeviceInfo(hdModelNumber);
    idHDDeviceNumber:  Result := ReadHDDeviceInfo(hdSerialNumber);
    idHDDriveNumber:   Result := ReadHDDriveNumber;
    idHDVolumeNumber:  Result := ReadHDVolumeNumber;
    idNICDeviceNumber: Result := ReadNICDeviceInfo(nicDeviceNumber);
    idNICMacAddress:   Result := ReadNICDeviceInfo(nicMacAddress);
    idNICIPAddress:    Result := ReadNICDeviceInfo(nicIPAdress);
    idNICIPNetMask:    Result := ReadNICDeviceInfo(nicIPNetMask);
    idWindowsType:     Result := ReadWindowsType;
    idWindowsNumber:   Result := ReadWindowsNumber;
    idWinUserName:     Result := ReadWinUserName;
    idWinComputerName: Result := ReadWinComputerName;
  end;
end;

function WinStrToType(const AWinStr: string): TWindowsType;
begin
  if AWinStr = 'Windows 95'     then Result := win95
  else
  if AWinStr = 'Windows 98'     then Result := win98
  else
  if AWinStr = 'Windows ME'     then Result := winME
  else
  if AWinStr = 'Windows 2000'   then Result := win2K
  else
  if AWinStr = 'Windows NT 3.5' then Result := winNT35
  else
  if AWinStr = 'Windows NT 4.0' then Result := winNT40
  else
  if AWinStr = 'Windows XP'     then Result := winXP
  else
    Result := winUnknown;
end;

end.

Source code juga bisa diunduh di http://esnips.com/web/delphindo-src dgn nama file winhwid.pas.