原始碼推薦：vb的GUID生成演算法 (轉)

原始碼推薦：vb的GUID生成演算法 (轉)[@more@]

推薦：vb的GUID生成演算法

'RETURNS: GUID if succesul; 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