by DiskJunky (16 Submissions)
Category: String Manipulation
Compatability: Visual Basic 5.0
Difficulty: Unknown Difficulty
Originally Published: Fri 12th May 2000
Date Added: Mon 8th February 2021
Rating: 
(1 Votes)
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
VBcoders
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
No comments have been posted about The long way to get the licensed user of a machine. Works though.. Why not be the first to post a comment about The long way to get the licensed user of a machine. Works though..
