'************************************** ' Name: CoCreateGuid Example ' Description:This is just a way I decid ' ed to use CoCreateGuid after a closer lo ' ok at someones example that I had been u ' sing. I don't know that there really is ' in difference if difference besides the ' obvious I'm allocating it in global memo ' ry, (use of global memory API etc..). I ' believe in GUID's should be heard and no ' t seen. As in only in development or tem ' porary situations, that they don't play ' fair spotted.So there's this code. ' By: Nicholas Forystek ' ' ' Inputs:None ' ' Returns:None ' 'Assumes:None ' 'Side Effects:None '************************************** 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