VB icon

CoCreateGuid Example

Email
Submitted on: 12/6/2017 6:54:25 PM
By: Nicholas Forystek  
Level: Advanced
User Rating: Unrated
Compatibility: VB 6.0
Views: 3010
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
D8(0 To 7) As Byte '8
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 toggle As Integer, ByRef val As Integer) As Byte
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 toggle As Integer, ByRef val As Long) As Integer
toggle = (-CInt(CBool(toggle)) + -1) + -CInt(Not CBool(-toggle + -1))
If Not toggle Then
SwitchInt = HiInt(val)
Else
SwitchInt = LoInt(val)
End If
End Function
Public Function GUID() As String
Dim lpGuid As Long
lpGuid = GlobalAlloc(GMEM_MOVEABLE And VarPtr(lpGuid), 4)
If lpGuid <> 0 Then
Dim lgGuid As GuidType
Dim toggle As Integer
If CoCreateGuid(VarPtr(lgGuid)) = 0 Then
RtlMoveMemory lgGuid, ByVal lpGuid, 4&
Dim lcGuid As Long
lcGuid = GlobalLock(lpGuid)
If lcGuid = lpGuid Then
toggle = (lgGuid.C2 > 0) Xor (lgGuid.B2 < 0)
GUID = GUID & Padding(2, Hex(SwitchByte(toggle, SwitchInt(toggle, lgGuid.A4))), "0")
GUID = GUID & Padding(2, Hex(SwitchByte(toggle, SwitchInt(toggle, lgGuid.A4))), "0")
toggle = toggle Xor (lgGuid.B2 > 0)
GUID = GUID & Padding(2, Hex(SwitchByte(toggle, SwitchInt(toggle, lgGuid.A4))), "0")
GUID = GUID & Padding(2, Hex(SwitchByte(toggle, SwitchInt(toggle, lgGuid.A4))), "0")
GUID = GUID & "-"
toggle = toggle Xor (lgGuid.C2 > 0)
GUID = GUID & Padding(2, Hex(SwitchByte(toggle, lgGuid.B2)), "0")
GUID = GUID & Padding(2, Hex(SwitchByte(toggle, lgGuid.B2)), "0")
GUID = GUID & "-"
GUID = GUID & Padding(2, Hex(SwitchByte(toggle, lgGuid.C2)), "0")
GUID = GUID & Padding(2, Hex(SwitchByte(toggle, lgGuid.C2)), "0")
GUID = GUID & "-"
GUID = GUID & Padding(2, Hex(lgGuid.D8(0)), "0")
GUID = GUID & Padding(2, Hex(lgGuid.D8(1)), "0")
GUID = GUID & "-"
GUID = GUID & Padding(2, Hex(lgGuid.D8(2)), "0")
GUID = GUID & Padding(2, Hex(lgGuid.D8(3)), "0")
GUID = GUID & Padding(2, Hex(lgGuid.D8(4)), "0")
GUID = GUID & Padding(2, Hex(lgGuid.D8(5)), "0")
GUID = GUID & Padding(2, Hex(lgGuid.D8(6)), "0")
GUID = GUID & Padding(2, Hex(lgGuid.D8(7)), "0")
End If
GlobalUnlock lcGuid
End If
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
Public Sub Main()
Do Until False
DoEvents
Debug.Print GUID
Loop
End Sub


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.