Fortran で GUID を得る。

Windows で識別のために生成される GUID を Fortran で求めます。

参考ページ
http://support.microsoft.com/kb/176790/ja

■出力結果

■　Fortran Source

Cray 式ポインターなど、非 ISO 規格の機能を使っています。Win32 なので仕方ないね。
イマイチ正しいか自信ありません。

MODULE m_guid
USE ifwin
IMPLICIT NONE
PRIVATE
PUBLIC :: t_GUID, make_guid
CONTAINS
TYPE (t_GUID) FUNCTION make_guid()
INTEGER (HANDLE) :: dllhInst
INTEGER (BOOL) :: lret
INTEGER :: i
!
POINTER (OleInitialize_PTR, OleInitialize)
POINTER (CoCreateGuid_PTR , CoCreateGuid)
!
INTERFACE
 INTEGER (HANDLE) FUNCTION OleInitialize( arg )
 !DEC$ ATTRIBUTES DEFAULT, STDCALL, DECORATE, ALIAS : "OleInitialize" :: OleInitialize
 USE, INTRINSIC :: ISO_C_BINDING
 USE ifwinty
 INTEGER, VALUE, INTENT(in) :: arg
 END FUNCTION OleInitialize
!
 INTEGER (BOOL) FUNCTION CoCreateGuid( arg )
 !DEC$ ATTRIBUTES DEFAULT, STDCALL, DECORATE, ALIAS : "CoCreateGuid" :: CoCreateGuid
 USE, INTRINSIC :: ISO_C_BINDING
 USE ifwinty
 INTEGER (LPLONG), VALUE, INTENT(IN) :: arg 
 END FUNCTION CoCreateGuid
END INTERFACE
!
dllhInst = LoadLibrary("ole32.dll"C)
IF (dllhInst .ne. NULL) THEN
 OleInitialize_PTR = GetProcAddress(dllhInst, "OleInitialize"C)
 IF (OleInitialize_PTR .ne. NULL) THEN
  i = OleInitialize(NULL)
  CoCreateGuid_PTR = GetProcAddress(dllhInst, "CoCreateGuid"C)
  IF (OleInitialize_PTR .ne. NULL) THEN
   lret = CoCreateGuid( LOC(make_guid) )
  END IF
 END IF
 lret = FreeLibrary(dllhInst)
END IF
RETURN
END FUNCTION make_guid
END MODULE m_guid
!==================================================
PROGRAM test
USE m_guid
IMPLICIT NONE
TYPE (t_GUID) :: gid
INTEGER :: i
gid = make_guid()
PRINT '( "{", Z8.8, "-", 2(Z4.4, "-"), 2Z2.2, "-", 6Z2.2, "}" )', gid%data1, gid%data2, gid%data3, &
                                             (gid%data4(i:i), i = 1, 2), (gid%data4(i:i), i = 3, 8)
STOP
END PROGRAM test