标题:源代码推荐:vb的GUID生成算法
取消只看楼主
月魔
Rank: 1
等 级:新手上路
帖 子:25
专家分:0
注 册:2006-7-24
 问题点数:0 回复次数:0 
源代码推荐:vb的GUID生成算法

源代码推荐: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


搜索更多相关主题的帖子: 源代码 GUID 算法 推荐 
2006-07-24 11:29



参与讨论请移步原网站贴子:https://bbs.bccn.net/thread-79967-1-1.html




关于我们 | 广告合作 | 编程中国 | 清除Cookies | TOP | 手机版

编程中国 版权所有,并保留所有权利。
Powered by Discuz, Processed in 0.109358 second(s), 8 queries.
Copyright©2004-2024, BCCN.NET, All Rights Reserved