GUID function สำหรับ VB Developer ครับ

[SBR10993]

หากไม่ถนัดสำหรับ select guid() ใน mysql ก็ใช้ฟังชั่นตัวนี้ดูก็ได้ครับ..ได้ผลดีอยู่แต่ว่าเป็นวีบี ไม่ใช่ delphi ครับ
*-------------------------------------------------------
Option Explicit
Type GUID
    l1 As Long
    l2 As Long
    l3 As Long
    l4 As Long
End Type
Declare Function CoCreateGuid Lib "OLE32.DLL" (lpGuid As GUID) As Long
Declare Function StringFromGUID2 Lib "OLE32.DLL" (lpGuid As GUID, ByVal lpString As String, ByVal cbBytes As Integer) As Integer

Public Function UniqueValue() As String
Dim id As GUID
Dim sTemp$
Dim nLen%, hr&

hr = CoCreateGuid(id)
If (hr = 0) Then
    sTemp = StrConv(String(38, Chr(0)), vbUnicode)
    nLen = StringFromGUID2(id, sTemp, Len(sTemp))
    sTemp = StrConv(sTemp, vbFromUnicode)
    If (nLen > 0) Then
        If (Left(sTemp, 1) = "{") Then sTemp = Right(sTemp, Len(sTemp) - 1)
        If (Right(sTemp, 1) = "}") Then sTemp = Left(sTemp, Len(sTemp) - 1)
        nLen = InStr(sTemp, "-")
        Do While (nLen <> 0)
            sTemp = Left(sTemp, nLen - 1) & Right(sTemp, Len(sTemp) - nLen)
            nLen = InStr(sTemp, "-")
        Loop
    Else
        sTemp = ""
    End If
End If
UniqueValue = sTemp

End Function

*----------------------------------------------------------------------

[manoi]

โค๊ด: [Select]

[code lang=vb]

Option Explicit
Type GUID
    l1 As Long
    l2 As Long
    l3 As Long
    l4 As Long
End Type
Declare Function CoCreateGuid Lib "OLE32.DLL" (lpGuid As GUID) As Long
Declare Function StringFromGUID2 Lib "OLE32.DLL" (lpGuid As GUID, ByVal lpString As String, ByVal cbBytes As Integer) As Integer

Public Function UniqueValue() As String
Dim id As GUID
Dim sTemp$
Dim nLen%, hr&

hr = CoCreateGuid(id)
If (hr = 0) Then
    sTemp = StrConv(String(38, Chr(0)), vbUnicode)
    nLen = StringFromGUID2(id, sTemp, Len(sTemp))
    sTemp = StrConv(sTemp, vbFromUnicode)
    If (nLen > 0) Then
        If (Left(sTemp, 1) = "{") Then sTemp = Right(sTemp, Len(sTemp) - 1)
        If (Right(sTemp, 1) = "}") Then sTemp = Left(sTemp, Len(sTemp) - 1)
        nLen = InStr(sTemp, "-")
        Do While (nLen <> 0)
            sTemp = Left(sTemp, nLen - 1) & Right(sTemp, Len(sTemp) - nLen)
            nLen = InStr(sTemp, "-")
        Loop
    Else
        sTemp = ""
    End If
End If
UniqueValue = sTemp

End Function


[SBR10993]

มีอีกครับ...
' VBIDEUtils#****************************************************
' * Programmer Name  : kanchit pinijmontree
' * Web Site         : http://10.136.215.19/codeCreate/
' * E-Mail           : chit164@hotmail.com
' * Date             : 22/8/49
' * Time             : 15:50
' * Module Name      : GUID_Module
' * Module Filename  : sGUID.bas
' *************************************************************
' * Comments         : Create a Globally Unique Identifier (GUID)
' *
' * Samples:
' *  {3201047B-FA1C-11D0-B3F9-004445535400}
' *  {0547C3D5-FA24-11D0-B3F9-004445535400}
' *
' *************************************************************

Option Explicit
DefLng A-Z

Private Type GUID
   Data1          As Long
   Data2          As Integer
   Data3          As Integer
   Data4(0 To 7)  As String * 1
End Type

Declare Function CoCreateGuid Lib "ole32.dll" (tGUIDStructure As GUID) As Long

Const mciLen As Integer = 4

' #VBIDEUtils#***************************************************
' * Programmer Name  : kanchit pinijmontree
' * Web Site         : http://10.136.215.19/codeCreate/
' * E-Mail           : chit164@hotmail.com
' * Date             : 22/8/49
' * Time             : 15:50
' * Module Name      : GUID_Module
' * Module Filename  : sGUID.bas
' *************************************************************
' * Comments         : Create a Globally Unique Identifier (GUID)
' *
' * Samples:
' *  {3201047B-FA1C-11D0-B3F9-004445535400}
' *  {0547C3D5-FA24-11D0-B3F9-004445535400}
' *
' **************************************************************

Public Function CreateGUID() As String
 ' VBIDEUtils#****************************************************
 ' * Programmer Name  : kanchit pinijmontree
' * Web Site         : http://10.136.215.19/codeCreate/
' * E-Mail           : chit164@hotmail.com
' * Date             : 22/8/49
' * Time             : 15:50
' * Module Filename  : sGUID.bas
' * Module Name      : GUID_Module
' * Procedure Name   : CreateGUID
' * Parameters       :
' *************************************************************
   ' * Comments         : Create a Globally Unique Identifier (GUID)
   ' *
   ' *
   ' ************************************************************
   
   Dim sGUID   As String       'store result here
   Dim tGUID   As GUID         'get into this structure
   If CoCreateGuid(tGUID) = 0 Then 'use API to get the GUID
      With tGUID              'build return string
         sGUID = "{" & PadLeft(Hex(.Data1), mciLen * 2) & "-"
         sGUID = sGUID & PadLeft(Hex(.Data2), mciLen) & "-"
         sGUID = sGUID & PadLeft(Hex(.Data3), mciLen) & "-"
         sGUID = sGUID & FormatGUIDData4(.Data4())
      End With
      sGUID = sGUID & "}"     'ending brace
      CreateGUID = sGUID
   End If
   
End Function

Private Function FormatGUIDData4(aryData4() As String * 1) As String
   
   Dim I       As Integer      'loop thru the array
   Dim sGUID   As String       'store result here
   Dim sTemp1  As String       'first part here
   Dim sTemp2  As String       'second part here
   
   For I = LBound(aryData4()) To UBound(aryData4())   'process string array
      If I < 2 Then           'first part
         sTemp1 = sTemp1 & Hex(Asc(aryData4(I)))
      Else                    'second part
         sTemp2 = sTemp2 & Hex(Asc(aryData4(I)))
      End If
   Next
   sGUID = PadLeft(sTemp1, mciLen) & "-" & PadLeft(sTemp2, mciLen * 3) 'pad left with zeros
   FormatGUIDData4 = sGUID                     'return what we created

End Function

Private Function PadLeft(sString As String, iLen As Integer) As String
   
   ' Pad with left zeros if needed
   Dim sTemp         As String
   sTemp = Right$(String$(iLen, "0") & sString, iLen)
   PadLeft = sTemp
   
End Function