Windows の与えるマシン固有の ID 二種

Intel 掲示板スレッドに話題が出ていたので、参考にしつつ Fortran で書いてみました。http://software.intel.com/en-us/forums/intel-visual-fortran-compiler-for-windows/topic/64037/

Win32 プログラムはいまだ作法がよく分からず手探りなので、チョンボしていないか確信が持てません。

■program identification number (PID)

OS のライセンス番号を出力します。

PROGRAM pid_main
USE ifwin
IMPLICIT NONE
CHARACTER(*), PARAMETER :: kSubKey    = "SOFTWARE\\MICROSOFT\\Windows NT\\CurrentVersion"C
CHARACTER(*), PARAMETER :: kValueName = "DigitalProductId"C  
INTEGER (HANDLE) :: hKey = NULL  
INTEGER (BOOL) :: iret
INTEGER (DWORD):: dwType, dwSize = 1025 
CHARACTER (1025) :: sPidStr = ''  
INTEGER :: nlen
iret = RegOpenKeyEx(HKEY_LOCAL_MACHINE, kSubKey, 0, IOR(KEY_QUERY_VALUE, KEY_WOW64_64KEY), LOC(hKey) )
iret = RegQueryValueEx(hKey, kValueName, NULL, LOC(dwType), NULL, NULL)
IF ( dwType == IOR(REG_SZ, REG_EXPAND_SZ) ) THEN  
 iret = RegQueryValueEx( hKey, kValueName, NULL, NULL, LOC(sPidStr), LOC(dwSize) )  
 nlen = INDEX( sPidStr(9:), ACHAR(0) ) - 1
 PRINT *, 'PID=', sPidStr(9:nlen + 8) 
ELSE
 STOP 'Error: RegQueryValueEx'
END IF   
STOP
END PROGRAM pid_main

■system identification number (SID)

マシン固有の番号を出力します。最適化がかかると異常終了してしまいます。Intel が Interface を用意してくれていない命令があってちょっと面倒でした。

PROGRAM sid_main
USE, INTRINSIC :: ISO_C_BINDING
USE ifwin
IMPLICIT NONE
!
INTERFACE
 INTEGER (BOOL) FUNCTION ConvertSidToStringSid(arg1, arg2) 
  IMPORT
  INTEGER (PVOID), VALUE :: arg1
  INTEGER (PVOID), VALUE :: arg2
 END FUNCTION ConvertSidToStringSid
END INTERFACE
POINTER (ConvertSidToStringSid_PTR, ConvertSidToStringSid)
INTEGER (HANDLE) :: dllhInst
!
CHARACTER (LEN = MAX_COMPUTERNAME_LENGTH + 1) :: ComputerName
INTEGER :: ComputerNameLen = MAX_COMPUTERNAME_LENGTH + 1 
CHARACTER (LEN = 2048) :: Domain=''
INTEGER (BOOL) :: iret
INTEGER (PVOID) :: pSid
INTEGER (LONG) ::  DomainLen, SidLen = 0
CHARACTER (256):: SidStr
INTEGER (LPLONG) :: psidstr
POINTER (pSidStr, SidStr)
INTEGER (ENUM) :: AccountType  
INTEGER :: nlen
!
iret = GetComputerName( ComputerName, LOC(ComputerNameLen) ) 
!PRINT *, 'ComputerName =', ComputerName(1:ComputerNameLen)
iret = LookupAccountName(NULL, ComputerName, NULL, LOC(SidLen), Domain, LOC(DomainLen), LOC(AccountType) ) 
pSid = GlobalAlloc(GPTR, SidLen)
iret = LookupAccountName(NULL, ComputerName, pSid, LOC(SidLen), Domain(1:DomainLen), LOC(DomainLen), LOC(AccountType) )
!PRINT *, 'DOMAIN =', Domain(1:DomainLen)
!
dllhInst = LoadLibrary("Advapi32.dll"C)
ConvertSidToStringSid_PTR = GetProcAddress(dllhInst, "ConvertSidToStringSidA"C)
iret = ConvertSidToStringSid( pSid, LOC(pSidStr) )
!
nlen = INDEX(SidStr, ACHAR(0)) - 1
PRINT *, 'SID=', SidStr(1:nlen) 
iret = LocalFree(pSidStr)
iret = GlobalFree(pSid)
STOP
END PROGRAM sid_main