cbli
Nov 21, 2007, updated at Nov 30, 2007 (UTC)
view6374
view9
0
Goto Top

In VB Script enthaltene angeklickte Checkboxen zählen und als Schleifendurchlaufanzahl benutzen

GermanQuestionVB for ApplicationsDevelopment
Folgendes Problem:

Ich habe eine HTA Applikation mit VB Script Inhalten erstellt.
Ich benutze sie um Rechner im Netzwerk ,hier von meinem PC aus, herunterfahren zu können.
Dazu muss ich nur die Haken in den entsprechenden Checkboxen machen und die Sub Prozedur aufrufen.
Soweit ist auch all funktionsfähig nur habe ich das Problem,daß wenn ich mehrere Rechner auf einmal herunterfahren will, mein Programm alle geklickten Checkboxen einzeln übergibt und damit meine Listenausgabe nicht funktioniert.
Es müsste also die Anzahl der angeklickten Checkboxen gezählt werden und diese Summe als Anzahl der Schleifendurchläufe genommen werden.
Wie erreiche ich das und wie muss die Schleife dann aussehen ?
Die ersten 6 Zeilen der Sub könnten auch weggelassen werden.
IP Adressen + Benutzernamen Übergabe erfolgt über ein array

Dim intZeile
Dim remuser(6,1)

remuser(0,0) = "Frau Müller"  
remuser(1,0) = "Herr Maier"  
remuser(2,0) = "Herr Kohler"  
remuser(3,0) = "Frau Beck"  
remuser(4,0) = "Frau Rose"  
remuser(5,0) = "Frau Schmidt"  
remuser(6,0) = "Herr Himst"  
remuser(0,1) = "192.168.115.11"  
remuser(1,1) = "192.168.115.12"  
remuser(2,1) = "192.168.115.13"  
remuser(3,1) = "192.168.115.14"  
remuser(4,1) = "192.168.115.15"  
remuser(5,1) = "192.168.115.16"  
remuser(6,1) = "192.168.115.17"

Code für die angeklickten Checkboxen welche an die Sub herunterfahren übergeben werden

        If Checkbox1.Checked Then
' Frau Müller  
remuser(0,0) = "Frau Müller"  
remuser(0,1) = "192.168.115.11"  
intzeile = 0
herunterfahren
        End If

Hier mal meine Sub Prozedur

sub herunterfahren

user = "administrator"  
password = "xxxxxx"  


Set obj = GetObject("winmgmts:Win32_PingStatus.address='" & remuser(intZeile,1) & "'")  
If IsNull(obj.StatusCode) Or obj.StatusCode <> 0 Then
fehlerliste = fehlerliste & "PC des Benutzers:          " & remuser(intZeile,0) & "    läuft nicht" & vbcrlf & vbcrlf  
else
on error resume next
set wmi = CreateObject("WBemScripting.SWbemLocator")  
Set cs = wmi.ConnectServer(remuser(intZeile,1),"root/cimv2",user,password)  
set col = cs.InstancesOf("Win32_OperatingSystem")  
for each obj in col
rc = obj.Shutdown
next
If (rc = 0) Then
MsgBox "Rechner:      " & remuser(intZeile,0) & "       wird heruntergefahren.    Returncode =    " & rc ,64,"Hinweis"  
okliste = okliste & "PC des Benutzers:          " & remuser(intZeile,0) & "    wurde heruntergefahren" & vbcrlf & vbcrlf   
end if
end if
msgbox okliste ,,"Heruntergefahrene PC´s"  
msgbox fehlerliste ,,"Nicht betriebsbereite PC´s"  
end sub

Vielen Dank für die Hilfe

mfg
Claus
comment-contentCommentShareShare
Share on Facebook Share on Twitter Share on Reddit Share on Linkedin

Content-Key: 74138

Url: https://administrator.de/contentid/74138

Printed on: April 24, 2024 at 22:04 o'clock

9 Comments
Latest comment
Goto Top
Member: bastla
bastla Nov 21, 2007 at 18:05:36 (UTC)
Goto Top
Hallo cbli!

Vielleicht mit einem Status-Array "checked()":
Dim remuser(6,1)

remuser(0,0) = "Frau Müller"  
remuser(1,0) = "Herr Maier"  
remuser(2,0) = "Herr Kohler"  
remuser(3,0) = "Frau Beck"  
remuser(4,0) = "Frau Rose"  
remuser(5,0) = "Frau Schmidt"  
remuser(6,0) = "Herr Himst"  
remuser(0,1) = "192.168.115.11"  
remuser(1,1) = "192.168.115.12"  
remuser(2,1) = "192.168.115.13"  
remuser(3,1) = "192.168.115.14"  
remuser(4,1) = "192.168.115.15"  
remuser(5,1) = "192.168.115.16"  
remuser(6,1) = "192.168.115.17"  

Dim checked(6)
If Checkbox1.Checked Then checked(0) = True
...
If Checkbox7.Checked Then checked(6) = True

For i = 0 To 6
    If checked(i) Then
		Code = Herunterfahren(remuser(i, 1))
		If Code = -1 Then
			fehlerliste = fehlerliste & "PC des Benutzers:          " & remuser(i, 0) & "    läuft nicht" & vbCrLF & vbCrLF  
		Else
			MsgBox "Rechner:      " & remuser(i, 0) & "       wird heruntergefahren.    Returncode =    " & Code ,64,"Hinweis"  
			If Code = 0 Then
				okliste = okliste & "PC des Benutzers:          " & remuser(i, 0) & "    wurde heruntergefahren" & vbCrLF & vbCrLF  
			Else
				fehlerliste = fehlerliste & "PC des Benutzers:          " & remuser(i, 0) & "    meldete Code " & Code & vbCrLF & vbCrLF  
			End If
		End If
	End If
Next
MsgBox okliste ,,"Heruntergefahrene PC"  
MsgBox fehlerliste ,,"Nicht betriebsbereite PC"  


Function Herunterfahren(IP)
user = "administrator"  
password = "xxxxxx"  

Set obj = GetObject("winmgmts:Win32_PingStatus.Address='" & IP & "'")  
If IsNull(obj.StatusCode) Or obj.StatusCode <> 0 Then
	Herunterfahren = -1
Else
	On Error Resume Next
	Set wmi = CreateObject("WBemScripting.SWBemLocator")  
	Set cs = wmi.ConnectServer(IP,"root/cimv2",user,password)  
	Set col = cs.InstancesOf("Win32_OperatingSystem")  
	For Each obj In col
		rc = obj.Shutdown
	Next
	Herunterfahren = rc
End If
End Function

Grüße
bastla

P.S.: Ungetestet, und (erkennbar zB an den fest verdrahteten Array-Größen) nur als Grobentwurf gedacht.
Member: cbli
cbli Nov 23, 2007 at 12:46:39 (UTC)
Goto Top
Hallo cbli!

Vielleicht mit einem Status-Array
"checked()":
Dim remuser(6,1)
> 
> remuser(0,0) = "Frau Müller"  
> remuser(1,0) = "Herr Maier"  
> remuser(2,0) = "Herr Kohler"  
> remuser(3,0) = "Frau Beck"  
> remuser(4,0) = "Frau Rose"  
> remuser(5,0) = "Frau Schmidt"  
> remuser(6,0) = "Herr Himst"  
> remuser(0,1) = "192.168.115.11"  
> remuser(1,1) = "192.168.115.12"  
> remuser(2,1) = "192.168.115.13"  
> remuser(3,1) = "192.168.115.14"  
> remuser(4,1) = "192.168.115.15"  
> remuser(5,1) = "192.168.115.16"  
> remuser(6,1) = "192.168.115.17"  
> 
> Dim checked(6)
> If Checkbox1.Checked Then checked(0) = True
> ...
> If Checkbox7.Checked Then checked(6) = True
> 
> For i = 0 To 6
>     If checked(i) Then
> 		Code = Herunterfahren(remuser(i, 1))
> 		If Code = -1 Then
> 			fehlerliste = fehlerliste & "PC  
> des Benutzers:          " &  
> remuser(i, 0) & "    läuft  
> nicht" & vbCrLF & vbCrLF  
> 		Else
> 			MsgBox "Rechner:      " &  
> remuser(i, 0) & "       wird  
> heruntergefahren.    Returncode =    "  
> & Code ,64,"Hinweis"  
> 			If Code = 0 Then
> 				okliste = okliste & "PC des  
> Benutzers:          " & remuser(i,  
> 0) & "    wurde  
> heruntergefahren" & vbCrLF &  
> vbCrLF
> 			Else
> 				fehlerliste = fehlerliste & "PC  
> des Benutzers:          " &  
> remuser(i, 0) & "    meldete Code  
> " & Code & vbCrLF & vbCrLF  
> 			End If
> 		End If
> 	End If
> Next
> MsgBox okliste ,,"Heruntergefahrene  
> PC"  
> MsgBox fehlerliste ,,"Nicht  
> betriebsbereite PC"  
> 
> 
> Function Herunterfahren(IP)
> user = "administrator"  
> password = "xxxxxx"  
> 
> Set obj =
> GetObject("winmgmts:Win32_PingStatus.Address='"  
> & IP & "'")  
> If IsNull(obj.StatusCode) Or obj.StatusCode
> <> 0 Then
> 	Herunterfahren = -1
> Else
> 	On Error Resume Next
> 	Set wmi =
> CreateObject("WBemScripting.SWBemLocator")  
> 	Set cs =
> wmi.ConnectServer(IP,"root/cimv2",user,password)  
> 	Set col =
> cs.InstancesOf("Win32_OperatingSystem")  
> 	For Each obj In col
> 		rc = obj.Shutdown
> 	Next
> 	Herunterfahren = rc
> End If
> End Function
>

Hallo Bastla !

Danke erstmal dafür. Nach ein bißchen anpasssen und probieren läuft es soweit ganz gut , mit einem einzigen Problem.
Wenn ich 2 oder mehr PC´s zum Herunterfahren auswähle,bekomme ich die Listenausgabe entsprechend oft angezeigt.
Genau das will ich aber nicht.
Ich möchte,daß er nur 1 x ganz am Schluß die Listen ausgibt,egal wieviel PC´s ich zum herunterfahren ausgewählt habe.
Wie schaffe ich das ?
Würde es damit gehen,daß nur die PC´s in die Schleife kommen und abgefragt werden, die ich vorher in den Checkboxen angehakt habe ?
Wenn ja,wie bekomme ich das hin ?

Hier der momentane Code

sub singledown

Dim checked(6)


If Checkbox1.Checked Then checked(0) = True
If Checkbox2.Checked Then checked(5) = True
If Checkbox3.Checked Then checked(6) = True
If Checkbox4.Checked Then checked(1) = True
If Checkbox5.Checked Then checked(3) = True
If Checkbox6.Checked Then checked(2) = True
If Checkbox7.Checked Then checked(4) = True


For i = 0 To 6
    If checked(i) Then
        Code = Herunterfahren(i)
        If Code = -1 Then
            fehlerliste = fehlerliste & "PC des Benutzers:          " & remuser(i,0) & "    läuft nicht" & vbCrLF & vbCrLF  
        Else
            MsgBox "Rechner:      " & remuser(i,0) & "       wird heruntergefahren.    Returncode =    " & Code ,64,"Hinweis"  
            If Code = 0 Then
                okliste = okliste & "PC des Benutzers:          " & remuser(i,0) & "    wurde heruntergefahren" & vbCrLF & vbCrLF  
            Else
                fehlerliste = fehlerliste & "PC des Benutzers:          " & remuser(i,0) & "    meldete Code " & Code & vbCrLF & vbCrLF  
            End If
        End If
    End If
Next
MsgBox okliste ,,"Heruntergefahrene PC"  
MsgBox fehlerliste ,,"Nicht betriebsbereite PC"  
end sub


Function Herunterfahren(i)
user = "administrator"  
password = "xxxxxx"  
Set obj = GetObject("winmgmts:Win32_PingStatus.Address='" & remuser(i,1) & "'")  
If IsNull(obj.StatusCode) Or obj.StatusCode <> 0 Then
    Herunterfahren = -1
Else
    On Error Resume Next
    Set wmi = CreateObject("WBemScripting.SWBemLocator")  
    Set cs = wmi.ConnectServer(remuser(i,1),"root/cimv2",user,password)  
    Set col = cs.InstancesOf("Win32_OperatingSystem")  
    For Each obj In col
        rc = obj.Shutdown
    Next
    Herunterfahren = rc
End If
End Function

Danke

Gruß
Claus
Member: bastla
bastla Nov 23, 2007 at 13:36:43 (UTC)
Goto Top
Hallo cbli!

Ich weiß ja nicht, wie dieser Code aufgerufen wird, aber eigentlich wäre ich davon ausgegangen, dass dies erst beim Klick auf eine Schaltfläche "Ausführen" oä geschieht. Somit würden auch die Listen nur einmal ausgegeben.

Die "MsgBox" in der Schleife könntest Du, wenn denn die unmittelbare Rückmeldung tatsächlich gewünscht / erforderlich wäre, durch ein 3-Sekunden-"Popup" ersetzen, etwa:
Set WshShell = WScript.CreateObject("WScript.Shell")  
R = WshShell.Popup("Rechner:      " & remuser(i,0) & "       wird heruntergefahren.    Returncode =    " & Code, 3, "Hinweis", vbOK + vbInformation)

Grüße
bastla
Member: cbli
cbli Nov 23, 2007 at 15:51:42 (UTC)
Goto Top
Ich weiß ja nicht, wie dieser Code
aufgerufen wird, aber eigentlich wäre
ich davon ausgegangen, dass dies erst beim
Klick auf eine Schaltfläche
"Ausführen" oä geschieht.
Somit würden auch die Listen nur einmal
ausgegeben.

Genau so ist es, durch klicken auf eine Schaltfläche

<input type="checkbox" name="Checkbox1"> Frau Müller  
...
<input type="checkbox" name="Checkbox7"> Herr Maier  
<input id=runbutton  class="button" type="button" value="PC  herunterfahren" name="button1"  onClick="TestSub">

Durch Drücken der Schaltfläche wird die Sub Testsub aufgerufen in der die angehakten Checkboxen abgefragt werden.

        If Checkbox1.Checked Then
' Frau Müller  
remuser(0,0) = "Frau Müller"  
remuser(0,1) = "192.168.115.11"  
intzeile = 0
herunterfahren
        End If

Könnte hier ein elseif helfen ?
Oder hast du noch eine andere Idee ?

Danke

Gruß
Claus
Member: bastla
bastla Nov 23, 2007 at 16:28:41 (UTC)
Goto Top
Hallo cbli!

Meine Idee dazu steht eigentlich schon oben - "Sub Testsub" sollte sich durch meinen Scriptvorschlag (bzw Deine angepasste Variante + Befüllen des "remuser()"-Arrays am Anfang, auf jeden Fall aber vor der "For"-Schleife) ersetzen lassen.

Grüße
bastla
Member: cbli
cbli Nov 23, 2007 at 17:15:06 (UTC)
Goto Top
Hallo cbli!

Meine Idee dazu steht eigentlich schon oben
- "Sub Testsub" sollte sich durch
meinen Scriptvorschlag (bzw Deine angepasste
Variante + Befüllen des
"remuser()"-Arrays am Anfang, auf
jeden Fall aber vor der
"For"-Schleife) ersetzen lassen.


Habe eben deinen Scriptvorschlag (mit meiner Anpassung) einfach mal mit elseif beim Checkboxen abfragen ergänzt und es funktioniert jetzt genau so wie es sollte !!
Danke nochmals an dich für die Hilfestellung.
Eine Winzigkeit noch:

Lässt sich einfach irgendwie mit VB Script /Java eine Fortschrittsanzeige der ganzen Aktion in die HTA mit einbauen ?
Hake ich nämlich einige Rechner an,kann es ziemlich dauern bis das Script zu Ende ist und meine Listenausgabe kommt.

Danke nochmals

Gruß
Claus
Member: bastla
bastla Nov 23, 2007 at 19:22:38 (UTC)
Goto Top
Hallo cbli!

Du könntest vielleicht doch das oben beschriebene "Popup" (mit einer längeren Anzeigedauer) verwenden, um einen Hinweis darauf zu erhalten, dass das Script noch läuft.

Grüße
bastla

P.S.: Wenn's dann für Dich gut genug ist, magst Du vielleicht Deine gesamte Lösung (mit ev angepasstem Threadtitel) hier reinstellen? face-smile
Member: cbli
cbli Nov 30, 2007 at 15:21:24 (UTC)
Goto Top
Hallo cbli!

Du könntest vielleicht doch das oben
beschriebene "Popup" (mit einer
längeren Anzeigedauer) verwenden, um
einen Hinweis darauf zu erhalten, dass das
Script noch läuft.

Grüße
bastla

P.S.: Wenn's dann für Dich gut
genug ist, magst Du vielleicht Deine gesamte
Lösung (mit ev angepasstem Threadtitel)
hier reinstellen? face-smile


Hallo Bastla

Sorry,komme erst jetzt dazu zu antworten.
Ich stelle meine Lösung gerne hier rein, aber erst wenn es zu 100% fertig ist.
Momentan gibts noch ein paar kleine Baustellen und mir fehlt etwas die Zeit weiterzumachen.
Vielleicht kannst Du mir helfen:

wshshell.popup scheint unter hta nicht zu funktionieren.

Ich bekomme zwar meinen Text angezeigt ,aber die Timerfunktion scheint ignoriert zu werden,d.h das Fenster
schließt sich nicht automatisch nach der von mir definierten Zeit.
Gibts da ne Lösung ? Hab im Inet gesucht aber nix gefunden.

Ach ja,wenn ich meine Lösung hier reinstelle,dann komplett mit HTA Code oder nur den VB Script Teil ?

Gruß
Claus

PS: Ein schönes Wochenende
Member: bastla
bastla Nov 30, 2007 at 17:53:34 (UTC)
Goto Top
Hallo cbli!

wshshell.popup scheint unter hta nicht zu funktionieren.
Da Du ja eine Art "Statusinfo" ausgeben willst, könntest Du als Ersatz dafür doch eigentlich auch zB eine Textbox
<input type="text" name="StatusTextBox" size="60">
verwenden und dieser bei jedem Schleifendurchlauf die aktuelle Info als "Value" zuweisen:
...
StatusTextBox.Value = "Rechner:      " & remuser(i,0) & "       wird heruntergefahren.    Returncode =    " & Code  
...

Ach ja,wenn ich meine Lösung hier reinstelle,dann komplett mit HTA Code oder nur den VB Script Teil ?
Da es im Forum ohnehin kaum Beispiele zu HTA gibt (und auch ich selbst mich noch nicht wirklich damit beschäftigt habe), würde ich auf jeden Fall das Gesamtpaket vorziehen - abgesehen davon sollst Du ja Dein HTA nicht unter den Scheffel stellen face-smile.

Auch Dir ein schönes Wochenende
bastla
GermanQuestionVB for ApplicationsDevelopment
Hotly discussed
gleixnerdCheck of ZFW Firewallgleixnerd - 5 CommentsjstrickerWireguard VPN on UDM Pro behind Fritzbox - Handshake did not completejstricker - 3 Comments