Solved

Creating GUID in VB

Posted on 2001-06-06
8
895 Views
Last Modified: 2012-05-04
How to create guid using VB, without GUIDGEN thru programming itself (solution may be on VC++ or VB.
0
Comment
Question by:wbcsl
8 Comments
 
LVL 6

Expert Comment

by:sharmon
ID: 6159038
Here ya go!

Option Explicit

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

Public Declare Function CoCreateGuid Lib "OLE32.DLL" _
(pGuid As GUID) As Long

Public Declare Function StringFromGUID2 Lib "ole32" _
(ByRef lpGUID As GUID, ByVal lpStr As String, _
ByVal lSize As Long) As Long


Public Function GetGUID() As String
  Dim udtGUID As GUID
  Dim strGUID As String * 80
  Dim lRet As Long
 
  If CoCreateGuid(udtGUID) = 0 Then
    lRet = StringFromGUID2(udtGUID, strGUID, 80)
    If lRet <> 0 Then
      strGUID = StrConv(strGUID, vbFromUnicode)
      GetGUID = Mid(strGUID, 1, lRet - 1)
    End If
  End If
End Function
0
 
LVL 1

Accepted Solution

by:
morgan_peat earned 50 total points
ID: 6159045
Private Type GUID
    Data1               As Long
    Data2               As Long
    Data3               As Long
    Data4(8)            As Byte
End Type


Private Declare Function CoCreateGuid Lib "ole32.dll" ( _
        pguid As GUID) As Long

Private Declare Function StringFromGUID2 Lib "ole32.dll" ( _
        rguid As Any, ByVal _
        lpstrClsId As Long, _
        ByVal cbMax As Long) As Long





    ' Length of a GUID when represented as a string.
    Const iGUID_LENGTH As Integer = 40
   
    Dim udtGUID         As GUID
    Dim bytGUID()       As Byte
    Dim strGUID         As String
    Dim lReturn         As Long    
   
   
    ' Create a new GUID
    lReturn = CoCreateGuid(udtGUID)
   
    ' Convert this into a displayable string
    bytGUID = String(iGUID_LENGTH, 0)
    lReturn = StringFromGUID2(udtGUID, VarPtr(bytGUID(0)), iGUID_LENGTH)
    strGUID = bytGUID
   
   
    ' Check for the end of the string.
    ' If the position at lReturn is a null char, then
    ' reduce the return by 1.
    If Mid$(strGUID, lReturn, 1) = Chr$(0) Then
        lReturn = lReturn - 1
    End If
   
   
    ' Trim off the trailing null chars
    strGUID = Left$(strGUID, lReturn)
0
 
LVL 2

Expert Comment

by:WalterM
ID: 6159068
No VC++ is necessary, plain VB will do. The API function to use is "CoCreateGUID", exported by ole32.dll

Add a new module to your project and paste the following code:

--- Module MCreateGUID ---

Option Explicit

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

Private Declare Sub CoCreateGuid Lib "ole32.dll" (pGUID As GUID)
Private Declare Function StringFromCLSID Lib "ole32.dll" (pCLSID As GUID, lpszProgID As Long) As Long

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDst As Any, pSrc As Any, ByVal ByteLen As Long)
Private Declare Function lstrlenW Lib "kernel32" (ByVal lpsz As Long) As Long

Public Function CreateGUID() As String
    Dim G As GUID
    Dim lpszProgID As Long
   
    ' Generate a new GUID
    CoCreateGuid G
    ' Convert the GUID to a string representation
    StringFromCLSID G, lpszProgID
   
    ' Convert the string pointer to a VB string
    CreateGUID = StringFromPointer(lpszProgID)

End Function

Private Function StringFromPointer(pOLESTR As Long) As String
    Dim L As Long
   
    ' Determine the length of the string
    L = lstrlenW(pOLESTR)
   
    If L > 0 Then
        ' Reserve buffer space
        StringFromPointer = String$(L, vbNullChar)
        ' Copy the string contents into the buffer
        ' Use StrPtr() to prevent the usual Unicode-ANSI string conversion
        CopyMemory ByVal StrPtr(StringFromPointer), ByVal pOLESTR, (2 * L)
    End If
   
End Function

--- End Module MCreateGUID ---

You can test the function in the immediate pane, e.g.

   ? CreateGUID
   {7AC3F8B9-5A73-11D5-9DE1-0050043ED30F}


And there you are!

Michel
0
 
LVL 2

Expert Comment

by:Microsoft
ID: 6161100
Private Type GUID
    PartOne As Long
    PartTwo As Integer
    PartThree As Integer
    PartFour(7) As Byte
End Type
     
Private Declare Function CoCreateGuid Lib "OLE32.DLL" _
(ptrGuid As GUID) As Long

'RETURNS:  GUID if successful; blank string otherwise.
'Unlike the GUIDS in the registry, this function returns GUID
'without "-" characters.  See comments for how to modify if you
'want the dash.

Public Function GUID() As String
    Dim lRetVal As Long
    Dim udtGuid As GUID
   
    Dim sPartOne As String
    Dim sPartTwo As String
    Dim sPartThree As String
    Dim sPartFour As String
    Dim iDataLen As Integer
    Dim iStrLen As Integer
    Dim iCtr As Integer
    Dim sAns As String
   
    On Error GoTo errorhandler
    sAns = ""
   
    lRetVal = CoCreateGuid(udtGuid)
   
    If lRetVal = 0 Then
   
       'First 8 chars
        sPartOne = Hex$(udtGuid.PartOne)
        iStrLen = Len(sPartOne)
        iDataLen = Len(udtGuid.PartOne)
        sPartOne = String((iDataLen * 2) - iStrLen, "0") _
        & Trim$(sPartOne)
       
        'Next 4 Chars
        sPartTwo = Hex$(udtGuid.PartTwo)
        iStrLen = Len(sPartTwo)
        iDataLen = Len(udtGuid.PartTwo)
        sPartTwo = String((iDataLen * 2) - iStrLen, "0") _
        & Trim$(sPartTwo)
           
        'Next 4 Chars
        sPartThree = Hex$(udtGuid.PartThree)
        iStrLen = Len(sPartThree)
        iDataLen = Len(udtGuid.PartThree)
        sPartThree = String((iDataLen * 2) - iStrLen, "0") _
        & Trim$(sPartThree)   'Next 2 bytes (4 hex digits)
           
        'Final 16 chars
        For iCtr = 0 To 7
            sPartFour = sPartFour & _
            Format$(Hex$(udtGuid.PartFour(iCtr)), "00")
        Next
 
     'To create GUID with "-", change line below to:
     'sAns = sPartOne & "-" & sPartTwo & "-" & sPartThree _
     '& "-" & sPartFour
       
       sAns = sPartOne & sPartTwo & sPartThree & sPartFour
           
        End If
       
        GUID = sAns
Exit Function


errorhandler:
'return a blank string if there's an error

Exit Function
End Function
0
Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

 
LVL 3

Expert Comment

by:wpsjr1
ID: 6161285
Its really a lot easier than everyone is making it.  :P

Option Explicit

' module by Wpsjr1@syix.com
' http://www.syix.com/wpsjr1/index.html

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

Declare Function CoCreateGuid Lib "ole32.dll" (pguid As GUID) As Long
Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal pv As Long)
Declare Function lstrlenW Lib "kernel32" (ByVal lpString As Long) As Long
Declare Function StringFromCLSID Lib "ole32.dll" (rclsid As GUID, lpsz As Long) As Long
Declare Sub RtlMoveMemory Lib "kernel32.dll" (dest As Any, src As Any, ByVal cb As Long)

Public Sub GUIDString(ByRef sGUID As String)
  Dim tGuid As GUID, lPointer&
 
  If CoCreateGuid(tGuid) = 0 Then                                  ' the GUID struct was filled
    StringFromCLSID tGuid, lPointer                                ' gives a pointer to a Unicode string
    sGUID = String$(lstrlenW(lPointer), 0)                         ' prepare a buffer
    RtlMoveMemory ByVal StrPtr(sGUID), ByVal lPointer, LenB(sGUID) ' use LenB to get the unicode size of the string
    CoTaskMemFree lPointer                                         ' clean up behind ourselves
  End If
End Sub


0
 
LVL 2

Expert Comment

by:WalterM
ID: 6163032
nice compact solution, wpsjr1 (cryptic nick?), although similar to some of the above.

Looking at your implementation, I noticed that the code I posted before didn't call CoTaskMemFree - as required by StringFromCLSID - causing a serious memory leak... Oops!

Good thing you posted, or this might have gone unnoticed.

So wbcsl watch out! Either use wpsjr1's solution, or check your own code for the use of StringFromCLSID without calling CoTaskMemFree afterwards.


To be absolutely clear, here's an update of my version:


--- Corrected CreateGUID ---

' Declarations ...

' Add this declaration to the top of the module
Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal pv As Long)

Public Function CreateGUID() As String
   Dim G As GUID
   Dim lpszProgID As Long
   
   ' Generate a new GUID
   CoCreateGuid G
   ' Convert the GUID to a string representation
   StringFromCLSID G, lpszProgID
   
   ' Convert the string pointer to a VB string
   CreateGUID = StringFromPointer(lpszProgID)

   ' !!! Clean up the original OLE string !!!
   CoTaskMemFree lpszProgID

End Function

--- End Corrected CreateGUID ---


My apologies for the bug, wbcls, I feel you should give your points to one of the other authors.

Michel
0
 

Author Comment

by:wbcsl
ID: 6190116
Although most of the OLE2 dll functions are exposed, we are from this point onwards carefully look all functions.

Thanks for all those who answers in the similer manner.  By considering feature error and implementation in all WIN 9X Platforms I award this to Morgan Peat.

Thanks once again.


WBCSL
0
 
LVL 3

Expert Comment

by:wpsjr1
ID: 6192255
wbcsl,
  Just so you know, the Data4 field of the chosen solution is incorrect, it should be Data4(7) as byte, as there are 8 chars 0-7.  Also (as WalterM mentioned) don't forget to call CoTaskMemFree, otherwise you'll have a nice memory leak.  

  You mention a solution that works for all 9X platforms, did you have any trouble with mine?
0

Featured Post

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Most everyone who has done any programming in VB6 knows that you can do something in code like Debug.Print MyVar and that when the program runs from the IDE, the value of MyVar will be displayed in the Immediate Window. Less well known is Debug.Asse…
Since upgrading to Office 2013 or higher installing the Smart Indenter addin will fail. This article will explain how to install it so it will work regardless of the Office version installed.
Get people started with the process of using Access VBA to control Excel using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Excel. Using automation, an Access application can laun…
Show developers how to use a criteria form to limit the data that appears on an Access report. It is a common requirement that users can specify the criteria for a report at runtime. The easiest way to accomplish this is using a criteria form that a…

895 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

15 Experts available now in Live!

Get 1:1 Help Now