VBS版ADSL_Link_Manage用于上网时间管理

fastslz

本人2009-1-8受百度一则悬赏题（用VBS脚本获取ADSL拨号上网的持续时间）的启发,完成了此脚本

' *==============================================================================*
' * ADSL_Link_Manage.vbs By: FastSLZ 2009-1-10        首次发布与 bbs.bathome.net  *
' * http://groups.google.com/group/fastslz?&hl=zh-CN                             *
' *==============================================================================*
'特别提醒：本脚本必须在Administrator账户，且必须通过杀毒软件授权下才能正常运行！
Dim WMI,WMIS,WS,Fso,LastLinkTime,AddTime,LinkTime,OffTime
Set WS=CreateObject("Wscript.Shell")
Set WMI = GetObject("Winmgmts:{impersonationLevel=impersonate}\\.\root\cimv2")
Set WMIS = GetObject("Winmgmts:{(Security)}\\.\root\cimv2")
Set Fso = CreateObject("Scripting.FileSystemObject")
LogPath = Left(FullName,Len(FullName)-Len(ScriptName)) & Year(Now) & "年" & Month(Now) & "月" & "\"
LogFile = LogPath & Day(Now) & "日.txt"
AddTimeLog = LogPath & Day(Now) & "日累计时间.log"
If Fso.FolderExists(LogPath) = False Then Fso.CreateFolder(LogPath)
OldLog=LogPath & Day(DateAdd("d", -1 , Now)) & "日累计时间.log"
If (Fso.FileExists(OldLog)) Then Fso.DeleteFile(OldLog)
Set B = WMI.ExecQuery ("Select * from Win32_NTLogEvent Where Logfile = 'System' and EventCode = '20158'")
For Each A In B
    Flag = Flag + 1:If Flag = 1 Then:LastLinkTime = FormatTime(A.TimeGenerated):End If
Next
Set B = Nothing:Set Flag = Nothing:Set StartDate = Nothing
'Wscript.echo LastLinkTime
Set AdslLink = WMIS.ExecNotificationQuery _   
    ("Select * from __InstanceCreationEvent Where " _
        & "TargetInstance ISA 'Win32_NTLogEvent' and TargetInstance.EventCode = '20158' Or "_
             & "TargetInstance ISA 'Win32_NTLogEvent' and TargetInstance.EventCode = '20159'")
Do
  Set OpenLogFile = Fso.OpenTextFile(AddTimeLog, 1,True)
  Do Until OpenLogFile.AtEndOfStream
  strLine = OpenLogFile.ReadLine
  If Len(strLine) > 0 Then:AddTime = strLine:End If
  Loop
  OpenLogFile.Close
  If AddTime = "" Then AddTime = 0:End If
  If AddTime > 720 Then
  YN = MsgBox (Day(Now) & "日累计时间已超过12小时了！"& vbCRLF &"是否继续上网计时？",vbYesNo + 4160 ,"提示")
       If YN = vbNo Then WScript.Quit:End If
  End If
  Set OpenLogFile = Nothing:Set YN = Nothing:Set strLine = Nothing
    Set A = AdslLink.NextEvent
    If TypeName(FormatTime(A.TargetInstance.TimeWritten)) = "Date" Then
       If A.TargetInstance.EventCode = "20158" Then
          LinkTime = FormatTime(A.TargetInstance.TimeWritten)
          WS.Popup "上线时间 " & LinkTime,4,"上线提示",4128
          ElseIf A.TargetInstance.EventCode = "20159" Then
          OffTime = FormatTime(A.TargetInstance.TimeWritten)
          If TypeName(LinkTime) <> "Date" Then LinkTime = LastLinkTime:End If
          WS.Popup "下线时间 " & OffTime ,4,"下线提示",4128
          LTime = "上线时间 " & LinkTime & vbTab & "下线时间 " & OffTime & vbTab &"用时：" & DateDiff("n",LinkTime,OffTime) & "分钟"
          Set WLog = Fso.OpenTextFile(LogFile ,8 ,True)
          WLog.WriteLine LTime
          WLog.Close:Set WLog = Nothing
          If TypeName(LinkTime) = "Date" and TypeName(OffTime) = "Date" Then
             Set WLog = Fso.OpenTextFile(AddTimeLog ,2 ,True)
             WLog.WriteLine AddTime + DateDiff("n",LinkTime,OffTime)
             WLog.Close:Set WLog = Nothing
          End If
        End If
    End If
Loop
Function FormatTime(TimeStr)
   FormatTime = CDate(Mid(TimeStr, 5, 2) & "/" & Mid(TimeStr, 7, 2) & "/" & Left(TimeStr, 4) & " " & Mid (TimeStr, 9, 2) & ":" & Mid(TimeStr, 11, 2) & ":" & Mid(TimeStr, 13, 2))
End Function

fastslz

未完成部分
防突然断电或是其它突发事情导致累计时间没保存（异步监视太耗资源如有必要待完善）
其它待完善说明：
因为本人是Adsl包月的，而此脚本仅限于12小时限时（包日限时）拨号上网，具我所知还有（包月限时）的Adsl套餐，而且每个省份都有不同的套餐，请路过的会员提供下

[ 本帖最后由 fastslz 于 2009-1-10 18:43 编辑 ]

youxi01

呵呵，代码是不错
不过我们用的都是包年的...