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 

转载于:https://www.cnblogs.com/todd/archive/2005/02/15/104550.html