Tolle Anwendungs-Idee, hab´ ich gleich mal umgesetzt (siehe unten)...
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