Generar un número único para cada equipo...

Fecha: 12/May/98

Nota del 25/Dic/2003:
Según parece este código sólo "era" válido para Windows 95/98, en los Windows 2000/XP y creo que también en Windows 98SE no funciona como aquí se explica... lo siento si esto te hubiese servido para proteger un poco tus programas.

De lo que se trata es de generar un número único para, por ejemplo, usarlo como forma de protección de nuestro programa, aunque aquí no se va a decir cómo hacerlo, ya que entonces le estaría dando pistas a posibles "crackeadores" de mis programas "no gratuitos"...

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.

No te preocupes que no me voy a enrollar demasiado, al menos en el aspecto técnico, ya que no es plan de enrollarse...

La función que se encarga de crear ese número único la he "encapsulado" 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 ya que siempre, lo he comprobado en unos 10 equipos, es diferente para cada equipo.
Nota: Aunque en un principio hagas varias pruebas y las 16 últimas cifras no cambien, por las pruebas que he hecho, sólo las ocho últimas son fijas, e incluso las cuatro anteriores al último número, que aunque tengan "letras", son números Hexadecimales.

Mas Notas: (25/Jun/98) Si al equipo en cuestión se le agregan discos duros o se le cambia/añade/quita la tarjeta de red u otras tarjetas, puede que el número varíe... incluso esos que parecen fijos. No lo he llegado a comprobar a fondo, pero es lo que he oído por ahí.

Según tengo entendido, si el equipo tiene una tarjeta de red, influye en esa cifra, pero si no la tiene, también hace que sea único; lo que quiero decir con este comentario es que puede que ese número cambie si se cambia la tarjeta de red o se instala en un equipo que no tenga. No todo iba a ser perfecto...

Vamos a ver el código de la clase y después te pondré un ejemplo de cómo usarla.
Nota: He dejado los comentarios originales en inglés, ya sabes que no me gusta apuntarme puntos que no me corresponden...

 

El código de la clase que genera los números únicos:

'------------------------------------------------------------------
'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

¿Cómo usar esta clase?

Para usar esta clase, hazlo de la siguiente forma:

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