• Home
 · 
• String Manipulation
 · 
• This get the registered owner of a machine and is about 60 times faster than the last code I put up

This get the registered owner of a machine and is about 60 times faster than the last code I put up

This get the registered owner of a machine and is about 60 times faster than the last code I put up. I know that I can access the registry to

API Declarations


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

'Created by Eric O'Sullivan.
'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 This get the registered owner of a machine and is about 60 times faster than the last code I put up

• 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?Eric O'Sullivan?             User.exe
'BOULAMITE?Eric O'Sullivan               ?

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 = "")
        
        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)
        
        'continue program while searching
        DoEvents
        
        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
'RegisteredOwnerEric O'Sullivan    ÿ    HwInfo.Dat
'BOULAMITE?Eric O'Sullivan?             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
Dim FoundInStr As Long

RetVal = Text

'string from HwInfo.Dat

'do normal events
If Second(Time) <> Second(frmHandsClk.lblShowTime.Caption) Then
    Call frmHandsClk.ShowDigitalValues
End If
    
DoEvents

'if something important comes up, stop searching
If Not Searching Then
    Exit Function
End If
    
FoundInStr = InStr(1, LCase(RetVal), LCase(RegHwSt))
    
If (FoundInStr <> 0) Then '(FoundInStr <> Null) And
    
    'find where the start of the name is
    Start = FoundInStr + Len(RegHwSt)
       
    'find where name ends
    Index = InStr(Start, RetVal, RegHwEn)
    If (Index <> 0) Then
        LastP = Index
    End If
    
    If LastP > 0 Then
        GotHw = Mid(RetVal, Start, (LastP - Start))
        
        'remove trailing zero characters
        GotHw = RemoveNull(Trim(GotHw))
    
        'return name
        GetInHw = GotHw
        Exit Function
    End If
End If
    
'--------------------------------------------------

End Function

Public Function GetInUser(Text As String) As String
'RegisteredOwnerEric O'Sullivan    ÿ    HwInfo.Dat
'BOULAMITE?Eric O'Sullivan?             User.exe

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

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

RetVal = Text
RegUrEn = Chr(30)

'search string from User.dat
'do normal events
If Second(Time) <> Second(frmHandsClk.lblShowTime.Caption) Then
    Call frmHandsClk.ShowDigitalValues
End If
    
DoEvents

'if something important comes up, stop searching
If Not Searching Then
    Exit Function
End If
    
FoundInStr = InStr(1, LCase(RetVal), LCase(RegUrSt))
    
If (FoundInStr <> 0) Then '(FoundInStr <> Null) And
    
    'find where the start of the name is
    Start = FoundInStr + Len(RegUrSt) + 1
       
    'find where name ends
    Index = InStr(Start, RetVal, RegUrEn)
    If (Index <> 0) Then
        LastP = Index
    End If
    
    If LastP > 0 Then
        GotUr = Mid(RetVal, Start, (LastP - Start))
        
        'remove trailing zero characters
        GotUr = RemoveNull(Trim(GotUr))
    
        'return name
        GetInUser = GotUr
        Exit Function
    End If
End If
'==================================================
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