Excel VBA: Stopping and Starting a background Service - excel

Is it possible to stop and start a background service.
There is a third party service that is interfering with an Excel Plug-In. I want to temporarily stop it when I run my code, and then turn it back on at the end.

Whenever you want to do something like this a Google using "WMI" will probably get you something useful.
For example -
From: https://learn.microsoft.com/en-us/windows/desktop/cimwin32prov/stopservice-method-in-class-win32-service
Set ServiceSet = GetObject("winmgmts:").ExecQuery( _
"select * from Win32_Service where Name='ClipSrv'")
for each Service in ServiceSet
RetVal = Service.StopService()
if RetVal = 0 then
WScript.Echo "Service stopped"
elseif RetVal = 5 then
WScript.Echo "Service already stopped"
end if
next
Similarly: https://learn.microsoft.com/en-us/windows/desktop/cimwin32prov/startservice-method-in-class-win32-service
Set ServiceSet = GetObject("winmgmts:").ExecQuery( _
"select * from Win32_Service where Name='ClipSrv'")
for each Service in ServiceSet
RetVal = Service.StartService()
if RetVal = 0 then WScript.Echo "Service started"
if RetVal = 10 then WScript.Echo "Service already running"
next

Related

Adding internal Search function to Screnegraph Brightscript Channell

I need to add search functionality to my Brightscript scenegraph script for a Roku Channel. Does anyone have a simple Search sample, or a script I can use to add to a "sliding panel" Roku channel script?
RoSearch has been depreciated.
The current page is very similar to the Sliding Panel example.
Need working Search feature on my Roku Channel.
<component name = "minikeyboardexample" extends = "Group" initialFocus = "exampleMiniKeyboard" >
<script type="text/brightscript" >
<![CDATA[
sub init()
m.testlabel = m.top.FindNode("testLabel")
m.testpostergrid = m.top.FindNode("testPosterGrid")
m.testpostergridcontent = createObject("roSGNode","ContentNode")
m.readPosterGridTask = createObject("roSGNode","postergridCR")
m.readPosterGridTask.setField("postergriduri","http://test-xml.xml")
m.readPosterGridTask.observeField("gotitem","buildpostergrid")
m.readPosterGridTask.observeField("gotcontent","showpostergrid")
m.readPosterGridTask.control = "RUN"
m.top.setFocus(true)
end sub
sub buildpostergrid()
gridposter = createObject("roSGNode","ContentNode")
gridposter.hdgridposterurl = m.readPosterGridTask.hdgridposterurl
gridposter.hdposterurl = m.readPosterGridTask.hdposterurl
gridposter.sdgridposterurl = m.readPosterGridTask.sdgridposterurl
gridposter.sdposterurl = m.readPosterGridTask.sdposterurl
gridposter.shortdescriptionline1 = m.readPosterGridTask.shortdescriptionline1
gridposter.shortdescriptionline2 = m.readPosterGridTask.shortdescriptionline2
gridposter.x = m.readPosterGridTask.xposterpos
gridposter.y = m.readPosterGridTask.yposterpos
gridposter.w = m.readPosterGridTask.wnumcols
gridposter.h = m.readPosterGridTask.hnumrows
m.testpostergridcontent.appendChild(gridposter)
end sub
sub showpostergrid()
m.testlabel.text = "Here's the PosterGrid: "
m.testpostergrid.content=m.testpostergridcontent
m.testpostergrid.visible=true
m.testpostergrid.setFocus(true)
end sub
]]>
</script>
<children>
<MiniKeyboard id = "exampleMiniKeyboard" />
<Label id="testLabel" translation="[100,32]" text="Building PosterGrid... " />
<PosterGrid
id="testPosterGrid"
translation="[100,100]"
basePosterSize="[240,240]"
itemSpacing="[32,32]"
caption1NumLines="1"
caption2NumLines="1"
numColumns="4"
numRows="3"
/>
</children>
</component>
first read following thinds :
https://developer.roku.com/en-gb/docs/developer-program/discovery/search/implementing-search.md
these code for a search functionality. it applies static way.
sub Main()
''Search Screen UI
'REM ******************************************************
'REM Main routine - example of search screen usage
'REM ******************************************************
print "start"
'toggle the search suggestions vs. search history behavior
'this allow you to generate both versions of the example below
displayHistory = false
history = CreateObject("roArray", 1, true)
'prepopulate the search history with sample results
history.Push("seinfeld")
history.Push("fraiser")
history.Push("cheers")
port = CreateObject("roMessagePort")
screen = CreateObject("roSearchScreen")
'commenting out SetBreadcrumbText() hides breadcrumb on screen
screen.SetBreadcrumbText("", "Search Channel")
screen.SetMessagePort(port)
if displayHistory
screen.SetSearchTermHeaderText("Recent Searches:")
screen.SetSearchButtonText("search")
screen.SetClearButtonText("clear history")
screen.SetClearButtonEnabled(true) 'defaults to true
screen.SetSearchTerms(history)
else
screen.SetSearchTermHeaderText("Suggestions:")
screen.SetSearchButtonText("search")
screen.SetClearButtonEnabled(false)
endif
print "Doing show screen..."
screen.Show()
print "Waiting for a message from the screen..."
' search screen main event loop
done = false
while done = false
msg = wait(0, screen.GetMessagePort())
if type(msg) = "roSearchScreenEvent"
if msg.isScreenClosed()
print "screen closed"
done = true
else if msg.isCleared()
print "search terms cleared"
history.Clear()
else if msg.isPartialResult()
print "partial search: "; msg.GetMessage()
if not displayHistory
screen.SetSearchTerms(GenerateSearchSuggestions(msg.GetMessage()))
endif
else if msg.isFullResult()
print "full search: "; msg.GetMessage()
history.Push(msg.GetMessage())
if displayHistory
screen.AddSearchTerm(msg.GetMessage())
end if
'uncomment to exit the screen after a full search result:
'done = true
else
print "Unknown event: "; msg.GetType(); " msg: "; sg.GetMessage()
endif
endif
endwhile
print "Exiting..."
End Sub
Function GenerateSearchSuggestions(partSearchText As String) As Object
availableContent = [
"ch1"
"ch2"
"ch3"
"ch4"
"ch5"
"ch6"
"ch7"
"ch8"
]
suggestions = []
if partSearchText <> ""
partSearchText = LCase(partSearchText)
for each available in availableContent
if available.Instr(partSearchText) >= 0
suggestions.Push(available)
end if
end for
end if
return suggestions
End Function
End sub
this code writes in main.brs file
I hope this code is helpful.
Most of the search screens in SceenGraph use a combination of MiniKeyboard with a combination of any type of list or grid, such are MarkupGrid. You add these component to your panels or a group component and manage the transition yourself.

silent logon to sap bw server via excel vba script and bexanalyzer

we are running SAP BW with BExAnalyzer 7.5. I've been trying for days to establish a connection to the SAP - Server, but unfortunately I am not even receiving an error message. So it seems the logon has succeeded, but no data from BW is fetched, so I am assuming there is a problem in the logon. Please help!
Function LogonToServer() As Boolean
LogonToServer = False
Dim myConnection As Object
Set myConnection = Run("'C:\Program Files (x86)\Common Files\SAP Shared\BW\BExAnalyzer.xla'!SAPBEXgetConnection")
With myConnection
.client = "xxx"
.user = "xxx"
.Password = "xxxx"
.Language = "DE"
.systemnumber = "xxx"
.system = "xxx"
.ApplicationServer = "xxx"
.SAProuter = ""
.Logon 0, True
End With
If myConnection.IsConnected <> 1 Then
'launch the Logon Dialog for manual connection
myConnection.Logon 0, False
If myConnection.IsConnected <> 1 Then
MsgBox "something went wrong ..."
Exit Function
End If
End If
If myConnection.IsConnected = 1 Then
LogonToServer = True
End If
Run "BExAnalyzer.xla!SAPBEXinitConnection"
End Function
SAP Note 2541995 says that the cause is that the Password property is not available in 7.5. It suggests that you can reconnect if you are using Single Sign On (SSO). It also points to note 2635165 that is a front end patch that may fix the issue with the password property. The code you attached does work with version 7.4 and I experienced similar issues with 7.5 but do not have access to download the patch. I'll try and get the front end patch and test again and update my answer with the results.

New Defect from Excecution Grid when Status is changed to failed

I want to open the Defect Window from the TestSet's Execution Grid when the "TC_STATUS" is "failed"
The following code seems only to work when I perform a "full" run
Actions.Action("Defects.NewDefect").Execute
or
Actions.Action("StepsView.NewDefect").Execute
I already tried:
Actions.Action("TestSetView.NewDefect").Execute
but this does nothing
You can post a new defect automatically each time test instance status is changed and link this new defect to currently selected test instance.
In Test Lab module script workflow put this code:
Sub TestSetTests_FieldChange(FieldName)
On Error Resume Next
If FieldName = "TC_STATUS" and TestSetTest_Fields.Field("TC_STATUS").Value = "Failed" Then
Set BugFact = TDConnection.BugFactory
Set NewBug = BugFact.AddItem(null)
'Fill new defect fields
NewBug.Summary = "New Defect"
NewBug.Field("BG_SEVERITY") = "3-High"
NewBug.Field("BG_STATUS") = "New"
NewBug.Field("BG_DETECTION_DATE") = "2016-01-01"
'...
NewBug.Post()
TestInstanceId = TestSetTest_Fields.Field("TC_TESTCYCL_ID").Value
Set TestInstanceFact = TDConnection.TSTestFactory
Set TestInstance = TestInstanceFact.Item(TestInstanceId)
Set NewBugLinkFact = TestInstance.BugLinkFactory
Set NewBugLink = NewBugLinkFact.AddItem(null)
NewBugLink.TargetEntity = NewBug
NewBugLink.Post
End If
On Error GoTo 0
End Sub
Or if you are working with ALM 12.53, you can try executing masthead "New Defect" action available from all modules.
Actions.Action("HeaderActions.HeaderNewDefect").Execute

I am getting a thread error when attempting to open a form based on a timer tick event

I have a program that runs a scoretable front screen. I want to have a running ad loop of videos that pop up based on a timer. I created a separate form to play the video and am using a timer to open the form and play one video, then I am incrementing a global variable, closing the form, then waiting for the timer to reopen the form. When the timer tries to reopen the form, it is giving me a thread error. I am somewhat new to this level of coding and am confused about why this error is occuring and how to fix it. I read up on the topic and think I generally understand the problem, but can't seem to find the proper code to get it to work. Here is the code (global variable of VAds) I have used the invoke procedure to fix this problem with a picture box, but cant figure out the same thing for the video. Thanks in advance.
Private Sub PlayAdVideos(sender As Object, e As EventArgs) Handles VideoAds.Click
On Error Resume Next
If Application.OpenForms().OfType(Of frmAds).Any Then
frmVideoAds.Close()
Play_Ads.Text = "Start Video Advertisement Loop"
Exit Sub
Else
Play_Ads.Text = "Close Video Advertisement Loop"
Dim Sz As Integer
If ScreenNo.Text = "" Then
Sz = 1
Else
Sz = ScreenNo.Text
End If
Dim screen As Screen
screen = Screen.AllScreens(Sz)
frmVideoAds.StartPosition = FormStartPosition.Manual
frmVideoAds.Location = screen.Bounds.Location + New Point(0, 0)
frmVideoAds.WindowState = FormWindowState.Maximized
frmVideoAds.FormBorderStyle = FormBorderStyle.None
frmVideoAds.TopMost = True
frmVideoAds.BackColor = Color.Black
frmVideoAds.Show()
End If
For Each foundFile As String In My.Computer.FileSystem.GetFiles("C:\CCHS\VideoAds\")
VideoAdList.Items.Add(foundFile)
Next
If VideoAdList.Items.Count = 0 Then
Exit Sub
End If
Dim TMR2 As New System.Timers.Timer()
VideoAdNum = VideoAdList.Items.Count - 1
TMR2.Interval = 10000 'miliseconds
TMR2.Enabled = True
TMR2.Start()
AddHandler TMR2.Elapsed, AddressOf OnTimedEvent
End Sub
Public Sub OnTimedEvent(ByVal sender As Object, ByVal e As ElapsedEventArgs)
If frmVideoAds.InvokeRequired Then
If VAds = VideoAdNum Then
VAds = 0
Else
VAds = VAds + 1
End If
frmVideoAds.Invoke(Sub() frmVideoAds.Show())
Else
If VAds = VideoAdNum Then
VAds = 0
Else
VAds = VAds + 1
End If
frmVideoAds.Show()
End If
End Sub
System.Timers.Timer elapsed events will generally always be fired on a thread other than the UI thread.
Which means you'll have to call the frmVideoAds.Invoke every time you call frmVideoAds.Show() in that method.
Your else statement should just need to have the invoke added, which would make both execution paths the same so you could update the whole thing.
Public Sub OnTimedEvent(ByVal sender As Object, ByVal e As ElapsedEventArgs)
If VAds = VideoAdNum Then
VAds = 0
Else
VAds = VAds + 1
End If
frmVideoAds.Invoke(Sub() frmVideoAds.Show())
End Sub
This will generally work, but in some cases , ActiveX in particular, the System.Timers is required to be in a Single Threaded Apartment (STA). It defaults to a Multi threaded apartment (MTA). To force it into a STA mode simply add
TMR2.SynchronizingObject = Me
just before your TM2.Start().

Application Pool Status in IIS 7

I want to get status of a Application Pool. I have vbscript taken from here.
strArgAppPool = Wscript.Arguments.Unnamed.Item(0)
Const noError = False
' Establish the connection to the WMI provider
Set oWebAdmin = GetObject("winmgmts:root\WebAdministration")
' Search the AppPool passed as argument in the list of application pools
Set oAppPool = oWebAdmin.Get("ApplicationPool.Name='" & strArgAppPool & "'")
' Create nice messages for pool states
Select Case oAppPool.GetState
Case 0
StateDescription = "STARTING"
outputStatus = "WARNING! "
outputCode = 1
Case 1
StateDescription = "STARTED"
outputStatus = "OK! "
outputCode = 0
Case 2
StateDescription = "STOPPING"
outputStatus = "WARNING! "
outputCode = 1
Case 3
StateDescription = "STOPPED"
outputStatus = "CRITICAL!! "
outputCode = 2
Case 4
StateDescription = "UNKNOWN"
outputStatus = "UNKNOWN? "
outputCode = 3
Case Else
StateDescription = "UNDEFINED VALUE"
outputStatus = "UNKNOWN? "
outputCode = 3
End Select
' Output
Wscript.Echo outputStatus & oAppPool.Name & ": " & StateDescription
' Error handling
If noError = true Then
' Error message
Wscript.echo "UNKNOWN: Error during the WMI query for app pool " & strArgAppPool & " !"
' Exit & return code
WScript.Quit(3)
Else
' Clean exit
WScript.Quit(outputCode)
End If
Through a batch file I am trying to run it as
status1.vbs "DefaultAppPool"
But I ended up with this
Is it some service is not started? I have tried running the vb script directly. I have tried passing arguments without quotes and all similar stuff. I don't write scripts, but got to do it this time.
Error dialog indicates line 5, Set oWebAdmin = GetObject("winmgmts:root\WebAdministration"). I have tried everything I could in last 5 hours. I have a readymade script and I am not able to run it. Shame and was not willing post this question all this while. But lost in end. Thanks for any help.
Also I have a working script for IIS 6. I am calling this script through PsExec on a remote server. But that's not working in IIS 7. Let me know if anyone want me to post it. Also I am using IIS 7 and Server 2008 R2 now and will be running this script using PsExec on remote server.
You don't have the role service IIS Management Scripts and Tools installed. Launch Server Manager, go to Roles → Web Server (IIS), and install the missing service.

Resources