Membaca Identitas Komputer

June 13, 2006 at 5:51 pm | Posted in Code Samples | 10 Comments

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)…

winkeyid.png

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.

About these ads

10 Comments »

RSS feed for comments on this post. TrackBack URI

  1. Wah, ini kunjungan pertamaku, dan langsung tertarik dengan sharing yang diberikan blog ini.

    Bagus deh, salam kenal yak! :)

  2. Pada kode diatas ada bagian yang mungkin mengandung resiko yaitu pada function ReadHDDeviceInfo.
    Pada function tersebut terdapat perintah exit yang berada dalam blok try-finally, padahal pada bagian finally ada perintah untuk CloseHandle.
    (Perintah exit ini tidak nampak karena barisnya terlalu lebar. Cari tulisan exit ketiga pada kode tersebut.)
    Maksud saya adalah pada function tersebut ketika handle sudah berhasil di create tapi hasil pemanggilan function DeviceIOControl adalah false maka device handle tidak di-close. Mungkin perlu sedikit perubahan, yaitu dengan memanggil CloseHandle terlebih dahulu sebelum exit.

  3. Hmm, mau ikut nongol nih, he he he ^^

    Apakah ada yang tau nih, kalau aplikasi semacam ini bisa digabung dengan MessageDigest pada keamanan komputer. Dengan penggabungan tsb, maka aplikasi mengambil ID komputer semacam ID BIOS, CPU, dll, dapat menjadi suatu program aktivasi. Seperti halnya pada Windows Server 2003 atau TransTool, setelah instalasi selesai, maka diminta mengirimkan suatu serial number yang digenerasi oleh program ke Internet, untuk kemudian diberitahu aktivasi ID-nya. Tanpa aktivasi, program tidak mau berjalan.

    Yup, itu saja deh. Moga-moga comment ni bermanfaat. GBU ^o~

  4. @Eka:
    Screenshot di atas adalah aplikasi seperti yg Anda maksud. Tapi karena faktor hak-cipta, saya belum bisa membaginya untuk umum (open-source). ;)

  5. wow! wow…. v^_^!

    sumpah aku dah nyari22 informasi sperti ini… akhirnya ketemu juga yak! keren, asli keren tenan banget.

    Makasih yak :P

  6. haloo.. bagus mas post nya.,., post new lagii donk.,. thx.,.

  7. mas bee ,

    pada function readwindowstype itu gak salah yah yg windows2000 dan windows95 nya ?

    kan yg di check cuman nilai minor version nya doang sedangkan win95 dan win 2000 sama2 minor version nya 0 …

    kalau pake fungsi mas bee nanti hasil nya semua windows 2000 akan tampil sebagai win 95 .. harusnya sih …untuk pengecekan di include kan jg pengecekan major version nya biar pas..

    untuk win98 major version nya 4 dan minor nya 10
    untuk winme major version nya 4 minor nya 90
    untuk win95 major version nya 4 dan minor nya 0
    untuk win2000 major versionnya 5 dan minor nya 0
    untuk winxp major nya 5 dan minor nya 1
    untuk winnt major nya lebih kecil dari 4
    untuk winvista major na 6

  8. Thanks atas Sharingnya.Mas Bee Aplikasi di atas sangat Bagus.Cuma kalau untuk Running di Windows 64 Bit ( windows 7 64 bit) gimana ya?
    Bisa tolong di bantu ?
    Thanks. Fandi

  9. waw waw waw, ternyata lebih panjang dari rumus fisika ya…hehehe…. salam kenal

  10. Kalau kebutuhannya seperti ini bagaimana ya..???
    Misal ada 5 komputer (A,B,C,D,E).
    Komputer A sebagai Host.
    Bagaimana cara agar Komputer A bisa menyruh komputer B,C,D,E menjalankan program SECUREID Tool ini…???

    Terimakasih atas infonya nanti…

    :o)
    Ant


Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s

Create a free website or blog at WordPress.com. | The Pool Theme.
Entries and comments feeds.

Follow

Get every new post delivered to your Inbox.

%d bloggers like this: