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