断开特定网络会话答案

【问题标题】：Disconnect Specific Network Sessions断开特定网络会话
【发布时间】：2016-08-05 08:32:03
【问题描述】：

我正忙于制作一个 HTA 小程序，它在我的用户登录到他们的工作站时验证他们的会话。理想情况下，我希望能够终止活动的网络会话，而不是仅仅删除用户通过身份验证时创建的网络驱动器。

我三天前才了解 HTA，这可能是我有点挣扎的原因，而且我的 VBS 知识也不是那么好，所以我正在通过将代码示例拼接在一起来处理它们. HTA 方法似乎是完成我想做的最简单和最合适的方法，因为我能够毫无困难地映射驱动器。

有人可以看看我的脚本，并告诉我如何优化它以完成我想做的事情？我正在学习每一步，所以请指导我找到合适的解决方案（我想先自己尝试一下）。

目标：

当用户启动 HTA 时，能够仅从特定服务器中删除当前活动的网络会话。

问题和发生：

假设正确的凭据：凭据被拉到名为“ExecMapping”的 Sub，并由脚本验证为有效长度（无空格）。

脚本完全通过 ExecMapping Sub 运行，它检查在尝试创建新映射时是否有任何错误。如果存在多个映射，则会针对该特定映射抛出错误对话框。
通常情况下，我收到“多连接”错误，正如预期的那样。这是应该解决的问题。

脚本：

<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">&nbsp;&nbsp; <input type="text" name="TextBox1" size="30">
        </td>
    </tr>
    <tr>
        <td height="30">
            <p align="right">Password</p>
        </td>
        <td height="30">&nbsp;&nbsp; <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">

&nbsp;&nbsp;&nbsp;

<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>

【问题讨论】：

标签： session vbscript hta mapped-drive

【解决方案1】：

我认为您可以使用以下命令行删除所有连接，或者首先遍历当前连接并断开符合您条件的连接。

net use * /delete /yes

或者，分别执行 objNetwork.EnumNetworkDrives 然后 objNetwork.RemoveNetworkDrive。

** 注意：对于那些映射到本地驱动器号的连接，您需要执行 objNetwork.RemoveNetworkDrive("\172.16.18.3\corporate") 之类的操作

祝你好运。

【讨论】：