RECUPERAR NOMBRE DE LA PC Y SERIE DE MOTHER BOARD

[SDN]

Me he iniciado en VB en excel y quiero ejecutar un archivo en una maquina sin que lo puedadn copiar y usar en otra. Para esto quiero saber como hago para que aparezca en la celda A1 de la Hoja1 el nombre de la pc y en la celda A2 la serie de la mother board para luego segùn estos datos coincidan con los que van a estar dentro del programa (que son de la PC autorizada), hacer que este este corra o no. Esta parte si la se hacer pero no logro lo primero.

Les agradezco su tiempo de antemano.

Saludos.

Sandro.

[Alella]

Hola, que tal.

Lo siguiente NO es exactamente lo que pides , pero pudiera solucionarte el problema.

OBTENER UN NÚMERO ÚNICO para el equipo.

***************************************

Generar un número único para un ordenador

Es la función que se usa para crear las claves esas que están en el registro de windows (CLSID) y que el VB6 usa internamente para generar una clave única cuando creamos un nuevo componente ActiveX.

La función 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 son siempre las mismas 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.

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

***************************************

Espero que te sea útil. Lo he copiado tal cual y no está verificado que funcione. Deberías de hacer pruebas.

Ya nos contarás.

[Alella]

Hola,que tal.

En una statusbar puedes poner lo siguiente para recuperar nombre de usuario y nombre del pc.

Private Sub Timer1_Timer()
Dim sthour As String
barra.Panels(1).Text = "Usuario:  " & Get_User_Name
barra.Panels(2).Text = Get_ComputerName
'El panel 3 lo pongo por defecto en propiedades q sea una fecha
barra.Panels(4).Text = Format(Now(), "HH:MM:SS AMPM")
End Sub

Public Function Get_User_Name()
    Dim s$, cnt&, dl&
    cnt& = 199
    s$ = String$(200, 0)
    dl& = WNetGetUserName(s$, cnt)
    Get_User_Name = Left$(s$, cnt)

LocalName = Get_ComputerName
End Function

En un módulo:

Declare Function WNetGetUserName& Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long)
Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long

Public Function Get_ComputerName()
    Dim lpBuff As String * 25
    Dim Ret As Long, ComputerName As String
    
    
    Ret = GetComputerName(lpBuff, 25)
    ComputerName = Left(lpBuff, InStr(lpBuff, Chr(0)) - 1)
    
    Get_ComputerName = ComputerName
End Function

Espero no dejarme nada. Ya nos contarás.