源代码推荐：vb的GUID生成算法 (转)

源代码推荐：vb的GUID生成算法 (转)[@more@]

源代码推荐：vb的GUID生成算法

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

 

来自 “ ITPUB博客 ” ，链接：http://blog.itpub.net/10752043/viewspace-987498/，如需转载，请注明出处，否则将追究法律责任。

转载于:http://blog.itpub.net/10752043/viewspace-987498/