by Waty Thierry (60 Submissions)
Category: Windows System Services
Compatability: Visual Basic 4.0 (32-bit)
Difficulty: Unknown Difficulty
Originally Published: Tue 30th March 1999
Date Added: Mon 8th February 2021
Rating: 
(1 Votes)
Create a Globally Unique Identifier (GUID)
API Declarations
' * Programmer Name : Waty Thierry
' * Web Site : www.geocities.com/ResearchTriangle/6311/
' * E-Mail : [email protected]
' * Date : 22/10/98
' * Time : 15:50
' * Module Name : GUID_Module
' * Module Filename : sGUID.bas
' **********************************************************************
' * Comments : Create a Globally Unique Identifier (GUID)
' *
' * Samples:
' * {3201047B-FA1C-11D0-B3F9-004445535400}
' * {0547C3D5-FA24-11D0-B3F9-004445535400}
' *
' **********************************************************************
Option Explicit
DefLng A-Z
Private Type GUID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(0 To 7) As String * 1
End Type
Declare Function CoCreateGuid Lib "ole32.dll" (tGUIDStructure As GUID) As Long
Const mciLen As Integer = 4
VBcoders
' * Programmer Name : Waty Thierry
' * Web Site : www.geocities.com/ResearchTriangle/6311/
' * E-Mail : [email protected]
' * Date : 22/10/98
' * Time : 15:50
' * Module Name : GUID_Module
' * Module Filename : sGUID.bas
' **********************************************************************
' * Comments : Create a Globally Unique Identifier (GUID)
' *
' * Samples:
' * {3201047B-FA1C-11D0-B3F9-004445535400}
' * {0547C3D5-FA24-11D0-B3F9-004445535400}
' *
' **********************************************************************
Public Function CreateGUID() As String
' * Programmer Name : Waty Thierry
' * Web Site : www.geocities.com/ResearchTriangle/6311/
' * E-Mail : [email protected]
' * Date : 26/11/98
' * Time : 15:27
' * Module Name : GUID_Module
' * Module Filename : guid.bas
' * Procedure Name : CreateGUID
' * Parameters :
' **********************************************************************
' * Comments : Create a Globally Unique Identifier (GUID)
' *
' *
' **********************************************************************
Dim sGUID As String 'store result here
Dim tGUID As GUID 'get into this structure
If CoCreateGuid(tGUID) = 0 Then 'use API to get the GUID
With tGUID 'build return string
sGUID = "{" & PadLeft(Hex(.Data1), mciLen * 2) & "-"
sGUID = sGUID & PadLeft(Hex(.Data2), mciLen) & "-"
sGUID = sGUID & PadLeft(Hex(.Data3), mciLen) & "-"
sGUID = sGUID & FormatGUIDData4(.Data4())
End With
sGUID = sGUID & "}" 'ending brace
CreateGUID = sGUID
End If
End Function
Private Function FormatGUIDData4(aryData4() As String * 1) As String
Dim I As Integer 'loop thru the array
Dim sGUID As String 'store result here
Dim sTemp1 As String 'first part here
Dim sTemp2 As String 'second part here
For I = LBound(aryData4()) To UBound(aryData4()) 'process string array
If I < 2 Then 'first part
sTemp1 = sTemp1 & Hex(Asc(aryData4(I)))
Else 'second part
sTemp2 = sTemp2 & Hex(Asc(aryData4(I)))
End If
Next
sGUID = PadLeft(sTemp1, mciLen) & "-" & PadLeft(sTemp2, mciLen * 3) 'pad left with zeros
FormatGUIDData4 = sGUID 'return what we created
End Function
Private Function PadLeft(sString As String, iLen As Integer) As String
' Pad with left zeros if needed
Dim sTemp As String
sTemp = Right$(String$(iLen, "0") & sString, iLen)
PadLeft = sTemp
End Function
