XProfan

Deutsch

E.T.

Einfache Frage, finde aber keine Lösung (auch nach 2-stündigem stöbern hier):
Kann ich per Profan-Prog (oder API) feststellen, ob (noch) Netzwerk - Verkehr stattfindet (Download, Streaming etc.) oder die NW-Verbindung "schläft" ??
Betrifft nur den Rechner, auf dem das Prog läuft, der restliche Verkehr im NW ist (mir) egal.

Grüße aus Sachsen... Mario
WinXP, Win7 (64 Bit),Win8(.1),Win10, Win 11, Profan 6 - X4, XPSE, und 'nen schwarzes, blinkendes Dingens, wo ich das alles reinschütte...

22.02.2010 ▲

Vollständiges Zitat

Absatzweise zitieren Zeilenweise zitieren

Per WMI (?) die Netzwerkadapter Listen und über deren Eingang/Ausgang-Status überwachen, ob das Netzwerk "schläft"? Habe mich mit WMI (noch) nicht beschäftigen können, trotz toller Beispiele (u.A. [...]

) von Andreas Miethe. Mach mal start, ausführen, cmd{enter}ipconfig /all{enter} für Adapterlistung. Man könnte auch per Hook messen, was genau solls werden? ^^ (ich glaube aber, es gibt APIs, auch ohne WMI, die dies ausgeben)

22.02.2010 ▲

Vollständiges Zitat

Absatzweise zitieren Zeilenweise zitieren

Schau mal auch: [...]

und [...]

22.02.2010 ▲

Vollständiges Zitat

Absatzweise zitieren Zeilenweise zitieren

E.T.

nmapi.dll >> Nur WIN 2000 ?? Habs unter XP nicht gefunden

Network Monitor Driver >>> Windows XP Embedded SP2 Feature Pack 2007, kann also auch nicht auf allen Systemen vorrausgesetzt zu werden...

Muss doch irgendeine (blöde) API geben, die auf allen Systemen (ab XP) da ist !!!

[offtopic]Hab schon eckige Glotzen vom lesen im I-Net, MSDN,...

[/offtopic]

Ich brauch doch "nur" ein Ja oder Nein, ob noch Traffic anliegt. Was da geschaufelt wird, ist mir völlig egal.

Grüße aus Sachsen... Mario
WinXP, Win7 (64 Bit),Win8(.1),Win10, Win 11, Profan 6 - X4, XPSE, und 'nen schwarzes, blinkendes Dingens, wo ich das alles reinschütte...

22.02.2010 ▲

Vollständiges Zitat

Absatzweise zitieren Zeilenweise zitieren

nmapi.dll scheint auch bei mir nicht dabei:
Kompilieren Markieren Separieren

print usedll("nmapi.dll")
waitinput
end

scheitert.

Es wird schon eine API geben, die sowas wie aktuelle Gesamtanz. Pakete eingehend/ausgehend pro Adapter zurückliefert, was dann "kein Traffic" bedeutet musst Du aber wahrscheinlich selbst z.B. per "Anz.Pakete in letzte Sekunde" "bestimmten".

22.02.2010 ▲

Vollständiges Zitat

Absatzweise zitieren Zeilenweise zitieren

Bekommst Du es mit dem WMI Code Creator [...]

heraus?

Bei mir gibt dieser Code:
Kompilieren Markieren Separieren

strComputer = "."
Set objWMIService = GetObject("winmgmts:\" & strComputer & "ootCIMV2")
Set colItems = objWMIService.ExecQuery( _
"SELECT * FROM Win32_PerfRawData_Tcpip_NetworkInterface",,48)
For Each objItem in colItems
Wscript.Echo "-----------------------------------"
Wscript.Echo "Win32_PerfRawData_Tcpip_NetworkInterface instance"
Wscript.Echo "-----------------------------------"
Wscript.Echo "PacketsSentPersec: " & objItem.PacketsSentPersec
Next

einen Wert zurück, welcher schneller steigt, desto aktiver ich z.B. browse.

22.02.2010 ▲

Vollständiges Zitat

Absatzweise zitieren Zeilenweise zitieren

Andreas
Miethe

DOKTOR XPROFAN EHRENHALBER

Versuchs mal hiermit. Es wird die Anzahl der Vebindungen angezeigt.
Kompilieren Markieren Separieren

 $H windows.ph
####################
benötigte Dlls laden
Var ole& = ImportDll("ole32.dll","")
Var oleaut& = ImportDll("oleaut32.dll","")
####################
####################
Hilfsfunktionen

Proc StringToBStr

    Parameters s$
    Var Unicode$ = Space$((Len(S$)*2)+1)
    ~MultiByteToWideChar(0,0,Addr(S$),-1,Addr(Unicode$),Len(Unicode$))
    return SysAllocString(addr(Unicode$))

EndProc

Proc UniToPrf

    Parameters U&
    Var P$ = Space$(1000)
    ~WideCharToMultiByte(0,0,U&,-1,Addr(p$),len(P$),0,0)
    return SysAllocString(addr(p$))

EndProc

####################
####################
Konstanten
Def &COINIT_MULTITHREAD  0
Def &RPC_C_AUTHN_LEVEL_CONNECT  2
Def &RPC_C_IMP_LEVEL_IDENTIFY  2
Def &EOAC_NONE  0
Def &RPC_C_AUTHN_WINNT  10
Def &RPC_C_AUTHZ_NONE  0
Def &RPC_C_AUTHN_LEVEL_CALL  3
Def &RPC_C_IMP_LEVEL_IMPERSONATE  3
Def &CLSCTX_INPROC_SERVER  1
Def &wbemFlagReturnImmediately  16
Def &wbemFlagForwardOnly  32
Def &IFlags (&wbemFlagReturnImmediately + &wbemFlagForwardOnly)
Def &WBEM_INFINITE  $FFFFFFFF
Def $WMISeparator = ","
####################
####################
Strukturen
Struct VARIANT = vt%,
wReserved1%,
wReserved2%,
wReserved3%,
Union#(8)
Struct IWbemServices = QueryInterface&,
AddRef&,
Release&,
OpenNamespace&,
CancelAsyncCall&,
QueryObjectSink&,
GetObject&,
GetObjectAsync&,
PutClass&,
PutClassAsync&,
DeleteClass&,
DeleteClassAsync&,
CreateClassEnum&,
CreateClassEnumAsync&,
PutInstance&,
PutInstanceAsync&,
DeleteInstance&,
DeleteInstanceAsync&,
CreateInstanceEnum&,
CreateInstanceEnumAsync&,
ExecQuery&,
ExecQueryAsync&,
ExecNotificationQuery&,
ExecNotificationQueryAsync&,
ExecMethod&,
ExecMethodAsync&
Struct IWbemLocator = QueryInterface&,
AddRef&,
Release&,
ConnectServer&
Struct IEnumWbemClassObject = QueryInterface&,
AddRef&,
Release&,
Reset&,
Next&,
NextAsync&,
Clone&,
Skip&
Struct IWbemClassObject = QueryInterface&,
AddRef&,
Release&,
GetQualifierSet&,
Get&,
Put&,
Delete&,
GetNames&,
BeginEnumeration&,
Next&,
EndEnumeration&,
GetPropertyQualifierSet&,
Clone&,
GetObjectText&,
SpawnDerivedClass&,
SpawnInstance&,
CompareTo&,
GetPropertyOrigin&,
InheritsFrom&,
GetMethod&,
PutMethod&,
DeleteMethod&,
BeginMethodEnumeration&,
NextMethod&,
EndMethodEnumeration&,
GetMethodQualifierSet&,
GetMethodOrigin&
Struct IUnknown =  QueryInterface&,
AddRef&,
Release&
####################
####################
Interfaces
Declare CLSID_IEnumWbemClassObject#
Dim CLSID_IEnumWbemClassObject#,16
Long CLSID_IEnumWbemClassObject#,0 = $1B1CAD8C
Word CLSID_IEnumWbemClassObject#,4 = $2DAB, $11D2
Byte CLSID_IEnumWbemClassObject#,8 = $B6, $04, $00, $10, $4B, $70, $3E, $FD
Declare IID_IEnumWbemClassObject#
Dim IID_IEnumWbemClassObject#,16
Long IID_IEnumWbemClassObject#,0 = $7C857801
Word IID_IEnumWbemClassObject#,4 = $7381, $11CF
Byte IID_IEnumWbemClassObject#,8 = $88, $4D, $00, $AA, $00, $4B, $2E, $24
Declare CLSID_WbemLocator#
Dim CLSID_WbemLocator#,16
Long CLSID_WbemLocator#,0 = $4590F811
Word CLSID_WbemLocator#,4 = $1D3A, $11D0
Byte CLSID_WbemLocator#,8 = $89,$1F,$00,$AA,$00,$4B,$2E,$24
Declare IID_IWbemLocator#
Dim IID_IWbemLocator#,16
Long IID_IWbemLocator#,0 = $DC12A687
Word IID_IWbemLocator#,4 = $737F, $11CF
Byte IID_IWbemLocator#,8 = $88,$4D,$00,$AA,$00,$4B,$2E,$24
Declare IID_IUnknown#
Dim IID_IUnknown#,16
Long IID_IUnknown#,0 = $00000000
Word IID_IUnknown#,4 = $0000, $0000
Byte IID_IUnknown#,8 = $C0, $00, $00, $00, $00, $00, $00, $46
####################
####################
globale Variablen
Declare Variant#,Union#,IWbemLocator#,IWbemServices#,IEnumWbemClassObject#,IWbemClassObject#,IUnknown#
Declare IWbemLocator&,IWbemServices&,IUnknown&,IEnumWbemClassObject&,IWbemClassObject&
Dim Variant#, VARIANT
Union# = Variant# + 8
Dim IWbemLocator#,IWbemLocator
Dim IWbemServices#,IWbemServices
Dim IEnumWbemClassObject#,IEnumWbemClassObject
Dim IWbemClassObject#,IWbemClassObject
Dim IUnknown#,IUnknown
####################

Proc FillInterface

    Interface-Strukturen füllen
    Parameters IFace#

    WhileLoop 0, SizeOf(IFace#)-4,4

        Long IFace#,&Loop = &Loop

    EndWhile

Endproc

Proc wmi_release

    Freigaben
    Parameters dummy$
    Case IWbemServices& <> 0 : Call(Long(Long(IWbemServices&,0),IWbemServices#.Release&),IWbemServices&)
    Case IWbemLocator& <> 0: Call(Long(Long(IWbemLocator&,0),IWbemLocator#.Release&),IWbemLocator&)
    Case IEnumWbemClassObject& <> 0 : Call(Long(Long(IEnumWbemClassObject&,0),IEnumWbemClassObject#.Release&),IEnumWbemClassObject&)
    Case IWbemClassObject& <> 0: Call(Long(Long(IWbemClassObject&,0),IWbemClassObject#.Release&),IWbemClassObject&)
    CoUninitialize()

    If Instr(dummy$, "Fehler", 1)

        MessageBox("", dummy)
        End

    EndIf

EndProc

Proc wmi_init

    WMI initialisieren
    Declare hRes&
    Var txt$ = ""
    CoInitializeEx(0,&COINIT_MULTITHREAD)
    hres& = CoInitializeSecurity(0, -1,0,0,&RPC_C_AUTHN_LEVEL_CONNECT,&RPC_C_IMP_LEVEL_IDENTIFY,0,&EOAC_NONE,0)

    If hres& <> 0: txt$="Fehler: nicht möglich CoInitializeSecurity aufzurufen": wmi_release(txt$): EndIf

        hres& = CoCreateInstance(CLSID_WbemLocator#,0,&CLSCTX_INPROC_SERVER,IID_IWbemLocator#,addr(IWbemLocator&))

        If hres& <> 0: txt$="Fehler: nicht möglich CoCreateInstance aufzurufen": wmi_release(txt$): EndIf €

            hRes& = Call(Long(Long(IWbemLocator&,0),IWbemLocator#.ConnectServer&),IWbemLocator&,StringToBStr("root\cimv2"),0,0,0,0,0,0,addr(IWbemServices&))

            If hres& <> 0: txt$="Fehler: micht möglich IWbemLocator.ConnectServer aufzurufen": wmi_release(txt$): EndIf

                hRes& = Call(Long(Long(IWbemServices&,0),IWbemServices#.QueryInterface&),IWbemServices&,IID_IUnknown#,Addr(IUnknown&))
                hres&=CoSetProxyBlanket(IWbemServices&,&RPC_C_AUTHN_WINNT,&RPC_C_AUTHZ_NONE,0,&RPC_C_AUTHN_LEVEL_CALL,&RPC_C_IMP_LEVEL_IMPERSONATE,0,&EOAC_NONE)

                If hres& <> 0: txt$="Fehler: nicht möglich CoSetProxyBlanket aufzurufen": wmi_release(txt$): EndIf

                    hres&=CoSetProxyBlanket(IUnknown&,&RPC_C_AUTHN_WINNT,&RPC_C_AUTHZ_NONE,0,&RPC_C_AUTHN_LEVEL_CALL,&RPC_C_IMP_LEVEL_IMPERSONATE,0,&EOAC_NONE)

                    If hres& <> 0: txt$="Fehler: nicht möglich CoSetProxyBlanket aufzurufen": wmi_release(txt$): EndIf

                        Call(Long(Long(IUnknown&,0),IUnknown#.Release&),IUnknown&)
                        Return txt$

                    EndProc

                    Proc wmi_call

                        WMI-Aufruf
                        Parameter(3) Select-Anweisung,Auswahl
                        Rückgabe erfolgt in einer Stringliste
                        wmi_init()
                        Parameters Command$,Vars$
                        Var CountVars& = 1
                        Var hList& =  @create("List",0)
                        Var RetList& =  @create("List",0)
                        ClearList hList&

                        Whileloop 1,Len(Vars$)

                            If Mid$(Vars$,&loop,1)=","

                                Inc Countvars&

                            Endif

                        Endwhile

                        Whileloop 1,Countvars&

                            AddString(hList&, Substr$(Vars$,&loop,","))

                        Endwhile

                        Declare hres&,uReturn&,nDim&,plUBound&,A$,rgVar&,z&,obj&
                        Obj& = 1
                        Call(Long(Long(IWbemServices&,0),IWbemServices#.ExecQuery&),IWbemServices&,StringToBStr("WQL"),StringToBStr(command$),0,0,Addr(IEnumWbemClassObject&))

                        If hres& <> 0: txt$="Fehler: nicht möglich IWbemServices::ExecQuery aufzurufen": wmi_release(txt$): EndIf

                            hres& = Call(Long(Long(IEnumWbemClassObject&,0),IEnumWbemClassObject#.Reset&),IEnumWbemClassObject&)

                            If hres& = 0: txt$="Fehler: nicht möglich IEnumWbemClassObject::aufzurufen": wmi_release(txt$): EndIf

                                Var NO& = 1

                                While NO&

                                    hRes& = Call(Long(Long(IEnumWbemClassObject&,0),IEnumWbemClassObject#.Next&),IEnumWbemClassObject&,&WBEM_INFINITE,1,Addr(IWbemClassObject&),Addr(uReturn&))

                                    If hRes& = 0 : NO& = 1 : Endif

                                        If uReturn& <> 0

                                            Whileloop 1,Countvars&

                                                hRes& = Call(Long(Long(IWbemClassObject&,0),IWbemClassObject#.Get&),IWbemClassObject&,StringToBStr(Getstring$(hList&,&loop-1)),0,Variant#,0,0)Select Word(Variant#,0)

                                                Select Variant#.vt%

                                                    Caseof 1

                                                    AddString(RetList&,"n/a")

                                                    Caseof 3

                                                    AddString(RetList&,Str$(Long(Union#,0)))

                                                    Caseof 8

                                                    If Instr("Date",Getstring$(hList&,&loop-1)) Or Instr("Time",Getstring$(hList&,&loop-1))

                                                        A$ = String$(UniToPrf(Long(Union#,0)),0)
                                                        A$ = Mid$(A$, 7, 2)+"."+Mid$(A$, 5, 2)+"."+Mid$(A$, 1, 4)+" "+Mid$(A$, 9, 2)+":"+Mid$(A$, 11,2)+":"+Mid$(A$, 13,2)
                                                        AddString(RetList&,+A$)

                                                    else

                                                        AddString(RetList&,String$(UniToPrf(Long(Union#,0)),0))

                                                    endif

                                                    Caseof 11

                                                    If byte(Union#,0) = 0

                                                        AddString(RetList&,"falsch")

                                                    Else

                                                        AddString(RetList&,"falsch")

                                                    Endif

                                                    Caseof 8195

                                                    nDim&=SafeArrayGetDim(Long(Union#,0))
                                                    A$ = ""
                                                    z& = 0
                                                    SafeArrayGetUBound(Long(Union#,0), nDim&, Addr(plUbound&))

                                                    Whileloop 0,plUbound&

                                                        SafeArrayGetElement(Long(Union#,0),addr(&loop), Addr(rgVar&))
                                                        A$ = A$ + ","+Str$(rgVar&)

                                                    EndWhile

                                                    A$ = Mid$(A$,2,Len(A$))
                                                    AddString(RetList&,A$)

                                                    Caseof 8200

                                                    nDim&=SafeArrayGetDim(Long(Union#,0))
                                                    A$ = ""
                                                    z& = 0
                                                    SafeArrayGetUBound(Long(Union#,0), nDim&, Addr(plUbound&))

                                                    Whileloop 0,plUbound&

                                                        SafeArrayGetElement(Long(Union#,0),addr(&loop), Addr(rgVar&))
                                                        A$ = A$ + ","+String$(UnitoPrf(rgVar&),0)

                                                    EndWhile

                                                    A$ = Mid$(A$,2,Len(A$))
                                                    AddString(RetList&,Getstring$(hList&,&loop-1)+" : "+ A$)

                                                endselect

                                            endwhile

                                        Else

                                            NO& = 0

                                        Endif

                                        Inc Obj&

                                    EndWhile

                                Endif

                                wmi_release()
                                Return Retlist&

                            Endproc

                            Proc FreeWMI

                                Dispose Variant#,Union#,IWbemLocator#,IWbemServices#,IEnumWbemClassObject#,IWbemClassObject#,IUnknown#

                            Endproc

                            ####################
                            Interface-Strukuren füllen
                            FillInterface(IWbemLocator#)
                            FillInterface(IWbemServices#)
                            FillInterface(IEnumWbemClassObject#)
                            FillInterface(IWbemClassObject#)
                            FillInterface(IUnknown#)
                            ####################
                            ###################################################
                            TEST
                            ###################################################
                            Decimals 2
                            windowstyle 527
                            cls

                            Proc CountConnections

                                Var l& = wmi_call("SELECT * FROM Win32_PerfFormattedData_Tcpip_TCPv4","ConnectionsEstablished")
                                Return Int(Val(GetString$(l&,0)))

                            EndProc

                            Print "Verbindungen" ,CountConnections()
                            Var ende& = 0

                            Whilenot ende&

                                waitinput 1000

                                If %Key = 2

                                    Ende& = 1

                                endif

                                Locate 0,0
                                Print "Verbindungen" ,CountConnections()

                            Endwhile

                            FreeWMI()
                            end

Gruss
Andreas
________ ________ ________ ________ _
Profan 3.3 - XProfanX2
Win 95,98,ME,2000,XP,Vista - Win 7 32 / 64 Bit
ASUS X93S - Intel Core I7-NVIDIA GForce 540M 8GB Arbeitsspeicher
Homepage : [...]

23.02.2010 ▲

Vollständiges Zitat

Absatzweise zitieren Zeilenweise zitieren

Hallo Andreas, war mit Deiner Session etwas schiefgelaufen? Wurde als Gast angezeigt.

Für solche Codes, für die die Nity-Anzeige zu "blöd" ist, empfehle ich den Qelltext-Merker [...]

- ich nehme den jedenfalls immer sehr gerne.

23.02.2010 ▲

Vollständiges Zitat

Absatzweise zitieren Zeilenweise zitieren

E.T.

Irgendwie gibt das WMI-Gedöns nur (für mich wirre) Zahlen zurück

.

@Andreas: Dein Code sieht vielerschreckend aus, leider läuft dieser bei mir nur bis zum
ersten Print "Verbindungen" ,CountConnections() , dann beendet sich das Programm (XProfan 11.2a)

[offtopic]Man(n) müsste einfach mehr Zeit haben...[/offtopic]

Grüße aus Sachsen... Mario
WinXP, Win7 (64 Bit),Win8(.1),Win10, Win 11, Profan 6 - X4, XPSE, und 'nen schwarzes, blinkendes Dingens, wo ich das alles reinschütte...

01.03.2010 ▲

Vollständiges Zitat

Absatzweise zitieren Zeilenweise zitieren