Solved

Creating GUID in VB

Posted on 2001-06-06
8
942 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
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
Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
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

Online Training Solution

Drastically shorten your training time with WalkMe's advanced online training solution that Guides your trainees to action. Forget about retraining and skyrocket knowledge retention rates.

Question has a verified solution.

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

If you have ever used Microsoft Word then you know that it has a good spell checker and it may have occurred to you that the ability to check spelling might be a nice piece of functionality to add to certain applications of yours. Well the code that…
This article describes some techniques which will make your VBA or Visual Basic Classic code easier to understand and maintain, whether by you, your replacement, or another Experts-Exchange expert.
As developers, we are not limited to the functions provided by the VBA language. In addition, we can call the functions that are part of the Windows operating system. These functions are part of the Windows API (Application Programming Interface). U…
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…

717 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