Windows 95 makes using services very simple. You can setup a service simply by adding one registry key. This makes getting around Windows security issues very easy.
For example, if you set Windows to logon and require network validation, then a user must logon with a valid username and password. At this point, your program will not be running because the Windows shell (Explorer.exe) has not yet been loaded.
You can get around this by running your program as a service. Windows runs services before you have logged in, so you could setup a small service that gave you a way to get into Windows if the network was down, or you had forgotten your password.
As a service, your program does not appear in the task list, making it very difficult to close. This way you could setup a security program that monitors what the user is doing, and stop them if they do something naughty.
For this article, I created a program called Service Manager. It allows you to simply manage the services installed on your machine – edit, add and delete. The program can also be password protected, and uses the Windows password system to verify a user.
The code is based on several previous howto articles:
Verifying the Windows password
Create a registry control
I have modified the registry control to support an enumeration that contains the different HKEY constants. This makes it easy to get and set strings. Open VB, make a new Standard EXE Project and add a usercontrol, 3 standard modules, and 3 extra forms (you need 4 in total). Rename the usercontrol ctlReg and the modules modVerfiyPassword, modUtils and modDeclares. Copy and paste the following code into the ctlReg usercontrol:
Option Explicit 'Enumeration to hold the HKEY constants Enum eHKEY eHKLM = HKEY_LOCAL_MACHINE eHKCR = HKEY_CLASSES_ROOT eHKCU = HKEY_CURRENT_USER eHKPD = HKEY_PERFORMANCE_DATA eHKU = HKEY_USERS End Enum 'Function for removing a key Public Function fDeleteValue(ByVal hKey As eHKEY, _ ByVal strPath As String, ByVal strValue As String) Dim keyhand As Long Dim r As Long 'Open it r = RegOpenKey(hKey, strPath, keyhand) 'Delete it r = RegDeleteValue(keyhand, strValue) 'Close it r = RegCloseKey(keyhand) End Function ' Function for getting a string Public Function fGetstring(hKey As eHKEY, _ strPath As String, strValue As String) Dim keyhand As Long Dim datatype As Long Dim lResult As Long Dim strBuf As String Dim lDataBufSize As Long Dim intZeroPos As Integer Dim lValueType As Long Dim r As Long 'Open it r = RegOpenKey(hKey, strPath, keyhand) 'Query the registry lResult = RegQueryValueEx(keyhand, strValue, 0&, lValueType, ByVal 0&, lDataBufSize) If lValueType = REG_SZ Then strBuf = String(lDataBufSize, " ") lResult = RegQueryValueEx(keyhand, strValue, 0&, 0&, _ ByVal strBuf, lDataBufSize) If lResult = ERROR_SUCCESS Then intZeroPos = InStr(strBuf, Chr$(0)) If intZeroPos > 0 Then fGetstring = Left$(strBuf, intZeroPos - 1) Else fGetstring = strBuf End If End If End If End Function 'Function for saving a string Public Sub fSaveString(hKey As eHKEY, strPath As String, _ strValue As String, strdata As String) Dim keyhand As Long Dim r As Long 'Create it r = RegCreateKey(hKey, strPath, keyhand) 'Set it r = RegSetValueEx(keyhand, strValue, 0, _ REG_SZ, ByVal strdata, Len(strdata)) 'Close it r = RegCloseKey(keyhand) End Sub Private Sub UserControl_Initialize() 'Set the width and height values UserControl.Width = UserControl.Picture.Width UserControl.Height = UserControl.Picture.Height End Sub Private Sub UserControl_Resize() 'Reset the width and height values UserControl.Width = UserControl.Picture.Width UserControl.Height = UserControl.Picture.Height End Sub Public Function EnumValues(ByVal hKey As eHKEY, _ ByVal sSectionKey As String, ByRef sKeyNames() As String, _ ByRef iKeyCount As Long) As Boolean Dim lIndex As Long Dim lResult As Long Dim sName As String Dim lNameSize As Long Dim sData As String Dim cJunk As Long Dim cNameMax As Long Dim ft As Currency 'Thanks to Steve McMahon as this came from his cRegistry class ' found at http://vbaccelerator.com/ iKeyCount = 0 Erase sKeyNames() lIndex = 0 lResult = RegOpenKeyEx(hKey, sSectionKey, 0, KEY_QUERY_VALUE, hKey) If (lResult = ERROR_SUCCESS) Then lResult = RegQueryInfoKey(hKey, "", cJunk, 0, cJunk, _ cJunk, cJunk, cJunk, cNameMax, cJunk, cJunk, ft) Do While lResult = ERROR_SUCCESS lNameSize = cNameMax + 1 sName = String$(lNameSize, 0) If (lNameSize = 0) Then lNameSize = 1 lResult = RegEnumValue(hKey, lIndex, sName, lNameSize, _ 0&, 0&, 0&, 0&) If (lResult = ERROR_SUCCESS) Then sName = Left$(sName, lNameSize) iKeyCount = iKeyCount + 1 ReDim Preserve sKeyNames(1 To iKeyCount) As String sKeyNames(iKeyCount) = sName End If lIndex = lIndex + 1 Loop End If If (hKey <> 0) Then RegCloseKey hKey End If EnumValues = True Exit Function End Function
Now add the following code into the modDeclares module:
Option Explicit ' Path to the Serices registry key Public Const ServicePath As String = _ "SOFTWAREMicrosoftWindowsCurrentVersionRunServices" ' Registry Constants Public Const HKEY_CLASSES_ROOT = &H80000000 Public Const HKEY_CURRENT_USER = &H80000001 Public Const HKEY_LOCAL_MACHINE = &H80000002 Public Const HKEY_USERS = &H80000003 Public Const HKEY_PERFORMANCE_DATA = &H80000004 Public Const ERROR_SUCCESS = 0& Public Const REG_SZ = 1 ' Unicode nul terminated string Public Const REG_DWORD = 4 Public Const KEY_QUERY_VALUE = &H1 ' Registry API Declarations Public Declare Function RegCloseKey Lib "advapi32.dll" _ (ByVal hKey As Long) As Long Public Declare Function RegCreateKey Lib "advapi32.dll" _ Alias "RegCreateKeyA" _ (ByVal hKey As Long, _ ByVal lpSubKey As String, _ phkResult As Long) As Long Public Declare Function RegDeleteKey Lib "advapi32.dll" _ Alias "RegDeleteKeyA" _ (ByVal hKey As Long, _ ByVal lpSubKey As String) As Long Public Declare Function RegDeleteValue Lib "advapi32.dll" _ Alias "RegDeleteValueA" _ (ByVal hKey As Long, _ ByVal lpValueName As String) As Long Public Declare Function RegOpenKey Lib "advapi32.dll" _ Alias "RegOpenKeyA" _ (ByVal hKey As Long, _ ByVal lpSubKey As String, _ phkResult As Long) As Long Public Declare Function RegQueryValueEx Lib "advapi32.dll" _ Alias "RegQueryValueExA" _ (ByVal hKey As Long, _ ByVal lpValueName As String, _ ByVal lpReserved As Long, _ lpType As Long, _ lpData As Any, _ lpcbData As Long) As Long Public Declare Function RegSetValueEx Lib "advapi32.dll" _ Alias "RegSetValueExA" _ (ByVal hKey As Long, _ ByVal lpValueName As String, _ ByVal Reserved As Long, _ ByVal dwType As Long, _ lpData As Any, _ ByVal cbData As Long) As Long Public Declare Function RegOpenKeyEx Lib "advapi32" _ Alias "RegOpenKeyExA" _ (ByVal hKey As Long, _ ByVal lpSubKey As String, _ ByVal ulOptions As Long, _ ByVal samDesired As Long, _ phkResult As Long) As Long Public Declare Function RegQueryInfoKey Lib "advapi32.dll" _ Alias "RegQueryInfoKeyA" _ (ByVal hKey As Long, _ ByVal lpClass As String, _ lpcbClass As Long, _ ByVal lpReserved As Long, _ lpcSubKeys As Long, _ lpcbMaxSubKeyLen As Long, _ lpcbMaxClassLen As Long, _ lpcValues As Long, _ lpcbMaxValueNameLen As Long, _ lpcbMaxValueLen As Long, _ lpcbSecurityDescriptor As Long, _ lpftLastWriteTime As Any) As Long Public Declare Function RegEnumValue Lib "advapi32.dll" _ Alias "RegEnumValueA" _ (ByVal hKey As Long, _ ByVal dwIndex As Long, _ ByVal lpValueName As String, _ lpcbValueName As Long, _ ByVal lpReserved As Long, _ ByVal lpType As Long, _ ByVal lpData As Long, _ ByVal lpcbData As Long) As Long
Now add the following code to the modVerfiyPassword module:
Option Explicit Declare Function GetUserName Lib "advapi32.dll" _ Alias "GetUserNameA" _ (ByVal lpBuffer As String, _ nSize As Long) As Long Private Declare Function WNetVerifyPassword Lib "mpr.dll" _ Alias "WNetVerifyPasswordA" _ (ByVal lpszPassword As String, _ ByRef pfMatch As Long) As Long Public Function GetWindowsLoginUserID() As String Dim rtn As Long Dim sBuffer As String Dim lSize As Long sBuffer = String$(260, Chr$(0)) lSize = Len(sBuffer) rtn = GetUserName(sBuffer, lSize) If rtn Then sBuffer = Left$(sBuffer, lSize) 'Reformat string If InStr(sBuffer, Chr$(0)) Then sBuffer = Left$(sBuffer, InStr(sBuffer, Chr$(0)) - 1) End If GetWindowsLoginUserID = sBuffer Else 'Error! GetWindowsLoginUserID = "" End If End Function Public Function VerifyWindowsLoginUserPassword(ByVal _ Password As String) As Boolean Dim rtn As Long, Match As Long rtn = WNetVerifyPassword(Password, Match) If rtn Then VerifyWindowsLoginUserPassword = False Else VerifyWindowsLoginUserPassword = (Match <> 0) End If End Function