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 Realbasic Plugins - Pfarrgemeinde St. Arnulf Nickenich