I have a script that maps network drives but i would like to create a way to display the realtime status of those drive for instance if the drive is connected then a cell in the table that displays all of the drives would turn green and if the drive was not connected then it will turn red. i am fairly new to VBS.
Option Explicit
const pcstrPath = ";G:\SYSINFO;F:\Public"
const pcstrC3Server = "\\Z02DBCVSC01\"
dim objExplorer, HTML
'set oIE = CreateObject("InternetExplorer.Application")
'Modeless oIE, "VSC Logon Script is running, please wait..."
On Error Resume Next
Set objExplorer = CreateObject ("InternetExplorer.Application")
objExplorer.Navigate "about:blank"
objExplorer.ToolBar = 0
objExplorer.StatusBar = 0
objExplorer.Fullscreen = 1
objExplorer.Left = 0
objExplorer.Top = 0
'objExplorer.Width = 800
'objExplorer.Height = 600
objExplorer.Visible = 1
objExplorer.Document.Body.Style.Cursor = "wait"
Dim objDocument:Set objDocument = objExplorer.Document
objDocument.Open
objDocument.Writeln "<HEAD></HEAD><TITLE>Logon Script Progress</TITLE>"
objDocument.Writeln "<Body BGColor=white SCROLL=YES>"
objDocument.Writeln "</BODY>"
'###Write to the IE Object
objExplorer.Document.Body.InnerHTML="<html><tablelor=lightblue border=3 width=100% bordercolor=black cellspacing=6 cellpadding=6" & _
"height=100%><tr valign=middle><td align=center> " & _
"<caption align=center><font size=20><b><i> Mapping Network Drives.... </b></i></font></caption> " & _
"<tr> " & _
"<th><font size=18 color=black><u>Network Drive:</u></font></th> " & _
"<th><font size=18 color=black><u>Connected:</u></font></th> " & _
"<tr> " & _
"<td align=left><font size=10 color=black>(G:) Rafacsii$ on 'Z02dbcvsc01'</font></td> " & _
"<td align=center></td> " & _
"<tr> " & _
"<td align=left><font size=10 color=black>(H:) Rafacs$ on ' Z02dbcvsc01'</font></td> " & _
"<td align=center></td> " & _
"<tr> " & _
"<td align=left><font size=10 color=black>(I:) User on 'Z02rscvsc07\User Share' </font></td> " & _
"<td align=center></td> " & _
"<tr> " & _
"<td align=left><font size=10 color=black>(J:) Local on 'Z02rscvsc07\NOVAShare\Mis' </font></td> " & _
"<td align=center></td> " & _
"<tr> " & _
"<td align=left><font size=10 color=black>(K:) Pubarc on 'Z02rscvsc07' </font></td> " & _
"<td align=center></td> " & _
"<tr> " & _
"<td align=left><font size=10 color=black>(L:) APPLShare on 'Z02rscvsc07' </font></td> " & _
"<td align=center></td> " & _
"<tr> " & _
"<td align=left><font size=10 color=black>(M:) Imroot$ on 'Z02dbcvsc01' </font></td> " & _
"<td align=center></td> " & _
"<tr> " & _
"<td align=left><font size=10 color=black>(O:) itsopshre on 'Z02rscvsc07' </font></td> " & _
"<td align=center></td> " & _
"<tr> " & _
"<td align=Left><font size=10 color=black>(P:) DocProd on 'Z02c4cvsc01' </font></td> " & _
"<td align=center></td> " & _
"<tr> " & _
"<td align=Left><font size=10 color=black>(Q:) PrintShare on 'Z02TBCVSC02(Z02tbcvsc02)' </font></td> " & _
"<td align=center></td> " & _
"<tr> " & _
"</font></td></tr></table>"
objDocument.Close
Dim pstrUserName,pstrGroups,pstrFailed,pstrSpecialVolChar
'Modeless oIE, "VSC Logon Script is running, please wait...</p></p> getting User Name"
pstrUserName = fstrGetUserProperty("samAccountName")
'Modeless oIE, "VSC Logon Script is running, please wait...</p></p> getting group membership"
pstrGroups = ucase(fstrGetUserProperty("MemberOf"))
if InStr(pstrGroups, "VSC C3 SERVICE ACCOUNTS") then
pstrSpecialVolChar = "Z"
end if
If fblnMapDriveAndFolder("I:", "\\Z02APPVSC01\User Share", "\" & pstrUserName) = False Then
pstrFailed = pstrFailed & "</p>" & "I:" & "\\Z02APPVSC01\User Share\" & pstrUserName & "\ Has NOT been mapped"
End If
'Modeless oIE, "VSC Logon Script is running, please wait...</p></p>Mapping " & "G:" & pcstrC3Server & pstrSpecialVolChar & "RAFACSII$\"
If fblnMapDriveAndFolder("G:", pcstrC3Server & pstrSpecialVolChar & "RAFACSII$", "") = False Then
pstrFailed = pstrFailed & "</p>" & "G:" & pcstrC3Server & pstrSpecialVolChar & "RAFACSII$\ Has NOT been mapped"
End If
'Modeless oIE, "VSC Logon Script is running, please wait...</p></p>Mapping " & "H:" & pcstrC3Server & pstrSpecialVolChar & "RAFACS$\"
If fblnMapDriveAndFolder("H:", pcstrC3Server & pstrSpecialVolChar & "RAFACS$", "") = False Then
pstrFailed = pstrFailed & "</p>" & "H:" & pcstrC3Server & pstrSpecialVolChar & "RAFACS$\ Has NOT been mapped"
End If
if InStr(pstrGroups, "VSC USERS - CIS") then
'Modeless oIE, "VSC Logon Script is running, please wait...</p></p>Mapping " & "J:\\Z02RSCVSC04\NOVAShare\MIS\LOCAL"
If fblnMapDriveAndFolder("J:", "\\Z02RSCVSC04\NOVAShare\MIS\LOCAL", "") = False Then
pstrFailed = pstrFailed & "</p>" & "J:" & "\\Z02RSCVSC04\NOVAShare\MIS\LOCAL Has NOT been mapped"
End If
end if
'Modeless oIE, "VSC Logon Script is running, please wait...</p></p>Mapping " & "K:\\Z02APPVSC01\PUBARC\"
q If fblnMapDriveAndFolder("K:", "\\Z02APPVSC01\PUBARC", "") = False Then
pstrFailed = pstrFailed & "</p>" & "K:" & "\\Z02APPVSC01\PUBARC\ Has NOT been mapped"
End If
if InStr(pstrGroups, "VSC USERS - CIS") then
'Modeless oIE, "VSC Logon Script is running, please wait...</p></p>Mapping " & "L:\\Z02RSCVSC04\APPLShare\"
If fblnMapDriveAndFolder("L:", "\\Z02RSCVSC04\APPLShare\", "") = False Then
pstrFailed = pstrFailed & "</p>" & "L:" & "\\Z02RSCVSC04\APPLShare\ Has NOT been mapped"
End If
end if
' if InStr(pstrGroups, "VSC C3 Service Accounts") then
' Modeless oIE, "VSC Logon Script is running, please wait...</p></p>Mapping " & "L:\\Z02RSCVSC04\APPLShare\"
' If fblnMapDriveAndFolder("L:", "\\Z02RSCVSC04\APPLShare\", "") = False Then
' pstrFailed = pstrFailed & "</p>" & "L:" & "\\Z02RSCVSC04\APPLShare\ Has NOT been mapped"
' End If
' end if
'Modeless oIE, "VSC Logon Script is running, please wait...</p></p>Mapping " & "M:" & pcstrC3Server & pstrSpecialVolChar & "IMROOT$\"
If fblnMapDriveAndFolder("M:", pcstrC3Server & pstrSpecialVolChar & "IMROOT$", "") = False Then
pstrFailed = pstrFailed & "</p>" & "M:" & pcstrC3Server & pstrSpecialVolChar & "IMROOT$\ Has NOT been mapped"
End If
'
'Sets up mappings for Supervisory share - \\Z02RSCVSC04\MGMTShare - Added by Rene 12/19/2006
'
if InStr(pstrGroups, "VSC _ADJUDICATIONS_MGMT_ZEN - CIS") then
'Modeless oIE, "VSC Logon Script is running, please wait...</p></p>Mapping " & "N:\\Z02RSCVSC04\SUPVShare\"
If fblnMapDriveAndFolder("N:", "\\Z02RSCVSC04\SUPVShare", "") = False Then
pstrFailed = pstrFailed & "</p>" & "N:" & "\\Z02RSCVSC04\SUPVShare\ Has NOT been mapped"
End If
end if
if InStr(pstrGroups, "VSC _SIIO_ZEN - CIS") then
'Modeless oIE, "VSC Logon Script is running, please wait...</p></p>Mapping " & "N:\\Z02RSCVSC04\SUPVShare\"
If fblnMapDriveAndFolder("N:", "\\Z02RSCVSC04\SUPVShare", "") = False Then
pstrFailed = pstrFailed & "</p>" & "N:" & "\\Z02RSCVSC04\SUPVShare\ Has NOT been mapped"
End If
end if
if InStr(pstrGroups, "VSC _N_DRIVE - CIS") then
'Modeless oIE, "VSC Logon Script is running, please wait...</p></p>Mapping " & "N:\\Z02RSCVSC04\SUPVShare\"
If fblnMapDriveAndFolder("N:", "\\Z02RSCVSC04\SUPVShare", "") = False Then
pstrFailed = pstrFailed & "</p>" & "N:" & "\\Z02RSCVSC04\SUPVShare\ Has NOT been mapped"
End If
end if
'
'End of Supervisory share mappings
'
'Modeless oIE, "VSC Logon Script is running, please wait...</p></p>Mapping " & "Checking to see if using Citrix"
if fblnCitrix = false then
'Modeless oIE, "VSC Logon Script is running, please wait...</p></p>Mapping P:\\Z02C4CVSC01\DocProd"
If fblnMapDriveAndFolder("P:", "\\Z02C4CVSC01\DocProd", "") = False Then
pstrFailed = pstrFailed & "</p>" & "P:\\Z02C4CVSC01\DocProd Has NOT been mapped"
End If
end if
'Modeless oIE, "VSC Logon Script is running, please wait...</p></p>Setting the PATH variable"
if fblnSetUserEnvVar("PATH",pcstrPath,True) = false then
pstrFailed = pstrFailed & "</p>" & "Could not set the Path environment variable to: " & "</p>" & pcstrPath
end if
if pstrFailed <> "" then
'Modeless oIE, " The following Errors Occured:" & pstrFailed
call pause(10) 'pause for 5 seconds
end if
'Determines whether the drive is already mapped
' If it is mapped to the wrong location this function will map it to
' the correct one
' else if drive doesn't exist then
' map it
' Yuppers Get 'R Done
Function fblnMapDriveAndFolder(strDriveLetter,strServerName, strPath)
On Error resume next
fblnMapDriveAndFolder = True
Dim pobjFsys
Set pobjFsys = CreateObject("Scripting.FileSystemObject")
'correction for wrong slash
strServerName = Replace(strServerName, "/", "\")
strPath = Replace(strPath, "/", "\")
'Below will put a "\\" on the front of the server name if it doesn't exist
If Left(strServerName, 2) <> "\\" Then
strServerName = "\\" & strServerName
End If
'Below will put take the "\" off of the end of the server name if it exists
If Right(strServerName, 1) = "\" Then
strServerName = Left(strServerName, Len(strServerName) - 1)
End If
'Below will put a "\" on the front of the path name if it doesn't exist
If Left(strPath, 1) <> "\" And strPath <> "" Then
strPath = "\" & strPath
End If
'Below will put a ":" on the end of the strDriveLetter if it doesn't exist
If Right(strDriveLetter, 1) <> ":" Then
strDriveLetter = Left(strDriveLetter, 1) & ":"
End If
If pobjFsys.FolderExists(strServerName & strPath) = False Then
'Create the folder because it doesn't exist
pobjFsys.CreateFolder strServerName & strPath & "\"
End If
'Check to see if the drive is already mapped
If pobjFsys.DriveExists(strDriveLetter) = True Then
'Check to see if the drive letter is mapped to the correct folder
If pobjFsys.FolderExists(strDriveLetter & strPath) = False Or strPath = "" Then 'The drive is mapped to the wrong location
'Map over the existing drive with the correct path
If fblnMapDrive(strDriveLetter, strServerName, strPath, True) = False Then
fblnMapDriveAndFolder = false
End If
End If
Else 'The drive doesn't exist
'Map the drive
If fblnMapDrive(strDriveLetter, strServerName, strPath, False) = False Then
fblnMapDriveAndFolder = false
End If
End If
Set pobjFsys = Nothing
If Err.Number <> 0 Then
err.clear
fblnMapDriveAndFolder = False
End If
End Function
Function fblnMapDrive(strDriveLetter, strServer, strFolderPath, blnRemoveFirst)' As Boolean
On Error resume next
fblnMapDrive = True
Dim objNetwork
' Purpose of script to create a network object. (objNetwork)
' Then to apply the MapNetworkDrive method.
Set objNetwork = CreateObject("WScript.Network")
If blnRemoveFirst = True Then
objNetwork.RemoveNetworkDrive strDriveLetter, True, True
End If
objNetwork.MapNetworkDrive strDriveLetter, strServer & strFolderPath, True
If Err.Number <> 0 Then
fblnMapDrive = False
End If
End Function
function fblnSetUserEnvVar(strVariable, strValue, blnConcat)
on Error resume next
dim wshShell, pobjEnv
fblnSetUserEnvVar = true
set WshShell = CreateObject("WScript.Shell")
Set pobjEnv = WshShell.Environment("User")
if blnConcat = true then
pobjEnv(strVariable) = pobjEnv(strVariable) & strValue
else
pobjEnv(strVariable) = strValue
end if
if err.number <> 0 then
fblnSetUserEnvVar = false
err.clear
end if
end function
Function fblnCitrix()
Dim strComputer
Dim objWMIService
Dim clSettings
Dim objRecord
fblnCitrix = true
on error resume next
strComputer = "."
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" _
& strComputer & "\root\cimv2")
Set clSettings = objWMIService.ExecQuery("Select * from Win32_OperatingSystem")
fblnCitrix = false
For Each objRecord In clSettings
if objRecord.WindowsDirectory <> "" then
if left(objRecord.WindowsDirectory,2) = "P:" then
fblnCitrix = true
exit for
end if
end if
Next
if err.number <> 0 then
msgbox err.description, "fblnCitrix",vbcritical
end if
Set objWMIService = Nothing
Set clSettings = Nothing
End Function
'This function will return the specified property
Function fstrGetUserProperty(strProperty)
On Error resume next
Dim pstrConnect, pstrVal
Dim pobjUser 'As ActiveDs.IADsUser
pstrConnect = fstrADSpath
Set pobjUser = GetObject(pstrConnect)
pstrVal = pobjUser.Get(strProperty)
if isArray(pstrVal) = true then
fstrGetUserProperty = join(pstrVal)
else
fstrGetUserProperty = pstrVal
end if
If Err.Number <> 0 Then
MsgBox Err.Description, vbCritical
End If
Set pobjUser = Nothing
End Function
'Gets the local Active Directory information
' Used to obtain the string to connect the user's AD object
Function fstrADSpath() 'As String
Dim pobjAdSysInfo 'As ActiveDs.ADSystemInfo
'Set pobjAdSysInfo = New ActiveDs.ADSystemInfo
Set pobjAdSysInfo = CreateObject("AdSystemInfo")
fstrADSpath = "LDAP://" & pobjAdSysInfo.UserName
Set pobjAdSysInfo = Nothing
End Function
function fblnSetUserEnvVar(strVariable, strValue, blnConcat)
on Error resume next
dim wshShell, pobjEnv
fblnSetUserEnvVar = true
set WshShell = CreateObject("WScript.Shell")
Set pobjEnv = WshShell.Environment("User")
if blnConcat = true then
if instr(1,ucase(pobjEnv(strVariable)),ucase(strValue)) <= 0 then
pobjEnv(strVariable) = pobjEnv(strVariable) & strValue
end if
else
pobjEnv(strVariable) = strValue
end if
if err.number <> 0 then
fblnSetUserEnvVar = false
err.clear
end if
end function
'Close the Splash Screen
objExplorer.quit
'******************************************************************************
' This will pause the number of seconds passed to it
'******************************************************************************
Sub pause(seconds)
Dim strTime
strTime = (second(Time) + seconds)
If (strTime >= 60) Then
strTime = (strTime - 60)
End If
Do Until (strTime = (second(Time)))
Loop
End Sub
REM 'Routine for Splash Screen
REM Sub modeless(oIE, sprompt)
REM with oIE
REM .fullscreen = True : .navigate "about:blank"
REM While .readystate <> 4 : wscript.sleep 100 : Wend
REM with .document
REM .write "<table bgcolor=lightblue border=3 width=100% bordercolor=black cellspacing=6 cellpadding=6" & _
REM "height=100%><tr valign=middle><td align=center> " & _
REM "<caption align=center><font size=20><b><i> Mapping Network Drives.... </b></i></font></caption> " & _
REM "<tr> " & _
REM "<th><font size=18 color=black><u>Network Drive:</u></font></th> " & _
REM "<th><font size=18 color=black><u>Connected:</u></font></th> " & _
REM "<tr> " & _
REM "<td align=left><font size=10 color=black>(G:) Rafacsii$ on 'Z02dbcvsc01'</font></td> " & _
REM "<td align=center></td> " & _
REM "<tr> " & _
REM "<td align=left><font size=10 color=black>(H:) Rafacs$ on ' Z02dbcvsc01'</font></td> " & _
REM "<td align=center></td> " & _
REM "<tr> " & _
REM "<td align=left><font size=10 color=black>(I:) User on 'Z02rscvsc07\User Share' </font></td> " & _
REM "<td align=center></td> " & _
REM "<tr> " & _
REM "<td align=left><font size=10 color=black>(J:) Local on 'Z02rscvsc07\NOVAShare\Mis' </font></td> " & _
REM "<td align=center></td> " & _
REM "<tr> " & _
REM "<td align=left><font size=10 color=black>(K:) Pubarc on 'Z02rscvsc07' </font></td> " & _
REM "<td align=center></td> " & _
REM "<tr> " & _
REM "<td align=left><font size=10 color=black>(L:) APPLShare on 'Z02rscvsc07' </font></td> " & _
REM "<td align=center></td> " & _
REM "<tr> " & _
REM "<td align=left><font size=10 color=black>(M:) Imroot$ on 'Z02dbcvsc01' </font></td> " & _
REM "<td align=center></td> " & _
REM "<tr> " & _
REM "<td align=left><font size=10 color=black>(O:) itsopshre on 'Z02rscvsc07' </font></td> " & _
REM "<td align=center></td> " & _
REM "<tr> " & _
REM "<td align=Left><font size=10 color=black>(P:) DocProd on 'Z02c4cvsc01' </font></td> " & _
REM "<td align=center></td> " & _
REM "<tr> " & _
REM "<td align=Left><font size=10 color=black>(Q:) PrintShare on 'Z02TBCVSC02(Z02tbcvsc02)' </font></td> " & _
REM "<td align=center></td> " & _
REM "<tr> " & _
REM "</font></td></tr></table>"
REM .title = "MESSAGE: _________________________________"
REM 'With .ParentWindow
REM ' .resizeto 350,100 1
REM ' .moveto (.screen.width - 400)\2, (.screen.height - 100)\2
REM 'End With
REM With .body.style
REM .borderStyle = "outset"
REM .borderWidth = "4px"
REM End With
REM .bgcolor = "white"
REM .body.scroll = "NO"
REM End With
REM .visible = true
REM End with
REM End Sub
Question
mtber
I have a script that maps network drives but i would like to create a way to display the realtime status of those drive for instance if the drive is connected then a cell in the table that displays all of the drives would turn green and if the drive was not connected then it will turn red. i am fairly new to VBS.
Option Explicit const pcstrPath = ";G:\SYSINFO;F:\Public" const pcstrC3Server = "\\Z02DBCVSC01\" dim objExplorer, HTML 'set oIE = CreateObject("InternetExplorer.Application") 'Modeless oIE, "VSC Logon Script is running, please wait..." On Error Resume Next Set objExplorer = CreateObject ("InternetExplorer.Application") objExplorer.Navigate "about:blank" objExplorer.ToolBar = 0 objExplorer.StatusBar = 0 objExplorer.Fullscreen = 1 objExplorer.Left = 0 objExplorer.Top = 0 'objExplorer.Width = 800 'objExplorer.Height = 600 objExplorer.Visible = 1 objExplorer.Document.Body.Style.Cursor = "wait" Dim objDocument:Set objDocument = objExplorer.Document objDocument.Open objDocument.Writeln "<HEAD></HEAD><TITLE>Logon Script Progress</TITLE>" objDocument.Writeln "<Body BGColor=white SCROLL=YES>" objDocument.Writeln "</BODY>" '###Write to the IE Object objExplorer.Document.Body.InnerHTML="<html><tablelor=lightblue border=3 width=100% bordercolor=black cellspacing=6 cellpadding=6" & _ "height=100%><tr valign=middle><td align=center> " & _ "<caption align=center><font size=20><b><i> Mapping Network Drives.... </b></i></font></caption> " & _ "<tr> " & _ "<th><font size=18 color=black><u>Network Drive:</u></font></th> " & _ "<th><font size=18 color=black><u>Connected:</u></font></th> " & _ "<tr> " & _ "<td align=left><font size=10 color=black>(G:) Rafacsii$ on 'Z02dbcvsc01'</font></td> " & _ "<td align=center></td> " & _ "<tr> " & _ "<td align=left><font size=10 color=black>(H:) Rafacs$ on ' Z02dbcvsc01'</font></td> " & _ "<td align=center></td> " & _ "<tr> " & _ "<td align=left><font size=10 color=black>(I:) User on 'Z02rscvsc07\User Share' </font></td> " & _ "<td align=center></td> " & _ "<tr> " & _ "<td align=left><font size=10 color=black>(J:) Local on 'Z02rscvsc07\NOVAShare\Mis' </font></td> " & _ "<td align=center></td> " & _ "<tr> " & _ "<td align=left><font size=10 color=black>(K:) Pubarc on 'Z02rscvsc07' </font></td> " & _ "<td align=center></td> " & _ "<tr> " & _ "<td align=left><font size=10 color=black>(L:) APPLShare on 'Z02rscvsc07' </font></td> " & _ "<td align=center></td> " & _ "<tr> " & _ "<td align=left><font size=10 color=black>(M:) Imroot$ on 'Z02dbcvsc01' </font></td> " & _ "<td align=center></td> " & _ "<tr> " & _ "<td align=left><font size=10 color=black>(O:) itsopshre on 'Z02rscvsc07' </font></td> " & _ "<td align=center></td> " & _ "<tr> " & _ "<td align=Left><font size=10 color=black>(P:) DocProd on 'Z02c4cvsc01' </font></td> " & _ "<td align=center></td> " & _ "<tr> " & _ "<td align=Left><font size=10 color=black>(Q:) PrintShare on 'Z02TBCVSC02(Z02tbcvsc02)' </font></td> " & _ "<td align=center></td> " & _ "<tr> " & _ "</font></td></tr></table>" objDocument.Close Dim pstrUserName,pstrGroups,pstrFailed,pstrSpecialVolChar 'Modeless oIE, "VSC Logon Script is running, please wait...</p></p> getting User Name" pstrUserName = fstrGetUserProperty("samAccountName") 'Modeless oIE, "VSC Logon Script is running, please wait...</p></p> getting group membership" pstrGroups = ucase(fstrGetUserProperty("MemberOf")) if InStr(pstrGroups, "VSC C3 SERVICE ACCOUNTS") then pstrSpecialVolChar = "Z" end if If fblnMapDriveAndFolder("I:", "\\Z02APPVSC01\User Share", "\" & pstrUserName) = False Then pstrFailed = pstrFailed & "</p>" & "I:" & "\\Z02APPVSC01\User Share\" & pstrUserName & "\ Has NOT been mapped" End If 'Modeless oIE, "VSC Logon Script is running, please wait...</p></p>Mapping " & "G:" & pcstrC3Server & pstrSpecialVolChar & "RAFACSII$\" If fblnMapDriveAndFolder("G:", pcstrC3Server & pstrSpecialVolChar & "RAFACSII$", "") = False Then pstrFailed = pstrFailed & "</p>" & "G:" & pcstrC3Server & pstrSpecialVolChar & "RAFACSII$\ Has NOT been mapped" End If 'Modeless oIE, "VSC Logon Script is running, please wait...</p></p>Mapping " & "H:" & pcstrC3Server & pstrSpecialVolChar & "RAFACS$\" If fblnMapDriveAndFolder("H:", pcstrC3Server & pstrSpecialVolChar & "RAFACS$", "") = False Then pstrFailed = pstrFailed & "</p>" & "H:" & pcstrC3Server & pstrSpecialVolChar & "RAFACS$\ Has NOT been mapped" End If if InStr(pstrGroups, "VSC USERS - CIS") then 'Modeless oIE, "VSC Logon Script is running, please wait...</p></p>Mapping " & "J:\\Z02RSCVSC04\NOVAShare\MIS\LOCAL" If fblnMapDriveAndFolder("J:", "\\Z02RSCVSC04\NOVAShare\MIS\LOCAL", "") = False Then pstrFailed = pstrFailed & "</p>" & "J:" & "\\Z02RSCVSC04\NOVAShare\MIS\LOCAL Has NOT been mapped" End If end if 'Modeless oIE, "VSC Logon Script is running, please wait...</p></p>Mapping " & "K:\\Z02APPVSC01\PUBARC\" q If fblnMapDriveAndFolder("K:", "\\Z02APPVSC01\PUBARC", "") = False Then pstrFailed = pstrFailed & "</p>" & "K:" & "\\Z02APPVSC01\PUBARC\ Has NOT been mapped" End If if InStr(pstrGroups, "VSC USERS - CIS") then 'Modeless oIE, "VSC Logon Script is running, please wait...</p></p>Mapping " & "L:\\Z02RSCVSC04\APPLShare\" If fblnMapDriveAndFolder("L:", "\\Z02RSCVSC04\APPLShare\", "") = False Then pstrFailed = pstrFailed & "</p>" & "L:" & "\\Z02RSCVSC04\APPLShare\ Has NOT been mapped" End If end if ' if InStr(pstrGroups, "VSC C3 Service Accounts") then ' Modeless oIE, "VSC Logon Script is running, please wait...</p></p>Mapping " & "L:\\Z02RSCVSC04\APPLShare\" ' If fblnMapDriveAndFolder("L:", "\\Z02RSCVSC04\APPLShare\", "") = False Then ' pstrFailed = pstrFailed & "</p>" & "L:" & "\\Z02RSCVSC04\APPLShare\ Has NOT been mapped" ' End If ' end if 'Modeless oIE, "VSC Logon Script is running, please wait...</p></p>Mapping " & "M:" & pcstrC3Server & pstrSpecialVolChar & "IMROOT$\" If fblnMapDriveAndFolder("M:", pcstrC3Server & pstrSpecialVolChar & "IMROOT$", "") = False Then pstrFailed = pstrFailed & "</p>" & "M:" & pcstrC3Server & pstrSpecialVolChar & "IMROOT$\ Has NOT been mapped" End If ' 'Sets up mappings for Supervisory share - \\Z02RSCVSC04\MGMTShare - Added by Rene 12/19/2006 ' if InStr(pstrGroups, "VSC _ADJUDICATIONS_MGMT_ZEN - CIS") then 'Modeless oIE, "VSC Logon Script is running, please wait...</p></p>Mapping " & "N:\\Z02RSCVSC04\SUPVShare\" If fblnMapDriveAndFolder("N:", "\\Z02RSCVSC04\SUPVShare", "") = False Then pstrFailed = pstrFailed & "</p>" & "N:" & "\\Z02RSCVSC04\SUPVShare\ Has NOT been mapped" End If end if if InStr(pstrGroups, "VSC _SIIO_ZEN - CIS") then 'Modeless oIE, "VSC Logon Script is running, please wait...</p></p>Mapping " & "N:\\Z02RSCVSC04\SUPVShare\" If fblnMapDriveAndFolder("N:", "\\Z02RSCVSC04\SUPVShare", "") = False Then pstrFailed = pstrFailed & "</p>" & "N:" & "\\Z02RSCVSC04\SUPVShare\ Has NOT been mapped" End If end if if InStr(pstrGroups, "VSC _N_DRIVE - CIS") then 'Modeless oIE, "VSC Logon Script is running, please wait...</p></p>Mapping " & "N:\\Z02RSCVSC04\SUPVShare\" If fblnMapDriveAndFolder("N:", "\\Z02RSCVSC04\SUPVShare", "") = False Then pstrFailed = pstrFailed & "</p>" & "N:" & "\\Z02RSCVSC04\SUPVShare\ Has NOT been mapped" End If end if ' 'End of Supervisory share mappings ' 'Modeless oIE, "VSC Logon Script is running, please wait...</p></p>Mapping " & "Checking to see if using Citrix" if fblnCitrix = false then 'Modeless oIE, "VSC Logon Script is running, please wait...</p></p>Mapping P:\\Z02C4CVSC01\DocProd" If fblnMapDriveAndFolder("P:", "\\Z02C4CVSC01\DocProd", "") = False Then pstrFailed = pstrFailed & "</p>" & "P:\\Z02C4CVSC01\DocProd Has NOT been mapped" End If end if 'Modeless oIE, "VSC Logon Script is running, please wait...</p></p>Setting the PATH variable" if fblnSetUserEnvVar("PATH",pcstrPath,True) = false then pstrFailed = pstrFailed & "</p>" & "Could not set the Path environment variable to: " & "</p>" & pcstrPath end if if pstrFailed <> "" then 'Modeless oIE, " The following Errors Occured:" & pstrFailed call pause(10) 'pause for 5 seconds end if 'Determines whether the drive is already mapped ' If it is mapped to the wrong location this function will map it to ' the correct one ' else if drive doesn't exist then ' map it ' Yuppers Get 'R Done Function fblnMapDriveAndFolder(strDriveLetter,strServerName, strPath) On Error resume next fblnMapDriveAndFolder = True Dim pobjFsys Set pobjFsys = CreateObject("Scripting.FileSystemObject") 'correction for wrong slash strServerName = Replace(strServerName, "/", "\") strPath = Replace(strPath, "/", "\") 'Below will put a "\\" on the front of the server name if it doesn't exist If Left(strServerName, 2) <> "\\" Then strServerName = "\\" & strServerName End If 'Below will put take the "\" off of the end of the server name if it exists If Right(strServerName, 1) = "\" Then strServerName = Left(strServerName, Len(strServerName) - 1) End If 'Below will put a "\" on the front of the path name if it doesn't exist If Left(strPath, 1) <> "\" And strPath <> "" Then strPath = "\" & strPath End If 'Below will put a ":" on the end of the strDriveLetter if it doesn't exist If Right(strDriveLetter, 1) <> ":" Then strDriveLetter = Left(strDriveLetter, 1) & ":" End If If pobjFsys.FolderExists(strServerName & strPath) = False Then 'Create the folder because it doesn't exist pobjFsys.CreateFolder strServerName & strPath & "\" End If 'Check to see if the drive is already mapped If pobjFsys.DriveExists(strDriveLetter) = True Then 'Check to see if the drive letter is mapped to the correct folder If pobjFsys.FolderExists(strDriveLetter & strPath) = False Or strPath = "" Then 'The drive is mapped to the wrong location 'Map over the existing drive with the correct path If fblnMapDrive(strDriveLetter, strServerName, strPath, True) = False Then fblnMapDriveAndFolder = false End If End If Else 'The drive doesn't exist 'Map the drive If fblnMapDrive(strDriveLetter, strServerName, strPath, False) = False Then fblnMapDriveAndFolder = false End If End If Set pobjFsys = Nothing If Err.Number <> 0 Then err.clear fblnMapDriveAndFolder = False End If End Function Function fblnMapDrive(strDriveLetter, strServer, strFolderPath, blnRemoveFirst)' As Boolean On Error resume next fblnMapDrive = True Dim objNetwork ' Purpose of script to create a network object. (objNetwork) ' Then to apply the MapNetworkDrive method. Set objNetwork = CreateObject("WScript.Network") If blnRemoveFirst = True Then objNetwork.RemoveNetworkDrive strDriveLetter, True, True End If objNetwork.MapNetworkDrive strDriveLetter, strServer & strFolderPath, True If Err.Number <> 0 Then fblnMapDrive = False End If End Function function fblnSetUserEnvVar(strVariable, strValue, blnConcat) on Error resume next dim wshShell, pobjEnv fblnSetUserEnvVar = true set WshShell = CreateObject("WScript.Shell") Set pobjEnv = WshShell.Environment("User") if blnConcat = true then pobjEnv(strVariable) = pobjEnv(strVariable) & strValue else pobjEnv(strVariable) = strValue end if if err.number <> 0 then fblnSetUserEnvVar = false err.clear end if end function Function fblnCitrix() Dim strComputer Dim objWMIService Dim clSettings Dim objRecord fblnCitrix = true on error resume next strComputer = "." Set objWMIService = GetObject("winmgmts:" _ & "{impersonationLevel=impersonate}!\\" _ & strComputer & "\root\cimv2") Set clSettings = objWMIService.ExecQuery("Select * from Win32_OperatingSystem") fblnCitrix = false For Each objRecord In clSettings if objRecord.WindowsDirectory <> "" then if left(objRecord.WindowsDirectory,2) = "P:" then fblnCitrix = true exit for end if end if Next if err.number <> 0 then msgbox err.description, "fblnCitrix",vbcritical end if Set objWMIService = Nothing Set clSettings = Nothing End Function 'This function will return the specified property Function fstrGetUserProperty(strProperty) On Error resume next Dim pstrConnect, pstrVal Dim pobjUser 'As ActiveDs.IADsUser pstrConnect = fstrADSpath Set pobjUser = GetObject(pstrConnect) pstrVal = pobjUser.Get(strProperty) if isArray(pstrVal) = true then fstrGetUserProperty = join(pstrVal) else fstrGetUserProperty = pstrVal end if If Err.Number <> 0 Then MsgBox Err.Description, vbCritical End If Set pobjUser = Nothing End Function 'Gets the local Active Directory information ' Used to obtain the string to connect the user's AD object Function fstrADSpath() 'As String Dim pobjAdSysInfo 'As ActiveDs.ADSystemInfo 'Set pobjAdSysInfo = New ActiveDs.ADSystemInfo Set pobjAdSysInfo = CreateObject("AdSystemInfo") fstrADSpath = "LDAP://" & pobjAdSysInfo.UserName Set pobjAdSysInfo = Nothing End Function function fblnSetUserEnvVar(strVariable, strValue, blnConcat) on Error resume next dim wshShell, pobjEnv fblnSetUserEnvVar = true set WshShell = CreateObject("WScript.Shell") Set pobjEnv = WshShell.Environment("User") if blnConcat = true then if instr(1,ucase(pobjEnv(strVariable)),ucase(strValue)) <= 0 then pobjEnv(strVariable) = pobjEnv(strVariable) & strValue end if else pobjEnv(strVariable) = strValue end if if err.number <> 0 then fblnSetUserEnvVar = false err.clear end if end function 'Close the Splash Screen objExplorer.quit '****************************************************************************** ' This will pause the number of seconds passed to it '****************************************************************************** Sub pause(seconds) Dim strTime strTime = (second(Time) + seconds) If (strTime >= 60) Then strTime = (strTime - 60) End If Do Until (strTime = (second(Time))) Loop End Sub REM 'Routine for Splash Screen REM Sub modeless(oIE, sprompt) REM with oIE REM .fullscreen = True : .navigate "about:blank" REM While .readystate <> 4 : wscript.sleep 100 : Wend REM with .document REM .write "<table bgcolor=lightblue border=3 width=100% bordercolor=black cellspacing=6 cellpadding=6" & _ REM "height=100%><tr valign=middle><td align=center> " & _ REM "<caption align=center><font size=20><b><i> Mapping Network Drives.... </b></i></font></caption> " & _ REM "<tr> " & _ REM "<th><font size=18 color=black><u>Network Drive:</u></font></th> " & _ REM "<th><font size=18 color=black><u>Connected:</u></font></th> " & _ REM "<tr> " & _ REM "<td align=left><font size=10 color=black>(G:) Rafacsii$ on 'Z02dbcvsc01'</font></td> " & _ REM "<td align=center></td> " & _ REM "<tr> " & _ REM "<td align=left><font size=10 color=black>(H:) Rafacs$ on ' Z02dbcvsc01'</font></td> " & _ REM "<td align=center></td> " & _ REM "<tr> " & _ REM "<td align=left><font size=10 color=black>(I:) User on 'Z02rscvsc07\User Share' </font></td> " & _ REM "<td align=center></td> " & _ REM "<tr> " & _ REM "<td align=left><font size=10 color=black>(J:) Local on 'Z02rscvsc07\NOVAShare\Mis' </font></td> " & _ REM "<td align=center></td> " & _ REM "<tr> " & _ REM "<td align=left><font size=10 color=black>(K:) Pubarc on 'Z02rscvsc07' </font></td> " & _ REM "<td align=center></td> " & _ REM "<tr> " & _ REM "<td align=left><font size=10 color=black>(L:) APPLShare on 'Z02rscvsc07' </font></td> " & _ REM "<td align=center></td> " & _ REM "<tr> " & _ REM "<td align=left><font size=10 color=black>(M:) Imroot$ on 'Z02dbcvsc01' </font></td> " & _ REM "<td align=center></td> " & _ REM "<tr> " & _ REM "<td align=left><font size=10 color=black>(O:) itsopshre on 'Z02rscvsc07' </font></td> " & _ REM "<td align=center></td> " & _ REM "<tr> " & _ REM "<td align=Left><font size=10 color=black>(P:) DocProd on 'Z02c4cvsc01' </font></td> " & _ REM "<td align=center></td> " & _ REM "<tr> " & _ REM "<td align=Left><font size=10 color=black>(Q:) PrintShare on 'Z02TBCVSC02(Z02tbcvsc02)' </font></td> " & _ REM "<td align=center></td> " & _ REM "<tr> " & _ REM "</font></td></tr></table>" REM .title = "MESSAGE: _________________________________" REM 'With .ParentWindow REM ' .resizeto 350,100 1 REM ' .moveto (.screen.width - 400)\2, (.screen.height - 100)\2 REM 'End With REM With .body.style REM .borderStyle = "outset" REM .borderWidth = "4px" REM End With REM .bgcolor = "white" REM .body.scroll = "NO" REM End With REM .visible = true REM End with REM End SubLink to comment
https://www.neowin.net/forum/topic/577892-vbs-how-to-get-realtime-status-of-network-drives/Share on other sites
0 answers to this question
Recommended Posts