• Home
 · 
• String Manipulation
 · 
• The long way to get the licensed user of a machine. Works though.

The long way to get the licensed user of a machine. Works though.

The long way to get the licensed user of a machine. Works though.

API Declarations


'way. It gets the owner by accessing the User.exe
'and HwInfo.dat files and compares the two strings.

'Created by DiskJunky.
'Any changes made to this code should be made aware
'to the creator at [email protected]
'-------------------------------------------------
'=================================================

Public Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Public Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long




Rate The long way to get the licensed user of a machine. Works though.

• 1
• 2
• 3
• 4
• 5

(1(1 Vote))

Const UserOrig = "User.Exe"
'HwOrig = windows dir
'UserOrig = windows\system dir

Dim HwInfo As String
Dim User As String

'used to stop file access during owner search
Public Searching As Boolean


Public Function SystemDirectory() As String
'returns the path of the windows directory.
Dim WinPath As String
Dim Temp As Variant
    
WinPath = String(145, Chr(0))
Temp = GetSystemDirectory(WinPath, 145)
'remove the NULL character from the returned
'String.
SystemDirectory = Left(WinPath, InStr(WinPath, Chr(0)) - 1)
End Function

Public Function WindowsDirectory() As String
'returns the path of the windows directory.
Dim WinPath As String
Dim Temp As Variant
    WinPath = String(145, Chr(0))
    Temp = GetWindowsDirectory(WinPath, 145)
    'remove the NULL character from the returned
    'String.
    WindowsDirectory = Left(WinPath, InStr(WinPath, Chr(0)) - 1)
End Function

Public Function AddFile(Path As String, File As String) As String
'This procedure adds a file name to a path.
If Right(Path, 2) = ":\" Then
    Path = Path & File
Else
    Path = Path & "\" & File
End If

AddFile = Path
End Function

Public Function GetRegOwner() As String
'This is the function to call in your code

'RegisteredOwnerEric O'Sullivan    ÿ    HwInfo.Dat
'BOULAMITE?DiskJunky?             User.exe
'BOULAMITE?DiskJunky               ?

Dim UOwner As String    'owner from user.exe
Dim HwOwner As String   'owner from HwInfo.Dat

Dim FileNum As Integer
Dim Check As String
Dim ErrNum As Long

Searching = False

'get file paths.
HwInfo = AddFile(WindowsDirectory, HwOrig)
User = AddFile(SystemDirectory, UserOrig)

'get a file number not used
FileNum = FreeFile

'check if there are no problems accessing files
On Error Resume Next
Open LCase(HwInfo) For Input As FileNum
ErrNum = Err
Close FileNum

If ErrNum <> 0 Then
    'exit function
    GetRegOwner = ""
    Searching = False
    Exit Function
End If

Open LCase(User) For Input As FileNum
ErrNum = Err
Close FileNum

If ErrNum <> 0 Then
    'exit function
    GetRegOwner = ""
    Searching = False
    Exit Function
End If

On Error GoTo 0

'get owner
'==================================================
Searching = True
'check the HwInfo.Dat file
Open LCase(HwInfo) For Binary As FileNum
    Do While (Not EOF(FileNum)) And (HwOwner = "")
        'continue program while searching
        'DoEvents
        
        If Not Searching Then
            'if the search was cancelled
            Close FileNum
            GetRegOwner = ""
            Exit Function
        End If
        
        'get data in 30k chunks
        Check = Input((1024 * 30), #FileNum)
        
        HwOwner = GetInHw(Check)
    Loop
Close FileNum

'check the User.exe file
If HwOwner = "" Then
    Open LCase(User) For Binary As FileNum
        Do While (Not EOF(FileNum)) And (UOwner = "")
            'continue program while searching
            'DoEvents
        
            If Not Searching Then
                'if the search was cancelled
                Close FileNum
                GetRegOwner = ""
                Exit Function
            End If
        
            'get data in 30k chunks
            Check = Input((1024 * 30), #FileNum)
        
            UOwner = GetInUser(Check)
        Loop
    Close FileNum
End If
'==================================================

'if the two values were the same, then return name
If HwOwner <> "" Then
    GetRegOwner = HwOwner
Else
    GetRegOwner = UOwner
End If

Searching = False
End Function

Private Function GetInHw(Text As String) As String
'RegisteredOwnerDiskJunky    ÿ    HwInfo.Dat
'BOULAMITE?DiskJunky?             User.exe

Const RegHwSt = "RegisteredOwner"
Const RegHwEn = "ÿ"
Const RegUrSt = "BOULAMITE" '+ ASCII #30
'Const RegUrEn = ASCII #30

Dim Start As Integer
Dim LastP As Integer
Dim RetVal As String
Dim Counter As Integer
Dim Index As Integer
Dim GotHw As String
Dim GotUr As String

RetVal = Text

'string from HwInfo.Dat
Counter = 1
Do While (Counter >= 1) And (Counter <= (Len(RetVal) - Len(RegHwSt)))
    If Second(Time) <> Second(frmHandsClk.lblShowTime.Caption) Then
        Call frmHandsClk.ShowDigitalValues
    End If
    
    DoEvents
    
    If Not Searching Then
        Exit Function
    End If
    
    If LCase(Mid(RetVal, Counter, Len(RegHwSt))) = LCase(RegHwSt) Then
        Start = Counter + Len(RegHwSt)
        
        'find where the start of the name is
        For Index = Start To Len(RetVal)
            If Not Searching Then
                Exit Function
            End If
            
            If Mid(RetVal, Index, 1) = RegHwEn Then
                LastP = Index
                Exit For
            End If
        Next Index
        
        If LastP > 0 Then
            GotHw = Mid(RetVal, Start, (LastP - Start))
            GotHw = RemoveNull(Trim(GotHw))
            
            'remove trailing zero characters
            For Index = 1 To Len(GotHw)
                If (Asc(Mid(GotHw, Index, 1)) = 0) Then
                    GotHw = Left(GotHw, Index - 2)
                    Exit For
                End If
            Next
            
            'return name
            GetInHw = GotHw
            Exit Function
        End If
    End If
    
    
    Counter = Counter + 1
Loop

'--------------------------------------------------

End Function

Public Function GetInUser(Text As String) As String
'RegisteredOwnerDiskJunky    ÿ    HwInfo.Dat
'BOULAMITE?DiskJunky?             User.exe

Const RegHwSt = "RegisteredOwner"
Const RegHwEn = "ÿ"
Const RegUrSt = "BOULAMITE" '+ ASCII #30
'Const RegUrEn = ASCII #30

Dim Start As Integer
Dim LastP As Integer
Dim RetVal As String
Dim Counter As Integer
Dim Index As Integer
Dim GotHw As String
Dim GotUr As String

RetVal = Text

'search string from User.dat
Counter = 1
Do While (Counter >= 1) And (Counter <= (Len(RetVal) - Len(RegUrSt)))
    DoEvents
    If Second(Time) <> Second(frmHandsClk.lblShowTime.Caption) Then
        'update time display
        Call frmHandsClk.ShowDigitalValues
    End If
    
    If LCase(Mid(RetVal, Counter, Len(RegUrSt))) = LCase(RegUrSt) Then
        Start = Counter + Len(RegUrSt) + 1
        
        'find the start of the owner
        For Index = Start To Len(RetVal)
            If Asc(Mid(RetVal, Index, 1)) = 30 Then
                LastP = Index
                Exit For
            End If
        Next Index
        
        'find where the owner name ends
        If LastP > 0 Then
            GotUr = Mid(RetVal, Start, (LastP - Start))
            GotUr = Trim(GotUr)
            
            'return name
            GetInUser = GotUr
            Exit Do
        End If
    End If
    
    Counter = Counter + 1
Loop

'Call frmHandsClk.ShowDigitalValues
'==================================================
End Function

Private Function RemoveNull(Text As String) As String
'This function remove null characters.

Const NullChars = 10

Dim Counter As Integer
Dim Result As String

For Counter = 1 To Len(Text)
    If Asc(Mid(Text, Counter, 1)) >= NullChars Then
        Result = Result & Mid(Text, Counter, 1)
    End If
Next Counter

test = Asc(Right(Result, 1))
RemoveNull = Result
End Function