VB6 - Random GUID Generator

[vbLewis]

Here is my guid code, its a small module that handles alot of different GUID needs.
Note that CoCreateGuid calls these api functions to create guids.

Option Explicit

Public Type GUID
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(7) As Byte
End Type


'same as guid
'note: if you have a reference to oleexp.tlb typelib you will need to comment this out
Public Type UUID
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(7) As Byte
End Type

'NOTE: GUID,UUID,IID etc are all the same 16 byte data structure just with differing names
'      and can be freely interchanged...

'these two are the same but the uuid's are name differently
Public Declare Function UuidCreate Lib "rpcrt4.dll" (pUUID As UUID) As Long
Public Declare Function GuidCreate Lib "rpcrt4.dll" Alias "UuidCreate" (pguid As GUID) As Long

'these two are the same but the uuid's are name differently
Public Declare Function UuidCreateSequential Lib "rpcrt4.dll" (pUUID As UUID) As Long
Public Declare Function GuidCreateSequential Lib "rpcrt4.dll" Alias "UuidCreateSequential" (pguid As GUID) As Long

Public Declare Function UuidCompare Lib "rpcrt4.dll" (pUuid1 As UUID, pUuid2 As UUID, ByRef Status As Long) As Long
Public Declare Function GuidCompare Lib "rpcrt4.dll" Alias "UuidCompare" (pGuid1 As GUID, pGuid2 As GUID, ByRef Status As Long) As Long

Public Declare Function UuidEqual Lib "rpcrt4.dll" (pUuid1 As UUID, pUuid2 As UUID, ByRef Status As Long) As Long
Public Declare Function GuidEqual Lib "rpcrt4.dll" Alias "UuidEqual" (pGuid1 As GUID, pGuid2 As GUID, ByRef Status As Long) As Long

Public Declare Function UuidFromString Lib "rpcrt4.dll" Alias "UuidFromStringA" (StringUuid As String, pUUID As UUID) As Long
Public Declare Function GuidFromString Lib "rpcrt4.dll" Alias "UuidFromStringA" (StringUuid As Long, pguid As GUID) As Long

Public Declare Function UuidHash Lib "rpcrt4.dll" (pUUID As UUID, Status As Long) As Integer
Public Declare Function GuidHash Lib "rpcrt4.dll" Alias "UuidHash" (pguid As GUID, Status As Long) As Integer

Public Declare Function UuidIsNil Lib "rpcrt4.dll" (pUUID As UUID, Status As Long) As Long
Public Declare Function GuidIsNil Lib "rpcrt4.dll" Alias "UuidIsNil" (pguid As GUID, Status As Long) As Long

'note: return string must be freed with rpcstringfree
Public Declare Function UuidToString Lib "rpcrt4.dll" Alias "UuidToStringA" (pUUID As UUID, StringUuid As Long) As Long

Public Declare Function GuidToString Lib "rpcrt4.dll" Alias "UuidToStringA" (pguid As GUID, StringUuid As Long) As Long

Public Declare Function RpcStringFree Lib "rpcrt4.dll" Alias "RpcStringFreeA" (pStr As Long) As Long

Public Declare Function CLSIDFromString Lib "ole32" (ByVal lpsz As Any, pclsid As Any) As Long

Public Declare Function IsEqualIID Lib "ole32" Alias "IsEqualGUID" (riid1 As UUID, riid2 As UUID) As Long

Private Declare Sub RtlMoveMemory Lib "kernel32" (Destination As Any, Source As Any, ByVal Length As Long)

Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As Long) As Long


'set blnGlobalUnique to True if you absolutely need a unique guid to the planet (its slower)
Function CreateGUID(Optional ByVal blnGlobalUnique As Boolean) As GUID
    Dim ret As Long

    If blnGlobalUnique Then
        ret = GuidCreate(CreateGUID)
    Else
        ret = GuidCreateSequential(CreateGUID)
    End If

End Function

Function CreateUUID(Optional ByVal blnGlobalUnique As Boolean) As UUID
    RtlMoveMemory CreateUUID, CreateGUID(blnGlobalUnique), Len(CreateUUID)
End Function


Function CreateGUIDString(Optional ByVal blnGlobalUnique As Boolean, Optional ByVal IncludeBraces As Boolean = True) As String
    CreateGUIDString = VBGUIDToString(CreateGUID(blnGlobalUnique), IncludeBraces)
End Function

Function CreateUUIDString(Optional ByVal blnGlobalUnique As Boolean, Optional ByVal IncludeBraces As Boolean = True) As String
    CreateUUIDString = VBGUIDToString(CreateGUID(blnGlobalUnique), IncludeBraces)
End Function




'VB only code for converting a guid to string (allows you to remove 4 api calls)
'just as fast as api version, use either as personal preference dictates
Public Function VBGUIDToString(pguid As GUID, Optional bIncludeBraces As Boolean = True) As String
    'optimized version coded by Lewis Miller
    'compiled app 1 million calls = .634 milliseconds
    'i do have a fast machine so times will vary

    Dim S As String
    Dim L As Long   'saves 11 calls to Len()

    'by precalculating positions we save 2 string concat operations
    Dim Pos1 As Long, Pos2 As Long, Pos3 As Long, Pos4 As Long
    Dim Pos5 As Long, Pos6 As Long, Pos7 As Long, Pos8 As Long
    Dim Pos9 As Long, Pos10 As Long, Pos11 As Long, AddOn As Long

    If bIncludeBraces Then
        VBGUIDToString = "{00000000-0000-0000-0000-000000000000}"
        AddOn = 1
    Else
        VBGUIDToString = "00000000-0000-0000-0000-000000000000"
    End If

    'we could put these in the If statement twice and save 11 Addition operations
    'but adding 2 ints is so fast that is is pretty inconsequential and saves code space
    Pos1 = 9 + AddOn
    Pos2 = 14 + AddOn
    Pos3 = 19 + AddOn
    Pos4 = 22 + AddOn
    Pos5 = 24 + AddOn
    Pos6 = 27 + AddOn
    Pos7 = 29 + AddOn
    Pos8 = 31 + AddOn
    Pos9 = 33 + AddOn
    Pos10 = 35 + AddOn
    Pos11 = 37 + AddOn

    With pguid
        S = Hex$(.Data1)
        L = Len(S)
        Mid(VBGUIDToString, Pos1 - L, L) = S

        S = Hex$(.Data2)
        L = Len(S)
        Mid(VBGUIDToString, Pos2 - L, L) = S

        S = Hex$(.Data3)
        L = Len(S)
        Mid(VBGUIDToString, Pos3 - L, L) = S

        S = Hex$(.Data4(0))
        L = Len(S)
        Mid(VBGUIDToString, Pos4 - L, L) = S

        S = Hex$(.Data4(1))
        L = Len(S)
        Mid(VBGUIDToString, Pos5 - L, L) = S

        S = Hex$(.Data4(2))
        L = Len(S)
        Mid(VBGUIDToString, Pos6 - L, L) = S
        S = Hex$(.Data4(3))
        L = Len(S)
        Mid(VBGUIDToString, Pos7 - L, L) = S
        S = Hex$(.Data4(4))
        L = Len(S)
        Mid(VBGUIDToString, Pos8 - L, L) = S
        S = Hex$(.Data4(5))
        L = Len(S)
        Mid(VBGUIDToString, Pos9 - L, L) = S
        S = Hex$(.Data4(6))
        L = Len(S)
        Mid(VBGUIDToString, Pos10 - L, L) = S
        S = Hex$(.Data4(7))
        L = Len(S)
        Mid(VBGUIDToString, Pos11 - L, L) = S
    End With


End Function

'convert uuid to string, simply calls vbguidtostring
Public Function VBUUIDToString(pUUID As UUID, Optional bIncludeBraces As Boolean = True) As String
    VBUUIDToString = VBGUIDToString(UUIDtoGUID(pUUID), bIncludeBraces)
End Function

'api version of convert guid to string, using the vb version allows you to remove 4 api calls
Public Function ApiGUIDToString(pguid As GUID, Optional ByVal bIncludeBraces As Boolean = True) As String

    Dim ret As Long
    Dim sPtr As Long

    ret = GuidToString(pguid, sPtr)

    'possible return values
    '    If RET = RPC_S_OK Then 'all good
    '    If RET = RPC_S_UUID_LOCAL_ONLY Then 'gauranteed local unique only
    '    If RET = RPC_S_UUID_NO_ADDRESS Then 'no MAC network address, not certain to be globaly unique

    'we just check if a string was returned
    If sPtr Then
        ApiGUIDToString = Space$(lstrlen(sPtr))
        RtlMoveMemory ByVal ApiGUIDToString, ByVal sPtr, Len(ApiGUIDToString)
        Call RpcStringFree(sPtr)
    End If

    'note: not needed , string guids are case-insensitive
    'ApiGuidToString = UCase$(ApiGuidToString)

    If bIncludeBraces Then
        ApiGUIDToString = "{" & ApiGUIDToString & "}"
    End If

End Function

'convert uuid to string with api, calls apiguidtostring
Public Function ApiUUIDToString(pUUID As UUID, Optional ByVal bIncludeBraces As Boolean = True) As String
    ApiUUIDToString = ApiGUIDToString(UUIDtoGUID(pUUID), bIncludeBraces)
End Function


'convert UUID to GUID and vice versa
Function GUIDtoUUID(pguid As GUID) As UUID
    RtlMoveMemory GUIDtoUUID, pguid, Len(pguid)
End Function

Function UUIDtoGUID(pUUID As UUID) As GUID
    RtlMoveMemory UUIDtoGUID, pUUID, Len(pUUID)
End Function

'uuidfromstring requires that there are no braces
Function ApiStringtoUUID(ByVal pStrUUID As String) As UUID
    Dim ret As Long

    If Left$(pStrUUID, 1) = "{" Then    'we can assume also a right brace
        pStrUUID = Mid$(pStrUUID, 2, Len(pStrUUID) - 2)
    End If
    ret = UuidFromString(ByVal pStrUUID, ApiStringtoUUID)

End Function

Function ApiStringtoGUID(ByVal StrGUID As String) As GUID
    ApiStringtoGUID = UUIDtoGUID(ApiStringtoUUID(StrGUID))
End Function