Stop Multiple Windows Logins

Forums

My Profile

Inbox

Address Book

My Subscription

My Forums

Stop Multiple Windows Logins

Logged in as: Guest

arrSession:exec spGetSession 2,16,26001

	Active Users: There are 0 members and 0 guests.
	Users viewing this topic: none

Printable Version

All Forums >> [Scripting] >> Post a VBScript >> Stop Multiple Windows Logins
Do you like VisualBasicScript.com? Link to us and help spread the word about our forum. Thanks!

Page: [1]

Message

<< Older Topic Newer Topic >>

Stop Multiple Windows Logins - 9/15/2005 3:48:22 PM

amfony

Posts: 6
Score: 0
Joined: 9/11/2005
Status: offline

'"Multiple Logons a problem? Not anymore!!" - By Amfony
'
'This is my vbscript interpretation of a batch script that will stop multiple logons in a windows environment (with logon and logoff scripts)
'
'
'Requirements for script to work:
'
'A server with a shared folder named "logons" everyone full access (for easiness of implementation)
'A Folder within the share folder "logons" named "SecondAttempt"
'A XL file named "duplicates.xls" with lines of DATA (being Anything) in the 4th and 5th row (Because ammending XL is a biiiiyatch)
'A XL file named "Status.xls" with 2 lines of DATA (being Anything) in the 4th and 5th row (refer above)
'
'These XL files need to be on the \\server\logons share
'
'
'Pseudo Code
'
'The idea of this code is to have a user when logging on create a file/folder object based on their username on a share folder on a server. Then incorporate in the script an IF EXists
'statement to forecfully log the user off if there is already a file/folder object with that same Username name.
'
'My code however will record to XL files everytime a user logs on successfully (write to status.xls), or unsuccessfully (write to duplicates.xls), also in addition to the username,
'computername, time and date at that the event occured. My code will also write the event time details INSIDE the file it created based on username, which it will then read from
'to display a popup box with variables about the user,computer loggedinto and so forth if there is a secondlogon attempt.
'
'My script will upon second logon, create a second text file named "\\SERVER\logons\secondAttempt\second%username%.txt" that it will then incorporate into my
'logoff.vbs script (REFER BELOW)

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

'logon.vbs

Dim WshShell, BtnCode, file, strUsername
'connect to objects
SET WshShell = WScript.CreateObject("WScript.Shell")
SET FSO = CreateObject("Scripting.FileSystemObject")
SET NET = CreateObject("Wscript.Network")
'set variables
strUserName = net.UserName
strComputerName = net.ComputerName
strDomainName = net.UserDomain

file = ("\\SERVER\logons\" & strUsername & ".txt")
ndAttempt = ("\\SERVER\logons\SecondAttempt\" & "Second" & strUserName & ".txt")

'deal maker or breaker of the script
If fso.fileexists(file) Then
DisplayThenLogoff()
Else
      MakeFile("\\SERVER\logons\" & strUsername & ".txt")
End If

'-------------------------------------------------------------------------------------------
Function MakeFile(FileToBeMade)

'This function will create a file named "%username%" in the logons share folder, it will then open THAT file and enter time, date, username, computername details.
'It will then ammend a pre-created XL file named status.xls, and write computername, username, time and date information into relevant fields. It will then MOVE down one row when a new entry is created (Sweet no?)
'After all event logging is over, it will continue to log on as usual.

On Error Resume Next
Const ForReading = 1, ForWriting = 2

'Create FILE, open FILE, add information to FILE 
FSO.CreateTextFile(FileToBeMade)
SET Accessfile = FSO.OpenTextFile("\\SERVER\logons\" & strUsername & ".txt", ForWriting, true)

Accessfile.Write strUsername
AccessFile.WriteBlankLines 1
Accessfile.Write strComputername
AccessFile.WriteBlankLines 1 
Accessfile.Write time() 
AccessFile.WriteBlankLines 1
Accessfile.Write date()

'Closes FILE from writing, opens FILE for reading - implied saving.
SET AccessFile = FSO.OpenTextFile("\\SERVER\logons\" & strUsername & ".txt", ForReading)

'Prepare and write to status.xls
Const xlDown = -4121

SET objExcel = CreateObject("Excel.Application")
SET objXLworkbook = objExcel.workbooks.open("\\SERVER\logons\status.xls")
SET objXLsheet = objXLworkbook.activesheet

'Range = start cell
Set objRange = objExcel.Range("A4")
objRange.End(xlDown).Activate
intNewRow = objExcel.ActiveCell.Row + 1

'I dont really get this chunk of code above, it does however mimic the "CTRL+DOWN" effect in excel. THIS part can definatley be modified!

colUsername = 1
colComputerName = 2
colTime = 3
colDate = 4

'Writes Variavle values to status.xls
objXLsheet.cells(intNewrow,colUsername) = net.username
objXLsheet.cells(intNewRow,colComputername) = net.computername
objXLsheet.cells(intNewRow,colTime) = Time()
objXLsheet.cells(intNewRow,colDate) = Date()
'Save and exit
objxlworkbook.save
objExcel.quit

End Function
'-------------------------------------------------------------------------------------------

'-------------------------------------------------------------------------------------------
Function DisplayThenLogoff ()

'This function will create a file named "second%username%" in the secondattempt folder, it will then open THAT file and enter time, date, username, computername details.
'It will then ammend a pre-created XL file named Duplicates.xls, and write computername, username, time and date information into relevant fields. It will then MOVE down one row when a new entry is created (Sweet no?)
'After all event logging is over, it will then pop up a message witha 15second timeout, then continue to logoff.
'This function is similar to the makefile function. No real explination neccesary

On Error Resume Next
Dim ObjRange, intnewrow, objExcel, objXLworkbook, objXLsheet, SecondAccessFile, OpenF, OtherComp

Const ForReading = 1, ForWriting = 2
FSO.CreateTextFile(ndattempt)
      SET SecondAccessFile = FSO.OpenTextFile(ndattempt, ForWriting, true)

SecondAccessfile.Write strUsername
SecondAccessFile.WriteBlankLines 1
SecondAccessfile.Write strComputername
SecondAccessFile.WriteBlankLines 1 
SecondAccessfile.Write time() 
SecondAccessFile.WriteBlankLines 1
SecondAccessfile.Write date()

SET SecondAccessFile = FSO.OpenTextFile(ndattempt, ForReading)
SET SecondAccessFile = Nothing

Const xlDown = -4121
SET objExcel = CreateObject("Excel.Application")
SET objXLworkbook = objExcel.workbooks.open("\\SERVER\logons\duplicates.xls")
SET objXLsheet = objXLworkbook.activesheet

Set objRange = objExcel.Range("A4")
objRange.End(xlDown).Activate
intNewRow = objExcel.ActiveCell.Row + 1

colUsername = 1
colComputerName = 2
colTime = 3
colDate = 4

objXLsheet.cells(intNewrow,colUsername) = net.username
objXLsheet.cells(intNewRow,colComputername) = net.computername
objXLsheet.cells(intNewRow,colTime) = Time
objXLsheet.cells(intNewRow,colDate) = Date
objxlworkbook.save
objExcel.quit

'Opens FILE, retrieves second line (strComputerName) and sets as OtherComp variable.
SET FirstAccessFile = FSO.OpenTextFile(file, ForReading)

FirstAccessFile.SkipLine 
OtherComp = FirstAccessFile.ReadLine

'This part creates a popup message which will time out in 15seconds, it will tell the user their username, their computername, their domain name, the comouter they are
'logged into ALREADY and tell them to rectify this problem.
BtnCode = WshShell.Popup("User " & strUserName & " on " & strComputerName & " in " & strDomainName & VBCRLF & VBCRLF & "You are Logged on at Computer: " & OtherComp & ". Multiple Logins are prohibited. Please rectify this before trying to login again.",15, "Message", 0 + 16)

'Sends logoff.exe to shell to be run, and then logs off (obvious? haha)
wshShell.run "logoff.exe"

End function
'-------------------------------------------------------------------------------------------

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
logoff.vbs

'
'The story with the logoff script is quite simply
'
'If the file "\\SERVER\logons\secondattempt\second%username%.txt" EXIST (which inturn means that there was a concurrent connection, a multiple logon was attempted, and that
'this logoff procedure is forced {not by choice}
'
'THEN delete the "\\SERVER\logons\secondattempt\second%username%.txt" File (clean up duty)
'and then proceed to send.keys "logoff.exe" to the shell.
'
'
'IF However the " \\... second%username%.txt DOES NOT EXIST
'THEN
'
'Call gracefulexit function which will delete the "\\SERVER\logons\%username%.txt file. (Leaving the user free to log on again anywhere/time they wish.)
'
'

Dim strUsername, del, secondattemptFile, file
Set fso = CreateObject("Scripting.FileSystemObject")
Set net = createobject("Wscript.network")
Set wshell = CreateObject("wscript.Shell")

strUserName = net.username
file = ("\\thomas2k\logons\" & strUsername & ".txt")
secondAttemptFile = ("\\thomas2k\logons\SecondAttempt\" & "Second" & strUserName & ".txt")
If fso.fileexists(secondAttemptFile) then
SecondAttemptExit(secondAttemptFile)
Else
GracefulExit(file)

End If
'----------------------------------------------------------
Function SecondAttemptExit(SecondAttemptDel)
FSO.deletefile(SecondAttemptDel)
wshell.run "logoff.exe"
End Function
Function GracefulExit(GracefulDel)
fso.deletefile(GracefulDel)
wshell.run "logoff.exe"
End Function

< Message edited by Snipah -- 9/16/2005 6:20:15 AM >