Feststellen der aktuellen Zeitzone / Discover the current time zone

Wenn wir mit Daten arbeiten, die nicht nur in einer einzigen Zeitzone erfaßt werden, dann können wir nicht direkt mit der Uhrzeit der jeweiligen Arbeitsstation arbeiten. Dies würde die Erfassungszeitpunkte ad absurdum führen.

In einem solchen Fall haben wir zwei Möglichkeiten. Ersten können wir die Zeitstempel vor dem Speichern entsprechend anpassen oder zweitens, wir führen einen Merker, der uns eine Nachberechnung der Zeitstempel ermöglicht.

Wie auch immer, wir müssen auf jeden Fall feststellen, wie die Uhrzeit in Bezug auf die Greenwich Mean Time (GMT) berechnet ist. Ein weiterer Aspekt dem wir Beachtung schenken müssen ist die Sommerzeit die u.a. in Mitteleuropa gilt. Hierdurch entsteht eine weitere Zeitverschiebung.

Im folgenden ein Codemuster, wie die entsprechenden Informationen aus Windows herausgekitzelt werden können. Benötigt wird übrigens die kernel32.dll.

* // Deklaration der Arbeitsvariablen                                        
LOCAL   lcTimeZoneDB     as String, ;
        liTimeZoneFlag   as Integer, ;
        lcTimeZoneDesc   as String, ;
        liTimeZoneOffset as Integer, ;
        liGMTOffset      as Integer, ;
        liSUTOffset      as Integer

* // Deklaration der Zeitzonen API Funktion und abrufen der Informationen    
#DEFINE TIME_ZONE_SIZE  172
DECLARE Integer GetTimeZoneInformation IN kernel32 String @lpTimeZoneInformation
lcTimeZoneDB             = REPLICATE( CHR( 0 ) , TIME_ZONE_SIZE )
liTimeZoneFlag           = GetTimeZoneInformation( @lcTimeZoneDB )

* // Feststellen der Standard- und Sommerzeitabweichung                        
liGMTOffset              = CTOBIN( SUBSTR( lcTimeZoneDB ,   1 , 4 ) , [4RS] )
liSUTOffset              = CTOBIN( SUBSTR( lcTimeZoneDB , 169 , 4 ) , [4RS] )

* // Feststellen der Zeitzonenabweichungen                                    
IF liTimeZoneFlag = 2    && Sommerzeit Abweichung berücksichtigen            
    lcTimeZoneDesc       = STRTRAN( STRCONV( SUBSTR( lcTimeZoneDB , 89 , 64 ) , 6 ) , CHR( 0 ) , [])  
    liTimeZoneOffset     = ( liGMTOffset + liSUTOffset ) * 60
ELSE                     && Nur Standard GMT Zeit Abweichung                    
    lcTimeZoneDesc       = STRTRAN( STRCONV( SUBSTR( lcTimeZoneDB ,  5 , 64 ) , 6 ) , CHR( 0 ) , [])  
    liTimeZoneOffset     = liGMTOffset * 60
ENDIF 

* // Informationsausgabe im _screen                                            
CLEAR 
lcFont           = _screen.FontName
_screen.FontName = [Courier New]

?PADR([Zeitzone] , 25 , [ ] )
??TRANSFORM( liTimeZoneFlag ) + [ - ] + lcTimeZoneDesc
?PADR([Zeitverschiebung gesamt] , 25 , [ ] )
??[=] + TRANSFORM( ABS( liTimeZoneOffset ) ) + [ sek / ]
??[=] + TRANSFORM( INT( ABS( liTimeZoneOffset ) / 60) ) + [ min / ]
??[=] + TRANSFORM( INT( ABS( liTimeZoneOffset ) / 60 / 60) ) + [ std]
?PADR([GMT Verschiebung ] , 25 , [ ] )
??TRANSFORM( liGMTOffset ) + [ min]
?PADR([SOZ Verschiebung] , 25 , [ ] )
??TRANSFORM( liSUTOffset ) + [ min]
?PADR([MESZ] , 25 , [ ] )
??TIME()
?PADR([GMT] , 25 , [ ] )
??GETWORDNUM( CAST( DATETIME() + liTimeZoneOffset as C( 20 ) ) , 2 , [ ] )

_screen.FontName = lcFont

Erzeugen von UNC Pfadnamen / Creating UNC Pathnames (Revisited)

Nachdem ich heute zufälligerweise in eine alte Funktion von mir reingeschaut habe (Erzeugen von UNC-Pfadnamen), gab es auch gleich Verbesserungsbedarf. Im Blogeintrag vom September 2008 konnte nur ein Laufwerksbuchstabe (bspw. H:) übergeben werden. Die neue Funktion habe ich nun dahingehend erweitert, dass es jetzt sowohl reine Laufwerksbuchstaben, als auch komplette Verzeichnis- und/oder Dateinamen sein dürfen. Die verschiedenen Möglichkeiten sind im vorgelagerten Funktionstest zu ersehen.

* // Funktionstest Start    
CLEAR 
?GetFullUNCPath( [H:] )
?GetFullUNCPath( [H:\] )
?GetFullUNCPath( [H:\Foxprogs] )
?GetFullUNCPath( [H:\Foxprogs\] )
?GetFullUNCPath( [H:\Foxprogs\mware71] )
?GetFullUNCPath( [H:\Foxprogs\mware71\] )
?GetFullUNCPath( [H:\Foxprogs\mware71\konf.exe] )
* // Funktionstest Ende        

FUNCTION GetFullUNCPath as String
LPARAMETERS vMappedName as String
    * // Datendeklaration und Initialisierung            
    LOCAL    lcUNCBuffer as String, liLength as Integer, ;
            lcUNCName as String, llContinue as Boolean, ;
            lcMessage as String, lcPath as String
    lcUNCBuffer    = []
    liLength    = 0
    lcUNCName    = []
    llContinue    = .T.
    lcMessage    = []
    vMappedName    = IIF(DIRECTORY( vMappedName ) , ADDBS( vMappedName ) , vMappedName )
    lcPath        = IIF( LEN( vMappedName ) > 2 , SUBSTR( vMappedName , 3 ) , [] )
    vMappedName    = JUSTDRIVE( vMappedName )
    * // Deklaration der API-Funktion                    
    TRY
        DECLARE INTEGER WNetGetConnection IN WIN32API ;
            STRING @ lpLocalName, ;
            STRING @ lpRemoteName, ;
            INTEGER @ lpliLength
    CATCH
        TEXT TO lcMessage NOSHOW TEXTMERGE PRETEXT 2
            Deklaration von WNetGetConnection in WIN32API
            ist fehlgeschlagen. Funktion wird vorzeitig beendet.
        ENDTEXT
        MESSAGEBOX(lcMessage,0+16+0,[Information])
        llContinue = .F.
    ENDTRY
    * // Umsetzung des lokalen Pfades in einen UNC Pfad    
    IF llContinue
        IF !EMPTY( vMappedName ) AND VARTYPE( [vMappedName] ) = [C]
            lcUNCBuffer    = REPL( CHR( 0 ) , 261 )
            liLength    = LEN( lcUNCBuffer )
            vMappedName    = ALLTRIM( vMappedName )
            IF LEN( vMappedName ) = 1
                vMappedName = vMappedName + [:]
            ENDIF
            TRY
                IF WNetGetConnection( vMappedName , @lcUNCBuffer , @liLength ) = 0
                    lcUNCName = LEFT( lcUNCBuffer , AT( CHR( 0 ) , lcUNCBuffer ) - 1 )
                ENDIF
            CATCH
                TEXT TO lcMessage NOSHOW TEXTMERGE PRETEXT 2
                    Aufruf von WNetGetConnection in WIN32API
                    ist fehlgeschlagen. UNC-Pfad konnte nicht
                    generiert werden.
                ENDTEXT
                MESSAGEBOX( lcMessage , 0+16+0 , [Information] )
            ENDTRY
        ENDIF
    ENDIF
    RETURN lcUNCName + lcPath
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 

Inaktivität des Anwenders über TIMEOUT prüfen / Using TIMEOUT to check user inactivity

Eine unangenehme Eigenschaft von VFP ist, dass eine Applikation, die aus einer EXE heraus gestartet wurde, solange für Updatevorgänge gesperrt bleibt, bis die aufrufende EXE beendet wird.

Jetzt stellt dies nicht wirklich ein Problem dar, denn üblicherweise genügt es, den Anwender zu informieren, das Programm für einen Updatevorgang zu beenden.

Dieser Gedankengang hat allerdings einen kleinen Haken, den Murphy sich nur zu gerne zu Nutzen macht. In einigen Fällen ist der Anwender, der eine Applikation sperrt, gerade nicht an seinem Arbeitsplatz...

Damit unsere Anwendung von sich aus feststellen kann, ob der Anwender eine 'Denkpause' eingelegt hat, benötigen wir eine systemweite Prüfung auf Aktivitäten bzw. in unserem Fall auf Inaktivitäten. Ist bspw. über einen Zeitraum von 15 Minuten keine Benutzereingabe erfolgt, dann können wir mit unserem Programm reagieren, und eine zeitgesteuerte Messagebox einblenden. Welche wiederum nach Ablauf ihres Timeouts ggf. das automatische und geordnete Beenden unserer Anwendung durchführen kann.

Im u.a. Beispiel wird mit einer PUBLIC Variablen gearbeitet. Alternativ kann das Objekt auch in einer Applikationsproperty erzeugt werden. Wichtig ist auf jeden Fall, dass der Timer jederzeit erreichbar ist.

Der Timer kann mit zwei Parametern versehen werden.
Parameter 1 definiert den Timeout Zeitraum in Minuten
Parameter 2 gibt den Timerzyklus in Sekunden vor

Wer die Parameter nicht nutzen möchte kann natürlich die entsprechenden Eigenschaften sozusagen 'ab Werk' vorbesetzen.

* // Funktionstext                                                    
CLEAR 
PUBLIC goTimer as Timer
* // 1 minütiger Timeout mit 15 Sekunden Prüfinterval                
* // Zum Beenden im Befehlsfenster 'Release goTimer' eingeben        
goTimer = CREATEOBJECT( [InactivityTimer] , 1 , 15 )

* // Bemerkt Benutzeraktivitäten und feuert ein Ereignis, nachdem    
* // der definierte Zeitraum für Inaktivität überschritten wurde.    
DEFINE CLASS InactivityTimer as Timer 

    * // Deklaration der API Konstanten                                
    #DEFINE WM_KEYUP        0x0101
    #DEFINE WM_SYSKEYUP     0x0105
    #DEFINE WM_MOUSEMOVE    0x0200
    #DEFINE GWL_WNDPROC     (-4)

    * // Interne Eigenschaften setzen und Timer setzen (5Sek.)        
    _iTimeoutInMinutes      = 0
    _tLastActivity          = {/:}
    Interval                = 5000
    Enabled                 = .T.

    * // Auf API Ereignisse horchen sobald die Form gestartet wurde    
    * // Optional wird ein Timeout Wert als Parameter übergeben        
    * // Zusätzlich kann als weiterer Parameter der Prüfinterval in    
    * // Sekunden übergeben werden.                                    
    PROCEDURE Init ( vTimeoutInMinutes as Integer , vIntervalInSeconds as Integer )

        WITH This
            ._iTimeoutInMinutes  = EVL( vTimeoutInMinutes , 1 )
            .Interval            = EVL( vIntervalInSeconds , 5 ) * 1000
            ._tLastActivity      = DATETIME()
        ENDWITH 
        BINDEVENT( 0 , WM_KEYUP ,     This , [WndProc] )
        BINDEVENT( 0 , WM_SYSKEYUP ,  This , [WndProc] )
        BINDEVENT( 0 , WM_MOUSEMOVE , This , [WndProc] )

    ENDPROC 

    * // mit dem Lauschen aufhören                                    
    PROCEDURE Unload 

        UNBINDEVENTS( 0 , WM_KEYUP )
        UNBINDEVENTS( 0 , WM_SYSKEYUP )
        UNBINDEVENTS( 0 , WM_MOUSEMOVE )

    ENDPROC 

    * // Jedes Ereignis zählt als Aktivität...                        
    PROCEDURE WndProc ( hWnd as Long, Msg as Long, wParam as Long, lParam as Long )

        This._tLastActivity = DATETIME()

    ENDPROC 

    * // Letzte Aktivität mit Timeout abgleichen                    
    PROCEDURE Timer

        WITH This
            LOCAL ltFireEvent as Datetime 
            ltFireEvent = ._tLastActivity + ( 60 * ._iTimeoutInMinutes )
            IF DATETIME() >= ltFireEvent
                .eventTimeout()
            ENDIF
        ENDWITH  

    ENDPROC 

    * // Diese Methode über BINDEVENT übersteuern oder enthaltenen    
    * // Code überschreiben...                                        
    * // Bspw. kann hier der Wert von iTimeoutInMinutes überschrie-    
    * // ben werden um einen mehrstufigen Timeout zu ermöglichen    
    PROCEDURE eventTimeout

        MESSAGEBOX( [<<< TIMEOUT >>>] , 0 , [Inaktiv] )

    ENDPROC 

ENDDEFINE 

Feststellen der aktuellen Farbtiefe / Determine current color depth

Wer in seiner Applikation mit hochauflösenden Grafiken und Fotos arbeitet, der benötigt für eine einwandfreie Anzeige auch eine akzeptable Anzahl an darstellbaren Farben.

Früher war für viele solcher Anwendungen der Zugriff über Terminaldienste (Citrix, Terminalserver, u.ä.) oftmals ein K.O.-Kriterium, da in diesen Umgebungen aus Geschwindigkeitsgründen eine Farbtiefe von 8 Bit (=256 Farben) eingestellt war. Die aktuellen Versionen dieser Serverumgebungen unterstützen mittlerweile auch höhere Farbtiefen, denn um ein Foto in allen Details betrachten zu können sind 256 Farben definitiv nicht ausreichend.

Auch heute kommt es vor, dass Anwender (bspw. wegen Updates des Grafikkartentreibers) plötzlich wieder vor einer 8 oder 16 Bit Farbdarstellung sitzen, ohne dies überhaupt zu bemerken. Eine andere Möglichkeit ist, dass wir in unserer Applikation, je nach eingestellter Farbtiefe, andere Grafiken einblenden.

Der folgende Mustercode gibt uns Aufschluss über die aktuelle Farbtiefe, die verfügbaren Paletten und die darstellbare Anzahl an Farben die unserer Applikation zur Verfügung stehen.

CLEAR 
? [verfügbare Paletten: ]
??GetBitsPerPixel(1)
? [Farbtiefe in Bit   : ] 
??GetBitsPerPixel(2)
? [Anzahl Farben      : ]
??GetBitsPerPixel(3)

FUNCTION GetBitsPerPixel as Integer
LPARAMETERS vVersion as Integer
    * // Mögliche Parameterwerte:                            
    * // 1 = Verfügbare Paletten                                
    * // 2 = Farbtiefe in Bit                                   
    * // 3 = Anzeigbare Farben                                  
    
    * // Wenn kein Parameter übergeben wurde, dann mit        
    * // Defaultwert vorbesetzen...                            
    vVersion = EVL(vVersion,2)
    
    * // liBitsPerPixel beinhaltet die Farbtiefe            
    * // 8        = 8 Bit     = 256 Color                    
    * // 16       = 16 Bit    = High Color                    
    * // 24 / 32  = 24/32 Bit = TrueColor                    
    * // Es gibt noch weitere Wertmöglichkeiten, die o.a.    
    * // aufgezählten stellen jedoch die üblichen             
    * // Varianten dar.                                        
    
    * // Um die Farbtiefe festzustellen benötigen wir        
    * // mehrere API-Funktionen                                
    DECLARE INTEGER GetDC IN WIN32API AS GetDCHandle INTEGER hWnd
    DECLARE INTEGER GetActiveWindow IN WIN32API
    DECLARE INTEGER GetDeviceCaps IN WIN32API INTEGER hDC, INTEGER nIndex
    DECLARE INTEGER ReleaseDC IN WIN32API INTEGER hWnd, INTEGER hDC
    #DEFINE PLANES 14
    #DEFINE BITSPIXEL 12

    LOCAL liDChandle as Integer, liReturn as Integer
    
    * GetDeviceCaps Handle erzeugen + Returnwert vorbesetzen
    liDChandle    = GetDCHandle( GetActiveWindow() )
    liReturn    = 0
    
    DO CASE 
    CASE vVersion = 1
        * // Anzahl der verfügbaren Paletten feststellen 
        liReturn    = GetDeviceCaps( liDChandle , PLANES )
    CASE vVersion = 2
        * // Farbtiefe in Bits feststellen 
        liReturn    = GetDeviceCaps( liDChandle , BITSPIXEL )
    OTHERWISE 
        * // Anzahl darstellbarer Farben feststellen        
        * // Formel: 2 ^ (AnzahlPaletten * BitsProPixel)    
        liReturn    = INT( 2 ^ ( GetDeviceCaps( liDChandle , PLANES ) * GetDeviceCaps( liDChandle , BITSPIXEL ) ) )
    ENDCASE 
    
    * // GetDeviceCaps Handle freigeben                        
    =ReleaseDC( GetActiveWindow() , liDChandle )

    RETURN liReturn
    
ENDFUNC

Erzeugen von UNC Pfadnamen / Creating UNC pathnames

Im folgenden Posting geht es um die Konvertierung von Verzeichnisnamen die auf gemappte Laufwerke zugreifen.

Mit Hilfe der WIN32API können wir über die dort verfügbare Funktion WNetGetConnection den UNC Namen ( Universal/Uniform Naming Convention ) einer solchen Verbindung abfragen.

FUNCTION GetUNCPath
LPARAMETERS vMappedName as String
  * // Datendeklaration und Initialisierung
  LOCAL    lcUNCBuffer as String, liLength as Integer, ;
          lcUNCName as String, llContinue as Boolean, ;
          lcMessage as String
  lcUNCBuffer    = []
  liLength    = 0
  lcUNCName    = []
  llContinue    = .T.
  lcMessage    = []
  * // Deklaration der API-Funktion
  TRY
      DECLARE INTEGER WNetGetConnection IN WIN32API ;
              STRING @ lpLocalName, ;
              STRING @ lpRemoteName, ;
              INTEGER @ lpliLength
  CATCH
      TEXT TO lcMessage NOSHOW TEXTMERGE PRETEXT 2
           Deklaration von WNetGetConnection in WIN32API
           ist fehlgeschlagen. Funktion wird vorzeitig beendet.
      ENDTEXT
      MESSAGEBOX(lcMessage,0+16+0,[Information])
      llContinue = .F.
  ENDTRY
  * // Umsetzung des lokalen Pfades in einen UNC Pfad
  IF llContinue
      IF !EMPTY(m.vMappedName) AND VARTYPE([m.vMappedName]) = [C]
          lcUNCBuffer        = REPL(CHR(0),261)
          liLength        = LEN(lcUNCBuffer)
          m.vMappedName    = ALLTRIM(m.vMappedName)
          IF LEN(m.vMappedName) = 1
              m.vMappedName = m.vMappedName + [:]
          ENDIF
          TRY
              IF WNetGetConnection(m.vMappedName, @lcUNCBuffer, @liLength) = 0
                 lcUNCName = LEFT(lcUNCBuffer,AT(CHR(0),lcUNCBuffer)-1)
              ENDIF
          CATCH
              TEXT TO lcMessage NOSHOW TEXTMERGE PRETEXT 2
                   Aufruf von WNetGetConnection in WIN32API
                   ist fehlgeschlagen. UNC-Pfad konnte nicht
                   generiert werden.
              ENDTEXT
              MESSAGEBOX(lcMessage,0+16+0,[Information])
          ENDTRY
      ENDIF
  ENDIF
  RETURN lcUNCName
ENDFUNC

Wie bewege ich eine Form ohne Titelleiste / How to move a form without titlebar

Ab und an besteht der Bedarf, ein Formobjekt ohne Titelleiste darzustellen. Mit Hilfe der Form-Eigenschaft 'TitleBar' läßt sich das soweit auch problemlos bewerkstelligen. Soll diese nun 'kopflose' Form jedoch trotzdem auf dem Bildschirm bewegt werden können, dann haben wir jetzt ein klitzekleines Problem, denn die Titelleiste einer Form dient nun einmal als Haltegriff für die Maus, wenn eine Form verschoben werden soll.

Um unsere Form aus ihrer Zwangsstarre zu befreien benötigen wir jedoch nur zwei Funktionen aus der win32api und schon klappts es wieder mit dem Bewegen. Um der Form eine maximale Beweglichkeit zu ermöglichen sollten wir zuvor noch einige Eigenschaften anpassen:

AlwaysOnTop = .T. && optional
Desktop     = .T. && optional
ShowWindow  = 2   && optional
TitleBar    = 0

Innerhalb des LOAD-Events der Form fügen wir den folgenden Code ein:

DECLARE integer ReleaseCapture IN WIN32API
DECLARE integer SendMessage IN WIN32API INTEGER, INTEGER, INTEGER, INTEGER

Dieser Code kommt in den MOUSEDOWN-Event:

LPARAMETERS nButton, nShift, nXCoord, nYCoord

IF nButton = 1
    ReleaseCapture()
    SendMessage(This.HWnd, 0x112, 0xF012,0)
ENDIF

Sobald wir nun mit der Maus auf einen objektfreien Bereich klicken und die Taste festhalten, können wir die Form frei bewegen.

Wenn nun noch eine kleine 'Einrastfunktion' wie in WinAMP dazukommen soll, dann packen wir einfach den folgenden Code in das MOVED-Ereignis:

liOffset = 20
WITH This
    IF .Height < SYSMETRIC(2) - liOffset
        DO CASE    
        CASE .Top < liOffset
            .Top = 0
        CASE .Top + .Height > SYSMETRIC(2) - liOffset
            .Top = SYSMETRIC(2) - .Height
        ENDCASE
    ENDIF
    IF .Width < SYSMETRIC(1) - liOffset
        DO CASE
        CASE .Left < liOffset
            .Left = 0
        CASE .Left + .Width > SYSMETRIC(1) - liOffset
            .Left = SYSMETRIC(1) - .Width
        ENDCASE 
    ENDIF
ENDWITH

Die o.a. lokale Variable liOffset kann natürlich auch als Form-Eigenschaft hinterlegt werden. Sie definiert letztlich nur den Randabstand, ab dem die Einrastfunktionalität greifen soll.
Übrigens wäre auf dieser Form ein Button zum Schliessen recht sinnvoll. Wegen der ausgeblendeten Titelleiste fehlt diese Funktion nämlich ;-).

Netzwerk Ping in VFP / Network ping with VFP

Wie eine Netzwerkadresse auf ihre Verfügbarkeit geprüft wird dürfte wohl den meisten Entwicklern bekannt sein...

    ping domaenenname.de

Hierbei erfolgt die Namensauflösung in eine IP-Adresse bei korrekt konfiguriertem DNS automatisch. Alternativ können wir natürlich auch direkt die IP-Adresse eingeben.

    ping 192.168.1.70

Im DOS-Befehlsfenster oder auch in Batchdateien kann es heute noch durchaus sinnvoll sein, diesen Befehl einzusetzen. Aber selbst dort stossen wir sofort an die Grenzen dieses transienten DOS-Befehls, er liefert nämlich nur eine visuelle Rückmeldung.

Aus diesem Grund kann ping.exe nicht für eine Ergebnisabfrage und eine davon abhängige weitere Programmausführung eingesetzt werden. In Batchdateien kommt bei mir deshalb schon lange das kleine Tool alive.exe zum Einsatz. Es liefert einen Fehlercode (im DOS-Jargon Errorlevel), der über das Ergebnis Auskunft gibt und so die weitere Verarbeitung steuern kann.

@echo off
cls

set TGT_HOST=myHost
set PRT_SCREEN="Y"
set PRT_FILE="C:\TEMP"

alive /repeat=30 %TGT_HOST% >>%PRT_FILE%
if %errorlevel% == 255 if %PRT_SCREEN% == "Y" echo Unbekannter Fehler
if %errorlevel% == 8   if %PRT_SCREEN% == "Y" echo Zieladresse unbekannt
if %errorlevel% == 7   if %PRT_SCREEN% == "Y" echo Verbindungsweg zu lang
if %errorlevel% == 6   if %PRT_SCREEN% == "Y" echo Hardwarefehler
if %errorlevel% == 5   if %PRT_SCREEN% == "Y" echo Zielport nicht erreichbar
if %errorlevel% == 4   if %PRT_SCREEN% == "Y" echo Zielprotokoll nicht erreichbar
if %errorlevel% == 3   if %PRT_SCREEN% == "Y" echo Zielnetzwerk nicht erreichbar
if %errorlevel% == 2   if %PRT_SCREEN% == "Y" echo Zielrechner nicht erreichbar
if %errorlevel% == 1   if %PRT_SCREEN% == "Y" echo Paketlaufzeit abgelaufen
if %errorlevel% == 0   goto :OEFFNE_VERBINDUNG

goto :ENDE_DER_VERARBEITUNG

:OEFFNE_VERBINDUNG
REM Hier findet der Connect und die sonstige Verarbeitung statt

:ENDE_DER_VERARBEITUNG
cls

So weit so gut. Aber wer möchte in VFP schon freiwillig eine hässliche DOS-Box öffnen? Also suchen wir uns einen anderen Weg.

Hilfreich ist hierbei die IP-Hilfs-API (zu finden im WINDOWS\System32 Ordner (iphlpapi.dll).
Im folgenden Codebeispiel, das im übrigen auch als Methode in der Klassenbibliothek unserer Wahl implementiert werden kann, ist die maximale Anzahl an Hops auf 5 beschränkt.

FUNCTION isAlive
LPARAMETERS vIpNum, vSilent

    * Deklaration der API-Schnittstelle
    DECLARE INTEGER GetRTTAndHopCount IN Iphlpapi;
       INTEGER DestIpAddress, LONG @HopCount,;
       INTEGER MaxHops, LONG @RTT
    DECLARE INTEGER inet_addr IN ws2_32 STRING cp

    * Deklaration der benötigten Variablen
    LOCAL lnDst, lnHop, lnRTT, llReturn

    lnDst        = inet_addr(m.vIpnum)
    llReturn    = .F.
    STORE 0 TO lnHop, lnRTT

    * Zieladresse anpingen und wenn als Ergebnis eine
    * 0 geliefert wird, dann war der ping erfolglos
    IF GetRTTAndHopCount(lnDst, @lnHop, 5, @lnRTT) = 0

        TEXT TO lcMsg TEXTMERGE NOSHOW PRETEXT 3
            keine Antwort von IP-Adresse <<m.vIpnum>>
        ENDTEXT
    
    * Andernfalls konnte die Zieladresse kontaktiert werden
    ELSE

        TEXT TO lcMsg TEXTMERGE NOSHOW PRETEXT 3
            Antwort von IP-Adresse <<m.vIpnum>>
            (<<m.lnRTT>> MSek / <<m.lnHop>> Hops)
        ENDTEXT
        llReturn = .T.
      
    ENDIF

    * Wenn Meldung erlaubt, dann das Ergebnis anzeigen
    IF !vSilent
        MESSAGEBOX(lcMsg,0+64+0,[Programminformation])
    ENDIF

    * Rückmeldung .T. = erfolgreich, .F. = erfolglos
    RETURN llReturn

ENDFUNC

Feststellen der aktuellen Windows Spracheinstellung / Determine the current Windows language

Mehrsprachigkeit in Applikationen ist schon lange ein Thema.

Wenn die Anwendung mit eigenen Logins arbeitet, kommt meist eine Klassenbibliothek zum Einsatz, die auf Basis des Anwendungslogins, die korrekte Sprache für die jeweiligen Masken einblendet.

Diese User-bezogene Reaktion können wir jedoch ganz einfach auf eine höhere Ebene tragen. Es wäre doch eigentlich ganz praktisch, wenn unsere Anwendung von sich aus merkt, dass der User bereits vom BS aus in einer anderen Sprache unterwegs ist.

Hilfreich ist uns hierbei wieder einmal die Windows API. Der folgende recht kurze Code zeigt, wie wir die entsprechenden Informationen aus Windows herauskitzeln.

* Konstantendeklaration
#DEFINE LOCAL_USER_DEFAULT     BITLSHIFT(0x01, 10) && Benutzer Standard
#DEFINE LOCAL_SYSTEM_DEFAULT   BITLSHIFT(0x02, 10) && System Standard
#DEFINE LOCAL_SENGLANGUAGE     0x00001001          && Englischer Name
#DEFINE LOCAL_SABBREVLANGNAME  0x00000003          && Abgekürzt
#DEFINE LOCAL_SNATIVELANGNAME  0x00000004          && Ausgeschrieben
* API Deklaration
DECLARE Integer GetLocaleInfo IN Win32API ;
    Long Locale, Long LCType, String @ LCData, Integer size
* Lokale Arbeitsvariablen
LOCAL lcBuffer as String, liLength as Integer
lcBuffer = SPACE(256)
liLength = 0

CLEAR

* Benutzersprache (standard), englisch, ausgeschrieben
liLength = GetLocaleInfo(LOCAL_USER_DEFAULT, LOCAL_SENGLANGUAGE,      @lcBuffer, 256)
? [(User) Standardsprache : ] + LEFT( lcBuffer , liLength - 1 )

* Systemsprache, abgekürzt, deutsch
liLength = GetLocaleInfo(LOCAL_SYSTEM_DEFAULT, LOCAL_SABBREVLANGNAME, @lcBuffer, 256)
? [(System) Abgekürzt     : ] + LEFT( lcBuffer , liLength - 1 )

* Systemsprache, ausgeschrieben, deutsch
liLength = GetLocaleInfo(LOCAL_SYSTEM_DEFAULT, LOCAL_SNATIVELANGNAME, @lcBuffer, 256)
? [Systemsprache          : ] + LEFT( lcBuffer , liLength - 1 )

Herausfinden der Pfadnamen von CSLID-Ordnern / Locating the paths of CSLID folders

Windows stellt eine Reihe von allgemein zugänglichen Standardverzeichnissen bereit.

Diese über Common System Location IDentifiers (CSLIDs) referenzierten Ordner werden über das Shell.Application - Objekt zum Abruf bereitgestellt. Hierbei steht für jeden Ordner den das jeweilige Windows BS unterstützt ein eigenes Ordnerobjekt zur Verfügung.

Der unten aufgeführte Mustercode beruht auf WinXPSP2 als BasisBS. Ältere oder andere BS-Versionen stellen einige der aufgelisteten Pfade nicht bereit.

Das Shell.Application - Objekt ist Bestandteil der Active Desktop Komponenten. Um auf dieses Objekt unter Win95 und WinNT4 zugreifen zu können muss zwingend der IE4 oder IE4.01 installiert sein. Neuere Versionen der Browsers enthalten die entsprechenden Komponenten nicht mehr.

Da somit nicht alle Ordnerobjekte in den verschiedenen BS zur Verfügung stehen und ebenfalls nicht alle BS-Varianten ein '.Self' Unterobjekt bereitstellen ist es unter Umständen notwendig, die Abfrage der Ordner über eine spezielle Schleife abzufragen (zu sehen im zweiten 'TRY...CATCH'-Block der Funktion 'ShowInfo()'.

#DEFINE NS_DESKTOP          0
#DEFINE NS_PROGRAMS         0x2
#DEFINE NS_CONTROLS         0x3
#DEFINE NS_PRINTERS         0x4
#DEFINE NS_PERSONAL         0x5
#DEFINE NS_FAVORITES        0x6
#DEFINE NS_STARTUP          0x7
#DEFINE NS_RECENT           0x8
#DEFINE NS_SENDTO           0x9
#DEFINE NS_BITBUCKET        0xa
#DEFINE NS_STARTMENU        0xb
#DEFINE NS_DESKTOPDIRECTORY 0x10
#DEFINE NS_DRIVES           0x11
#DEFINE NS_NETWORK          0x12
#DEFINE NS_NETHOOD          0x13
#DEFINE NS_FONTS            0x14
#DEFINE NS_TEMPLATES        0x15
#DEFINE NS_COMMONSTARTMENU  0x16
#DEFINE NS_COMMONPROGRAMS   0x17
#DEFINE NS_COMMONSTARTUP    0x18
#DEFINE NS_COMMONDESKTOPDIR 0x19
#DEFINE NS_APPDATA          0x1a
#DEFINE NS_PRINTHOOD        0x1b
#DEFINE NS_LOCALAPPDATA     0x1c
#DEFINE NS_ALTSTARTUP       0x1d
#DEFINE NS_COMMONALTSTARTUP 0x1e
#DEFINE NS_COMMONFAVORITES  0x1f
#DEFINE NS_INTERNETCACHE    0x20
#DEFINE NS_COOKIES          0x21
#DEFINE NS_HISTORY          0x22
#DEFINE NS_COMMONAPPDATA    0x23
#DEFINE NS_WINDOWS          0x24
#DEFINE NS_SYSTEM           0x25
#DEFINE NS_PROGRAMFILES     0x26
#DEFINE NS_MYPICTURES       0x27
#DEFINE NS_PROFILE          0x28

CLEAR 

PUBLIC oShell as Object
LOCAL lcScreenFont as String

lcScreenFont = _screen.FontName 
_screen.FontName = [Courier New]

oShell    = CREATEOBJECT([Shell.Application])

IF VARTYPE(oShell) = [O]

    ShowInfo(NS_DESKTOP)           && Desktop
    ShowInfo(NS_PROGRAMS)          && Programme
    ShowInfo(NS_CONTROLS)          && Systemsteuerung (Registrykey)
    ShowInfo(NS_PRINTERS)          && Drucker und Faxgeräte (Registrykey)
    ShowInfo(NS_PERSONAL)          && Eigene Dateien
    ShowInfo(NS_FAVORITES)         && Favoriten
    ShowInfo(NS_STARTUP)           && Autostart
    ShowInfo(NS_RECENT)            && Zuletzt verwendete Dateien
    ShowInfo(NS_SENDTO)            && Senden an
    ShowInfo(NS_BITBUCKET)         && Papierkorb (Registry)
    ShowInfo(NS_STARTMENU)         && Startmenü
    ShowInfo(NS_DESKTOPDIRECTORY)  && Desktop
    ShowInfo(NS_DRIVES)            && Arbeitsplatz (Registrykey)
    ShowInfo(NS_NETWORK)           && Netzwerkumgebung (Registrykey)
    ShowInfo(NS_FONTS)             && Schriftarten
    ShowInfo(NS_TEMPLATES)         && Vorlagen
    ShowInfo(NS_COMMONSTARTMENU)   && Startmenü 'All Users'
    ShowInfo(NS_COMMONPROGRAMS)    && Programme 'All Users'
    ShowInfo(NS_COMMONSTARTUP)     && Autostart 'All Users'
    ShowInfo(NS_COMMONDESKTOPDIR)  && Desktop ' All Users'
    ShowInfo(NS_APPDATA)           && Anwendungsdaten
    ShowInfo(NS_PRINTHOOD)         && Druckumgebung
    ShowInfo(NS_LOCALAPPDATA)      && Lokale Einstellungen / Anwendungsdaten
    ShowInfo(NS_ALTSTARTUP)        && ?????
    ShowInfo(NS_COMMONALTSTARTUP)  && ?????
    ShowInfo(NS_COMMONFAVORITES)   && Favoriten 'All Users'
    ShowInfo(NS_INTERNETCACHE)     && Temporäre Internetdateien
    ShowInfo(NS_COOKIES)           && Cookies
    ShowInfo(NS_HISTORY)           && Verlauf
    ShowInfo(NS_COMMONAPPDATA)     && Anwendungsdaten 'All Users'
    ShowInfo(NS_WINDOWS)           && Windows
    ShowInfo(NS_SYSTEM)            && System32
    ShowInfo(NS_PROGRAMFILES)      && Programme
    ShowInfo(NS_MYPICTURES)        && Eigene Bilder
    ShowInfo(NS_PROFILE)           && Profile

ENDIF 

_screen.FontName = lcScreenFont
oShell  = [ ]
oFolder = [ ]
RELEASE lcScreenFont, oShell, oFolder


FUNCTION ShowInfo
LPARAMETERS vNameSpaceID
    LOCAL loFolder as Object 
    loFolder = oShell.NameSpace(m.vNameSpaceID)

    IF VARTYPE(loFolder) = [O]
        * Unter XP-SP2 stehen fast alle Ordner zur Verfügung
        TRY 
            ? PADR(loFolder.Self.Name,30,[ ]), loFolder.Self.Path
        CATCH
            * Info ausgeben, Zugriff auf NameSpace fehlgeschlagen ist
            ? ['->] + PADR(TRANSFORM(m.vNameSpaceID,[@0]),27,[ ]), [nicht verfügbar]
        ENDTRY 
        
        * Unter älteren  WinBS oder nur basierend auf dieser 2. Routine
        * stehen diverse Ordner nicht zur Verfügung
        lcPath = NULL
        TRY
            FOR EACH item IN loFolder.ParentFolder.Items
                 IF item.name == loFolder.Title
                      ? PADR(['-> ] + item.name,30,[ ]), Item.Path
                      EXIT
                 ENDIF
            ENDFOR
        CATCH
            * Info ausgeben, Zugriff auf NameSpace fehlgeschlagen ist
            ? PADR(['-> ] + TRANSFORM(m.vNameSpaceID,[@0]),30,[ ]), [nicht verfügbar]
        ENDTRY 
    ENDIF 
    
    loFolder = [ ]
    RELEASE loFolder
ENDFUNC 

Arbeiten mit Umgebungsvariablen / Working with Environment Variables

Als Umgebungsvariablen werden solche Werte angesehen, die vom BS bereitgestellt werden. Die meisten dieser Variablen können über START/Systemsteuerung/System/Erweitert/Umgebungsvariablen eingesehen und auch den eigenen Bedürfnissen entsprechend angepasst werden.

Die Funktion GetEnv() kommt in VFP schon lange zum Einsatz. Sie stellt nicht nur die zur Verfügung stehenden Variablen des BS dar, sondern zeigt gleichzeitig als Tooltip den aktuellen Inhalt dieser Variablen an. Benötigen wir nun bspw. eine Liste der auf unserem Rechner freigegebenen Verzeichnisse, dann ist dies über eine Kombination von GetEnv() und ANetResources() möglich.

ANETRESOURCES(myResources,[\\] + GETENV([COMPUTERNAME]),1)
DISPLAY MEMORY LIKE myResources

Oben stehender Code liefert ein 1-Dimensionales Array mit dem Namen 'myResources' in dem sämtliche Netzwerkfreigaben des eigenen Rechners aufgelistet sind.

Wie erhalte ich nun die aktuell gesetzten Umgebungsvariablen in einer Liste?

In 2002 wurde von Michael Reynolds im fox wiki eine ausgesprochen einfache Lösung gepostet. Wissend, dass in der DOS-Shell über den Befehl SET sämtliche Umgebungsvariablen abrufbar sind:

RUN set > setlist.txt
lnFile = FOPEN('setlist.txt')
DO WHILE !FEOF(lnFile)
    lcString = FGETS(lnFile)
    lcVar = LEFT(lcString, AT('=', lcString) - 1)
    ? lcVar + ' = ' + GETENV(lcVar)
ENDDO
FCLOSE(lnFile)

Als Fan der Funktion FileToStr() (Wer diesen Blog verfolgt wird dies sicherlich schon bemerkt haben), habe ich Michael's Code auf diese Funktion umgestellt. Die Routine liefert ein 2-Dimensionales Array das in Spalte 1 den Namen und in Spalte 2 den Wert der Umgebungsvariablen enthält.

RUN set > c:\temp\setlist.txt

LOCAL lcSetList as String, i as Integer

* Einlesen der Ergebnisdatei
lcSetlist = FILETOSTR([c:\temp\setlist.txt])
* Ergebnisdatei loeschen
DELETE FILE ([c:\temp\setlist.txt])

* Abarbeitungsschleife für jede Zeile innerhalb der Ergebnisdatei
FOR i = 1 TO GETWORDCOUNT(lcSetList,CHR(13)+CHR(10))

    * Array redimensionieren
    DIMENSION laSetArray(i,2) as String
    * Variablenname auslesen
    laSetArray(i,1) = GETWORDNUM(GETWORDNUM(lcSetList,i,CHR(13)+CHR(10)),1,[=])
    * Variablenwert auslesen
    laSetArray(i,2) = GETWORDNUM(GETWORDNUM(lcSetList,i,CHR(13)+CHR(10)),2,[=])

ENDFOR

* Schleifenergebnis anzeigen
DISPLAY MEMORY LIKE laSetArray

RELEASE lcSetList, i, laSetArray

Im selben wiki-Beitrag (s.o.) zeigte Ed Rauh ein Codemuster auf Basis von Pointern und API-Aufrufen zur Arbeit mit statischen Blöcken wie sie im Zusammenspiel mit Umgebungsvariablen zum Tragen kommen.

Der API-Aufruf GetEnvironmentStrings() liefert einen vom OS verwalteten Datenblock.

Die VFP-Funktion GetEnv() ruft den Wert einer spezifischen Variablen gezielt ab. Hierfür muss jedoch deren genauer Name bekannt sein. GetEnv() unterstützt zwar Intellisense, je nach Einsatzgebiet steht Intellisense jedoch nicht zur Verfügung.

Der u.a. Code liefert ebenfalls einen 2-Dimensionalen Array der in Spalte 1 den Namen und in Spalte 2 den Wert der Umgebungsvariablen enthält.

DECLARE aEnv[1,2]
? GetAllEnvStrings(@aEnv)
DISPLAY MEMORY LIKE aENV

FUNCTION GetAllEnvStrings
LPARAMETER aEnvArray
DECLARE INTEGER GetEnvironmentStrings IN WIN32API
DECLARE SHORT FreeEnvironmentStrings IN WIN32API INTEGER lpszEnvironmentBlock
DECLARE INTEGER lstrcpyn IN WIN32API AS StrCpyN ;
    STRING @ lpDestString, ;
    INTEGER lpSource, ;
    INTEGER nMaxLength
LOCAL nOffset, nEnvironmentBlock, cEnvString, nNumEntries, cEqualPos
DECLARE aEnvArray(1,2)
nNumEntries = 0
cEnvString = ' '
nOffset = 0
nEnvironmentBlock = GetEnvironmentStrings()
DO WHILE LEN(cEnvString) > 0
   cEnvString = REPL(CHR(0), 512)
   IF StrCpyN(@cEnvString, nEnvironmentBlock + nOffset, 512) # 0
      cEnvString = LEFT(cEnvString, MAX(0,AT(CHR(0),cEnvString) - 1))
      nEqualPos = AT('=',cEnvString)
      IF nEqualPos > 0
         nNumEntries = nNumEntries + 1
         DECLARE aEnvArray(nNumEntries,2)
         aEnvArray[nNumEntries,1] = LEFT(cEnvString,nEqualPos - 1)
         aEnvArray[nNumEntries,2] = SUBST(cEnvString, nEqualPos + 1)
         nOffset = nOffset + LEN(cEnvString) + 1
      ENDIF
   ENDIF
ENDDO
=FreeEnvironmentStrings(nEnvironmentBlock)