I'm busy making an HTA applet, which authenticates my users' sessions as they log on to their workstation. Ideally, I'd like to be able to terminate an active network session, instead of just removing the network drives which are made when users are authenticated.
I've only learned of HTA three days ago, which may be why I'm struggling a bit, and my VBS knowledge isn't all that good either, so I'm working off examples of code by stitching them together. The HTA method seems to be the most simple and suitable method of accomplishing what I wanted to do, as I'm able to map drives without any apparent difficulty.
Can someone take a look at my script, and tell me how I can optimise it to accomplish what I'm trying to do? I'm learning every step of the way, so please guide me to the appropraite solution (I'd like to try it myself first).
Objective:
Be able to remove a currently active network session from only a specific server when the HTA is launched by the user.
Issues and Occurrences:
Assuming Correct Credentials: The credentials are pulled to the Sub called "ExecMapping", and is validated by the script to be a valid length (no blanks).
The script runs completely through the ExecMapping Sub, which checks if there are any errors in attempting to create a new mapping. If multiple mapping exists, error dialog is thrown for that specific mapping.
Most often than not, I get a "Multiple Connections" error, as expected. This is what should be resolved.
The Scripting:
<HEAD>
<!-- Full Credits to the Authors of the ReadIni Function
Dependencies:
-> Logo (./Logo_alpha.png)
-> Ini File (./config.ini)
-> Icon (./Kreede$arch$.ico)
-->
<TITLE>Kreede Authenticator</TITLE>
<HTA:APPLICATION
APPLICATIONNAME="Kreede Authenticator"
VERSION="1.2"
BORDER="none"
INNERBORDER="no"
CAPTION="no"
SYSMENU="no"
MAXIMIZEBUTTON="no"
MINIMIZEBUTTON="no"
ICON="Kreede32.ico"
SCROLL="no"
SINGLEINSTANCE="yes"
SHOWINTASKBAR="no"
CONTEXTMENU="no"
SELECTION="no"/>
</HEAD>
<SCRIPT language="vbscript">
Function ReadIni( myFilePath, mySection, myKey )
' This function returns a value read from an INI file
'
' Arguments:
' myFilePath [string] the (path and) file name of the INI file
' mySection [string] the section in the INI file to be searched
' myKey [string] the key whose value is to be returned
'
' Returns:
' the [string] value for the specified key in the specified section
'
' CAVEAT: Will return a space if key exists but value is blank
'
' Written by Keith Lacelle
' Modified by Denis St-Pierre and Rob van der Woude
Const ForReading = 1
Const ForWriting = 2
Const ForAppending = 8
Dim intEqualPos
Dim objFSO, objIniFile
Dim strFilePath, strKey, strLeftString, strLine, strSection
Set objFSO = CreateObject( "Scripting.FileSystemObject" )
ReadIni = ""
strFilePath = Trim( myFilePath )
strSection = Trim( mySection )
strKey = Trim( myKey )
If objFSO.FileExists( strFilePath ) Then
Set objIniFile = objFSO.OpenTextFile( strFilePath, ForReading, False )
Do While objIniFile.AtEndOfStream = False
strLine = Trim( objIniFile.ReadLine )
' Check if section is found in the current line
If LCase( strLine ) = "[" & LCase( strSection ) & "]" Then
strLine = Trim( objIniFile.ReadLine )
' Parse lines until the next section is reached
Do While Left( strLine, 1 ) <> "["
' Find position of equal sign in the line
intEqualPos = InStr( 1, strLine, "=", 1 )
If intEqualPos > 0 Then
strLeftString = Trim( Left( strLine, intEqualPos - 1 ) )
' Check if item is found in the current line
If LCase( strLeftString ) = LCase( strKey ) Then
ReadIni = Trim( Mid( strLine, intEqualPos + 1 ) )
' In case the item exists but value is blank
If ReadIni = "" Then
ReadIni = " "
End If
' Abort loop when item is found
Exit Do
End If
End If
' Abort if the end of the INI file is reached
If objIniFile.AtEndOfStream Then Exit Do
' Continue with next line
strLine = Trim( objIniFile.ReadLine )
Loop
Exit Do
End If
Loop
objIniFile.Close
Else
WScript.Echo strFilePath & " doesn't exists. Exiting..."
Wscript.Quit 1
End If
End Function
Sub Window_onLoad
Dim objNetwork
Dim objFSO
Set objNetwork = CreateObject("WScript.Network")
'### First Impressions! ###
window.resizeTo 480,270
window.moveTo screen.width / 3, screen.height / 4
'### Remove Previous Session's Access to Shared Drives ###
Set objFSO = CreateObject("Scripting.FileSystemObject")
If objFSO.DriveExists("O") Then
objNetwork.RemoveNetworkDrive("O:")
End If
If objFSO.DriveExists("S") Then
objNetwork.RemoveNetworkDrive("S:")
End If
Set objNetwork = Nothing
End Sub
Sub CancelAction
'### Remove Previous Session's Access to Shared Drives ###
Set objNetwork = CreateObject("WScript.Network")
Set objFSO = CreateObject("Scripting.FileSystemObject")
If objFSO.DriveExists("O") Then
objNetwork.RemoveNetworkDrive("O:")
End If
If objFSO.DriveExists("S") Then
objNetwork.RemoveNetworkDrive("S:")
End If
MsgBox "You have not logged in, and will not be able to access drives O: and S: To regain access, please run Kreede from your Desktop again.", vbOKOnly + vbCritical, "Important"
Set oShell = Nothing
Set objNetwork = Nothing
Self.Close()
End Sub
Sub ExecMapping
On Error Resume Next
Dim objNetwork, oShell, WshShell
Set objNetwork = CreateObject("WScript.Network")
Set oShell = CreateObject("Shell.Application")
Set WshShell = CreateObject("WScript.Shell")
'### Initialise all variables needed ###
strDriveLetter1 = "O:"
strDriveLetter2 = "S:"
'### Our Fail-Safe Locations, just in case... ###
strRemotePath1 = "\\172.16.18.3\corporate"
strRemotePath2 = "\\172.16.18.3\scratch"
strDriveAlias1 = "Corporate (HO)"
strDriveAlias2 = "Scratch (HO)"
intTimeout = 1 'Seconds
strMessage = "Login Succeeded!"
strTitle = "Success!"
'### We'll find out who you are in bit, but we first need to know where you are? ###
strBranch = UCase(ReadIni(".\config.ini", "Config-Data", "branch"))
Select Case strBranch
Case "HO"
strRemotePath1 = "\\172.16.18.3\corporate"
strRemotePath2 = "\\172.16.18.3\scratch"
strDriveAlias1 = "Corporate (HO)"
strDriveAlias2 = "Scratch (HO)"
Case "REM"
strRemotePath1 = "\\172.16.20.3\corporate"
strRemotePath2 = "\\172.16.20.3\scratch"
strDriveAlias1 = "Office (Remote)"
strDriveAlias2 = "Scratch (Remote)"
End Select
'### Are we working with humans? Set minimum length for validation ###
validUsr = 2
validPass = 3
'### Check if the Computer lied... ###
Set objFSO = CreateObject("Scripting.FileSystemObject")
If objFSO.DriveExists("O") Then
objNetwork.RemoveNetworkDrive("O:")
End If
If objFSO.DriveExists("S") Then
objNetwork.RemoveNetworkDrive("S:")
End If
'### Map drives using the entered credentials ###
'STEP 1: Collect Credentials
strUser = TextBox1.Value
strPwd = TextBox2.Value
'STEP 2: Validate and Map!
If Len(strUser) >= validUser Then
strUsr = Ucase(strUser)
If Len(strPwd) >= validPass Then
Err.Clear
objNetwork.MapNetworkDrive strDriveLetter1, strRemotePath1, False, strUser, strPwd
If Err.Number <> 0 Then
MsgBox "MAP-O :: Error Occurred [" & Err.Number & "]: " & Err.Description
End If
objNetwork.MapNetworkDrive strDriveLetter2, strRemotePath2, False, strUser, strPwd
If Err.Number <> 0 Then
MsgBox "MAP-S :: Error Occurred [" & Err.Number & "]: " & Err.Description
Call CancelAction
End If
If Err.Number = 0 Then
oShell.NameSpace(strDriveLetter1).Self.Name = strDriveAlias1
oShell.NameSpace(strDriveLetter2).Self.Name = strDriveAlias2
intResult = WshShell.Popup(strMessage, intTimeout, strTitle)
End If
Else
Msgbox "Password is invalid!"
Exit Sub
End If
ELSE
Msgbox chr(34) & strUser & """ is not a valid username!"
Exit Sub
End If
Set oShell = Nothing
Set objNetwork = Nothing
Self.Close()
End Sub
</SCRIPT>
<BODY STYLE="
TEXT-ALIGN: center;
background-color: #dddddd;
FONT:10 pt verdana;
COLOR:black;
filter:progid:DXImageTransform.Microsoft.Gradient(GradientType=0, StartColorStr='#FFCC66', EndColorStr='#FFFFFF')
">
<img src="./Logo_alpha.png" alt="Logo"></a><br>
Please enter your corporate user credentials to access the Corporate Servers.<br><br>
<CENTER>
<HR color="#FF0000">
<table border="0" cellpadding="0" cellspacing="0"><font size="2" color="black" face="Arial">
<tr>
<td height="30">
<p align="right">Username</p>
</td>
<td height="30"> <input type="text" name="TextBox1" size="30">
</td>
</tr>
<tr>
<td height="30">
<p align="right">Password</p>
</td>
<td height="30"> <input type="password" name="TextBox2" size="30">
</td>
</tr>
</table>
<HR color="#FF0000">
<Input id=runbutton class="button" type="button" value=" Login " name="run_button" onClick="ExecMapping">
<Input id=runbutton class="button" type="button" value="Cancel" name="cancel_button" onClick="CancelAction"><br>
<span style="font-size: 8pt; color: red"><strong>If you cancel, you will not be able to access the O: and S: drives in this session.</strong></span>
</CENTER>
</BODY>
