'Ä=Ž , Ö=™ , Ü=š ; ä=„ , ö=”, ü= , ß=á ,§=õ , ©=¸
#include "vbcompat.bi"
#include "windows.bi"
Type SvcRec
SvcName As String
DispName As String
SvcType As String
State As String
Contd As String
W32ExitCode As String
SvcExitCode As String
ChkPt As String
W8Hint As String
PId As String
Flags As String
End Type
Declare Sub SaveAll(byVal DateiExt As String, byVal Which As String)
Declare Function SkipSpecials(s As String) As String
Declare Function Exists(DateiName As String) As Integer
Declare Function MenuChar(s As String, First As Integer=1, nVG As Byte=12) As String
Declare Sub AnsiToOem Lib "USER32" Alias "CharToOemA" (byVal ANSI As String, byVal ASCII As String)
Const MaxServices=200 'or how many you are using..
Dim CurColor(2) As ZString Ptr={@"#d2f6cc", @"white"}
Dim Services(MaxServices) As SvcRec
Dim Shared As Integer DNr
Dim As String SC, s, t, Csv, Htm, m
Dim As Integer i=-1, j, Stopped, Running
SC=Environ("windir") &"\System32\Sc.Exe"
DNr=FreeFile
If Not Exists(SC) Then
Print "SC.Exe not found or not properly installed ;-))"
GetKey
End
End If
Csv="ShowAllServices.Bas ©2008 by ytwinky, MD " &Format(Now, "dd.mm.yyyy, hh:mm:ss") &" am " &Environ("ComputerName")
Htm=""
Htm+=""
Htm+="| " &Csv &" |
|---|
"
Htm+="| lfd. | Display_Name | Service_Name | Status | Prozeß-ID |
|---|
"
Csv+=!"\nlfd.;Display_Name;Service_Name;Status;Prozeß-ID\n"
Open Pipe SC &" QueryEx state= all" For Input As DNr
While Not Eof(DNr)
i+=1
With Services(i)
Line Input #DNr, s 'there may be commas in the line, ignore them..
Line Input #DNr, s 's.a.
.SvcName=SkipSpecials(s)
Line Input #DNr, s 's.a.
.DispName=SkipSpecials(s)
Line Input #DNr, s 's.a.
.SvcType=SkipSpecials(s)
Line Input #DNr, s 's.a.
.State=RTrim(Mid(SkipSpecials(s), 4))
Stopped+=Abs(.State="STOPPED")
Running+=Abs(.State="RUNNING")
Line Input #DNr, s 's.a.
.Contd=SkipSpecials(s)
Line Input #DNr, s 's.a.
.W32ExitCode=SkipSpecials(s)
Line Input #DNr, s 's.a.
.SvcExitCode=SkipSpecials(s)
Line Input #DNr, s 's.a.
.ChkPt=SkipSpecials(s)
Line Input #DNr, s 's.a.
.W8Hint=SkipSpecials(s)
Line Input #DNr, s 's.a.
.PId=SkipSpecials(s)
Line Input #DNr, s 's.a.
.Flags=SkipSpecials(s)
t=Str(i+1)
If i<99 Then t=" " &t
If i<9 Then t=" " &t
t+=".;" &.DispName &";" &.SvcName &";" &.State &";" &.PId
If .SvcName<>"" Then
Csv+=t &!"\n"
Htm+="| " &(i+1) &". | " &.DispName &" | " &.SvcName &" | " &.State &" | " &.PId &" |
"
End If
End With
Wend
Close DNr
t=Stopped &" Dienste gestoppt, " &Running &" laufen.."
Csv+=t
Htm+="| " &t &" |
"
t=Csv
AnsiToOem(t, t)
Print t
Print "Speichern (";
Print MenuChar("Csv") &", ";
Print MenuChar("Htm") &", ";
Print MenuChar("N”") &")"
Print "Was darf's denn sein?";
Do
m=lcase(Input(1))
Loop Until Len(m)=1
Print m
If m="c" Then SaveAll("Csv", Csv)
If m="h" Then SaveAll("Htm", Htm)
End
Function SkipSpecials(s As String) As String
Return LTrim(Mid(s, 2+IIF(Instr(s, ":")=0, 1, Instr(s, ":"))))
End Function
Function Exists(DateiName As String) As Integer
Dim As Byte Nr, Missing
Nr=FreeFile
Missing=Open(DateiName For Input As Nr)
If Not Missing Then Close Nr
Return Missing=0
End Function
Function MenuChar(s As String, First As Integer=1, nVG As Byte=12)As String
If First<>1 Then Print Left(s, First-1);
Color nVG
Print Chr(s[First-1]);
Color 7
Return Mid(s, First+1)
End Function
Sub SaveAll(byVal DateiExt As String, byVal Which As String)
Dim As String Vorgabe, m
Vorgabe=Environ("Tmp") &"\ShowAllServices." &DateiExt
Print "Speichern als " &Vorgabe
Print "Dateiname eingeben/Vorgabe akzeptieren"
Input "Enter beendet die Eingabe:", m
If m="" Then m=Vorgabe
Open m For OutPut As #DNr
Print #DNr,, Which
Close #DNr
End Sub