Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

Register Log in
  • Congratulations Chriss Miller on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Hta message boc when reach end of line

Status
Not open for further replies.
DvZ73

DvZ73

IS-IT--Management
Joined
Nov 3, 2013
Messages
16
Location
NL
Hi all,

i have the following sub in a hta :

strgroup = Groups.Value
strText = serverTextArea.Value
arrLines = Split(strText, vbCrLf)
For Each strserver in arrLines
If strserver = <> Then
strPingStatus = PingStatus(strserver)
If strPingStatus = "Success" Then
checkshare strserver, strgroup
Else
MsgBox " server: " & strserver & " is not online or does not exist, rerun script with the correct servername script will continu with next server"
On Error Resume Next
end If
End If
next


What i can't get working is then the strserver has no value that it display's a messagebox that everthing is finished
if i add the following line it's not working
if strserver = "" then msgbox finsished" any one an idea ?

thx
 
Sort by date Sort by votes
Hi [peace]
Can you post your hole HTA ?
Thank you !
 
Upvote 0 Downvote
Also, are you sure your data is correct and [tt]arrLines[/tt] is populated? Put a msgbox just after the split to verify.

Code: 
arrLines = Split(strText, vbCrLf)
msgbox ubound(arrLines)

If the msgbox reads "-1" then you know [tt]arrLines[/tt] is empty and you need to look at the line before to see what [tt]strText[/tt] equals...

Code: 
strText = serverTextArea.Value
msgbox "strText: " & strText

-Geates

 
Upvote 0 Downvote
I made a typo, ofcourse the line needs to be If strserver <> Then

if i fill the textboc with 5 servers it return 0 if i add this
msgbox ubound(arrLines)
arrlines is populated as the complete thing works except it doesn't give a message when all complete

what i want to happen is if the last server is done that it gives a message box that it is ready
with all servers
i can make it work tha tit gives a message box after each server but that isn't what i need

thx
for the help so far

 
Upvote 0 Downvote
I made a typo, ofcourse the line needs to be If strserver <> Then
Click to expand...
Another typo?

What is [tt]textboc[/tt]? If the msgbox ubound(arrLines) is returning 0, that means that the array has 1 index with the value equal to [tt]strText[/tt]. However, because you say "arrlines is populated as the complete thing works except it doesn't give a message when all complete", let's address that.

Because [tt]strServer[/tt] is defined in the FOR EACH scope, it is not accessible outside the FOR EACH so [tt]strServer[/tt] is always going to be blank.

Example:
Code: 
arrLines = split("a,b,c", ",")
for each txt in arrLines
   msgbox "inside: " & txt
next
msgbox "outside: " & txt

Gather the status of each server and show them at the end
Code: 
strgroup = Groups.Value
strText = serverTextArea.Value
arrLines = Split(strText, vbCrLf)
For Each strserver in arrLines
   If strserver <> "" Then
      strPingStatus = PingStatus(strserver)
      If strPingStatus = "Success" Then
         checkshare strserver, strgroup
         strStatus = "online"
      Else
         strStatus = "offline"
      End IF
      [s]On Error Resume Next[/s]
   End If
   strAllStatuses = strAllStatus & strServer & ": " & strStatus & vbNewLine
next 

msgbox strAllStatuses

Is this the type of behavior you are after?

-Geates

PS. [tt]On Error Resume Next [/tt] hides all errors and can make troubleshooting a complete nightmare. Avoid using it.


 
Upvote 0 Downvote
Geates what you say isn't working as it isn't the complete script
i'll post the complete source the textfile grous.txt has the security groups per line
it's a bit messy but it works except for the complete status issue

<html>
<HTA:APPLICATION
APPLICATIONNAME="create Tam Share "
SCROLL="no"
SINGLEINSTANCE="yes"

<head>
<title>Create /add Tam group to D share of server</title>
<!-- <style type="text/css">
.style3 {font-size: 13px}
body,td,th {
font-family: Arial, Helvetica, sans-serif;
}
.style2 { font-family: Arial, Helvetica, sans-serif;
font-size: 13.5pt;
color: #CC6600;
font-weight: bold;
}
.style5 {font-size: small; color: #FF0000; }
.style6 {color: #FF0000}
div
{
text-align: center;
}?
</style> -->

<SCRIPT LANGUAGE="VBScript">

Sub Window_onLoad
intWidth = 450
intHeight = 435
Me.ResizeTo intWidth, intHeight
Me.MoveTo ((Screen.Width / 2) - (intWidth / 2)),((Screen.Height / 2) - (intHeight / 2))
window.resizeTo 450,435
Set objShell = CreateObject("WScript.Shell")
objShell.RegWrite "HKCU\Software\Microsoft\Windows\CurrentVersion\Internet Settings\Zones\1\1406", 0, "REG_DWORD"
LoadDropDown
End Sub

</SCRIPT>

<script type="text/vbscript">
'read file with groups and text area with server names
Sub LoadDropDown
ForReading = 1
strNewFile = "Groups.txt"
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile _
(strNewFile, ForReading)
Do Until objFile.AtEndOfStream
strserver = objFile.ReadLine
Set objOption = Document.createElement("OPTION")
objOption.Text = strserver
objOption.Value = strserver
Groups.Add(objOption)
Loop
objFile.Close
End Sub

Sub filterserver 'filter out empty line and death server text area
strgroup = Groups.Value
strText = serverTextArea.Value
arrLines = Split(strText, vbCrLf)
For Each strserver in arrLines
If strserver <> "" Then
strPingStatus = PingStatus(strserver)
If strPingStatus = "Success" Then
checkshare strserver, strgroup
Else
MsgBox " server: " & strserver & " is not online or does not exist, rerun script with the correct servername script will continu with next server"
'On Error Resume Next
End If
End If
next
End Sub

Sub checkshare(strserver, strgroup) ' check if share exists
sShareName = "TAM-Share"
snode = strserver
If ExistShare(sNode, sShareName) Then
addshare strserver, strgroup, sShareName
Else
createshare strserver, strgroup, sShareName
End If
End Sub


Sub createshare(strserver, strgroup, sShareName) ' create share when not exist
Const FILE_SHARE = 0
Const MAXIMUM_CONNECTIONS = 25
Dim objWMIService
Dim objNewShare
Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & strserver & "\root\cimv2")
Set objNewShare = objWMIService.Get("Win32_Share")

Call setsharesec ("C:\", sShareName, sShareName,strgroup, strserver)
End Sub

Sub setsharesec(Fname,shr,info,strgroup,strserver) 'Fname = Folder path, shr = Share name, info = Share Description, account = account or group you are assigning share permissions to
Dim FSO
Dim Services
Dim SecDescClass
Dim SecDesc
Dim Trustee1
Dim ACE
Dim Share
Dim InParam
Dim Network
Dim FolderName
Dim AdminServer
Dim ShareName

FolderName = Fname
AdminServer = "\\" & strserver
ShareName = shr

Set Services = GetObject("WINMGMTS:{impersonationLevel=impersonate,(Security)}!" & AdminServer & "\ROOT\CIMV2")
Set SecDescClass = Services.Get("Win32_SecurityDescriptor")
Set SecDesc = SecDescClass.SpawnInstance_()
Set Trustee1 = SetgroupTrustee("paccar-eu", strgroup)
'To assign permissions to individual accounts use SetAccountTrustee rather than SetGroupTrustee

Set ACE = Services.Get("Win32_Ace").SpawnInstance_
ACE.Properties_.Item("AccessMask") = 1179817
ACE.Properties_.Item("AceFlags") = 3
ACE.Properties_.Item("AceType") = 0
ACE.Properties_.Item("Trustee") = Trustee1
SecDesc.Properties_.Item("DACL") = Array(ACE)
Set Share = Services.Get("Win32_Share")
Set InParam = Share.Methods_("Create").InParameters.SpawnInstance_()
InParam.Properties_.Item("Access") = SecDesc
InParam.Properties_.Item("Description") = Info
InParam.Properties_.Item("Name") = ShareName
InParam.Properties_.Item("Path") = FolderName
InParam.Properties_.Item("Type") = 0
Share.ExecMethod_ "Create", InParam
Setntfssec strserver, strgroup
End Sub

Sub addshare(strserver, strgroup, sShareName) ' add extra group to existing share
computer = strserver
username = strgroup
share = sShareName
domain = CreateObject("WScript.Network").UserDomain

' copy existing ACEs
Set objLocator = CreateObject("wbemscripting.swbemlocator")
Set wmi = objLocator.ConnectServer(Computer) 'THIS IS THE NAME OF THE COMPUTER YOU ARE SETTING PERMISSIONS ON
wmi.security_.impersonationlevel = 3
wmi.security_.privileges.AddAsString("SeSecurityPrivilege")
set shareSec = wmi.Get("Win32_LogicalShareSecuritySetting.Name='" & Share & "'")

rc = shareSec.GetSecurityDescriptor(sd)
flags = sd.ControlFlags
ReDim acl(UBound(sd.DACL)+1) '+1 for the new ACL we're going to add
For i = 0 To UBound(sd.DACL)
Set acl(i) = sd.DACL(i)
Next
Set sd = Nothing

' add new ACE

Set acl(UBound(acl)) = NewACE(NewTrustee(username, domain))
' prepare new security descriptor
Set sd = wmi.Get("Win32_SecurityDescriptor").SpawnInstance_
sd.ControlFlags = flags
sd.DACL = acl

' assign new security descriptor
rc = shareSec.SetSecurityDescriptor(sd)
Setntfssec strserver, strgroup
End sub 'shareadd

Function NewTrustee(name, domain)
Set objLocator = CreateObject("wbemscripting.swbemlocator")
Set wmi = objLocator.ConnectServer(Computer)
Dim trustee, account
Set trustee = wmi.Get("Win32_Trustee").SpawnInstance_
trustee.Name = name
trustee.Domain = domain
set account = getObject("Winmgmts:{impersonationlevel=impersonate}!root/cimv2:Win32_Account.Name='" & Name & "',Domain='" & Domain &"'")
trustee.Properties_.Item("SID") = wmi.Get("Win32_SID.SID='" & account.SID _
& "'").BinaryRepresentation

Set NewTrustee = trustee
End Function

Function NewACE(trustee)
Set objLocator = CreateObject("wbemscripting.swbemlocator")
Set wmi = objLocator.ConnectServer(Computer)
Dim ace1 : Set ace1 = wmi.Get("Win32_Ace").SpawnInstance_
ace1.Properties_.Item("AccessMask") = 1179817
ace1.Properties_.Item("AceFlags") = 3
ace1.Properties_.Item("AceType") = 0
ace1.Properties_.Item("Trustee") = trustee
Set NewACE = ace1
End Function

Sub Setntfssec(strserver, strgroup)
Dim strDdrive
Dim intRunError, objShell, objFSO
strDdrive = "\\" & strserver & "\" & "C$"
Set objShell = CreateObject("Wscript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")
strPermision = strgroup & ":(CI)(OI)RX"
intRunError = objShell.Run("cmd /c icacls.exe " & strDdrive & " /T /grant:r " & "paccar-eu\" & strPermision & " /inheritance:e")
createadmin strserver
End Sub

Sub createadmin(strserver)
Dim WshShell, fso
Set WSHShell =CreateObject("WScript.Shell")
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FolderExists("\\" & strserver & "\" & "C$" & "\Admin") = False Then
fso.CreateFolder("\\" & strserver & "\" & "C$\Admin")
End If
Dim objShell, intRunError
Set objShell = CreateObject("Wscript.Shell")
intRunError = objShell.Run("icacls.exe \\" & strserver & "\C$\Admin /inheritance:r /grant:r administrators:(CI)(OI)F",2 ,True)
End sub

Function ExistShare(sComputer, sShare) ' check if share already exists

Set oWMI = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & sComputer & "\root\cimv2")
Set colShares = oWMI.ExecQuery _
("Select * from Win32_Share WHERE name = '" & sShare & "'")
If colShares.Count > 0 Then
ExistShare = True
Else
ExistShare = False
End If
End Function

Function PingStatus(strComputer) ' check if server is online
strWorkstation = "."
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & strWorkstation & "\root\cimv2")
Set colPings = objWMIService.ExecQuery _
("SELECT * FROM Win32_PingStatus WHERE Address = '" & strComputer & "'")
For Each objPing in colPings
Select Case objPing.StatusCode
Case 0 PingStatus = "Success"
Case Else PingStatus = "Failure"
End Select
Next
End Function

Function SetAccountTrustee(strDomain, strName)
Dim objTrustee
Dim account
Dim accountSID
set objTrustee = getObject("Winmgmts:{impersonationlevel=impersonate}!root/cimv2:Win32_Trustee").Spawninstance_
set account = getObject("Winmgmts:{impersonationlevel=impersonate}!root/cimv2:Win32_Account.Name='" & strName & "',Domain='" & strDomain &"'")
set accountSID = getObject("Winmgmts:{impersonationlevel=impersonate}!root/cimv2:Win32_SID.SID='" & account.SID &"'")
objTrustee.Domain = strDomain
objTrustee.Name = strName
objTrustee.Properties_.item("SID") = accountSID.BinaryRepresentation
set accountSID = nothing
set account = nothing
set SetAccountTrustee = objTrustee
End Function

Function SetGroupTrustee(strDomain, strName)
Dim objTrustee
Dim account
Dim accountSID
set objTrustee = getObject("Winmgmts:{impersonationlevel=impersonate}!root/cimv2:Win32_Trustee").Spawninstance_
set account = getObject("Winmgmts:{impersonationlevel=impersonate}!root/cimv2:Win32_Group.Name='" & strName & "',Domain='" & strDomain &"'")
set accountSID = getObject("Winmgmts:{impersonationlevel=impersonate}!root/cimv2:Win32_SID.SID='" & account.SID &"'")
objTrustee.Domain = strDomain
objTrustee.Name = strName
objTrustee.Properties_.item("SID") = accountSID.BinaryRepresentation
set accountSID = nothing
set account = nothing
set SetGroupTrustee = objTrustee
End Function


</script>

</head>
<!--<body onLoad="bodyLoaded()"> -->
<body STYLE="font:13 pt arial; color:white; filter:progid:DXImageTransform.Microsoft.Gradient (GradientType=1, StartColorStr='#000000', EndColorStr='#0000FF')">
<p>set D drive share for Tam</p>
<table width="450" border="0">
<tr>
<td>Select SG group: </td>
<td><select size="1" name="Groups"></td>
<option>&nbsp&nbsp</option>
</select>
</tr>
<tr>
<td><span class="style5">*</span>Servername(s): </td>
<td><textarea name="serverTextArea" rows=8 cols=25></textarea><p>
</tr>
</table>
<br>
<p></p>
<td><span class="style5"></span>Make sure you select the correct group and, </td>
<p><center> leave no empty row in adding servernames.</center></p>

<p><center><input type="button" align="center" name="Submit" value="Submit" onClick="filterserver"></center></P>
<p class="style3"><span class="style6">*</span>Indicates Required Field</p>
</body>
</html>
 
Upvote 0 Downvote
Code: 
<html> 
<HTA:APPLICATION 
APPLICATIONNAME="create Tam Share " 
SCROLL="no" 
SINGLEINSTANCE="yes" 

<head> 
<title>Create /add Tam group to D share of server</title> 
<!-- <style type="text/css"> 
.style3 {font-size: 13px} 
body,td,th { 
font-family: Arial, Helvetica, sans-serif; 
} 
.style2 { font-family: Arial, Helvetica, sans-serif; 
font-size: 13.5pt; 
color: #CC6600; 
font-weight: bold; 
} 
.style5 {font-size: small; color: #FF0000; } 
.style6 {color: #FF0000} 
div
{
    text-align: center;
}?
</style> -->

<SCRIPT LANGUAGE="VBScript">

    Sub Window_onLoad
	intWidth = 450
	intHeight = 435
	Me.ResizeTo intWidth, intHeight
    Me.MoveTo ((Screen.Width / 2) - (intWidth / 2)),((Screen.Height / 2) - (intHeight / 2))
        window.resizeTo 450,435
Set objShell = CreateObject("WScript.Shell") 
objShell.RegWrite "HKCU\Software\Microsoft\Windows\CurrentVersion\Internet Settings\Zones\1\1406", 0, "REG_DWORD"
LoadDropDown
    End Sub 

</SCRIPT>

<script type="text/vbscript"> 
'read file with groups and text area with server names
    Sub LoadDropDown
       ForReading = 1
    strNewFile = "Groups.txt"
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objFile = objFSO.OpenTextFile _
        (strNewFile, ForReading)
    Do Until objFile.AtEndOfStream
        strserver = objFile.ReadLine
        Set objOption = Document.createElement("OPTION")
        objOption.Text = strserver
        objOption.Value = strserver
        Groups.Add(objOption)
    Loop
    objFile.Close
    End Sub

Sub filterserver 'filter out empty line and death server text area
    strgroup = Groups.Value
	strText = serverTextArea.Value
    arrLines = Split(strText, vbCrLf)
    For Each strserver in arrLines
      If strserver <> "" Then
      strPingStatus = PingStatus(strserver)
      If strPingStatus = "Success" Then
        checkshare strserver, strgroup
        Else
        MsgBox " server: " & strserver & " is not online or does not exist, rerun script with the correct servername script will continu with next server"
       'On Error Resume Next
        End If
        End If  
        next 
End Sub
  
  Sub checkshare(strserver, strgroup)  ' check if share exists
  sShareName = "TAM-Share" 
snode = strserver
If ExistShare(sNode, sShareName) Then 
  addshare strserver, strgroup, sShareName
Else 
  createshare strserver, strgroup, sShareName
End If 
End Sub 


Sub createshare(strserver, strgroup, sShareName) ' create share when not exist
Const FILE_SHARE = 0 
Const MAXIMUM_CONNECTIONS = 25 
Dim objWMIService 
Dim objNewShare
Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & strserver & "\root\cimv2") 
Set objNewShare = objWMIService.Get("Win32_Share") 
 
Call setsharesec ("C:\", sShareName, sShareName,strgroup, strserver) 
End Sub

Sub setsharesec(Fname,shr,info,strgroup,strserver) 'Fname = Folder path, shr = Share name, info = Share Description, account = account or group you are assigning share permissions to 
Dim FSO 
Dim Services 
Dim SecDescClass 
Dim SecDesc 
Dim Trustee1 
Dim ACE 
Dim Share 
Dim InParam 
Dim Network 
Dim FolderName 
Dim AdminServer 
Dim ShareName 
 
FolderName = Fname 
AdminServer = "\\" & strserver 
ShareName = shr 
 
Set Services = GetObject("WINMGMTS:{impersonationLevel=impersonate,(Security)}!" & AdminServer & "\ROOT\CIMV2") 
Set SecDescClass = Services.Get("Win32_SecurityDescriptor") 
Set SecDesc = SecDescClass.SpawnInstance_() 
Set Trustee1 = SetgroupTrustee("paccar-eu", strgroup)  
'To assign permissions to individual accounts use SetAccountTrustee rather than SetGroupTrustee  
 
Set ACE = Services.Get("Win32_Ace").SpawnInstance_ 
ACE.Properties_.Item("AccessMask") = 1179817
ACE.Properties_.Item("AceFlags") = 3 
ACE.Properties_.Item("AceType") = 0 
ACE.Properties_.Item("Trustee") = Trustee1 
SecDesc.Properties_.Item("DACL") = Array(ACE) 
Set Share = Services.Get("Win32_Share") 
Set InParam = Share.Methods_("Create").InParameters.SpawnInstance_() 
InParam.Properties_.Item("Access") = SecDesc 
InParam.Properties_.Item("Description") = Info 
InParam.Properties_.Item("Name") = ShareName 
InParam.Properties_.Item("Path") = FolderName 
InParam.Properties_.Item("Type") = 0 
Share.ExecMethod_ "Create", InParam 
Setntfssec strserver, strgroup
End Sub 

Sub addshare(strserver, strgroup, sShareName) ' add extra group to existing share
computer = strserver
username = strgroup
share    = sShareName
domain   = CreateObject("WScript.Network").UserDomain

' copy existing ACEs
Set objLocator = CreateObject("wbemscripting.swbemlocator")
Set wmi = objLocator.ConnectServer(Computer)   'THIS IS THE NAME OF THE COMPUTER YOU ARE SETTING PERMISSIONS ON
wmi.security_.impersonationlevel = 3
wmi.security_.privileges.AddAsString("SeSecurityPrivilege")
set shareSec = wmi.Get("Win32_LogicalShareSecuritySetting.Name='" & Share & "'")

rc = shareSec.GetSecurityDescriptor(sd)
flags = sd.ControlFlags
ReDim acl(UBound(sd.DACL)+1)  '+1 for the new ACL we're going to add
For i = 0 To UBound(sd.DACL)
  Set acl(i) = sd.DACL(i)
Next
Set sd = Nothing

' add new ACE

Set acl(UBound(acl)) = NewACE(NewTrustee(username, domain))
' prepare new security descriptor
Set sd = wmi.Get("Win32_SecurityDescriptor").SpawnInstance_
sd.ControlFlags = flags
sd.DACL = acl

' assign new security descriptor
rc = shareSec.SetSecurityDescriptor(sd)
Setntfssec strserver, strgroup
End sub 'shareadd 
 
 Function NewTrustee(name, domain)
  Set objLocator = CreateObject("wbemscripting.swbemlocator")
  Set wmi = objLocator.ConnectServer(Computer) 
  Dim trustee, account
  Set trustee = wmi.Get("Win32_Trustee").SpawnInstance_
  trustee.Name   = name
  trustee.Domain = domain
  set account = getObject("Winmgmts:{impersonationlevel=impersonate}!root/cimv2:Win32_Account.Name='" & Name & "',Domain='" & Domain &"'")  
  trustee.Properties_.Item("SID") = wmi.Get("Win32_SID.SID='" & account.SID _
    & "'").BinaryRepresentation

  Set NewTrustee = trustee
End Function

Function NewACE(trustee)
 Set objLocator = CreateObject("wbemscripting.swbemlocator")
  Set wmi = objLocator.ConnectServer(Computer)
 Dim ace1 : Set ace1 = wmi.Get("Win32_Ace").SpawnInstance_
  ace1.Properties_.Item("AccessMask") = 1179817
  ace1.Properties_.Item("AceFlags") = 3
  ace1.Properties_.Item("AceType") = 0
  ace1.Properties_.Item("Trustee") = trustee
  Set NewACE = ace1
End Function
  
Sub Setntfssec(strserver, strgroup)
Dim strDdrive
Dim intRunError, objShell, objFSO
	strDdrive = "\\" & strserver & "\" & "C$"
	Set objShell = CreateObject("Wscript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")
strPermision = strgroup & ":(CI)(OI)RX"
intRunError = objShell.Run("cmd /c icacls.exe " & strDdrive & " /T /grant:r " & "paccar-eu\" & strPermision & " /inheritance:e")
createadmin strserver
End Sub 

Sub createadmin(strserver)
Dim WshShell, fso
Set WSHShell =CreateObject("WScript.Shell")
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FolderExists("\\" & strserver & "\" & "C$" & "\Admin") = False Then
fso.CreateFolder("\\" & strserver & "\" & "C$\Admin")
End If
Dim objShell, intRunError
Set objShell = CreateObject("Wscript.Shell")
intRunError = objShell.Run("icacls.exe \\" & strserver & "\C$\Admin /inheritance:r /grant:r administrators:(CI)(OI)F",2 ,True)
End sub
    
Function ExistShare(sComputer, sShare) ' check if share already exists

  Set oWMI = GetObject("winmgmts:" _ 
      & "{impersonationLevel=impersonate}!\\" & sComputer & "\root\cimv2") 
  Set colShares = oWMI.ExecQuery _ 
      ("Select * from Win32_Share WHERE name = '" & sShare & "'") 
  If colShares.Count > 0 Then 
    ExistShare = True 
  Else 
    ExistShare = False 
  End If 
End Function 

Function PingStatus(strComputer) '  check if server is online
    strWorkstation = "."
    Set objWMIService = GetObject("winmgmts:" _
      & "{impersonationLevel=impersonate}!\\" & strWorkstation & "\root\cimv2")
    Set colPings = objWMIService.ExecQuery _
      ("SELECT * FROM Win32_PingStatus WHERE Address = '" & strComputer & "'")
    For Each objPing in colPings
        Select Case objPing.StatusCode
            Case 0 PingStatus = "Success"
            Case Else PingStatus = "Failure"
        End Select
    Next
End Function

Function SetAccountTrustee(strDomain, strName) 
Dim objTrustee 
Dim account 
Dim accountSID  
     set objTrustee = getObject("Winmgmts:{impersonationlevel=impersonate}!root/cimv2:Win32_Trustee").Spawninstance_  
     set account = getObject("Winmgmts:{impersonationlevel=impersonate}!root/cimv2:Win32_Account.Name='" & strName & "',Domain='" & strDomain &"'")  
     set accountSID = getObject("Winmgmts:{impersonationlevel=impersonate}!root/cimv2:Win32_SID.SID='" & account.SID &"'")  
     objTrustee.Domain = strDomain  
     objTrustee.Name = strName  
     objTrustee.Properties_.item("SID") = accountSID.BinaryRepresentation  
     set accountSID = nothing  
     set account = nothing  
     set SetAccountTrustee = objTrustee  
End Function  
  
Function SetGroupTrustee(strDomain, strName)  
Dim objTrustee 
Dim account
Dim accountSID 
set objTrustee = getObject("Winmgmts:{impersonationlevel=impersonate}!root/cimv2:Win32_Trustee").Spawninstance_  
set account = getObject("Winmgmts:{impersonationlevel=impersonate}!root/cimv2:Win32_Group.Name='" & strName & "',Domain='" & strDomain &"'")  
set accountSID = getObject("Winmgmts:{impersonationlevel=impersonate}!root/cimv2:Win32_SID.SID='" & account.SID &"'")  
objTrustee.Domain = strDomain  
objTrustee.Name = strName  
objTrustee.Properties_.item("SID") = accountSID.BinaryRepresentation  
set accountSID = nothing  
set account = nothing  
set SetGroupTrustee = objTrustee  
End Function  


</script>

</head> 
<!--<body onLoad="bodyLoaded()"> -->
<body STYLE="font:13 pt arial; color:white; filter:progid:DXImageTransform.Microsoft.Gradient (GradientType=1, StartColorStr='#000000', EndColorStr='#0000FF')">
<p>set D drive share for Tam</p> 
<table width="450" border="0"> 
<tr> 
<td>Select SG group: </td> 
<td><select size="1" name="Groups"></td>
<option>&nbsp&nbsp</option>
</select>
</tr>
<tr> 
<td><span class="style5">*</span>Servername(s): </td> 
<td><textarea name="serverTextArea" rows=8 cols=25></textarea><p>
</tr> 
</table>
<br>
<p></p>
<td><span class="style5"></span>Make sure you select the correct group and, </td>
<p><center> leave no empty row in adding servernames.</center></p>

<p><center><input type="button" align="center" name="Submit" value="Submit" onClick="filterserver"></center></P>
<p class="style3"><span class="style6">*</span>Indicates Required Field</p> 
</body> 
</html>
 
Upvote 0 Downvote
Any one an idea ?
please help
 
Upvote 0 Downvote
"Geates what you say isn't working as it isn't the complete script"

It's likely not working because of this the typo on this line.

Code: 
strAllStatuses = strAllStatus & strServer & ": " & strStatus & vbNewLine

If you are still having problems, I would recommend seeking out the problem code by commenting out bits of code.

-Geates

 
Upvote 0 Downvote
Status
Not open for further replies.

Similar threads

bdwilcox
  • Locked
  • Question Question
HTA fails with Syntax Error when working VBScript inserted
Replies
2
Views
925
bdwilcox
bdwilcox
S
  • Locked
  • Question Question
Need to submit page when clicking a checkbox
Replies
0
Views
624
shbr5413
S
bdwilcox
  • Locked
  • Question Question
Validate that HTA text input boxes aren't blank on submission
Replies
1
Views
690
bdwilcox
bdwilcox
Don Child
  • Locked
  • Question Question
Oracle connection works while debugging in VBSEdit, but not when run from the command line.
Replies
2
Views
671
Don Child
Don Child
Alexvb6
  • Locked
  • Question Question
Deprecation of VBScript + Classic ASP: How to Ask Microsoft to cancel their planned craziness
Replies
0
Views
891
Alexvb6
Alexvb6

Part and Inventory Search

Sponsor

Back
Top