Solved

Creating GUID in VB

Posted on 2001-06-06
8
880 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
Comment Utility
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
Comment Utility
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
Comment Utility
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
Comment Utility
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
Find Ransomware Secrets With All-Source Analysis

Ransomware has become a major concern for organizations; its prevalence has grown due to past successes achieved by threat actors. While each ransomware variant is different, we’ve seen some common tactics and trends used among the authors of the malware.

 
LVL 3

Expert Comment

by:wpsjr1
Comment Utility
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
Comment Utility
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
Comment Utility
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
Comment Utility
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

Highfive + Dolby Voice = No More Audio Complaints!

Poor audio quality is one of the top reasons people don’t use video conferencing. Get the crispest, clearest audio powered by Dolby Voice in every meeting. Highfive and Dolby Voice deliver the best video conferencing and audio experience for every meeting and every room.

Join & Write a Comment

Article by: Martin
Here are a few simple, working, games that you can use as-is or as the basis for your own games. Tic-Tac-Toe This is one of the simplest of all games.   The game allows for a choice of who goes first and keeps track of the number of wins for…
Background What I'm presenting in this article is the result of 2 conditions in my work area: We have a SQL Server production environment but no development or test environment; andWe have an MS Access front end using tables in SQL Server but we a…
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…
This lesson covers basic error handling code in Microsoft Excel using VBA. This is the first lesson in a 3-part series that uses code to loop through an Excel spreadsheet in VBA and then fix errors, taking advantage of error handling code. This l…

771 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

13 Experts available now in Live!

Get 1:1 Help Now