域环境下做到单用户登陆控制脚本

   早两年的时候因目前工作的工厂有要求做域环境下单用户的登陆控制，即只允许一个用户帐号在域环境下一台电脑登陆，以此来做好相关用户资料及权限控制的要求，故通过此脚本来做好相关用户的登陆记录，并配合之后的注销脚本来一起完成此任务，但因后来管理上的疏松及工作要求的改变，此脚本被取消部署，之前有做过几份拷贝，可是后来都不是因为硬盘坏或是忘了放哪，要用时到处找不到，故将此两脚本安放在此，以备后用！

 

登陆脚本：

 

文件名： LOGON.VBS

 

内容：

 

Option Explicit
Dim oNet, sUser, sComputer, ServerLog

ServerLog = ""   '加$目的是为了用户在游览服务器共享文件的时候看不到.这样用户就无法来更改他们的登录信息..
Set oNet = CreateObject("Wscript.Network")
sUser = oNet.UserName
sComputer = oNet.ComputerName
Set oNet = Nothing

Dim fso, f1, WshShell, argu, alllog, lastlog
Dim FileName
FileName=ServerLog & sUser & ".txt"
Set fso = CreateObject("Scripting.FileSystemObject")
If Not (fso.FileExists(FileName)) Then
   Set f1 = fso.CreateTextFile(FileName,True)
   f1.WriteLine sUser & "   " & sComputer
   f1.Close
   Set WshShell = Wscript.CreateObject("Wscript.Shell")
   argu = FileName & "/T/E/G" & sUser & ":f /R Everyone"
   WshShell.run("cacls " & argu)
   Set WshShell = Nothing
End If
  
Set f1 = fso.OpenTextFile(FileName, 1, True)
alllog = f1.readall
f1.Close
Set f1 = fso.OpenTextFile(FileName, 1, True)
lastlog = f1.readline
f1.Close

If Left(lastlog,5) = "logon" Then    '判断是否登入
 If InStr(lastlog,sComputer) < 1 Then    '判断是否同一台机器，如果不是，往下运行
         Set f1 = fso.OpenTextFile(FileName, 2, True)
         f1.WriteLine (lastlog & Chr(13) & Chr(10) & "fail-so-logoff:" & Now() & " " & sUser & "  at  " & scomputer & Chr(13) & Chr(10) & alllog)
         f1.Close
       
         Set WshShell = Wscript.CreateObject("Wscript.Shell")
         Dim i,OldComputer
         i=InStr(lastlog,"at")
         OldComputer=Right(lastlog,Len(lastlog)-i-2)
         WshShell.popup "对不起:此账号已经在 " & OldComputer & " 上登入使用！出现此提示,如是你还没有登录，说明你的账号被盗，请及时上报电脑部，谢谢合作！！！" , 10
         Set WshShell = Nothing
         Dim os, retcode
         For Each os In GetObject("Winmgmts:{impersonationLevel=impersonate,(shutdown,remoteshutdown)}!//" + sComputer).InstancesOf("Win32_OperatingSystem")
            retcode = os.Win32ShutDown(4, 0)
         Next
         Wscript.quit
        Else
         Set f1 = fso.OpenTextFile(FileName, 2, True)
         f1.WriteLine ("logon:  " & Now() & " " & sUser & "  at " & sComputer & Chr(13) & Chr(10) & alllog)
         f1.Close
        End If
Else   '没有登入
        Set f1 = fso.OpenTextFile(FileName, 2, True)
        f1.WriteLine ("logon:  " & Now() & " " & sUser & "  at " & sComputer & Chr(13) & Chr(10) & alllog)
        f1.Close
End If
Set f1 = Nothing
Set fso = Nothing
Wscript.quit

 

注销脚本：

 

文件名：LOGOFF.VBS

 

内容：

 

option explicit
dim oNet,sUser,sComputer,ServerLog
ServerLog = ""
set oNet=createobject("Wscript.Network")
sUser=oNet.UserName
sComputer=oNet.ComputerName
set oNet=nothing

dim fso,f1,alllog,lastlog
Dim FileName
FileName=ServerLog & sUser & ".txt"

set fso=createobject("Scripting.filesystemobject")
set f1=fso.opentextfile(FileName,1,true)
lastlog=f1.readline
f1.close
set f1=fso.opentextfile(FileName,1,true)
alllog=f1.readall
f1.close
if left(lastlog,5)="logon" Then
 If InStr(lastlog,sComputer) > 0 Then    '判断是否同一台机器，如果是，往下运行
  Set f1=fso.opentextfile(FileName,2,true)
  f1.writeline("logoff: " & Now() & " " & suser & "  at " & scomputer & Chr(13) & chr(10) & alllog)
  f1.close
 End If
end if
set f1=nothing
set fso=nothing
wscript.quit