0
我正在忙于制作HTA小程序，该程序会在我的用户会话登录到其工作站时对其进行身份验证。理想情况下，我希望能够终止活动的网络会话，而不是仅仅删除用户通过身份验证时所创建的网络驱动器。断开特定网络会话
三天前我才知道HTA，这可能就是为什么我挣扎了一下，而且我的VBS知识也不是那么好，所以我正在通过拼接代码来处理代码示例一起。 HTA方法似乎是实现我想要完成的最简单和合适的方法，因为我可以毫无困难地映射驱动器。
有人可以看看我的脚本，并告诉我怎么可以优化它来完成我想要做的事？我正在学习每一步，所以请引导我去适合的解决方案（我想先尝试一下）。
目的：
能够从只有当HTA是由用户发起的特定服务器中删除当前活动的网络会话。
问题和出现次数：
假设正确的凭据：凭据拉到称为“ExecMapping”小组，并通过脚本验证，是一个有效的长度（不包含空格）。
脚本通过ExecMapping子，如果在尝试创建一个新的映射任何错误，检查完全运行。如果存在多个映射，则针对该特定映射抛出错误对话框。
大多数情况下，我得到一个“多连接”错误，正如所料。这是应该解决的。
脚本：
<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>