XProfan

- page 1 -

E.T.

Feine l'affaire, mais Programme "bescheißt"

qui réellement eingebaute grenier wäre aussi encore intéressant,
XP verrät cela De toute façon pas

Beschiss.png	13 kB

Hochgeladen:	21.01.2010

Downloadcounter:
		Download

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...

Arbeitsplatz rechte Bouton de la souris Eigenschaften - steht es aussi pas? Spätestens wohl per WMI abfragbar - peut-être pourrait Roland pour WMI une Stittschnelle bereitstellen - habe de WMI mais je n'en sais rien.

cet Speicherrechnerei ist vraie irr, mais aussi verständlich - gibt so viel grenier dass wohl aussi Windows aucun concept plus hat, comment on le reste verrechnen soll.

mais seulement Mut zur Lücke, wohin un Byte ist, trouver sich meist aussi Anhänger!

iF, Beitrag=55898, Zeitpunkt=21.01.2010

Andreas
Miethe

DOKTOR XPROFAN EHRENHALBER

Spätestens wohl per WMI abfragbar - peut-être pourrait Roland pour WMI une Stittschnelle bereitstellen - habe de WMI mais je n'en sais rien.

ici qui WMI-Schnittstelle avec einem kleinen Beispiel

Kompilieren Marque Séparation

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

Proc StringToBStr

    Paramètres 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

    Paramètres 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
Déclarer CLSID_IEnumWbemClassObject#
Faible 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
Déclarer IID_IEnumWbemClassObject#
Faible 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
Déclarer CLSID_WbemLocator#
Faible 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
Déclarer IID_IWbemLocator#
Faible 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
Déclarer IID_IUnknown#
Faible 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
Déclarer Variant#,Union#,IWbemLocator#,IWbemServices#,IEnumWbemClassObject#,IWbemClassObject#,IUnknown#
Déclarer IWbemLocator&,IWbemServices&,IUnknown&,IEnumWbemClassObject&,IWbemClassObject&
Faible Variant#, VARIANT
Union# = Variant# + 8
Faible IWbemLocator#,IWbemLocator
Faible IWbemServices#,IWbemServices
Faible IEnumWbemClassObject#,IEnumWbemClassObject
Faible IWbemClassObject#,IWbemClassObject
Faible IUnknown#,IUnknown
####################

Proc FillInterface

    Interface-Strukturen füllen
    Paramètres IFace#

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

        Long IFace#,&Boucle = &Boucle

    Endwhile

ENDPROC

Proc wmi_release

    Freigaben
    Paramètres dummy$
    Cas IWbemServices& <> 0 : Call(Long(Long(IWbemServices&,0),IWbemServices#.Release&),IWbemServices&)
    Cas IWbemLocator& <> 0: Call(Long(Long(IWbemLocator&,0),IWbemLocator#.Release&),IWbemLocator&)
    Cas IEnumWbemClassObject& <> 0 : Call(Long(Long(IEnumWbemClassObject&,0),IEnumWbemClassObject#.Release&),IEnumWbemClassObject&)
    Cas IWbemClassObject& <> 0: Call(Long(Long(IWbemClassObject&,0),IWbemClassObject#.Release&),IWbemClassObject&)
    CoUninitialize()

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

        MessageBox(», dummy)
        Fin

    EndIf

ENDPROC

Proc wmi_init

    WMI initialisieren
    Déclarer 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)

    Si hres& <> 0: txt$="Fehler: pas possible CoInitializeSecurity aufzurufen": wmi_release(txt$): EndIf

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

        Si hres& <> 0: txt$="Fehler: pas possible 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&))

            Si hres& <> 0: txt$="Fehler: micht possible 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)

                Si hres& <> 0: txt$="Fehler: pas possible 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)

                    Si hres& <> 0: txt$="Fehler: pas possible CoSetProxyBlanket aufzurufen": wmi_release(txt$): EndIf

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

                    ENDPROC

                    Proc wmi_call

                        WMI-Aufruf
                        paramètre(3) Select-Anweisung,sélection
                        Rückgabe erfolgt dans einer Stringliste
                        wmi_init()
                        Paramètres Command$,Vars$
                        Var CountVars& = 1
                        Var hList& =  @create("List",0)
                        Var RetList& =  @create("List",0)
                        ClearList hList&

                        Whileloop 1,Len(Vars$)

                            Si Mid $(Vars$,&loop,1)=»

                                Inc Countvars&

                            Endif

                        Endwhile

                        Whileloop 1,Countvars&

                            AddStrings(hList&, Substr$(Vars$,&loop,»))

                        Endwhile

                        Déclarer 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&))

                        Si hres& <> 0: txt$="Fehler: pas possible IWbemServices::ExecQuery aufzurufen": wmi_release(txt$): EndIf

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

                            Si hres& = 0: txt$="Fehler: pas possible IEnumWbemClassObject::aufzurufen": wmi_release(txt$): EndIf

                                Var NO& = 1

                                Tandis que NO&

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

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

                                        Si 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

                                                    AddStrings(RetList&,"n/a")

                                                    Caseof 3

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

                                                    Caseof 8

                                                    Si 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)
                                                        AddStrings(RetList&,+A$)

                                                    d'autre

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

                                                    endif

                                                    Caseof 11

                                                    Si byte(Union#,0) = 0

                                                        AddStrings(RetList&,"falsch")

                                                    D'autre

                                                        AddStrings(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$))
                                                    AddStrings(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$))
                                                    AddStrings(RetList&,Getstring$(hList&,&loop-1)+" : "+ A$)

                                                endselect

                                            endwhile

                                        D'autre

                                            NO& = 0

                                        Endif

                                        Inc Obj&

                                    Endwhile

                                Endif

                                wmi_release()
                                Retour 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
                            style de fenêtre 527
                            cls
                            Var Div! = 1024^2
                            Var Div3! = 1024^3
                            Var TotalMem! = 0
                            Var MemAVail! = 0
                            capacité qui installierten Speicherbausteine abfragen.
                            Je Baustein wird un un String dans une Stringliste hinzugefügt.
                            dans qui Boucle volonté qui Einzel-Kapazitäten zusammengezählt.
                            Var l& = wmi_call("SELECT * FROM Win32_PhysicalMemory","Capacity")

                            Whileloop 0,GetCount(l&)-1

                                TotalMem! = TotalMem! + Val(GetString$(l&,&Boucle))

                            Endwhile

                            capacité des Arbeitsspeichers, qui de Windows pour den User zur
                            Disposition gestellt wird
                            L& =wmi_call("SELECT * FROM Win32_ComputerSystem","TotalPhysicalMemory")

                            Whileloop 0,GetCount(l&)-1,2

                                MemAvail! = MemAvail! + Val(GetString$(l&,&Boucle))

                            Endwhile

                            Ausgeben

                            Si TotalMem! <> 0

                                Imprimer "Physikalischer grenier : ",TotalMem!/div!,"MB"

                            D'autre

                                Imprimer "Physikalischer grenier : ",GetMem()/div!,"MB"

                            Endif

                            Imprimer "Arbeitsspeicher total   : ",MemAvail!/div!,"MB"
                            capacité qui Partitionen
                            Es volonté 3 Werte pro Partition abgefragt, daher dans qui Boucle Step 3
                            Es volonté seulement Partitionen abgefragt en Grösse > 0 est.
                            D.h. aucun vider CD-Laufwerke
                            Localiser 6,0
                            l& = wmi_call("SELECT * FROM Win32_LogicalDisk where Size > 0","Name,Freespace,Size")

                            Whileloop 0,GetCount(l&)-1,3

                                Ausgeben
                                Imprimer GetString$(l&,&Boucle),"Frei :" ,Val(GetString$(l&,&Boucle+1))/div3!,"GB ","Total :",Val(GetString$(l&,&Boucle+2))/div3!,"GB"

                            Endwhile

                            Proc showmem

                                Kontinuierliche Abfrage des freien Mémoire
                                Var Freespace! = 0
                                Var Avail! = 0
                                Var Size! = 0
                                locate 3,0
                                Localiser 6,0
                                l& = wmi_call("SELECT * FROM Win32_LogicalDisk where Size > 0","Name,Freespace,Size")

                                Whileloop 0,GetCount(l&)-1,3

                                    Ausgeben
                                    Imprimer GetString$(l&,&Boucle),"Frei :" ,Val(GetString$(l&,&Boucle+1))/div3!,"GB ","Total :",Val(GetString$(l&,&Boucle+2))/div3!,"GB"

                                Endwhile

                                Imprimer Space$(50)
                                locate 3,0
                                L& =wmi_call("SELECT * FROM Win32_PerfRawData_PerfOS_Memory","AvailableBytes")

                                Whileloop 0,GetCount(l&)-1

                                    Avail! = Avail! + Val(GetString$(l&,&Boucle))

                                Endwhile

                                Imprimer "Speicher libre           : ",Avail!/div!,"MB"
                                Imprimer "Speicher benutzt        : ",(MemAvail!-Avail!)/div!,"MB"
                                Imprimer »

                            ENDPROC

                            showmem()
                            Var ende& = 0

                            Whilenot ende&

                                waitinput 100

                                Si %Key = 2

                                    Ende& = 1

                                endif

                                showmem()

                            Endwhile

                            FreeWMI()
                            end

                            Proc GetMem

                                Struct MEMORYSTATUSEX =
                                dwLength&,
                                dwMemoryLoad&,
                                ullTotalPhysLow&,
                                ullTotalPhysHi&,
                                ullAvailPhysLow&,
                                ullAvailPhysHi&,
                                ullTotalPageFileLow&,
                                ullTotalPageFileHi&,
                                ullAvailPageFileLow&,
                                ullAvailPageFileHi&,
                                ullTotalVirtualLow&,
                                ullTotalVirtualHi&,
                                ullAvailVirtualLow&,
                                ullAvailVirtualHi&,
                                ullAvailExtendedVirtualLow&,
                                ullAvailExtendedVirtualHi&
                                Var Memory# = New(MEMORYSTATUSEX)
                                Memory#.dwLength& = SizeOf(Memory#)
                                Externe("Kernel32.dll","GlobalMemoryStatusEx",Memory#)
                                Var TotalMem! = 0
                                Totalmem! = Memory#.ullTotalPhysLow&
                                cas Memory#.ullTotalPhysLow& < 0: TotalMem! =  Memory#.ullTotalPhysLow& + (2^32)
                                TotalMem! = (Memory#.ullTotalPhysHi& * (2^32)) + TotalMem!
                                Dispose Memory#
                                Retour TotalMem!

                            ENDPROC

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 : [...]

Jaul, super! si je wieder dans Dt. suis! ensuite! Hoho!

E.T.

simple Cool

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.01.2010 ▲

Kompilieren Marque Séparation

Jörg
Sellmeyer

Hab versucht, cela la fois wiederherzustellen. malheureusement gibt es entre $B "1" et $B "1.1" ne Schutzverletzung.

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

Proc StringToBStr

    Paramètres 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

    Paramètres 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
Déclarer CLSID_IEnumWbemClassObject#
Faible 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
Déclarer IID_IEnumWbemClassObject#
Faible 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
Déclarer CLSID_WbemLocator#
Faible 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
Déclarer IID_IWbemLocator#
Faible 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
Déclarer IID_IUnknown#
Faible 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
Déclarer Variant#,Union#,IWbemLocator#,IWbemServices#,IEnumWbemClassObject#,IWbemClassObject#,IUnknown#
Déclarer IWbemLocator&,IWbemServices&,IUnknown&,IEnumWbemClassObject&,IWbemClassObject&
Faible Variant#, VARIANT
Union# = Variant# + 8
Faible IWbemLocator#,IWbemLocator
Faible IWbemServices#,IWbemServices
Faible IEnumWbemClassObject#,IEnumWbemClassObject
Faible IWbemClassObject#,IWbemClassObject
Faible IUnknown#,IUnknown
'####################

Proc FillInterface

    'Interface-Strukturen füllen
    Paramètres IFace#

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

        Long IFace#,&Boucle = &Boucle

    Endwhile

ENDPROC

Proc wmi_release

    'Freigaben
    Paramètres dummy$
    Cas IWbemServices& <> 0 : Call(Long(Long(IWbemServices&,0),IWbemServices#.Release&),IWbemServices&)
    Cas IWbemLocator& <> 0: Call(Long(Long(IWbemLocator&,0),IWbemLocator#.Release&),IWbemLocator&)
    Cas IEnumWbemClassObject& <> 0 : Call(Long(Long(IEnumWbemClassObject&,0),IEnumWbemClassObject#.Release&),IEnumWbemClassObject&)
    Cas IWbemClassObject& <> 0: Call(Long(Long(IWbemClassObject&,0),IWbemClassObject#.Release&),IWbemClassObject&)
    CoUninitialize()

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

        MessageBox(», dummy)
        Fin

    EndIf

ENDPROC

Proc wmi_init

    'WMI initialisieren
    Déclarer 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)

    Si hres& <> 0: txt$="Fehler: pas possible CoInitializeSecurity aufzurufen": wmi_release(txt$): EndIf

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

        Si hres& <> 0: txt$="Fehler: pas possible 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&))

            Si hres& <> 0: txt$="Fehler: micht possible 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)

                Si hres& <> 0: txt$="Fehler: pas possible 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)

                    Si hres& <> 0: txt$="Fehler: pas possible CoSetProxyBlanket aufzurufen": wmi_release(txt$): EndIf

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

                    ENDPROC

                    Proc wmi_call

                        'WMI-Aufruf
                        'paramètre(3) Select-Anweisung,sélection
                        'Rückgabe erfolgt dans einer Stringliste
                        wmi_init()
                        Paramètres Command$,Vars$
                        Var CountVars& = 1
                        Var hList& =  @create("List",0)
                        Var RetList& =  @create("List",0)
                        Var txt$ = »
                        ClearList hList&

                        Whileloop 1,Len(Vars$)

                            Si Mid $(Vars$,&loop,1)=»

                                Inc Countvars&

                            Endif

                        Endwhile

                        Whileloop 1,Countvars&

                            AddStrings(hList&, Substr$(Vars$,&loop,»))

                        Endwhile

                        Déclarer 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&))

                        Si hres& <> 0: txt$="Fehler: pas possible IWbemServices::ExecQuery aufzurufen": wmi_release(txt$): EndIf

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

                            Si hres& = 0: txt$="Fehler: pas possible IEnumWbemClassObject::aufzurufen": wmi_release(txt$): EndIf

                                Var NO& = 1

                                Tandis que NO&

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

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

                                        Si 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

                                                    AddStrings(RetList&,"n/a")

                                                    Caseof 3

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

                                                    Caseof 8

                                                    Si 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)
                                                        AddStrings(RetList&,+A$)

                                                    d'autre

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

                                                    endif

                                                    Caseof 11

                                                    Si byte(Union#,0) = 0

                                                        AddStrings(RetList&,"falsch")

                                                    D'autre

                                                        AddStrings(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$))
                                                    AddStrings(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$))
                                                    AddStrings(RetList&,Getstring$(hList&,&loop-1)+" : "+ A$)

                                                endselect

                                            endwhile

                                        D'autre

                                            NO& = 0

                                        Endif

                                        Inc Obj&

                                    Endwhile

                                Endif

                                wmi_release()
                                Retour 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
                            '###################################################
                            Set("Décimal", 2)
                            style de fenêtre 527
                            cls
                            Var Div! = 1024^2
                            Var Div3! = 1024^3
                            Var TotalMem! = 0
                            Var MemAVail! = 0
                            '                            capacité qui installierten Speicherbausteine abfragen.
                            '                            Je Baustein wird un un String dans un Stringliste hinzugefügt.
                            '                            dans qui Boucle volonté qui Einzel-Kapazitäten zusammengezählt.
                            'traceon
                            Var l& = wmi_call("SELECT * FROM Win32_PhysicalMemory","Capacity")
                             $B "2"

                            Whileloop 0,GetCount(l&)-1

                                TotalMem! = TotalMem! + Val(GetString$(l&,&Boucle))

                            Endwhile

                            '                            capacité des Arbeitsspeichers, qui de Windows pour den User zur
                            '                            Disposition gestellt wird
                            L& =wmi_call("SELECT * FROM Win32_ComputerSystem","TotalPhysicalMemory")

                            Whileloop 0,GetCount(l&)-1,2

                                MemAvail! = MemAvail! + Val(GetString$(l&,&Boucle))

                            Endwhile

                             $B "3"
                            '                            Ausgeben

                            Si TotalMem! <> 0

                                Imprimer "Physikalischer grenier : ",TotalMem!/div!,"MB"

                            D'autre

                                Imprimer "Physikalischer grenier : ",GetMem()/div!,"MB"

                            Endif

                            Imprimer "Arbeitsspeicher total   : ",MemAvail!/div!,"MB"
                            '                            capacité qui Partitionen
                            '                            Es volonté 3 Werte pro Partition abgefragt, daher dans qui Boucle Step 3
                            '                            Es volonté seulement Partitionen abgefragt en Grösse > 0 ist.
                            '                            D.h. aucun vider CD-Laufwerke
                            Localiser 6,0
                             $B "4"
                            l& = wmi_call("SELECT * FROM Win32_LogicalDisk where Size > 0","Name,Freespace,Size")

                            Whileloop 0,GetCount(l&)-1,3

                                '                                Ausgeben
                                Imprimer GetString$(l&,&Boucle),"Frei :" ,Val(GetString$(l&,&Boucle+1))/div3!,"GB ","Total :",Val(GetString$(l&,&Boucle+2))/div3!,"GB"

                            Endwhile

                            Proc showmem

                                '                                Kontinuierliche Abfrage des freien Mémoire
                                Var Freespace! = 0
                                Var Avail! = 0
                                Var Size! = 0
                                locate 3,0
                                Localiser 6,0
                                l& = wmi_call("SELECT * FROM Win32_LogicalDisk where Size > 0","Name,Freespace,Size")

                                Whileloop 0,GetCount(l&)-1,3

                                    '                                    Ausgeben
                                    Imprimer GetString$(l&,&Boucle),"Frei :" ,Val(GetString$(l&,&Boucle+1))/div3!,"GB ","Total :",Val(GetString$(l&,&Boucle+2))/div3!,"GB"

                                Endwhile

                                Imprimer Space$(50)
                                locate 3,0
                                L& =wmi_call("SELECT * FROM Win32_PerfRawData_PerfOS_Memory","AvailableBytes")

                                Whileloop 0,GetCount(l&)-1

                                    Avail! = Avail! + Val(GetString$(l&,&Boucle))

                                Endwhile

                                Imprimer "Speicher libre           : ",Avail!/div!,"MB"
                                Imprimer "Speicher benutzt        : ",(MemAvail!-Avail!)/div!,"MB"
                                Imprimer »

                            ENDPROC

                            showmem()
                            Var ende& = 0

                            Whilenot ende&

                                waitinput 100

                                Si %Key = 2

                                    Ende& = 1

                                endif

                                showmem()

                            Endwhile

                            FreeWMI()
                            end

                            Proc GetMem

                                Struct MEMORYSTATUSEX =\
                                dwLength&,\
                                dwMemoryLoad&,\
                                ullTotalPhysLow&,\
                                ullTotalPhysHi&,\
                                ullAvailPhysLow&,\
                                ullAvailPhysHi&,\
                                ullTotalPageFileLow&,\
                                ullTotalPageFileHi&,\
                                ullAvailPageFileLow&,\
                                ullAvailPageFileHi&,\
                                ullTotalVirtualLow&,\
                                ullTotalVirtualHi&,\
                                ullAvailVirtualLow&,\
                                ullAvailVirtualHi&,\
                                ullAvailExtendedVirtualLow&,\
                                ullAvailExtendedVirtualHi&
                                Var Memory# = New(MEMORYSTATUSEX)
                                Memory#.dwLength& = SizeOf(Memory#)
                                Externe("Kernel32.dll","GlobalMemoryStatusEx",Memory#)
                                Var TotalMem! = 0
                                Totalmem! = Memory#.ullTotalPhysLow&
                                cas Memory#.ullTotalPhysLow& < 0: TotalMem! =  Memory#.ullTotalPhysLow& + (2^32)
                                TotalMem! = (Memory#.ullTotalPhysHi& * (2^32)) + TotalMem!
                                Dispose Memory#
                                Retour TotalMem!

                            ENDPROC

XProfan X4
Windows XP SP2 XProfan X4
... und hier mal was ganz anderes als Profan ...

12.06.2018 ▲

Michael
W.

erstmal richtig einrücken. voilà peut-être un "endif" trop viel. si un solches auskommentiert était, ensuite prost...

Alle Sprachen
System: Windows 8/10, XProfan X4
Programmieren, das spannendste Detektivspiel der Welt.

13.06.2018 ▲

Kompilieren Marque Séparation

Jörg
Sellmeyer

non, es knallt oui c'est ca chez cette fUNKTION.

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

XProfan X4
Windows XP SP2 XProfan X4
... und hier mal was ganz anderes als Profan ...

13.06.2018 ▲

Alle Sprachen
WinXP, SP3, Core(TM) i7-3770 @ 3.40GHz

aussi avec X11?

13.06.2018 ▲

Jörg
Sellmeyer

nie gemacht Addr aussi la fois weggelassen, si du cela meinst. Ansonsten: quoi ist X11 ?

XProfan X4
Windows XP SP2 XProfan X4
... und hier mal was ganz anderes als Profan ...

14.06.2018 ▲

p.specht

Free!

XProfan 11
Computer: Gerät, daß es in Mikrosekunden erlaubt, 50.000 Fehler zu machen, zB 'daß' statt 'das'...

14.06.2018 ▲

- page 2 -

E.T.

avec XProfan 11.2 läufts aussi pas

Éditer: je glaub, je hab's dans meiner "Sammlung" trouvé, si quelqu'un Lust hat peux il oui la fois comparer

(mir fehlt grad qui Zeit en supplément)

ram-und-platten-anzeigen.prf	20 kB

Hochgeladen:	14.06.2018

Downloadcounter:
		Download

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...

14.06.2018 ▲