Informationen über den Arbeitsspeicher ermitteln / Retrieving RAM infos

Im UT kam vor ein paar Tagen die Frage auf, wie denn unter VFP Informationen über den installierten Arbeitsspeicher in Erfahrung gebracht werden könnten. Hugo Ranea lieferte daraufhin einen kurzen Mustercode zur Abfrage dieser Informationen über die Windows Management Instrumentation (WMI). Der folgende Beispielcode basiert auf seinem Codemuster.

Auf MSDN gibt es wie immer eine detaillierte Beschreibung der Funktion, die ich als Basis für die Aufschlüsselung der gelieferten Integerwerte genutzt habe.

http://msdn.microsoft.com/en-us/library/aa394347%28VS.85%29.aspx

Das u.a. Beispiel wurde von mir (in Ermangelung einer neueren Version) unter WinXP SP3 getestet.

LOCAL    loRAMs as Object, ;
        loRAM as Object, ;
        loWMI as Object, ;
        loLocator as Object

CLEAR 
loLocator    = CREATEOBJECT( [WBEMScripting.SWBEMLocator] )
loWMI        = loLocator.ConnectServer()
loRAMs        = loWMI.ExecQuery( [Select * from Win32_PhysicalMemory] )

    ? [Anzahl RAM Bausteine  : ] + TRANSFORM( loRAMs.Count )
FOR EACH loRAM IN loRAMs
    ? [----------------------- ]
    ? [Position              : ] + loRAM.DeviceLocator
    ? [Typisierung           : ] + loRAM.BankLabel
    ? [Kapazität             : ] + TRANSFORM( loRAM.Capacity )
    ? [Beschriftung          : ] + loRAM.Caption
    ? [Bandbreite            : ] + TRANSFORM( loRAM.DataWidth )
    ? [Beschreibung          : ] + loRAM.Description
    ? [Bauarttyp             : ] + GetFormFactor( loRAM.FormFactor )
    ? [HotSwap tauglich      : ] + IIF( VARTYPE( loRAM.HotSwappable )         = [X] , [nein]      , TRANSFORM( loRAM.HotSwappable ) )
    ? [Interleave Datentiefe : ] + TRANSFORM( loRAM.InterleaveDataDepth ) + IIF( loRAM.InterleaveDataDepth = 0 , [ - nicht Interleave tauglich] , [] )
    ? [Interleave Position   : ] + GetILPosition( loRAM.InterleavePosition )
    ? [Hersteller            : ] + IIF( VARTYPE( loRAM.Manufacturer )         = [X] , [unbekannt] , TRANSFORM( loRAM.Manufacturer ) )
    ? [Speichertyp           : ] + TRANSFORM( loRAM.MemoryType )
    ? [Modell                : ] + IIF( VARTYPE( loRAM.Model )                = [X] , [unbekannt] , TRANSFORM( loRAM.Model ) )
    ? [Name                  : ] + loRAM.Name
    ? [Zusätzliche Infos     : ] + IIF( VARTYPE( loRAM.OtherIdentifyingInfo ) = [X] , [keine]     , TRANSFORM( loRAM.OtherIdentifyingInfo ) )
    ? [Artikelnummer         : ] + IIF( VARTYPE( loRAM.PartNumber )           = [X] , [unbekannt] , TRANSFORM( loRAM.PartNumber ) )
    ? [Steckplatz            : ] + TRANSFORM( loRAM.PositionInRow )
    ? [PoweredOn             : ] + IIF( VARTYPE( loRAM.PoweredOn )            = [X] , [nein]      , TRANSFORM( loRAM.PoweredOn ) )
    ? [Entfernbar            : ] + IIF( VARTYPE( loRAM.PartNumber )           = [X] , [nein]      , TRANSFORM( loRAM.Removable ) )
    ? [Austauschbar          : ] + IIF( VARTYPE( loRAM.Replaceable )          = [X] , [nein]      , TRANSFORM( loRAM.Replaceable ) )
    ? [Seriennummer          : ] + IIF( VARTYPE( loRAM.SerialNumber )         = [X] , [unbekannt] , TRANSFORM( loRAM.SerialNumber ) )
    ? [Stock Keeping Unit    : ] + IIF( VARTYPE( loRAM.SKU )                  = [X] , [unbekannt] , TRANSFORM( loRAM.SKU ) )
    ? [Taktung               : ] + TRANSFORM( loRAM.Speed )
    ? [Status                : ] + IIF( VARTYPE( loRAM.Status )               = [X] , [unbekannt] , TRANSFORM( loRAM.Status ) )
    ? [Unique Identifier     : ] + TRANSFORM( loRAM.Tag )
    ? [Gesamt Bandbreite     : ] + TRANSFORM( loRAM.TotalWidth )
    ? [Typ Details           : ] + GetTypDetails( loRAM.TypeDetail )
    ? [Version               : ] + IIF( VARTYPE( loRAM.Version )              = [X] , [unbekannt] , TRANSFORM( loRAM.Version ) )
    ? [Installationsdatum    : ] + IIF( VARTYPE( loRAM.Version )              = [X] , [unbekannt] , TRANSFORM( loRAM.InstallDate ) )
ENDFOR 

FUNCTION GetFormFactor as String
LPARAMETERS vValue as Integer
    LOCAL lcReturn as String
    lcReturn = []
    vValue = EVL( vValue , 0 )
    DO CASE 
    CASE vValue = 0
        lcReturn = [0 - unbekannt]
    CASE vValue = 1
        lcReturn = [1 - anderer]
    CASE vValue = 2
        lcReturn = [2 - SIP]
    CASE vValue = 3
        lcReturn = [3 - DIP]
    CASE vValue = 4
        lcReturn = [4 - ZIP]
    CASE vValue = 5
        lcReturn = [5 - SOJ]
    CASE vValue = 6
        lcReturn = [6 - Proprietär]
    CASE vValue = 7
        lcReturn = [7 - SIMM]
    CASE vValue = 8
        lcReturn = [8 - DIMM]
    CASE vValue = 9
        lcReturn = [9 - TSOP]
    CASE vValue = 10
        lcReturn = [10 - PGA]
    CASE vValue = 11
        lcReturn = [11 - RIMM]
    CASE vValue = 12
        lcReturn = [12 - SODIMM]
    CASE vValue = 13
        lcReturn = [13 - SRIMM]
    CASE vValue = 14
        lcReturn = [14 - SMD]
    CASE vValue = 15
        lcReturn = [15 - SSMP]
    CASE vValue = 16
        lcReturn = [16 - QFP]
    CASE vValue = 17
        lcReturn = [17 - TQFP]
    CASE vValue = 18
        lcReturn = [18 - SOIC]
    CASE vValue = 19
        lcReturn = [19 - LCC]
    CASE vValue = 20
        lcReturn = [20 - PLCC]
    CASE vValue = 21
        lcReturn = [21 - BGA]
    CASE vValue = 22
        lcReturn = [22 - FPBGA]
    CASE vValue = 23
        lcReturn = [23 - LGA]
    ENDCASE 
    RETURN lcReturn
ENDFUNC 

FUNCTION GetILPosition as String
LPARAMETERS vValue as Integer
    LOCAL lcReturn as String
    lcReturn = []
    vValue = EVL( vValue , 0 )
    DO CASE 
    CASE vValue = 0
        lcReturn = [0 - Non-Interleaved]
    CASE vValue = 1
        lcReturn = [1 - Erste Position]
    CASE vValue = 2
        lcReturn = [2 - Zweite Position]
    ENDCASE 
    RETURN lcReturn
ENDFUNC 

FUNCTION GetMemoryTyp as String
LPARAMETERS vValue as Integer
    LOCAL lcReturn as String
    lcReturn = []
    vValue = EVL( vValue , 0 )
    DO CASE
    CASE vValue = 0
        lcReturn = [0 - unbekannt]
    CASE vValue = 1
        lcReturn = [1 - anderer]
    CASE vValue = 2
        lcReturn = [2 - DRAM]
    CASE vValue = 3
        lcReturn = [3 - Synchroner DRAM]
    CASE vValue = 4
        lcReturn = [4 - Cache DRAM]
    CASE vValue = 5
        lcReturn = [5 - EDO]
    CASE vValue = 6
        lcReturn = [6 - EDRAM]
    CASE vValue = 7
        lcReturn = [7 - VRAM]
    CASE vValue = 8
        lcReturn = [8 - SRAM]
    CASE vValue = 9
        lcReturn = [9 - RAM]
    CASE vValue = 10
        lcReturn = [10 - ROM]
    CASE vValue = 11
        lcReturn = [11 - Flash]
    CASE vValue = 12
        lcReturn = [12 - EEPROM]
    CASE vValue = 13
        lcReturn = [13 - FEPROM]
    CASE vValue = 14
        lcReturn = [14 - EPROM]
    CASE vValue = 15
        lcReturn = [15 - CDRAM]
    CASE vValue = 16
        lcReturn = [16 - 3DRAM]
    CASE vValue = 17
        lcReturn = [17 - SDRAM]
    CASE vValue = 18
        lcReturn = [18 - SGRAM]
    CASE vValue = 19
        lcReturn = [19 - RDRAM]
    CASE vValue = 20
        lcReturn = [20 - DDR]
    CASE vValue = 21
        lcReturn = [21 - DDR-2]
    CASE vValue = 22
        lcReturn = [22 - DDR-3]
    ENDCASE
    RETURN lcReturn
ENDFUNC 

FUNCTION GetTypDetails as String
LPARAMETERS vValue as Integer
    LOCAL lcReturn as String
    lcReturn = []
    vValue = EVL( vValue , 4 )
    DO CASE
    CASE vValue = 1
        lcReturn = [1 - reserviert]
    CASE vValue = 2
        lcReturn = [2 - anderer]
    CASE vValue = 4
        lcReturn = [4 - unbekannt]
    CASE vValue = 8
        lcReturn = [8 - Fast-paged]
    CASE vValue = 16
        lcReturn = [16 - Statische Spalten]
    CASE vValue = 32
        lcReturn = [32 - Pseudo-statisch]
    CASE vValue = 64
        lcReturn = [64 - RAMBUS]
    CASE vValue = 128
        lcReturn = [128 - Synchron]
    CASE vValue = 256
        lcReturn = [256 - CMOS]
    CASE vValue = 512
        lcReturn = [512 - EDO]
    CASE vValue = 1024
        lcReturn = [1024 - Window DRAM]
    CASE vValue = 2048
        lcReturn = [2048 - Cache DRAM]
    CASE vValue = 4096
        lcReturn = [4096 - nicht flüchtig]
    ENDCASE
    RETURN lcReturn
ENDFUNC 

ProzessIDs lesen und beenden / Reading and terminating process IDs (Revisited)

Im letzten Eintrag ging es um das gezielte Beenden von Applikationen. In diesem Posting stelle ich nun eine kleine Abwandlung dieser Vorgehensweise vor. Genauer gesagt für die Aufgabenstellung, dass unsere soeben gestartete Applikation sicherstellen soll, das keine weiteren (zuvor gestarteten) Prozesse von ihr sich im Arbeitsspeicher befinden.

Diese Aufgabe läßt sich mit der Funktion TerminateProcess() des letzten Postings nicht durchführen, da dort die eigene ProzessID nicht verfügbar gemacht wurde.

Die eigene ProzessID herauszufinden ist in VFP nicht weiter schwierig. Das Applikationsobjekt _VFP stellt sie uns als eine seiner Eigenschaften zu Verfügung (_VFP.ProcessID). Die folgende Beispielfunktion prüft nun vor dem Terminierungsvorgang ab, ob der Zielprozess über die selbe ProzessID verfügt wie die aktuelle Applikation. Ist dies der Fall so wird die Terminierung nicht durchgeführt. Eine weitere Sicherheitsüberprüfung ist, ob der ausführende User auch der 'Eigentümer' der zu löschenden Prozesse ist (Diese Vorgehensweise ist analog zum vorherigen Posting).

* // Funktionstest
RUN /n vfp9.exe
RUN /n vfp9.exe

CLEAR 
? [beendete Prozesse:]
?? TerminateOldProcess( [vfp9.exe] )



FUNCTION TerminateOldProcess as Integer 
LPARAMETERS vAppname as String
    * // Funktion zum Löschen gleichnamiger Prozesse übergebener Programme    
    * // oder der aktuellen Applikation                                        
    * //                                                                    
    * // Parameter    Variable    Status                                        
    * // #1           vAppname    optional (default = Aktuelles Programm)        
    * //                          Name der Programmdatei                        
    vAppname = EVL( vAppname , PROGRAM() )

    * // Deklaration und Belegung benötigter Arbeitsvariablen. Hierbei        
    * // erfolgt bei den zwei Objekt-Variablen eine direkte Referenzierung    
    * // auf das WMI-Objekt sowie das Abfrageergebnis                        
    LOCAL    liReturn as Integer, llExit as Boolean, ;
            lcLogname as String , lcComputer as String, ;
            loCIMV2 as Object, loProcCols as Object, lcOwner as String
    liReturn    = 0
    llExit      = .F.
    lcLogname   = ALLTRIM( GETWORDNUM( SYS( 0 ) , 2 , [#] ) )
    lcComputer  = [.]

    TRY 
        loCIMV2    = GETOBJECT( [winmgmts:{impersonationLevel=impersonate}!\\] + lcComputer + [\root\cimv2] )
        loProcCols = loCIMV2.ExecQuery( [select * from Win32_Process where name='] + vAppname + ['] )
    CATCH 
        llExit     = .T.
    ENDTRY 
    
    * // Wenn die Instanziierungen erfolgreich waren, dann    
    * // kann es jetzt losgehen...                            
    IF !llExit

        * // Die gefundenen Prozesse entsorgen                
        FOR EACH objProcess in loProcCols

            * // Sicherstellen, dass nur eigene             
            * // Prozesse gelöscht werden!                    
            lcOwner = SPACE( 256 )
            = objProcess.GetOwner( @lcOwner )

            IF  lcLogname == lcOwner ;
            AND _VFP.ProcessID <> objProcess.ProcessID
                liReturn = liReturn + 1 
                objProcess.Terminate( 0 )
            ENDIF 

        ENDFOR 
        
        * // WMI-Objektreferenzen auflösen                     
        loCIMV2    = .NULL.
        loProcCols = .NULL.
        
    ENDIF 
    
    * // Anzahl der gelöschten Prozesse zurückgeben.        
    RETURN liReturn 
    
ENDFUNC 

ProzessIDs lesen und beenden / Reading and terminating process IDs

Wenn wir, aus welchem Grund auch immer, sicherstellen wollen, das eine bestimmte Anwendung nur einmal gestartet sein darf, dann kommt üblicherweise ein Singleton-Pattern zum Einsatz. Bei der Arbeit mit Objekten ist dies für viele sicherlich eine immer wiederkehrende Routine und die Funktion PEMSTATUS() wird in diesem Fall wohl auch oft genug zum Einsatz kommen.

Wollen wir jedoch eine komplette Applikation aus dem Arbeitsspeicher entfernen oder einfach nur überprüfen, ob eine Anwendung bereits aktiv ist, dann können wir diese Prüfung nicht mit PEMSTATUS() durchführen.

Bereits im April und Dezember habe ich in meinen Postings zur Druckerstatus Abfrage die Windows Management Instrumentation eingesetzt. Jetzt kommt sie erneut zum Einsatz, um uns Prozessinformationen zu liefern.

Die unten stehende Demofunktion 'TerminateProcess()' dient dem gezielten Entsorgen von unerwünschten Prozessen. Im Bereich der Singleton Patterns ist dies nicht immer die gewünschte Vorgehensweise. Aus diesem Grund verfügt die Funktion auch über Parameter, mit denen gezielte Abfragen und Ansichten ohne Prozesslöschung durchgeführt werden können.

Wird bspw. als einziger Parameter der Programmname übergeben erfolgt eine automatische Löschung sämtlicher gefunden Prozesse dieser Applikation. Die beiden Funktionstests zeigen mögliche unterschiedliche Parametrisierungen auf.

* // Funktionstest 1
* // - Anzahl vorhandener Prozesse zurückmelden
RUN /n notepad.exe
RUN /n notepad.exe
RUN /n notepad.exe

liAnzahl = TerminateProcess( [notepad.exe] , .T. )

CLEAR 
? [gefundene Prozesse: ]
?? liAnzahl

* // Funktionstest 2
* // - alle gefundenen Prozesse entsorgen
* // Alternativer Aufruf um gefundene Prozesse anzuzeigen
* liAnzahl = TerminateProcess( [notepad.exe] , .F. , .F. , .T. )
liAnzahl = TerminateProcess( [notepad.exe] )
 
? [beendete Prozesse:  ]
?? liAnzahl

FUNCTION TerminateProcess as Integer 
LPARAMETERS vAppname as String, vJustCheck as Boolean, vAllButLast as Boolean, vBrowseLast as Boolean
    * // Funktion zum löschen/melden von Prozessen übergebener Programmnamen
    * //
    * // Parameter    Variable    Status
    * // #1           vAppname    optional (default = Aktuelles Programm)
    * //                          Name der Programmdatei
    * // #2           vJustCheck  optional (default = .F.)
    * //                          Nicht löschen, nur Melden
    * // #3           vAllButLast optional (default = .F.)
    * //                          Letzen Prozess nicht löschen
    * // #4           vBrowseLast optional (default = .F.)
    * //                          Gefundene Prozesse anzeigen
    vAppname    = EVL( vAppname , PROGRAM() )
    vAllButLast = EVL( vAllButLast , .F. )
    vBrowseLast = EVL( vBrowseLast , .F. )

    * // Deklaration und Belegung benötigter Arbeitsvariablen. Hierbei
    * // erfolgt bei den zwei Objekt-Variablen eine direkte Referenzierung
    * // auf das WMI-Objekt sowie das Abfrageergebnis
    LOCAL   liReturn as Integer, liCount as Integer , llExit as Boolean, ;
            lcLogname as String , lcComputer as String, ;
            loCIMV2 as Object, loProcCols as Object, lcOwner as String
    liReturn    = 0
    liCount     = 0
    llExit      = .F.
    lcLogname   = ALLTRIM( GETWORDNUM( SYS( 0 ) , 2 , [#] ) )
    lcComputer  = [.]

    TRY 
        loCIMV2    = GETOBJECT( [winmgmts:{impersonationLevel=impersonate}!\\] + lcComputer + [\root\cimv2] )
        loProcCols = loCIMV2.ExecQuery( [select * from Win32_Process where name='] + vAppname + ['] )
    CATCH 
        llExit     = .T.
    ENDTRY 
    
    IF !llExit
        * // Arbeitscursor erstellen und die WMI Objekte verarbeiten
        CREATE CURSOR crsTasks ( ProgOwner c( 30 ) , ProgName c( 30 ) , ProgPath c( 200 ) )
        FOR EACH objProcess in loProcCols
            liCount     = liCount + 1 
            lcOwner     = SPACE( 256 )
            = objProcess.GetOwner( @lcOwner )
            m.ProgOwner = lcOwner
            m.ProgName  = objProcess.Name
            m.ProgPath  = EVL( objProcess.ExecutablePath , [-] )
            INSERT INTO crsTasks FROM MEMVAR 
        ENDFOR 

        * // Ggf. die gefundenen Prozesse angezeigen (Parameter #4)
        IF vBrowseLast
            BROWSE LAST 
        ENDIF 

        IF !vJustCheck
            * // Die gefundenen Prozesse der Reihe nach entsorgen
            FOR EACH objProcess in loProcCols
                liReturn = liReturn + 1 
                * // Wenn der letzte Prozess beibehalten werden soll (Parm.#3)
                * // dann raus aus der Schleife, andernfalls geht's weiter bis
                * // zum bitteren Ende... ;-)
                IF vAllButLast AND liReturn = liCount 
                    EXIT 
                ELSE 
                    SELECT crsTasks
                    GO ( liReturn )
                    IF ALLTRIM( crsTasks.ProgOwner ) == lcLogname
                        objProcess.Terminate( 0 )
                    ENDIF 
                ENDIF 
            ENDFOR 
        ELSE 
            liReturn = liCount
        ENDIF 
        
        * // Arbeitscursor entsorgen, WMI-Objektreferenzen auflösen
        USE IN SELECT( [crsTasks] )
        loCIMV2    = .NULL.
        loProcCols = .NULL.
        
    ENDIF 
    
    * // Anzahl der gelöschten/gefundenen Prozesse zurückgeben
    RETURN liReturn 
    
ENDFUNC 

Weitere Aufrufmöglichkeiten:

Löscht alle Prozesse des übergebenen Programms, der letzte Prozess bleibt jedoch bestehen

liAnzahl = TerminateProcess( [notepad.exe] , .F. , .T. )

Löscht alle Prozesse des übergebenen Programms, zeigt jedocht zuvor eine Liste der gefundenen Prozesse an

liAnzahl = TerminateProcess( [notepad.exe] , .F. , .F. , .T. )

Druckerstatus abfragen - Teil 2 / Query printer status - Part 2

Im Dezember hatte ich einen Eintrag verfasst, in dem es darum ging, den Status der vorhandenen Drucker abzufragen. Im folgenden Codebeispiel habe ich diese Funktionalität dahingehend erweitert, dass nun auch der Standarddrucker des aktuellen Benutzers gefunden und gekennzeichnet wird.

Ermöglicht wird dies durch eine Abfrage des Windows-Spoolertreibers (winspool.drv) der sich üblicherweise im Windows System- und/oder System32-Verzeichnis befindet.

Der u.a. Code baut auf den bereits im Dezember Posting gezeigten Funktionen GetPrinterStatus() und GetPrinterStatusAsText() auf. Neu hinzugekommen sind die Funktionen DisplayPrinterInfos() sowie GetDefaultPrinter() welche innerhalb von GetPrinterStatus() direkt aufgerufen wird. Ebenfalls neu ist, dass nun sämtliche Daten in einem Cursor vorgehalten werden.

DisplayPrinterInfos() erweitert die _SCREEN-Ausgabe um Druckerstandort und Kommentar. GetDefaultPrinter() greift auf die API-Funktion 'GetDefaultPrinter' aus winspool.drv zurück. Hierbei habe ich den API-Funktionsnamen mit einem Alias ( -> MyDefaultPrinter) versehen, damit meine identische interne Funktionsbenamung keine Rekursion verursacht.

LOCAL liFlag as Integer

* // installierte Drucker überprüfen und entsprechenden Cursor erzeugen    
=APRINTERS(laPrn,1)

* // Leeren Cursor erzeugen 
CREATE CURSOR crsprinters ( ;
    prn_type        C(  1), ;
    prn_default     C(  1), ;
    prn_printer     C(250), ;
    prn_port        C( 50), ;
    prn_driver      C(100), ;
    prn_comment     C(250), ;
    prn_location    C(250), ;
    prn_status      C( 30) ;
    )

* // Wurden installierte Drucker gefunden, dann wird nun der Inhalt        
* // des Arrays in einer Schleife verarbeitet und an 'crsPrinters'         
* // übergeben. 
IF !EMPTY(laPrn(1,1))
    FOR liFlag = 1 TO ALEN(laPrn,1)
        IF SUBSTR(laPrn(liFlag,1),1,2) = [\\]
            m.prn_type       = [n]
            m.prn_printer    = [ ] + laPrn(liFlag,1)
        ELSE 
            m.prn_type       = [l]
            m.prn_printer    = laPrn(liFlag,1)
        ENDIF
        m.prn_port      = laPrn(liFlag,2)
        m.prn_driver    = laPrn(liFlag,3)
        m.prn_comment   = laPrn(liFlag,4)
        m.prn_location  = laPrn(liFlag,5)
        m.prn_default   = [ ]
        m.prn_status    = [ ]
        INSERT INTO crsPrinters FROM MEMVAR 
    ENDFOR 
    * // Nun die noch fehlenden Statusinformationen im Cursor            
    * // hinterlegen und die Ausgaberoutine aufrufen. 
    GetPrinterStatus()
    DisplayPrinterInfos()
    USE IN SELECT([crsPrinters])
ELSE 
    * // Ab und an soll es tatsächlich vorkommen, dass überhaupt kein    
    * // Drucker im System vorhanden ist. Dies sollten wir dem Anwender    
    * // natürlich nicht vorenthalten.
    LOCAL lcString as String
    TEXT TO lcString NOSHOW ADDITIVE TEXTMERGE PRETEXT 2
        A C H T U N G ! ! !
        Für Ihr Login sind noch keine Drucker installiert!
        Zum Ausdrucken von Daten werden diese jedoch zwingend
        benötigt. Bitte installieren Sie über
        
        [Start] - [Einstellungen] - [Drucker] - [Neuer Drucker]
        
        einen oder mehrere Drucker!
    ENDTEXT 
    MESSAGEBOX(lcString,0+64+0,[Kein Drucker installiert])
    RELEASE lcString
ENDIF 

RELEASE laPrn

* // ----------------------------------------- DisplayDefaultPrinter
FUNCTION GetDefaultPrinter as String

    * // Wichtig bei dieser Funktion ist, dass der als Referenz        
    * // übergebene String mit CHR(0) Zeichen vorbesetzt wird.        
    LOCAL liBuffSize as Integer, lcPrinter as String
    liBufsize = 250
    lcPrinter = REPLICATE( CHR( 0 ), liBufsize )
    
    * // Über winspool.drv können wir den aktuellen Standarddrucker    
    * // abfragen. Das Ergebnis liefern wir als String zurück, um    
    * // in der nachfolgenden Verarbeitung einen direkten Namens-    
    * // vergleich durchführen zu können.
    TRY 
        DECLARE INTEGER GetDefaultPrinter IN winspool.drv AS MyDefaultPrinter ;
                STRING  @ pszBuffer,;
                INTEGER @ pcchBuffer

        * // Da die API-Funktion genauso heisst, wie die VFP-Funktion
        * // war eine Umbenennung der API-Funktion mit Hilfe eines    
        * // ALIAS notwendig. Somit wurde aus GetDefaultPrinter() die 
        * // Funktion MyDefaultPrinter.
        = MyDefaultPrinter( @lcPrinter, @liBufsize )
        lcPrinter = SUBSTR(lcPrinter, 1, AT( CHR( 0 ), lcPrinter ) - 1 )
    CATCH 
        lcPrinter = [ ]
    ENDTRY 
    
    RETURN lcPrinter

ENDFUNC 

* // ------------------------------------------- DisplayPrinterInfos
FUNCTION DisplayPrinterInfos
    
    * // Diese Funktion zeigt den Inhalt des Druckercursors an.        
    * // hierbei erfolgt die Kennzeichnung des Standarddruckers über
    * // ein kleines 'x' vor dem Druckernamen.
    
    LOCAL lcFont as String, lcDisplay as String
    
    * // VFP Screen vorbereiten                                        
    lcFont              = _screen.Fontname
    _screen.FontName    = [Courier New]
    CLEAR 
    
    SELECT crsPrinters
    GO TOP 
    ??[Status                   Drucker (x=Standarddrucker)              Standort                            Kommentar                                                             ]
     ?[---------------------------------------------------------------------------------------------------------------------------------------------------------------------------]
    DO WHILE !EOF()
        TEXT TO lcDisplay TEXTMERGE NOSHOW PRETEXT 1+2+4+8
            <<SUBSTR( crsPrinters.prn_status,1,20 )>>
            <<IIF(EMPTY(crsPrinters.prn_default),[   ],[ x ])>>
            <<SUBSTR( crsPrinters.prn_printer,1,40 )>>
            <<SUBSTR( crsPrinters.prn_location,1,35 )>>
            <<SUBSTR( crsPrinters.prn_comment,1,70 )>>
        ENDTEXT 
        ? lcDisplay
        SKIP IN ([crsPrinters])
    ENDDO 
         
    * // VFP Screen zurücksetzen            
    _screen.FontName = lcFont
    
ENDFUNC 

* // ---------------------------------------------- GetPrinterStatus
FUNCTION GetPrinterStatus as String

    LOCAL lcComputer as String, loWMIService as Object, ;
          loInstalledPrinters as Object, lcStatus as String, ;
          lcFont as String, lcDefPrn as String

    * // Arbeitsvariablen initialisieren    
    lcComputer          = [.]
    loWMIService        = GETOBJECT([winmgmts:] + [{impersonationLevel=impersonate}!\\] + lcComputer + [\root\cimv2])
    loInstalledPrinters = loWMIService.ExecQuery([SELECT * FROM Win32_Printer])
    lcFont              = _screen.FontName 
    lcDefPrn            = GetDefaultPrinter()

    * // Druckerobjekt auslesen                
    FOR EACH loPrinter IN loInstalledPrinters

        lcStatus = GetPrinterStatusAsText(loPrinter)

        SELECT crsPrinters
        GO TOP 
        LOCATE FOR prn_printer = loPrinter.Name
        IF FOUND()
            IF LEN(ALLTRIM(lcStatus)) > 15
                REPLACE prn_status WITH SUBSTR(lcStatus,16)   IN crsPrinters
            ELSE 
                REPLACE prn_status WITH SUBSTR(lcStatus,1,15) IN crsPrinters
            ENDIF 
            * // Standarddrucker im Cursor kennzeichnen.
            IF ALLTRIM(crsPrinters.prn_printer) == lcDefPrn
                REPLACE prn_default WITH [x] IN crsPrinters
            ENDIF 
        ENDIF 
        
    NEXT 
ENDFUNC 

* // ---------------------------------------- GetPrinterStatusAsText
FUNCTION GetPrinterStatusAsText as String
LPARAMETERS oPrinter as Object

    LOCAL lcReturn as String
    lcReturn = []
    
    DO CASE 
    CASE oPrinter.PrinterStatus = 1
        lcReturn = [anderes        ]    && Other
    CASE oPrinter.PrinterStatus = 2
        lcReturn = [unbekannt      ]    && Unknown
    CASE oPrinter.PrinterStatus = 3
        lcReturn = [bereit         ]    && Idle
    CASE oPrinter.PrinterStatus = 4
        lcReturn = [druckt         ]    && Printing
    CASE oPrinter.PrinterStatus = 5
        lcReturn = [aufwärmen      ]    && Warming Up
    CASE oPrinter.PrinterStatus = 6
        lcReturn = [gestoppt       ]    && Stopped Printing
    CASE oPrinter.PrinterStatus = 7
        lcReturn = [Offline        ]    && Offline
    CASE oPrinter.PrinterStatus = 8
        lcReturn = [pausierend     ]    && Paused
    CASE oPrinter.PrinterStatus = 9
        lcReturn = [Fehler         ]    && Error
    CASE oPrinter.PrinterStatus = 10
        lcReturn = [beschäftigt    ]    && Busy
    CASE oPrinter.PrinterStatus = 11
        lcReturn = [nicht verfügbar]    && Not Available
    CASE oPrinter.PrinterStatus = 12
        lcReturn = [wartend        ]    && Waiting
    CASE oPrinter.PrinterStatus = 13
        lcReturn = [verarbeiten    ]    && Processing
    CASE oPrinter.PrinterStatus = 14
        lcReturn = [initialisieren ]    && Initialization
    CASE oPrinter.PrinterStatus = 15
        lcReturn = [Stromsparmodus ]    && Power Save
    CASE oPrinter.PrinterStatus = 16
        lcReturn = [löscht Druckjob]    && Pending Deletion
    CASE oPrinter.PrinterStatus = 17
        lcReturn = [E/A aktiv      ]    && I/O Active
    CASE oPrinter.PrinterStatus = 18
        lcReturn = [manuelle Zufuhr]    && Manual Feed
    ENDCASE 
    * // Die Liste ggf. nach Bedarf erweitern
    IF INLIST(oPrinter.PrinterStatus,1,9)
        lcReturn = lcReturn + GetDetectedErrorStateAsText(oPrinter.DetectedErrorState)
    ENDIF 
    RETURN lcReturn
    
ENDFUNC 

* // ----------------------------------- GetDetectedErrorStateAsText
FUNCTION GetDetectedErrorStateAsText as String
LPARAMETERS vErrorstate as Integer 

    LOCAL lcReturn as String 
    
    DO CASE
    CASE m.vErrorState = 0
        lcReturn = [Unbekannter Fehler]                 && Unknown
    CASE m.vErrorState = 1
        lcReturn = [Anderer Fehler]                     && Other
    CASE m.vErrorState = 2
        lcReturn = [kein Fehler]                        && No Error
    CASE m.vErrorState = 3
        lcReturn = [zu wenig Papier]                    && Low Paper
    CASE m.vErrorState = 4
        lcReturn = [kein Papier]                        && No Paper
    CASE m.vErrorState = 5
        lcReturn = [zu wenig Toner]                     && Low Toner
    CASE m.vErrorState = 6
        lcReturn = [kein Toner]                         && No Toner
    CASE m.vErrorState = 7
        lcReturn = [Gehäuse geöffnet]                   && Door Open
    CASE m.vErrorState = 8
        lcReturn = [Papierstau]                         && Jammed
    CASE m.vErrorState = 9
        lcReturn = [Kundendienst erforderlich]          && Service Requested
    CASE m.vErrorState = 10
        lcReturn = [Ausgabeschacht ist voll]            && Output Bin Full
    CASE m.vErrorState = 11
        lcReturn = [Papier Problem]                     && Paper Problem
    CASE m.vErrorState = 12
        lcReturn = [Seite kann nicht gedruckt werden]   && Cannot Print Page
    CASE m.vErrorState = 13
        lcReturn = [Benutzereingriff notwendig]         && User Intervention Required
    CASE m.vErrorState = 14
        lcReturn = [Arbeitsspeicher voll]               && Out Of Memory
    CASE m.vErrorState = 15
        lcReturn = [unbekannter Server]                 && Server Unknown
    OTHERWISE
        lcReturn = [Unbekannt]    
    ENDCASE
    RETURN     [(] + ALLTRIM(STR(m.vErrorState)) + [) ] + lcReturn
    
ENDFUNC 

Druckerstatus abfragen / Query printer status

Die Anzeige des aktuellen Zustands der verfügbaren Drucker kann für so manchen Anwender von essentieller Bedeutung sein, wenn es darum geht einen Ausdruck möglichst schnell in den Händen zu halten. Andererseits kann es nur von Vorteil sein, wenn bei einer Druckausgabe bereits im Vorfeld erkennbar ist, daß ein spezieller Drucker bspw. einen Papierstau hat, oder nur wenig Papier im Einzugschacht verfügbar ist.

Die Funktion APRINTER(myPrinterArray[,1]) liefert uns in einem Array den Druckernamen, den Anschluss, den Treiber, den Kommentar und den Standort.

APRINTER(laPrinters,1)
CLEAR
DISPLAY MEMORY LIKE laPrinters

Was fehlt ist die Information, ob der oder die Drucker auch tatsächlich verfügbar sind, oder ob gerade ein Druckjob abgearbeitet wird, oder ob der Drucker überhaupt verfügbar ist. Solche Informationen können wir jedoch über den Windows Management Service recht einfach abrufen.Detaillierte Infos zur Win32_Printer Klasse (Bestandteil der Windows Management Instrumentation) gibt es auf MSDN:

http://msdn.microsoft.com/en-us/library/aa394363(VS.85).aspx

Dort finden wir u.a. auch die Aufschlüsselung der Fehlernummern auf die wir gezielt reagieren können, wenn der Druckerstatus bspw. eine 1 (=Other) oder 9 (=Error) liefert. Im folgenden ein wenig Mustercode der über den Zugriff auf die WMI auskunft gibt:

LOCAL lcComputer as String, loWMIService as Object, ;
      loInstalledPrinters as Object, lcStatus as String, ;
      lcFont as String

* // Arbeitsvariablen initialisieren und WMI Objekt erzeugen
lcComputer          = [.]
loWMIService        = GETOBJECT([winmgmts:] + [{impersonationLevel=impersonate}!\\] + lcComputer + [\root\cimv2])
loInstalledPrinters = loWMIService.ExecQuery([SELECT * FROM Win32_Printer])
lcFont              = _screen.FontName
* // VFP Screen vorbereiten            
_screen.FontName    = [Courier New]
CLEAR 
?[Name] + SPACE(40) + [Status]
?REPLICATE([-],50)

* // Druckerobjekt auslesen            
FOR EACH loPrinter IN loInstalledPrinters

    ?PADR(loPrinter.Name,44,[ ])
    lcStatus = GetPrinterStatusAsText(loPrinter)
    ?? lcStatus

NEXT
* // VFP Screen zurücksetzen        
_screen.FontName = lcFont


FUNCTION GetPrinterStatusAsText as String
LPARAMETERS oPrinter as Object

    LOCAL lcReturn as String
    lcReturn = []

    DO CASE
    CASE oPrinter.PrinterStatus = 1
        * // Other
        lcReturn = [anderes        ]
    CASE oPrinter.PrinterStatus = 2
        * // Unknown
        lcReturn = [unbekannt      ]
    CASE oPrinter.PrinterStatus = 3
        * // Idle
        lcReturn = [bereit         ]
    CASE oPrinter.PrinterStatus = 4
        * // Printing
        lcReturn = [druckt         ]
    CASE oPrinter.PrinterStatus = 5
        * // Warming Up
        lcReturn = [aufwärmen      ]
    CASE oPrinter.PrinterStatus = 6
        * // Stopped Printing
        lcReturn = [gestoppt       ]
    CASE oPrinter.PrinterStatus = 7
        * // Offline
        lcReturn = [Offline        ]
    CASE oPrinter.PrinterStatus = 8
        * // Paused
        lcReturn = [pausierend     ]
    CASE oPrinter.PrinterStatus = 9
        * // Error
        lcReturn = [Fehler         ]
    CASE oPrinter.PrinterStatus = 10
        * // Busy
        lcReturn = [beschäftigt    ]
    CASE oPrinter.PrinterStatus = 11
        * // Not Available
        lcReturn = [nicht verfügbar]
    CASE oPrinter.PrinterStatus = 12
        * // Waiting
        lcReturn = [wartend        ]
    CASE oPrinter.PrinterStatus = 13
        * // Processing
        lcReturn = [verarbeiten    ]
    CASE oPrinter.PrinterStatus = 14
        * // Initialization
        lcReturn = [initialisieren ]
    CASE oPrinter.PrinterStatus = 15
        * // Power Save
        lcReturn = [Stromsparmodus ]
    CASE oPrinter.PrinterStatus = 16
        * // Pending Deletion
        lcReturn = [löscht Druckjob]
    CASE oPrinter.PrinterStatus = 17
        * // I/O Active
        lcReturn = [E/A aktiv      ]
    CASE oPrinter.PrinterStatus = 18
        * // Manual Feed
        lcReturn = [manuelle Zufuhr]
    ENDCASE
    * // Die Liste ggf. nach Bedarf erweitern
    IF INLIST(oPrinter.PrinterStatus,1,9)
        lcReturn = lcReturn + GetDetectedErrorStateAsText(oPrinter.DetectedErrorState)
    ENDIF
    RETURN lcReturn

ENDFUNC


FUNCTION GetDetectedErrorStateAsText as String
LPARAMETERS vErrorstate as Integer

    LOCAL lcReturn as String

    DO CASE
    CASE m.vErrorState = 0
        * // Unknown
        lcReturn = [Unbekannter Fehler]
    CASE m.vErrorState = 1
        * // Other
        lcReturn = [Anderer Fehler]
    CASE m.vErrorState = 2
        * // No Error
        lcReturn = [kein Fehler]
    CASE m.vErrorState = 3
        * // Low Paper
        lcReturn = [zu wenig Papier]
    CASE m.vErrorState = 4
        * // No Paper
        lcReturn = [kein Papier]
    CASE m.vErrorState = 5
        * // Low Toner
        lcReturn = [zu wenig Toner]
    CASE m.vErrorState = 6
        * // No Toner
        lcReturn = [kein Toner]
    CASE m.vErrorState = 7
        * // Door Open
        lcReturn = [Gehäuse geöffnet]
    CASE m.vErrorState = 8
        * // Jammed
        lcReturn = [Papierstau]
    CASE m.vErrorState = 9
        * // Service Requested
        lcReturn = [Kundendienst erforderlich]
    CASE m.vErrorState = 10
        * // Output Bin Full
        lcReturn = [Ausgabeschacht ist voll]
    CASE m.vErrorState = 11
        * // Paper Problem
        lcReturn = [Papier Problem]
    CASE m.vErrorState = 12
        * // Cannot Print Page
        lcReturn = [Seite kann nicht gedruckt werden]
    CASE m.vErrorState = 13
        * // User Intervention Required
        lcReturn = [Benutzereingriff notwendig]
    CASE m.vErrorState = 14
        * // Out Of Memory
        lcReturn = [Arbeitsspeicher voll]
    CASE m.vErrorState = 15
        * // Server Unknown
        lcReturn = [unbekannter Server]
    OTHERWISE
        lcReturn = [Unbekannt]
    ENDCASE
    RETURN     [(] + ALLTRIM(STR(m.vErrorState)) + [) ] + lcReturn

ENDFUNC