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