Отключить определенные сетевые сеансы
Я занят созданием 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>
1 ответ
Я думаю, что вы можете либо использовать приведенную ниже командную строку, чтобы удалить ВСЕ соединения, либо сначала пройтись по текущим соединениям и отключить то, что соответствует вашим критериям.
net use * /delete /yes
Или выполните objNetwork.EnumNetworkDrives, затем objNetwork.RemoveNetworkDrive для каждого из них.
** Примечание: для тех соединений, которые сопоставлены с буквой локального диска, вам нужно сделать что-то вроде objNetwork.RemoveNetworkDrive("\172.16.18.3\corporate")
Удачи.