VB icon

CoCreateGuid Example

Email
Submitted on: 10/18/2017 9:07:33 PM
By: Nicholas Forystek  
Level: Advanced
User Rating: Unrated
Compatibility: VB 6.0
Views: 1359
author picture
 
     This is just a way I decided to use CoCreateGuid after a closer look at someones example that I had been using. I don't know that there really is in difference if difference besides the obvious I'm allocating it in global memory, (use of global memory API etc..). I believe in GUID's should be heard and not seen. As in only in development or temporary situations, that they don't play fair spotted. I literally tried to get the type declaration and means to call hone the final GUID in repeated debug display not to repeat and portion. Letting debug fly through generating often my results show a portion dominating in repeats, and no matter how I curved it somewhere repeats showed besides this particular way. I could not find another with out that happening, so I don't know if there is any difference if it did matter. Either way here's the code I decided to use for it along with another function to check if the input is a valid GUID.
 
code:
Can't Copy and Paste this?
Click here for a copy-and-paste friendly version of this code!
				
'**************************************
' Name: CoCreateGuid Example
' Description:This is just a way I decided to use CoCreateGuid after a closer look at someones example that I had been using. I don't know that there really is in difference if difference besides the obvious I'm allocating it in global memory, (use of global memory API etc..). I believe in GUID's should be heard and not seen. As in only in development or temporary situations, that they don't play fair spotted. I literally tried to get the type declaration and means to call hone the final GUID in repeated debug display not to repeat and portion. Letting debug fly through generating often my results show a portion dominating in repeats, and no matter how I curved it somewhere repeats showed besides this particular way. I could not find another with out that happening, so I don't know if there is any difference if it did matter. Either way here's the code I decided to use for it along with another function to check if the input is a valid GUID.
' By: Nicholas Forystek
'**************************************

Option Explicit
Option Compare Binary
Option Private Module
Private Type GuidType '16
 A4 As Long '4
 B2 As Integer '2
 c2 As Integer '2
 D1 As Byte '1
 E1 As Byte '1
 F6(5) As Byte '6
End Type
Private Declare Function CoCreateGuid Lib "ole32" (ByVal pGuid As Long) As Long
Private Const GPTR = &H40
Private Const GMEM_MOVEABLE = &H2
Private Declare Function GlobalFree Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Sub RtlMoveMemory Lib "kernel32" (Left As Any, Pass As Any, ByVal Right As Long)
Private Function Padding(ByVal Length As Long, ByVal Value As String, Optional ByVal PadWith As String = " ") As String
 Padding = String(Abs((Length * Len(PadWith)) - (Len(Value) \ Len(PadWith))), PadWith) & Value
End Function
Private Function HiInt(ByVal lParam As Long) As Integer
 If (lParam And &HFFFF&) > &H7FFF Then
 HiInt = (lParam And &HFFFF&) - &H10000
 Else
 HiInt = lParam And &HFFFF&
 End If
End Function
Private Function LoInt(ByVal lParam As Long) As Integer
 LoInt = (lParam And &HFFFF0000) \ &H10000
End Function
Private Function HiByte(ByVal wParam As Integer)
 HiByte = wParam \ &H100 And &HFF&
End Function
Private Function LoByte(ByVal wParam As Integer)
 LoByte = wParam And &HFF&
End Function
Private Function SwitchByte(ByRef val As Integer) As Byte
 Static toggle As Long
 If Not toggle Then
 SwitchByte = HiByte(val)
 Else
 SwitchByte = LoByte(val)
 End If
 toggle = (-CInt(CBool(toggle)) + -1) + -CInt(Not CBool(-toggle + -1))
End Function
Private Function SwitchInt(ByRef val As Long) As Integer
 Static toggle As Long
 If Not toggle Then
 SwitchInt = HiInt(val)
 Else
 SwitchInt = LoInt(val)
 End If
 toggle = (-CInt(CBool(toggle)) + -1) + -CInt(Not CBool(-toggle + -1))
End Function
Public Function GUID() As String
 
 Dim lpGuid As Long
 lpGuid = GlobalAlloc(GMEM_MOVEABLE And VarPtr(lpGuid), 4)
 If lpGuid <> 0 Then
 Dim lcGuid As Long
 lcGuid = GlobalLock(lpGuid)
 If lcGuid = lpGuid Then
 
 Static lgGuid As GuidType
 If CoCreateGuid(VarPtr(lgGuid)) = 0 Then
 
 RtlMoveMemory lgGuid, ByVal lpGuid, 4&
 GUID = GUID & Padding(2, Hex(SwitchByte(SwitchInt(lgGuid.A4))), "0")
 GUID = GUID & Padding(2, Hex(SwitchByte(SwitchInt(lgGuid.A4))), "0")
 GUID = GUID & Padding(2, Hex(SwitchByte(SwitchInt(lgGuid.A4))), "0")
 GUID = GUID & Padding(2, Hex(SwitchByte(SwitchInt(lgGuid.A4))), "0")
 GUID = GUID & "-"
 GUID = GUID & Padding(2, Hex(SwitchByte(lgGuid.B2)), "0")
 GUID = GUID & Padding(2, Hex(SwitchByte(lgGuid.B2)), "0")
 GUID = GUID & "-"
 GUID = GUID & Padding(2, Hex(SwitchByte(lgGuid.c2)), "0")
 GUID = GUID & Padding(2, Hex(SwitchByte(lgGuid.c2)), "0")
 GUID = GUID & "-"
 
 GUID = GUID & Padding(2, Hex(lgGuid.D1), "0")
 GUID = GUID & Padding(2, Hex(lgGuid.E1), "0")
 GUID = GUID & "-"
 
 GUID = GUID & Padding(2, Hex(lgGuid.F6(0)), "0")
 GUID = GUID & Padding(2, Hex(lgGuid.F6(1)), "0")
 GUID = GUID & Padding(2, Hex(lgGuid.F6(2)), "0")
 GUID = GUID & Padding(2, Hex(lgGuid.F6(3)), "0")
 GUID = GUID & Padding(2, Hex(lgGuid.F6(4)), "0")
 GUID = GUID & Padding(2, Hex(lgGuid.F6(5)), "0")
 
 End If
 
 End If
 
 GlobalUnlock lcGuid
 
 GlobalFree lpGuid
 
 Else
 Debug.Print "Error: GlobalAlloc " & Err.Number & " " & Err.Description
 End If
 
End Function
Public Function IsGuid(ByVal Value As Variant) As Boolean
 If Not (Len(Value) = 36) And (InStr(Value, ".") = 0) Then
 IsGuid = False
 Else
 Dim tmp As Variant
 tmp = Value
 Dim cnt As Byte
 For cnt = Asc("0") To Asc("9")
 tmp = Replace(tmp, Chr(cnt), "")
 Next
 For cnt = Asc("A") To Asc("F")
 tmp = Replace(UCase(tmp), Chr(cnt), "")
 Next
 IsGuid = (tmp = "----")
 If IsGuid Then
 tmp = Value
 For cnt = 1 To 4
 IsGuid = IsGuid And ((Len(Left(tmp, InStr(tmp, "-") - 1)) Mod 2) = 0)
 tmp = Mid(tmp, InStr(tmp, "-") + 1)
 Next
 IsGuid = IsGuid And ((Len(tmp) Mod 2) = 0)
 End If
 End If
End Function


Other 11 submission(s) by this author

 


Report Bad Submission
Use this form to tell us if this entry should be deleted (i.e contains no code, is a virus, etc.).
This submission should be removed because:

Your Vote

What do you think of this code (in the Advanced category)?
(The code with your highest vote will win this month's coding contest!)
Excellent  Good  Average  Below Average  Poor (See voting log ...)
 

Other User Comments


 There are no comments on this submission.
 

Add Your Feedback
Your feedback will be posted below and an email sent to the author. Please remember that the author was kind enough to share this with you, so any criticisms must be stated politely, or they will be deleted. (For feedback not related to this particular code, please click here instead.)
 

To post feedback, first please login.