Trucos Generar un número único para un ordenador

Extraído del mejor web de Visual Basic, el del guille: http://guille.costasol.net

El código usado para conseguir este número único es el mismo que usan la mayoría de las aplicaciones de Microsoft y otros...
Es la función que se usa para crear las claves esas que están en el registro de windows (CLSID) y que el VB5 usa internamente para generar una clave única cuando creamos un nuevo componente ActiveX.

La función que está encapsulada en una clase y se usa como cualquier objeto, es decir declaras el tipo y llamas al método que te interesa, que en este caso es una función que devuelve el valor formateado al estilo de como lo vemos en el registro.
El valor devuelto es una cadena en la que, como mínimo, las últimas 8 cifras es siempre la misma para cada equipo, por tanto usando esas 8 cifras tienes identificado el equipo.

Parece que si el equipo tiene una tarjeta de red, influye en esa cifra, pero si no la tiene, también hace que sea único por lo que puede que ese número cambie si se cambia la tarjeta de red o se instala en un equipo que no tenga.

Veamos el código :

'------------------------------------------------------------------
'Clase para generar GUID (20/Abr/98)
'
'Código extraido de la Knowledge Base de Microsoft:
'HOWTO: Use CoCreateGUID API to Generate a GUID with VB
'Article ID: Q176790
'------------------------------------------------------------------
Option Explicit

Private Type GUID
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(0 To 7) As Byte
End Type

Private Declare Function CoCreateGuid Lib "OLE32.DLL" (pGuid As GUID) As Long

Const S_OK = 0 ' return value from CoCreateGuid

Public Function GetGUID() As String

    Dim lResult As Long
    Dim lguid As GUID
    Dim MyguidString As String
    Dim MyGuidString1 As String
    Dim MyGuidString2 As String
    Dim MyGuidString3 As String
    Dim DataLen As Integer
    Dim StringLen As Integer
    Dim i As Integer

    On Error GoTo error_olemsg

    lResult = CoCreateGuid(lguid)
    If lResult = S_OK Then
        MyGuidString1 = Hex$(lguid.Data1)
        StringLen = Len(MyGuidString1)
        DataLen = Len(lguid.Data1)
        MyGuidString1 = LeadingZeros(2 * DataLen, StringLen) & MyGuidString1 'First 4 bytes (8 hex digits)
        MyGuidString2 = Hex$(lguid.Data2)
        StringLen = Len(MyGuidString2)
        DataLen = Len(lguid.Data2)
        MyGuidString2 = LeadingZeros(2 * DataLen, StringLen) & Trim$(MyGuidString2) 'Next 2 bytes (4 hex digits)
        MyGuidString3 = Hex$(lguid.Data3)
        StringLen = Len(MyGuidString3)
        DataLen = Len(lguid.Data3)
        MyGuidString3 = LeadingZeros(2 * DataLen, StringLen) & Trim$(MyGuidString3) 'Next 2 bytes (4 hex digits)
        MyguidString = MyGuidString1 & "-" & MyGuidString2 & "-" & MyGuidString3 & "-"
        For i = 0 To 7
            MyguidString = MyguidString & Format$(Hex$(lguid.Data4(i)), "00")
        Next
        'MyGuidString contains last 8 bytes of Guid (16 hex digits)
        GetGUID = MyguidString
    Else
        GetGUID = "00000000-0000-0000-0000000000000000" ' return zeros if function unsuccessful
    End If
    Exit Function

error_olemsg:
    MsgBox "Error " & Str(Err) & ": " & Error$(Err)
    GetGUID = "00000000-0000-0000-0000000000000000"
    Exit Function
End Function

Private Function LeadingZeros(ExpectedLen As Integer, ActualLen As Integer) As String
    LeadingZeros = String$(ExpectedLen - ActualLen, "0")
End Function


Para usar la clase :

Private Sub cmdGenGUID_Click()
    'Creamos una instancia de la clase
    Dim tGuid As New cGUID

    'Asignamos el número generado, en este ejemplo lo asignamos a un Label
    Label2 = tGuid.GetGUID
    'Destruimos la referencia al objeto
    Set tGuid = Nothing
End Sub



Trucos Trucos

Visual Basic Página de Visual Basic

Página principal Página principal

www.jrubi.com