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
Pulsa este link
para bajarte el listado con el ejemplo para VB5 (genGUID.zip 2.12 KB)