' /////////////////////////////////////////////////////////////////////////////// ' // ActiveXperts Network Monitor - VBScript based checks ' / ' // For more information about ActiveXperts Network Monitor and VBScript, please ' // visit the online ActiveXperts Network Monitor VBScript Guidelines at: ' // http://www.activexperts.com/support/activmonitor/online/vbscript/ ' // ' /////////////////////////////////////////////////////////////////////////////// Option Explicit Const retvalUnknown = 1 ' ////////////////////////////////////////////////////////////////////////////// Function CheckFreeSpace( strComputer, strDisk, strCredentials ) ' Description: ' このFunctionはstrComputer上のstrDiskの空き容量が10%以上あるかをチェックします。 ' Parameters: ' 1) strComputer As String - Hostname or IP address of the computer you want to monitor ' 2) strDisk As String - Disk Name of the computer you want to monitor like C: orD: ' 3) strCredentials As String - Specify an empty string to use Network Monitor service credentials. ' To use alternate credentials, enter a server that is defined in Server Credentials table. ' (To define Server Credentials, choose Tools->Options->Server Credentials) ' Usage: ' CheckFreeSpace( "", "", "" ) ' Sample: ' CheckFreeSpace( "localhost", "C:", "" ) On Error Resume Next Dim objWMIService CheckFreeSpace = retvalUnknown ' Default return value SYSDATA = "" ' Not used in this function SYSEXPLANATION = "" ' Set initial value Set objWMIService = getWMIObject( strComputer, strCredentials, SYSEXPLANATION ) If( objWMIService Is Nothing ) Then CheckDiskDrives = retvalUnknown Exit Function End If CheckFreeSpace = CheckFreeSpaceWMI( objWMIService, strDisk, SYSEXPLANATION ) End Function ' ////////////////////////////////////////////////////////////////////////////// Function CheckFreeSpaceWMI( objWMIService, strDisk, BYREF strSysExplanation ) On Error Resume Next Dim colDisks, objDisk, freeDisk CheckFreeSpaceWMI = retvalUnknown ' Default return value Set colDisks = objWMIService.ExecQuery( "Select * from Win32_LogicalDisk" ) For Each objDisk In colDisks If (objDisk.Name = (strDisk)) then freeDisk=CStr(Fix(objDisk.FreeSpace/1024/1024)) If (objDisk.FreeSpace / objDisk.Size) < 0.1 Then CheckFreeSpaceWMI = False strSysExplanation = "空き容量は10%未満です[" & strDisk & freeDisk & "MB]" Exit Function else CheckFreeSpaceWMI = True strSysExplanation = "空き容量は問題ありません[" & strDisk & freeDisk & "MB]" Exit Function End If End If CheckFreeSpaceWMI = retvalUnknown strSysExplanation = "Diskが見つかりません [" & strDisk & "]" Next End Function ' ////////////////////////////////////////////////////////////////////////////// Function getWMIObject( strComputer, strCredentials, BYREF strSysExplanation ) On Error Resume Next Dim objNMServerCredentials, objWMIService, objSWbemLocator, colItems Dim strUsername, strPassword If( strCredentials = "" ) Then ' Connect to remote host on same domain using same security context Set objWMIService = GetObject( "winmgmts:{impersonationLevel=Impersonate}!\\" & strComputer &"\root\cimv2" ) Else Set objNMServerCredentials = CreateObject( "ActiveXperts.NMServerCredentials" ) strUsername = objNMServerCredentials.GetLogin( strCredentials ) strPassword = objNMServerCredentials.GetPassword( strCredentials ) If( strUsername = "" ) Then getWMIObject = Nothing strSysExplanation = "No alternate credentials defined for [" & strCredentials & "]. In the Manager application, select 'Options' from the 'Tools' menu and select the 'Server Credentials' tab to enter alternate credentials" Exit Function End If ' Connect to remote host using different security context and/or different domain Set objSWbemLocator = CreateObject( "WbemScripting.SWbemLocator" ) Set objWMIService = objSWbemLocator.ConnectServer( strComputer, "root\cimv2", strUsername, strPassword ) If( Err.Number <> 0 ) Then getWMIObject = Nothing strSysExplanation = "Unable to access [" & strComputer & "]. Possible reasons: WMI not running on the remote server, Windows firewall is blocking WMI calls, insufficient rights, or remote server down" Exit Function End If objWMIService.Security_.ImpersonationLevel = 3 End If If( Err.Number <> 0 ) Then getWMIObject = Nothing strSysExplanation = "Unable to access '" & strComputer & "'. Possible reasons: no WMI installed on the remote server, no rights to access remote WMI service, or remote server down" Exit Function End If Set getWMIObject = objWMIService End Function