! Copyright (C) 2001 by Fortran Library ! ! This source may be freely copied, modified, or distributed so long as the original ! copyright statement remains intact. ! ! Suggestions for improvment to the original posted version are welcome. Comments ! should be sent to mailto:webmaster@fortranlib.com ! ! Version: 2.0, 6 August 2001, 17:47:00 ! ! Purpose: Routine to generate a Universally Unique Identifier ! ! A UUID is a 128 bit unique value. It takes the following hexadecimal ! form: ! ! 6B29FC40-CA47-1067-B31D-00DD010662DA ! ! This routine returns the UUID value as an array of 16 8-bit integers ! ! System Requirements: Requires Digital/Compaq/Intel) Visual Fortran (x86) ! ! Routine Name: uuIDGen ! ! Definition of a UUID: ! ! time_low : Unsigned 32-bit integer, octets 00-03 - the low field of the time stamp ! time_mid : Unsigned 16-bit integer, octets 04-05 - the middle field of the time stamp ! time_hi/ver : Unsigned 16-bit integer, octets 06-07 - the high field of the time stamp ! multiplexed with the version number ! clock_seq_hi_and_reserved: Unsigned 08-bit integer, octet 08-08 - the high field of the clock sequence ! multiplexed with the variant ! clock_seq_low : Unsigned 08-bit integer, octet 09-09 - the low field of hte clock sequence ! node : unsigned 48-bit integer, octets 10-15 - the spatially unique node identifier ! ! version: The upper 4 bits of time_hi/ver ! ! 2#0001 = time-based ! 2#0010 = reserved for DCE security version with embedded POSIX UIDs ! 2#0011 = name-based ! 2#0100 = random or pseudo-random ! ! timestamp: Version 1 - A 60-bit UTC (preferred, or local time) value consisting of a count of 100ns intervals since 00:00:00.00, 15 October 1582. ! Version 3 - A 60-bit value constructed from a name. ! Version 4 - A 60-bit value randomly or pseudo-randomly generated. ! ! clock sequence: A correction to account for backwards clock setting or node ID changes. ! High portion is the 2 most significant bits of clock_seq_high_and_reserved. ! The 2-bit variant/reserved field should be set to 2#01. ! Version 3 - A 14-bit value constructed from a name. ! Version 4 - A 14-bit value randomly or pseudo-randomly generated. ! ! node: Version 1 - A 48-bit IEEE address, usually host address. Low octet (10) contains the ! global/local bit and the unicst/multicast bit, and is the first octet of the ! address transmitted on an 802.3 LAN. ! ! If no network card, a randomly or pseudo-randomly genreated value may be used. ! The multicast bit (bit 1 of the first octet)must be set to prevent conflict with ! network card addresses. ! Version 3 - A 48-bit value constructed from a name. ! Version 4 - A 48-bit value randomly or pseudo-randomely generated. ! ! ! The following module defines the interface to CoCreateGuid which is not presently ! provided by Visual Fortran 6.5 (rumor is that it is in 6.6). Thanks to John Termine. ! module uuIDDefine interface function CoCreateGuid(pguID) result(iStat) !dec$ attributes default, stdcall, alias:'_CoCreateGuid@4' :: CoCreateGuid use dfcom, only : GUID implicit none type(GUID), intent(out) :: pguID !dec$ attributes reference :: pguID integer :: iStat end function CoCreateGuid end interface ! ! The structure containing the GUI ID components ! type (GUID) :: guIDStruct !Structure definition for CoCreateGUID contains ! ! Routine to generate a UUID ! ! Arguments: ! ! uuID - returned array of sixteen 8-bit integers ! may also be referenced via: ! ! guIDStruct%data1 (32-bit integer) ! guIDStruct%data2 (16-bit integer) ! guIDStruct%data3 (16-bit integer) ! guIDStruct%data4 (8-character string) ! ! iRet - return code from CoCreateGUID (0=successful UUID creation) ! 0 = UUID created successfully (S_OK) ! Other possible values: RPC_S_UUID_LOCAL_ONLY and RPC_S_UUID_NO_ADDRESS ! subroutine uuIDGen(uuID, iRet) use dfwinty, only : GUID !Definition of the GUID data type ! use CCGDefine !Declarations for CoCreateGUID from OLE32.LIB implicit none character(2) :: text2 !16-bit work area for transfer character(4) :: text4 !32-bit work area for transfer integer(1), intent(out) :: uuID(16) !Returned 16-byte (128-bit) UUID integer, intent(out) :: iRet !Return code integer :: iStat !Return code from CoCreateGUID ! ! Initialize return code ! iRet = 0 ! ! Create a new UUID (GUID) ! iStat = CoCreateGuid(guIDStruct) if (iStat .ne. 0) then iRet = iStat return end if ! ! Since we want this into a 16-byte array, translate the structure content ! ! Data1 is a 32-bit integer, data2 is a 16-bit integer, data3 is a 16-bit integer, and ! in this definition, data4 is an 8-character string (I guess because 64-bit integer not supported) ! text4 = transfer(guIDStruct%data1,text4) uuID(01) = transfer(text4(4:4),uuID(01)) !We want to transfer each data component, but must be uuID(02) = transfer(text4(3:3),uuID(02)) !byte swapped for our needs (little endian) uuID(03) = transfer(text4(2:2),uuID(03)) uuID(04) = transfer(text4(1:1),uuID(04)) ! ! Extract data2 ! text2 = transfer(guIDStruct%data2,text2) uuID(05) = transfer(text2(2:2),uuID(05)) uuID(06) = transfer(text2(1:1),uuID(06)) ! ! Extract data3 ! text2 = transfer(guIDStruct%data3,text2) uuID(07) = transfer(text2(2:2),uuID(07)) uuID(08) = transfer(text2(1:1),uuID(08)) ! ! Extract data4 ! uuID(09) = transfer(guIDStruct%data4(1:1),uuID(09)) uuID(10) = transfer(guIDStruct%data4(2:2),uuID(10)) uuID(11) = transfer(guIDStruct%data4(3:3),uuID(11)) uuID(12) = transfer(guIDStruct%data4(4:4),uuID(12)) uuID(13) = transfer(guIDStruct%data4(5:5),uuID(13)) uuID(14) = transfer(guIDStruct%data4(6:6),uuID(14)) uuID(15) = transfer(guIDStruct%data4(7:7),uuID(15)) uuID(16) = transfer(guIDStruct%data4(8:8),uuID(16)) return end subroutine end module