Seite 1 von 2

Dateinamem eines laufenden Programms holen - Probleme!

Verfasst: 16.04.2013 10:09
von OlderCoder
Hallo allerseits,

ich möchte innerhalb eines Programms, das PC-Nutzergewohnheiten erfasst, den Dateinamen des Programms holen, dessen Fenster momentan den Fokus besitzt.
Dafür hatte ich mir zwei passende Code-Schnipsel aus der API-Library von RSBasic besorgt und diese in mein Programm eingepasst.
Eins für den Fenstertitel des Fensters, das den Fokus hat - das funktioniert ohne Probleme.
Und eins für den Dateinamen des Programms, dessen Fenster einen bestimmten Titel hat.
Mit diesem zweiten Code-Schnipsel gibt es jetzt in meinem Programm Probleme.
Verschiedene getestete Programme werden sauber erkannt. Hole ich aber das PureBasic-IDE-Fenster in den Vordergrund, dann erkennt mein Programm den Dateinamen nicht.
Das ist aber nur dann der Fall, wenn ich das Programm als exe starte. Aus der IDE heraus gestartet funktioniert es ohne Probleme!

Um das Problem einzukreisen, hab ich mir das Prinzip in ein kleineres Test-Programm kopiert, das nur das Nötigste tut.
Dummerweise funktioniert dieses Programm aber noch schlechter (und ich hab keine Ahnung, warum).
Jetzt wird bei allen Programmfenstern immer nur Explorer.EXE als Programm ausgegeben.
Am Anfang wird auch noch PureBasic erkannt. Aber wenn ich dann andere Fenster hervorhole, wird auch PureBasic nur noch als Explorer.EXE erkannt.
Und zwar aus der IDE heraus gestartet.

Aber vielleicht ist so der Fehler sogar leichter zu finden, falls es derselbe ist. Und wenn nicht, kann so zumindest meine Vorgehensweise nachvollzogen werden.
Zur Not poste ich auch den Code des gesamten Programms, aber das sind über 500 Zeilen.

Hier der Test-Code:

Code: Alles auswählen

Global titel$
Global titelneu$
Global prog$

Procedure fenstertitel()
  Protected hwnd.l,Length.w,*Buffer
  hwnd=GetForegroundWindow_()              
  Length = GetWindowTextLength_(hwnd)+1   
  *Buffer = AllocateMemory(length)        
  GetWindowText_(hwnd,*Buffer,Length)      
  titelneu$=PeekS(*Buffer,length,#PB_Ascii)
  FreeMemory(*Buffer)                     
EndProcedure

Procedure programm()
  Define.MODULEENTRY32 Entry
  Entry\dwSize = SizeOf(MODULEENTRY32)
   PID=1
  GetWindowThreadProcessId_(FindWindow_(0,titel$),@PID)
  If Module32First_(CreateToolhelp32Snapshot_(#TH32CS_SNAPMODULE,PID),Entry)
    prog$=GetFilePart(PeekS(@Entry\szExePath))
  EndIf
EndProcedure

OpenWindow(1,0,0,300,300,"Test")
Repeat
  event=WaitWindowEvent(20)
  fenstertitel()
  If titelneu$<>titel$
    Debug titelneu$
    programm()
    Debug prog$
    titel$=titelneu$
  EndIf  
Until event=#PB_Event_CloseWindow
Immer, wenn ein anderes Fenster den Fokus bekommt, soll der Fenstertitel und der Programname ausgegeben werden.
Der Fenstertitel passt, der Programmname ist aber immer Explorer.EXE
Habt Ihr einen Plan, warum der Programmname falsch ausgegeben wird?
Was in der Prozedur programm() passiert, kann ich am wenigsten nachvollziehen. Berücksichtigt das bitte bei Eueren Antworten.
Ich bin mir nicht ganz sicher, ob das Thema an sich in das Anfänger-Forum gehört, wo es doch auch um ein API-Problem geht. Aber mein Wissensstand ist eher der eines Anfängers, deshalb kommt meine Frage wieder in diesem Forum.

Gruß
OlderCoder

Re: Dateinamem eines laufenden Programms holen - Probleme!

Verfasst: 16.04.2013 10:39
von ts-soft
Naja, so ganz verstehe ich Dein Vorhaben noch nicht, aber folgendes funktioniert:

Code: Alles auswählen

EnableExplicit

Procedure.s GetEXEFromHwnd(hWnd = 0)
  Protected Result.s, PID, handle, err
  Protected Entry.MODULEENTRY32
  
  If hWnd = 0 : hWnd = GetForegroundWindow_() : EndIf
  
  Entry\dwSize = SizeOf(MODULEENTRY32)
  GetWindowThreadProcessId_(hWnd, @PID)
  handle = CreateToolhelp32Snapshot_(#TH32CS_SNAPMODULE, PID)

  If handle
    err = Module32First_(handle, Entry)
    If err
       Result = PeekS(@Entry\szExePath)
    EndIf
    CloseHandle_(handle)
  EndIf  
  
  ProcedureReturn Result
EndProcedure

Define event
Define prog.s, oldprog.s

OpenWindow(0, #PB_Ignore, #PB_Ignore, 300, 300, "Test")
ListViewGadget(0, 5, 5, 290, 290)
Repeat
  event = WaitWindowEvent(20)
  prog = GetFilePart(GetEXEFromHwnd())
  If prog <> oldprog
    AddGadgetItem(0, -1, prog)
    oldprog = prog
  EndIf 
Until event=#PB_Event_CloseWindow
Vielleicht hilft das ja weiter.

Re: Dateinamem eines laufenden Programms holen - Probleme!

Verfasst: 16.04.2013 12:26
von OlderCoder
Mein Vorhaben war, herauszufinden, wie lange ich täglich am Rechner bin, und mit welchen Programmen ich wieviel Zeit verbringe.
Und um das herauszufinden, brauche ich die Information, welches Programmfenster für welches Programm gerade im Vordergrund ist.

Danke für Deinen Vorschlag. Auf den ersten Blick verwendet dieser die gleichen oder ähnliche API-Funktionen wie mein Programm.
Aber bei Dir funktioniert es. Jetzt muss ich nur noch herausfinden, worin der Unterschied liegt.

Edit: etwas seltsam ist allerdings, dass bei Dir bei jedem Fensterwechsel häufig noch die PureBasic_Compilation6.exe (bei mir ist es die Nr. 6) eingeschoben wird, auch wenn ich das Fenster gar nicht anklicke.

Re: Dateinamem eines laufenden Programms holen - Probleme!

Verfasst: 16.04.2013 16:44
von ts-soft
OlderCoder hat geschrieben:Aber bei Dir funktioniert es. Jetzt muss ich nur noch herausfinden, worin der Unterschied liegt.
Etwas sauberer Codingstil :wink: , sowie freigeben des Handles und weil PB mich mag :mrgreen:

Re: Dateinamem eines laufenden Programms holen - Probleme!

Verfasst: 17.04.2013 17:02
von sibru
Tolle Anwendungs-Idee, hab´ ich gleich mal umgesetzt (siehe unten)...
(Ist diesmal nicht ganz so riesig)

Hinweis:
- kein Unicode !!! (mit Unicode werden die Exe-DateiNamen nicht ermittelt...)
- irgendeine .ICO-Datei zu CompUse.ICO kopieren

Code: Alles auswählen

;+----------------------------------------------------------------------+
;|          PureBasic-QuellCode "CompUse" mit allen ModulBody´s         |
;|erstellt durch Programm "PB_Mod2Body", Vers. 11225a am 17.04.13, 16:55|
;+----------------------------------------------------------------------+


#Prg_Name = "CompUse"
#Prg_Vers = "13417a"          ;<-- set by PB_VersUpd Vers 11415a
#PB_Vers  = "4.20"

; Dieses Prg. dient der Erfassung des Computer-Gebrauches: es werden die Zeiten,
; in denen Programm-Fenster aktiv (=im Vordergrund) sind, Programmweise addiert.
; Konzipiert ist Dieses Prg. als dauerhaft laufendes (Autostart-)Prg, das
; lediglich im SysTray durch ein Icon angesprochen werden kann. Hier kann auch
; eine Auswertung angefordert werden, die als Textdatei aufgebaut und via Prg.
; Notepad angezeigt wird (nicht-proporzionale Schriftart wie z. Bsp. "Lucida
; Console" empfehlenswert!!!)
;
; In der Auswertung sind alle Programme enthalten, die seit dem ersten
; Start Dieses Prg´s aufgerufen wurden bzw. derren Fenster aktiviert
; wurden. Neben der Exe-Datei (incl. Pfad!!!) wird die Zeitsumme (Std:min),
; die erste und die letzte Benutzung (Datum) des Prg´s sowie der Anteil
; der Nutzzeit des Prg´s in Relation zur Gesammt-NutzungsZeit [%] ausgewiesen.

EnableExplicit
Structure PrgUse_Type
  ExeFile$  ;vollständiger Dateiname der EXE-Datei (incl. Pfad und Extension)
  ZeitSum.l  ;sekundengenaue Summe der Zeit, die das Prg.-Fenster aktiviert war [Anz. Sekunden]
  Dat1.l     ;Datum und Uhrzeit der ersten Prg-Benutzung [Unix-Format]
  Dat9.l     ;Datum und Uhrzeit der letzten Prg-Benutzung [Unix-Format]
  Update.l   ;Änderungs-Flag
EndStructure
Global NewList PrgUse.PrgUse_Type();je EXE-Datei ein ListenElement

 ;==========  Begin Modul "SysTrayEntry.PBI"  ==========
;Modul      SysTrayEntry Version 1.01 vom 09.12.2008
#PB_Vers  = "4.20"
;
;Funktion:  legt Eintrag im SysTray (Monitior unten rechts) an und liefert dessen #Nr
;
;Aufruf:    EntryNr = SysTrayEntry(Ref$, IconFile$)
;           Ref$ = Text, der angezeigt wird, wenn sich der MausZeiger auf dem
;                  SysTray-Bildchen befindet
;           IconFile$=vollständiger DateiName einer .ICO-Datei, die das anzu=
;                  zeigende Bildchen enthält (Größe egal, wird angepasst...)
;                  oder #ImageNr eines bereits geladenen Bildchen (!!! nicht
;                  ImageHandle, sondern #ImageNr !!!)
;
;           Die Aktivierung (MausZeiger auf unserem SysTray und ´ne betätigte
;           Maus-Tatse) kann folgendermaßen ermittelt werden:
;             Select WaitWindowEvent()
;               Case #PB_Event_SysTray ;- SysTray-Aktion
;                  If EventType() = #PB_EventType_LeftClick Or EventType() = #PB_EventType_RightClick
Global SysTray_WinNr  ;Fenster-#Nr des (gehideten) SysTray-Fensters
Global SysTray_WinID  ;Fenster-ID des (gehideten) SysTray-Fensters
;#jaPBeExt exit
Procedure SysTrayEntry(PrgRef$, IconFile$)  ;- SysTray-Eintrag aufbauen
  Protected MutterWinID, BildNr, BildID
  MutterWinID = GetFocus_()
  SysTray_WinNr = OpenWindow(#PB_Any, 0, 0, 0, 0, PrgRef$, #PB_Window_Invisible)
  SysTray_WinID = WindowID(SysTray_WinNr)
  BildNr=Val(IconFile$) : If BildNr=0 : BildNr = LoadImage(#PB_Any, IconFile$) : EndIf
  BildID = ImageID(BildNr)
  BildNr = AddSysTrayIcon(#PB_Any, SysTray_WinID, BildID)
  SysTrayIconToolTip(BildNr, PrgRef$)
  If MutterWinID : SetFocus_(MutterWinID) : EndIf
  ProcedureReturn BildNr
EndProcedure
; jaPBe Version=3.8.6.707
; Build=0
; FirstLine=0
; CursorPosition=30
; ExecutableFormat=Windows
; DontSaveDeclare
; EOF
 ;==========  Ende Modul "SysTrayEntry.PBI"  ==========
 ;==========  Begin Modul "WinID2EXE.PBI"  ==========
;Modul      WinID2EXE Version 1.00 vom 16.04.2013
#PB_Vers  = "4.20"
;
;Funktion:  liefert Exe-Dateiname zur angegebenen WinID (kann auch Fremdfenster sein...)
;
;
;Aufruf:    ExeFile$ = WinID2EXE(WinID)
;           WinID: Fenster-Identifikator, der mittels WindowID(#PB_Win), FindWindow_(WinTitel$),
;                  GetForegroundWindow_() oder so ermittelt werden kann
;
;           Geliefert wird der vollständige Dateiname (incl. Pfad und DateiTyp) der EXE-Datei,
;           die das angegebene Fenster aufgebaut hat oder Leerstring, wenn WinID kein Fenster
;           ist oder nicht auf Exe-Datei basiert.
;
Global WinID2EXE_PID ;enthält den Process-Identifikator
;#jaPBeExt exit
Procedure.s WinID2EXE(WinID)
  Protected Entry.MODULEENTRY32
  Entry\dwSize = SizeOf(MODULEENTRY32)
  GetWindowThreadProcessId_(WinID, @WinID2EXE_PID)
  If Module32First_(CreateToolhelp32Snapshot_(#TH32CS_SNAPMODULE, WinID2EXE_PID), Entry)
  Else : WinID2EXE_PID = 0
  EndIf
  ProcedureReturn PeekS(@Entry\szExePath, - 1, #PB_Ascii)
EndProcedure
;Version für Unicode-Handling, klappt auch nicht immer....
; Prototype.l GetModuleFileNameEx(hProcess.l, hModule.l, *lpFilename, nSize)
; Prototype.l EnumProcessModules(hProcess, *lphModule, cb, lpchNeeded)
;
; Procedure.s WinID2EXE(WinID)
  ; Protected File$, process, result, Temp, LibNr
  ; Protected GetModuleFileNameEx.GetModuleFileNameEx
  ; Protected EnumProcessModules.EnumProcessModules
  ; Dim lModules.l(200)
  ; LibNr=OpenLibrary(0, "psapi.dll")
  ; GetModuleFileNameEx = GetFunction(0, "GetModuleFileNameExA")
  ; EnumProcessModules = GetFunction(0, "EnumProcessModules")
  ; If GetWindowThreadProcessId_(WinID, @WinID2EXE_PID)
    ; process = OpenProcess_(#PROCESS_QUERY_INFORMATION | #PROCESS_VM_READ, 0, WinID2EXE_PID)
    ; If process  : result = EnumProcessModules(process, @lModules(0), 200, @Temp)
      ; If result : File$ = Space(260)
        ; result = GetModuleFileNameEx(process, 0, @File$, Len(File$))
        ; File$ = LCase(Left(File$, result))
      ; EndIf
      ; CloseHandle_(process)
    ; EndIf
  ; EndIf
  ; ;CloseLibrary(LibNr)
  ; ProcedureReturn File$
; EndProcedure
; jaPBe Version=3.8.6.707
; Build=0
; Language=0x0000 Language Neutral
; FirstLine=2
; CursorPosition=25
; ExecutableFormat=Windows
; DontSaveDeclare
; EOF
 ;==========  Ende Modul "WinID2EXE.PBI"  ==========
 ;==========  Begin Modul "Wort.PBI"  ==========
;Modul      Wort           Version 1.14 vom 05.03.2013 (PB_V3.73)
#PB_Vers  = "4.20"
;                 (Basis: THEOS-Modul SYSTEM.MODLIB.WORT V 3.03 vom 11.05.1997)
;
;Funktion: liefert erstes Wort in einem String und verkürzt Diesen entsprechend
;          entspricht prinzipell der PB-Funktion "StringField()", benötigt jedoch
;          keinen Wort-Index und erkennt Wort aufgrund diverser Trenn- / Klammerungs=
;          zeichen. Außerdem wird die Wort-Basis (Eingangs-String-Parameter) wie
;          eine Queue gehandhabt und nach FunktionsEnde ist das erkannte Wort am
;          Anfang dieses Strings entfernt...
;
;Aufruf: Wort$ = Wort(@String$) - liefert nächstes Wort von String$ (bis Leerzeichen bzw. geklammert)
;      wobei: String$ = Text-Variable !!!, in der ggf. mehrere Worte enthalten sind.
;             Ein Wort ist:
;             - alle Zeichen bis zum nächsten Blank(führende Blank´s werden ignoriert)  oder
;             - geklammert durch " (^34), ' (^39), ´(^180), " " (^160) oder ^255       oder
;             - bis zum nächsten Zeichen lt. Global ´Wort_Ende$´                       oder
;             - geklammter durch Zeichen lt. Global ´Wort_Klammer$´
;     Die Global´s Wort_Ende$ und Wort_Klammer$ sind nach Funktions-Rückkehr resetet
;     (=leer!!), müßen also -sofern erforderlich- _vor jedem Aufruf_ dieser Funktion
;     entsprechend gesetzt werden !!!!
;
;     Diese Funktion liefert das 1. Wort im String (führende Leerzeichen werden ignoriert)
;     und der String wird entsprechend verkürzt
;     Beispiel:
;     A$ = "hallo ´du da´ alles klar"
;     B$ = Wort(@A$) ;1. Aufruf
;      (--> B$ ist "hallo",    A$ ist nun "´du da´ alles klar")
;     B$ = Wort(@A$) ;2. Aufruf
;      (--> B$ ist "du da",    A$ ist nun "alles klar") (wg. ´´-Klammerung)
;     B$ = Wort(@A$) ;3. Aufruf
;      (--> B$ ist "alles",    A$ ist nun "klar")
;     B$ = Wort(@A$) ;4. Aufruf
;      (--> B$ ist "klar",     A$ ist nun leer)
;
Global Wort_Ende$       ;Zeichen(kette) für Wort-Ende, GROSS-/klein-Schrift egal
                        ;!!! ist nach Funktionsausführung resettet (=leer) !!!
Global Wort_Klammer$    ;Klammerungs-Zeichen: alle Zeichen, die als Wort-Anfangs- oder Ende-Kennung
                        ;beim folgenden Aufruf zulässig sein sollen
Global Wort_EndKz$      ;Rückgabe: gefundenes/benutztes Wort-Ende-Zeichen
                        ;bzw. Zeichenkette bei Einsatz von Wort_Ende$
#Wort_BlankReplace = Chr(28);siehe Modul "WortForm()"...
 ;==========  Begin Modul "CharChg.PBI"  ==========
;Modul CharChg  Version 1.13 vom 27.11.2011
#PB_Vers  = "4.20"
;
;Funktion:  mehrfach-Austausch in einem String, in einem BasisString
;           wird ein Suchbegriff (EinzelZeichen oder auch ZeichenKette)
;           gesucht und durch einem Ersatzbegriff (leer, EinzelZeichen
;           oder auch Zeichenkette) ersetzt, das ganze auch mehrfach
;           (jedes Vorkommen des Suchbegriffes wird durch den Ersatz=
;           begriff ersetzt), innerhalb des Ersatzbegriffes kann der
;           Suchbegriff vorkommen, wird jedoch nicht verändert.
;
;           Gegenüber der PureBasic-StandartFunktion ReplaceString(),
;           die standartmäßig eingesetzt werden sollte, bestehen
;           folgende Unterschiede:
;           - bei der GROSS-/klein-Schrift-Suche werden auch deutsche
;             Sonderzeichen (Ä, Ö, Ü, ß) korrekt gehandhabt
;           - Wort-Austausch möglich (vor und nach Suchbegriff darf
;             kein Buchstabe im Basis-String stehen)
;           - es wird die Anzahl durchgeführter Tauschungen zurück=
;             geliefert
;           - Mehrfach-Austausch (z.Bsp. TrimAll: "  "->" ") hier
;             fehlerfrei (klappt nicht in ReplaceString of PB3.80)
;           Für nähere Details siehe unten (Global´s)...
;
;
;Aufruf:    newstring = CharChg(base$, such$, ersatz$ {, Mode})   -Zeichen(ketten)-Austausch
;wobei:     base$   = Basis-String, in dem Teile ausgetauscht werden
;                     sollen
;           such$   = Zeichen(-kette), die in base$ gesucht und ersetzt
;                     werden soll
;           ersatz$ = Zeichen(-kette), die anstelle von such$ in base$
;                     eingesetzt werden soll
;           Mode    = Steuerungen (bitorientiert):
#CharChg_noCase = 1 ;  = noCase (siehe Global "CharChg_noCase")
#CharChg_Word   = 2 ;  = Word (siehe Global "CharChg_Word")
;                     Sobald entweder die Steuerung aktiv ist _oder_ die
;                     entsprechende globale Variable, so wird die Funktion
;                     ausgeführt.
;                     Diese Mode-Steuerung ist zu bevorzugen, ggf. die alte,
;                     reduntante Global´s-Steuerung (siehe unten) entfernen !!!
;
Global CharChg_noCase  ;!!!nicht mehr einsetzen !!! benutze #CharChg_noCase !!!
                       ;wenn ungleich 0, so wird GROSS-/klein-Schrift
                       ;ignoriert ("AnKe" wird in "TaNkEn" gefunden
                       ;und ausgetauscht) !!! Variable ist nach
                       ;FunktionsEnde resetet !!! (auf 0 gestellt)
Global CharChg_Word    ;!!!nicht mehr einsetzen !!! benutze #CharChg_Word !!!
                       ;wenn ungleich 0, so wird nur ausgetauscht, wenn
                       ;vor und nach dem Suchbegriff kein Buchstabe und
                       ;keine Ziffer steht ("anke" wird _nicht_ in
                       ;"tanken" gefunden). Variable ist nach
                       ;FunktionsEnde resetet !!! (auf 0 gestellt)
Global CharChg_Cnt     ;liefert die Anzahl der durchgeführten Aus=
                       ;tauschungen
#CharChg_WordChars = "ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789ÄÖÜabcdefghijklmnopqrstuwvxyzöäü"
;#jaPBeExt exit
Procedure.s CharChg(Base$, Such$, Repl$, Mode = 0)
   Protected Base$, pos.l, Such$
   CharChg_Cnt = 0
  If Mode & #CharChg_noCase : CharChg_noCase = 1 : EndIf
  If Mode & #CharChg_Word : CharChg_Word = 1 : EndIf
   If Such$>""
    charChg_suchen:
    If CharChg_noCase
      Base$ = Base$ : Such$ = Such$
      pos = FindString(PeekS(CharLower_(Base$)), PeekS(CharLower_(Such$)), pos + 1)
    Else : pos = FindString(Base$, Such$, pos + 1)
    EndIf
      If pos
        If CharChg_Word
;          Debug "WordSuch [" + Such$ + "] in [" + Base$ + "]"
;          Debug "pre=[" + Mid(" " + Base$, Pos, 1) + "], post=[" + Mid(Base$ + " ", Pos + Len(Such$), 1) + "]"
            If FindString(#CharChg_WordChars, Mid(" " + Base$, pos, 1), 1)Or FindString(#CharChg_WordChars, Mid(Base$ + " ", pos + Len(Such$), 1), 1)
               pos + 1
               Goto charChg_suchen
            EndIf
         EndIf
         Base$ = Left(Base$, pos - 1) + Repl$ + Mid(Base$, pos + Len(Such$), 99999)
         CharChg_Cnt = CharChg_Cnt + 1
         pos + Len(Repl$) - Len(Such$)
         Goto charChg_suchen
      EndIf
   EndIf
   CharChg_noCase = 0 : CharChg_Word = 0
   ProcedureReturn Base$
EndProcedure
 ;==========  Ende Modul "CharChg.PBI"  ==========
;#jaPBeExt exit
Procedure.s Wort(*Param)
  Protected Param$, Wort$
  If * Param>1
    Param$ = LTrim(PeekS(*Param))
    If Wort_Ende$ = ""
      If Wort_Klammer$ = ""
        Wort_Klammer$ = #DQUOTE$ + Chr(39) + Chr(180) + Chr(255) + Chr(160);", ', ´ oder ^255
      EndIf
      If FindString(Wort_Klammer$, Left(Param$, 1), 1)And Param$>""
        Wort_Ende$ = Left(Param$, 1)
        Param$ = Right(Param$, Len(Param$) - 1)
      Else
        Wort_Ende$ = " "
      EndIf
    EndIf
    Wort_Ende$ = UCase(Wort_Ende$)
    While UCase(Left(Param$, Len(Wort_Ende$)))<>Wort_Ende$ And Param$>""
      Wort$ + Left(Param$, 1)
      Param$ = Mid(Param$, 2)
    Wend
    Param$ = Mid(Param$, Len(Wort_Ende$))
    Wort$ = LTrim(CharChg(Wort$, #Wort_BlankReplace, Chr(32)))
    Wort_EndKz$ = Wort_Ende$
    Wort_Ende$ = "" : Wort_Klammer$ = ""
    PokeS(*Param, LTrim(Right(Param$, Len(Param$) - 1)))
  EndIf
  ProcedureReturn Wort$
EndProcedure
;{- Test-Routine
; Queue$ = "na, mal%LF sehen"
; Wort_Ende$ = "%lf"
; Debug "Queue = " + #DQUOTE$ + Queue$ + #DQUOTE$
; Debug "Wort_Ende$ = " + #DQUOTE$ + Wort_Ende$ + #DQUOTE$
; While Queue$>""
  ; Wort + 1
  ; Debug Str(Wort) + ". Wort = " + #DQUOTE$ + Wort(@Queue$) + #DQUOTE$
; Wend
;}
 ;==========  Ende Modul "Wort.PBI"  ==========

Procedure PrgExit(ExeFile$, StartZeit);- Programm-Ende in Liste eintragen
  ResetList(PrgUse()): ExeFile$ = LCase(ExeFile$)
  While NextElement(PrgUse())And ExeFile$>"" ;aktuelle Datei in Liste suchen
    If PrgUse()\ExeFile$ = ExeFile$ : ExeFile$ = "" : EndIf ;gefunden: Liste ist positioniert, Suche abbrechen
  Wend
  If ExeFile$>"" ;nicht gefunden: neu anlegen
    AddElement(PrgUse())
    PrgUse()\ExeFile$ = ExeFile$
    PrgUse()\Dat1 = Date();Datum+Zeit der ersten Benutzung
  EndIf
  PrgUse()\ZeitSum + Date() - StartZeit ;aktiv-Fenster-Zeit addieren
  PrgUse()\Dat9 = Date()
  PrgUse()\Update = 1
EndProcedure

Procedure save_PrgDatas()           ;- Präferenz-Datei updaten
  ForEach PrgUse()
    With PrgUse()
      If \Update ;nur geänderte Einträge updaten / neu anlegen
        WritePreferenceString(\ExeFile$, Str(\ZeitSum) + " " + Str(\Dat1) + " " + Str(\Dat9))
      EndIf
    EndWith
  Next
  ClosePreferences()
EndProcedure

Procedure Auswert()                 ;- Auswertung in Textdatei anlegen, Diese anzeigen
  Protected maxLen, min, outFile, Outfile$, Std, totalZeit, Zeile$
  ;SortStructuredList(PrgUse(),#PB_Sort_Ascending,OffsetOf(PrgUse_Type\ExeFile$), #PB_Sort_String) ;Sortierung nach FileNames
  SortStructuredList(PrgUse(), #PB_Sort_Descending, OffsetOf(PrgUse_Type\ZeitSum), #PB_Sort_Long)  ;Sortierung nach ZeitSumme
  ForEach PrgUse();erstmal Total-Zeit (für %-Anteile) und max. DateiNamensLänge ermitteln
    totalZeit + PrgUse()\ZeitSum
    If Len(PrgUse()\ExeFile$)>maxLen : maxLen = Len(PrgUse()\ExeFile$): EndIf
  Next
  Outfile$ = #Prg_Name + ".txt"
  outFile = CreateFile(#PB_Any, Outfile$)
  If outFile
  WriteStringN(outFile, LSet("Programm-Datei", maxLen) + "|ZeitSumme|     vom| zuletzt|Anteil|")
    ForEach PrgUse()
      With PrgUse()
        min = \ZeitSum / 60 : Std = min / 60
        Zeile$ = LSet(\ExeFile$, maxLen) + "|" ;DateiName (incl. Pfad)
        Zeile$ + RSet(Str(Std), 6) + ":" + RSet(Str(min), 2, "0") + "|" ;ZeitSumme [Std:Min]
        Zeile$ + FormatDate("%DD.%MM.%YY", \Dat1) + "|" ;Datum 1. Nutzung
        Zeile$ + FormatDate("%DD.%MM.%YY", \Dat9) + "|" ;Datum letzter Nutzung
        Zeile$ + RSet(StrD(\ZeitSum * 100 / totalZeit, 2), 5) + "%|" ;Anteil [%]
        WriteStringN(outFile, ReplaceString(Zeile$, " ", "_"))
      EndWith
    Next
    CloseFile(outFile)
    RunProgram("notepad", Outfile$, "", #PB_Program_Wait) ;Auswertung anzeigen
  EndIf
EndProcedure

;****************************************************************
;**                         MainSource                         **
;****************************************************************
DisableExplicit

iniFile$ = #Prg_Name + ".ini" ;Präferenz-Datei wird zur Datenspeicherung benutzt
;{ gesammelte Programm-Zeiten aus Präferenz-Datei einlesen
If OpenPreferences(iniFile$)
  If ExaminePreferenceKeys()
    While NextPreferenceKey()
      AddElement(PrgUse())
      With PrgUse()
        \ExeFile$ = PreferenceKeyName()
        Queue$ = PreferenceKeyValue()
        \ZeitSum = Val(Wort(@Queue$))
        \Dat1 = Val(Wort(@Queue$))
        \Dat9 = Val(Wort(@Queue$))
      EndWith
    Wend
  EndIf
EndIf ;}

IconFile$ = #Prg_Name + ".ico"
SysTrayNr = SysTrayEntry("Programm-Nutzung analysieren", IconFile$)
If CreatePopupMenu(0); Menü definieren für´s SysTray-Anklick-Menü
  MenuItem(1, "Auswertung")
  MenuItem(2, "Programm-Ende")
  MenuItem(3, "Menü-Abbruch")
EndIf

Repeat ;{/ die SteuerSchleife
  Select WaitWindowEvent(500) ;spätestens alle 0,5 Sek wird Fensterwechsel geprüft...
    Case #PB_Event_SysTray ;{- SysTray-Aktion: Menü-Aufbau und -Aktionen
      If EventType() = #PB_EventType_LeftClick Or EventType() = #PB_EventType_RightClick
        DisplayPopupMenu(0, SysTray_WinID)
      EndIf
    Case #PB_Event_Menu        ; ein Eintrag des Popup-Menüs wurde angeklickt
      Select EventMenu()
        Case 1 : ;Auswertung
          Auswert()
        Case 2 : ;Programm beenden
          PrgExit(lastFile$, lastStart);aktuelles Programm beenden
          save_PrgDatas();Präferenz-Datei aktualisieren
          exit = 1 ;PrgAusgang setzen
      EndSelect ;}
    Default                ;{- aktives Fenster prüfen, Wechsel protokolieren
      FocusWinID = GetForegroundWindow_();aktives Fenster ermitteln
      If lastFocus<>FocusWinID          ;aktives Fenster gewechselt:
        If lastFocus : PrgExit(lastFile$, lastStart): EndIf ;NutzungsZeit beendetes Fenster addieren
        lastFocus = FocusWinID            ;  neues Fenster merken für weitere Änderungs-Prüfungen
        lastFile$ = WinID2EXE(FocusWinID);der Dateiname der EXE, die das neue Fenster verwaltet
        lastStart = Date()
        Debug #DQUOTE$ + GetFilePart(lastFile$) + #DQUOTE$
      EndIf ;}
  EndSelect
Until exit ;}
RemoveSysTrayIcon(SysTrayNr)



; jaPBe Version=3.8.6.707
; Build=0
; Language=0x0000 Language Neutral
; FirstLine=0
; CursorPosition=0
; EnableOnError
; ExecutableFormat=Windows
; DontSaveDeclare
; EOF


;==========< Auswertung >==========
;      436 Zeilen
;    19395 Bytes
;        4 Module

Viel Erfolg !!!

Re: Dateinamem eines laufenden Programms holen - Probleme!

Verfasst: 17.04.2013 17:35
von ts-soft
@sibru

Naja, da muß ich doch gleich meinen Senf abgeben :wink:

In WinID2EXE(WinID) wird das Handle von CreateToolhelp32Snapshot_ wird nicht wieder freigegeben - Speicherleak! Wie man das besser macht, kannst Du obigem Code von mir entnehmen.

Code: Alles auswählen

ProcedureReturn PeekS(@Entry\szExePath, - 1, #PB_Ascii)
Naja, wenn Du immer nur Ascii ausliest, wird es natürlich unter Unicode nicht gehen,
siehe wieder obigen Code von mir, der geht in ASCII und Unicode.

Ich werde das Gefühl nicht los, das ich doch weniger posten sollte, es wird ja anscheinend nicht gelesen :mrgreen:

Gruß
Thomas

Re: Dateinamem eines laufenden Programms holen - Probleme!

Verfasst: 17.04.2013 17:50
von Nino
ts-soft hat geschrieben:Ich werde das Gefühl nicht los, das ich doch weniger posten sollte, es wird ja anscheinend nicht gelesen :mrgreen:
Ich gehörige zu denjenigen, die am liebsten kurzen, "knackigen" und korrekten Code lesen, der genau das jeweilige Problem löst. Vielen Dank für den obigen Code, Thomas! Ich werde ihn demnächst gut brauchen können. Es wird immer Leute geben, die guten Code nicht erkennen, ignorieren oder verschlimmbessern. Damit muss man in solchen Foren wohl leider leben ... Bitte nicht deshalb weniger posten. :-)

Re: Dateinamem eines laufenden Programms holen - Probleme!

Verfasst: 17.04.2013 18:30
von ts-soft
sibru hat aber wenigstens einen besseren EventLoop. Die Überprüfung findet nur alle 0,5 Sekunden bei nicht Ereignis statt.
Beim Threadsteller wird alle 20 ms + bei jeglichem Event ein Handle erzeugt. Wer das mal nachrechnet, kann dann auch
abschätzen wann Windows den Geist aufgibt :mrgreen:
Aber das war ja nicht die eigentliche Frage.

Aber ich werde ab nächste Woche sowieso weniger posten können, hab lediglich noch zwischen Weihnachten und
Neujahr ein paar freie Tage /:-> und dann erst wieder ab ende Januar mehr Zeit.

Re: Dateinamem eines laufenden Programms holen - Probleme!

Verfasst: 17.04.2013 20:02
von Nino
Thomas, bevor Du offline gehst ... ;-)

Kann man eigentlich zusätzlich zu den EXE-Pfaden auch jeweils die ganze Kommandozeile herausbekommen, mit der das Programm aufgerufen wurde? Ich glaube das könnte ich demnächst brauchen um zu sehen, welche Datei ein best. Programm beim Aufruf per Kommandozeile geöffnet hat.

Re: Dateinamem eines laufenden Programms holen - Probleme!

Verfasst: 17.04.2013 20:47
von ts-soft
@Nino

Jetzt werden wir langsam offtopic :wink:
Dieselbe Frage hab ich vor kurzem im engl. Forum gelesen, weiß aber nicht, ob es da auch eine Lösung gibt,
ich habe keine in meinem persönlichem CodeArchiv.

Gruß
Thomas