About Log Application Usage 1.1 source code

Class App
Inherits Application
// Properties
Protected Dim c as myCarbonApplicationEvents


c as myCarbonApplicationEvents



Dim tab as string


tab as string




// Event implementations
Sub Open()
RegisterPlugins

tab=Encodings.ASCII.Chr(9)

c=new MyCarbonApplicationEvents
c.Listen

End Sub
End Class

Class Data
// Properties
Dim ProcessID as memoryBlock


ProcessID as memoryBlock



Dim LaunchTime as date


LaunchTime as date



Dim Name as string


Name as string



End Class

Class MyCarbonApplicationEvents
Inherits CarbonApplicationEventsMBS
// Properties
Dim apps(-1) as data


apps(-1) as data




// Event implementations
Sub ApplicationTerminated(ProcessSerial as memoryblock)
LogQuit ProcessSerial
End Sub
Sub ApplicationLaunched(ProcessSerial as memoryblock)
LogStart ProcessSerial
End Sub

// Methods
Sub LogQuit(p as memoryBlock)
dim d as data
dim z as integer
dim min,sec as integer
dim da as date

d=FindApp(p)

if d<>nil then
da=new date

z=da.TotalSeconds-d.LaunchTime.TotalSeconds

min=z\60
sec=z mod 60

Write "Quit"+app.tab+d.Name+app.tab+"after "+Format(min,"0")+":"+Format(sec,"00")

apps.Remove apps.IndexOf(d)
else
Write "Quit"+app.tab+app.tab+"Unknown application terminated ("+hex(p.Long(0))+":"+hex(p.Long(4))+")"
end if
End Sub
Sub LogStart(p as memoryBlock)
dim d as data
dim o as ProcessMBS

o=new ProcessMBS
o.GetProcess(p)

d=new data

d.Name=o.Name
d.LaunchTime=new date
d.ProcessID=p

apps.Append d

Write "Open"+app.tab+d.Name

End Sub
Function FindApp(p as memoryBlock) As data
dim d as data
dim m as MemoryBlock

for each d in apps
m=d.ProcessID
if m.Long(0)=p.Long(0) and m.Long(4)=p.Long(4) then
Return d
end if
next

Return nil // not found
End Function
Sub Write(s as string)
dim f as FolderItem
dim t as TextOutputStream
dim d as date

f=PreferencesFolder.Child("Log Application Usage.log")
if f<>Nil then
if f.Exists then
t=f.AppendToTextFile
else
t=f.CreateTextFile
end if

if t<>Nil then
d=new date

s=d.ShortDate+app.tab+d.ShortTime+app.tab+s
s=s.ConvertEncoding(Encodings.UTF8)
t.WriteLine s
t.Close


// CC messages to console on DebugBuild
#if DebugBuild
System.DebugLog s
#endif
end if
end if

Exception e
End Sub
End Class





Links
MBS Xojo blog