Improve company productivity with a Business Account.Sign Up

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 1047
  • Last Modified:

Creating GUID in VB

How to create guid using VB, without GUIDGEN thru programming itself (solution may be on VC++ or VB.
0
wbcsl
Asked:
wbcsl
1 Solution
 
sharmonCommented:
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
 
morgan_peatCommented:
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
 
WalterMCommented:
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
Get your problem seen by more experts

Be seen. Boost your question’s priority for more expert views and faster solutions

 
MicrosoftCommented:
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
 
wpsjr1Commented:
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
 
WalterMCommented:
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
 
wbcslAuthor Commented:
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
 
wpsjr1Commented:
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
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Featured Post

Upgrade your Question Security!

Your question, your audience. Choose who sees your identity—and your question—with question security.

Tackle projects and never again get stuck behind a technical roadblock.
Join Now