Solved

Creating GUID in VB

Posted on 2001-06-06
8
918 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
Free Tool: IP Lookup

Get more info about an IP address or domain name, such as organization, abuse contacts and geolocation.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

 
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
 
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

Active Directory Webinar

We all know we need to protect and secure our privileges, but where to start? Join Experts Exchange and ManageEngine on Tuesday, April 11, 2017 10:00 AM PDT to learn how to track and secure privileged users in Active Directory.

Question has a verified solution.

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

Suggested Solutions

There are many ways to remove duplicate entries in an SQL or Access database. Most make you temporarily insert an ID field, make a temp table and copy data back and forth, and/or are slow. Here is an easy way in VB6 using ADO to remove duplicate row…
You can of course define an array to hold data that is of a particular type like an array of Strings to hold customer names or an array of Doubles to hold customer sales, but what do you do if you want to coordinate that data? This article describes…
Get people started with the process of using Access VBA to control Outlook using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Microsoft Outlook. Using automation, an Access applic…
Get people started with the utilization of class modules. Class modules can be a powerful tool in Microsoft Access. They allow you to create self-contained objects that encapsulate functionality. They can easily hide the complexity of a process from…

821 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