Discuz!NT
欢迎 游客 , 注册 | 登录 | 会员 | 界面 | 简洁版本 | 在线 | 帮助
商都网教育宝典宝库

发表新主题 回复该主题
本主题被查看417次, 共1个帖子, 1页, 当前为第1页     选择页数: 1      跳转到第   上一主题   下一主题
标题: 源代码推荐:vb的GUID生成算法
-[尕硴]
超级版主
UID: 71
来自:
精华: 130
积分: 14003
帖子: 12909
注册: 2007-10-22 17:59:00
状态: 离线
威望: 444.00
金钱: 3355.00 元
只看楼主 2008-01-28 14:51
源代码推荐: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
#1  
发表新主题 回复该主题
本主题被查看417次, 共1个帖子, 1页, 当前为第1页     选择页数: 1      跳转到第







现在的时间是 2008-10-08 17:16:23

版权所有 商都网教育宝典
         Powered by Discuz!NT 1.0.6666    Copyright © 2001-2008 Comsenz Inc.
Processed in 0 seconds