Platforms to show: All Mac Windows Linux Cross-Platform
/Util/BugreporterKit/BugReporter Console
You find this example project in your Plugins Download as a Xojo project file within the examples folder: /Util/BugreporterKit/BugReporter Console
This example is the version from Sat, 18th Aug 2023.
Project "BugReporter Console.xojo_binary_project"
Class App Inherits ConsoleApplication
EventHandler Function Run(args() as String) As Integer
BugreporterConsole.init
// cause exception
dim d as Dictionary
d.Value(nil) = nil
End EventHandler
EventHandler Function UnhandledException(error As RuntimeException) As Boolean
#Pragma StackOverflowChecking false
Return BugreporterConsole.UnhandledException(error)
End EventHandler
End Class
Class BugReporterHTTPSocket Inherits HTTPSocket
EventHandler Sub Connected()
// print CurrentMethodName
End EventHandler
EventHandler Sub Error(code as integer)
if code=102 then
// ignore
elseif code=103 then
print CurrentMethodName+": "+str(code)
end if
End EventHandler
EventHandler Sub PageReceived(url as string, httpStatus as integer, headers as internetHeaders, content as string)
print content
#Pragma Unused url
#Pragma Unused httpStatus
#Pragma Unused headers
#Pragma Unused content
End EventHandler
End Class
Module BugReporterConfiguration
Const AllowContinueAfterException = true
Const AutoSendBugreportAfterDelay = 60
Const ReportNetworkInterfaces = true
Const TextFileTypeName = "text"
Const kScriptURL = "http://www.monkeybreadsoftware.de/cgi-bin/bugreporter.php"
Const kSupportEmail = "support@monkeybreadsoftware.de"
Const kUseAddressbookViaMBS = false
Const kUseAddressbookViaRS = false
Protected Function QueryApplicationState() As string
#Pragma StackOverflowChecking false
// return here any custom variables you may need for your bug report in one string
Return "Just a test for the application state"
End Function
End Module
Class MyGlobalExceptionHandlerMBS Inherits GlobalExceptionHandlerMBS
EventHandler Sub GotException()
#Pragma StackOverflowChecking false
dim BackTraceLines() as string
#if mbs.BuildNumber>17662 and not TargetWin32 then // new in 13.0 plugins
BackTraceLines = BacktraceMBS
#endif
#if TargetConsole
BugReporterConsole.ShowExceptionReporter "C++ exception", BackTraceLines
#else
BugReporter.ShowExceptionReporter "C++ exception", BackTraceLines
#endif
// quit now without cleaning up the RB runtime which may crash again
ExitMBS 1
End EventHandler
End Class
Class MySignalHandlerMBS Inherits SignalHandlerMBS
EventHandler Sub Signal(n as integer)
#Pragma StackOverflowChecking false
// Mac and Linux can have different signal numbers:
#if TargetMacOS then
dim c as string = "Signal "+str(n)+" on Mac OS X"
#elseif TargetLinux then
dim c as string = "Signal "+str(n)+" on Linux"
#else
dim c as string = "Signal "+str(n)+" on ?"
#endif
// restore system default if we crash again now for same signal
call MySignalHandlerMBS.SetDefaultHandler n
dim BackTraceLines() as string
#if mbs.BuildNumber>17662 and not TargetWin32 then // new in 13.0 plugins
BackTraceLines = BacktraceMBS
#endif
#if TargetConsole
BugReporterConsole.ShowExceptionReporter c, BackTraceLines
#else
BugReporter.ShowExceptionReporter c, BackTraceLines
#endif
// quit now without cleaning up the RB runtime which may crash again
ExitMBS 1
End EventHandler
End Class
Class MyWinExceptionMBS Inherits WinExceptionMBS
EventHandler Function GotException() As integer
#Pragma StackOverflowChecking false
dim BackTraceLines() as string
#if TargetConsole
BugReporterConsole.ShowExceptionReporter me.ExceptionName+" at "+hex(me.ExceptionAddress), BackTraceLines
#else
BugReporter.ShowExceptionReporter me.ExceptionName+" at "+hex(me.ExceptionAddress), BackTraceLines
#endif
// die silently
Return kExecuteHandlerNoDialog
End EventHandler
End Class
Class BugReporterConsole
Const kFailedToCreateTextFile = "Failed to create text file."
Const kReasonBugReport = "Please enter your bug report in this form:"
Const kReasonCrash = "This application crashed recently. You can send a bug report to us so we can fix it:"
Const kReasonException = "This application has produced an error. Please fill this form so we can locate the bug and fix it: "
Shared Sub CheckForCrashes()
// call when your application has been launch
// searches for existing crash reports
#if TargetMachO then
dim file as FolderItem
dim folder as FolderItem
dim i,c as integer
// with MBS Plugins:
folder=LogsFolderMBS(0)
// without:
'folder=SpecialFolder.Library
'if folder=nil then Return
'folder=folder.Child("Logs")
if folder=nil then Return
folder=folder.Child("CrashReporter")
if folder=nil then Return
dim name as string = app.ExecutableFile.name
dim names(-1) as string
dim files(-1) as FolderItem
c=folder.Count
for i=1 to c
file=folder.TrueItem(i)
if file<>Nil and file.Visible and file.Directory=False and left(file.Name,len(name))=name then
names.Append file.name
files.append file
end if
next
if UBound(names)<0 then Return
names.SortWith files
dim w as new BugReporterConsole
'w.SetClassificationBugReport
w.Reason=kReasonCrash
w.SetDetails nil,Files(UBound(files))
w.CheckSending
w.ShowModal
#endif
End Sub
Private Sub CheckSending()
#Pragma StackOverflowChecking false
// do we have internet?
// if we have a DNS server and we find 3 of 5 domains, we should be online
dim n as integer
dim ip as string
ip=System.Network.LookupIPAddress("www.google.com")
if len(ip)>0 then n=n+1
ip=System.Network.LookupIPAddress("www.apple.com")
if len(ip)>0 then n=n+1
ip=System.Network.LookupIPAddress("www.microsoft.com")
if len(ip)>0 then n=n+1
ip=System.Network.LookupIPAddress("www.monkeybreadsoftware.de")
if len(ip)>0 then n=n+1
ip=System.Network.LookupIPAddress("www.wikipedia.org")
if len(ip)>0 then n=n+1
// if DNS is okay, we certainly have internet access
if n>=3 then
HaveInternet=true
'SendButton.Caption=kSend
else
'SendButton.Caption=kSave
end if
End Sub
Sub Constructor()
#Pragma StackOverflowChecking false
SharedInstance = self
// keep us alive, so we can email....
sock = new BugReporterHTTPSocket
End Sub
Private Function DateString(d as date) As string
#Pragma StackOverflowChecking false
// returns a date as a sql string
if d=nil then
Return "n/a"
else
Return d.SQLDateTime
end if
End Function
Private Sub DoSave(lines() as string)
#Pragma StackOverflowChecking false
dim t as TextOutputStream
dim f as FolderItem
f=GetFolderItem("Bugreport.txt")
if f=nil then Return
try
t = TextOutputStream.Create(f)
for each line as string in lines
t.WriteLine line
next
t.Close
catch i as IOException
print kFailedToCreateTextFile
Return
end try
Exception io as IOException
// ignore
End Sub
Private Sub DoSend(lines() as string)
#Pragma StackOverflowChecking false
dim s as string = Join(lines, EndOfLine)
dim dic as new Dictionary
dic.Value("text")=s
dic.Value("reason")=ReasonText
// if you have udpater engine, you can support proxies here:
' UpdaterEngine.SetSocketProxy(sock)
sock.SetRequestContent "",""
sock.SetFormData dic
sock.Post(BugReporterConfiguration.kScriptURL)
dim t as integer = ticks+5*60
while t>ticks
sock.poll
app.DoEvents 1
wend
End Sub
Private Shared Function FormatMemory(d as Double) As string
#Pragma StackOverflowChecking false
if d<1500 then
Return Format(d, "-0")+" Bytes"
end if
d = d / 1024.0
if d<1500 then
Return Format(d, "-0")+" KB"
end if
d = d / 1024.0
Return Format(d, "-0")+" MB"
End Function
Private Function GetEmail() As String
#Pragma StackOverflowChecking false
if EmailAddress<>"" then
Return EmailAddress
end if
// Mac OS X 10.8 shows a dialog to ask if Addressbook access is okay.
// We try to avoid the dialog
#if BugReporterConfiguration.kUseAddressbookViaMBS
#if TargetMacOS then
if ABAddressBookMBS.GotSharedAddressbook or not SystemInformationMBS.isMountainLion then
dim a as ABAddressBookMBS = ABAddressBookMBS.sharedAddressbook
dim p as ABPersonMBS = a.owner
dim m as ABMultiValueMBS = p.valueForProperty(a.kABEmailProperty)
if m<>nil then
dim v as Variant = m.valueForIdentifier(m.primaryIdentifier)
return v
end if
end if
#endif
#elseif BugReporterConfiguration.kUseAddressbookViaRS
if not SystemInformationMBS.isMountainLion then
dim a as AddressBook = System.AddressBook
dim p as AddressBookContact = a.CurrentUser
return p.EmailAddresses.Operator_Convert
end if
#endif
Exception
// ignore
End Function
Private Shared Function GetExceptionName(error as RuntimeException) As string
#Pragma StackOverflowChecking false
Return GetObjectClassName(error)
End Function
Private Shared Function GetObjectClassName(o as Object) As string
#Pragma StackOverflowChecking false
dim t as Introspection.TypeInfo = Introspection.GetType(o)
if t<>Nil then
Return t.FullName
end if
End Function
Private Function MakeReport() As string()
dim lines(-1) as string
dim i,c as integer
dim b as string
dim ilines(-1) as string
lines.Append "Reason: "+Reason
lines.Append "Name: "+SystemInformationMBS.Username
lines.Append "Company: "+CompanyName
lines.Append "Email: "+GetEmail
lines.Append "Computer: "+SystemInformationMBS.ComputerName
lines.Append "Product: "+DefineEncoding(app.LongVersion,Encodings.UTF8)
lines.Append ""
// Details
lines.Append "Details:"
b=ReplaceLineEndings(iDetails,EndOfLine)
ilines=split(b,EndOfLine)
c=UBound(ilines)
for i=0 to c
lines.Append ilines(i)
next
lines.Append ""
// fix encoding
c=UBound(lines)
for i=0 to c
if lines(i).Encoding = nil then
lines(i) = ConvertEncoding(lines(i),encodings.UTF8)
end if
next
Return lines
End Function
Shared Sub SetCompanyName(theCompanyName as string, ReadOnly as Boolean = false)
CompanyName=theCompanyName
CompanyNameReadOnly=ReadOnly
End Sub
Shared Sub SetCustomData(data as string)
CustomData=data
End Sub
Private Sub SetDetails(error as RuntimeException = nil, crashreport as FolderItem = nil)
#Pragma StackOverflowChecking false
dim lines(-1) as string
dim e as FolderItem=app.ExecutableFile
dim n as NetworkInterface
dim i as integer
dim s as string
// current date/time
lines.Append log(ReasonText)
lines.Append log
lines.Append log("Current date: "+DateString(new date))
lines.Append log
// about executable file (so you can identify it exactly)
if e<>nil then
lines.Append log("Executable Name: "+e.Name)
lines.Append Log("Executable Path: "+e.NativePath)
lines.Append log("Executable Size: "+Format(e.Length,"0"))
lines.Append log("Executable Modification Date: "+DateString(e.ModificationDate))
lines.Append log("Executable Creation Date: "+DateString(e.CreationDate))
lines.Append log
end if
// version details:
lines.Append log("Version: "+str(app.MajorVersion)+"."+str(app.MinorVersion)+"."+str(app.BugVersion)+"."+str(app.NonReleaseVersion))
lines.Append Log("Long Version: "+app.LongVersion)
lines.Append log("Short Version: "+app.ShortVersion)
lines.Append log("Package Info: "+app.PackageInfo)
lines.Append log
// system information:
dim d as Double = Runtime.MemoryUsed
if d<0 then // workaround for older bug
d = d + 2^32
end if
lines.Append log("User name: "+SystemInformationMBS.Username)
lines.Append log("Computer name: "+SystemInformationMBS.Computername)
lines.Append log("OS Name: "+SystemInformationMBS.OSName)
lines.Append log("OS Version: "+SystemInformationMBS.OSVersionString)
lines.Append log("ProcessorCount: "+str(SystemInformationMBS.ProcessorCount))
lines.Append log("CommandLine: "+System.CommandLine)
lines.Append log("PhysicalRAM: "+FormatMemory(SystemInformationMBS.PhysicalRAM))
lines.Append log("Runtime.MemoryUsed: "+FormatMemory(d))
lines.Append log("Runtime.ObjectCount: "+str(Runtime.ObjectCount))
lines.Append log
dim LowMemory as Boolean = false
#if TargetMacOS then // check how much memory is currently in usage by application
dim u as DarwinResourceUsageMBS = GetDarwinResourceUsageMBS
dim v as DarwinVMStatisticsMBS = GetDarwinVMStatisticsMBS
dim t as new DarwinTaskInfoMBS
dim Pagesize as Double = v.Pagesize
lines.Append Log("Application Resident Size: "+FormatMemory(t.ResidentSize))
lines.Append log("Application Virtual Size: "+FormatMemory(t.VirtualSize))
lines.Append log("Application Integral Max Resident Size: "+FormatMemory(u.IntegralMaxResidentSetSize))
lines.Append log("Application Page Ins: "+str(t.PageIns))
lines.Append log("Computer Free Memory: "+FormatMemory(Pagesize*v.FreePages))
lines.Append log("Computer Inactive Memory: "+FormatMemory(Pagesize*v.InactivePages))
lines.Append log("Computer Active Memory: "+FormatMemory(Pagesize*v.ActivePages))
lines.Append log("Computer Wired Memory: "+FormatMemory(Pagesize*v.WiredPages))
lines.Append log("Computer Total Free Memory: "+FormatMemory(Pagesize*(v.InactivePages+v.FreePages)))
lines.Append log("Computer Total Used Memory: "+FormatMemory(Pagesize*(v.ActivePages+v.WiredPages)))
d = u.IntegralMaxResidentSetSize
if d > 2.0*1024*1024*1024 then
LowMemory = true
end if
#endif
#if TargetWin32 then
dim p as new WindowsProcessMemoryInfoMBS
dim v as new WindowsVMStatisticsMBS
dim Pagesize as Double = v.Pagesize
lines.Append log("Available Page File Memory: "+FormatMemory(v.AvailablePageFileMemory))
lines.Append log("Available Physical Memory: "+FormatMemory(v.AvailablePhysicalMemory))
lines.Append log("Available Virtual Memory: "+FormatMemory(v.AvailableVirtualMemory))
lines.Append log("Memoryload: "+Format(v.Memoryload/100,"0%"))
lines.Append log("Total Page File Memory: "+FormatMemory(v.TotalPageFileMemory))
lines.Append log("Total Physical Memory: "+FormatMemory(v.TotalPhysicalMemory))
lines.Append log("Total Virtual Memory: "+FormatMemory(v.TotalVirtualMemory))
lines.Append log("Page Fault Count: "+str(p.PageFaultCount))
lines.Append log("Peak Working Set Size: "+FormatMemory(p.PeakWorkingSetSize))
lines.Append log("Working Set Size: "+FormatMemory(p.WorkingSetSize))
lines.Append log("Quota Peak Paged Pool Usage: "+FormatMemory(p.QuotaPeakPagedPoolUsage))
lines.Append log("Quota Paged Pool Usage: "+FormatMemory(p.QuotaPagedPoolUsage))
lines.Append log("Quota Peak Non Paged Pool Usage: "+FormatMemory(p.QuotaPeakNonPagedPoolUsage))
lines.Append log("Quota Non Paged Pool Usage: "+FormatMemory(p.QuotaNonPagedPoolUsage))
lines.Append log("Pagefile Usage: "+FormatMemory(p.PagefileUsage))
lines.Append log("Peak Pagefile Usage: "+FormatMemory(p.PeakPagefileUsage))
d = p.WorkingSetSize
if d > 1024.0*1024.0*1024.0 then
LowMemory = true
end if
#endif
#if TargetLinux then
dim p as new LinuxSysInfoMBS
if p.Valid then
lines.Append log("Total Memory: "+FormatMemory(p.TotalRam))
lines.Append log("Free Memory: "+FormatMemory(p.FreeRam))
lines.Append log("Number of processes: "+FormatMemory(p.NumberOfProcesses))
lines.Append log("Number of processors: "+FormatMemory(p.NumberOfProcessors))
lines.Append log("UpTime: "+str(p.upTime))
end if
#endif
if LowMemory then
lines.Append log
lines.Append log("This may be a crash due to heavy memory usage!")
end if
lines.Append log
if BugReporterConfiguration.ReportNetworkInterfaces then
lines.Append log("Network Interfaces:")
for i = 0 to System.NetworkInterfaceCount - 1
n = System.GetNetworkInterface(i)
lines.Append log(n.IPAddress+"/"+n.SubnetMask+", "+n.MACAddress)
next
lines.Append log
end if
// exception details:
if error<>Nil then
dim type as string = GetExceptionName(Error)
lines.Append log("Exception Type: "+type)
'iSubject.text="Unhandled "+type
lines.Append log("Message: "+error.Message)
lines.Append log("Error Number: "+str(error.ErrorNumber))
lines.Append log
lines.Append log("Xojo Backtrace:")
for each line as string in error.Stack
lines.Append log(line)
next
lines.Append log
end if
if crashreport<>Nil then
lines.Append "Crashreport: "+crashreport.Name
try
dim ti as TextInputStream = TextInputStream.open(crashreport)
while not ti.eof
s=Ti.ReadLine(encodings.ASCII)
lines.Append s
wend
ti.Close
catch io as IOException
// ignore
end try
crashreport.Delete // so we won't send it again
end if
dim data as string = BugReporterConfiguration.QueryApplicationState
if data<>"" then
lines.Append log(data)
lines.Append log
end if
if CustomData<>"" then
lines.Append log(customdata)
lines.Append log
end if
if UBound(BackTraceLines)>=0 then
lines.Append "System Backtrace:"
for each line as string in BackTraceLines
lines.Append line
next
lines.Append ""
end if
lines.Append ""
lines.Append ""
lines.Append LastJSON
lines.Append ""
iDetails=Join(lines,EndOfLine)
End Sub
Shared Sub SetEmailAddress(theEmailAddress as string, ReadOnly as Boolean = false)
EmailAddress=theEmailAddress
EmailAddressReadOnly=ReadOnly
End Sub
Shared Sub ShowExceptionReporter(exceptionname as string, BackTraceLines() as string)
#Pragma StackOverflowChecking false
// shows a bug report dialog for a windows exception
dim w as new BugReporterConsole
dim e as RuntimeException = nil
buf=nil // release memory
if UBound(BackTraceLines) < 0 then
// Raise Exception so we have a stack trace in case we have no backtrace
try
dim re as new RuntimeException
re.Message = "Dummy Exception to get stack trace."
raise re
catch r as RuntimeException
e = r
end try
end if
w.BackTraceLines = BackTraceLines
'w.SetClassificationBugReport
w.ReasonText = exceptionname
w.Reason = kReasonException+exceptionname
w.SetDetails e
w.CheckSending
w.ShowModal
End Sub
Private Sub ShowModal()
#Pragma StackOverflowChecking false
// we can't show window, so save and send
dim lines(-1) as string = MakeReport
doSave lines
doSend lines
End Sub
Shared Function UnhandledException(error as RuntimeException) As Boolean
#Pragma StackOverflowChecking false
// shows bug report dialog for unhandled exceptions
static Inside as Boolean = False
if inside then Return false
Inside = true
buf=nil // release memory
dim ExceptionName as string = GetExceptionName(error)
print ExceptionName
print error.message
dim w as new BugReporterConsole
w.ReasonText = ExceptionName
'w.SetClassificationBugReport
w.Reason=kReasonException+" "+ExceptionName
w.SetDetails error
w.CheckSending
w.ShowModal
Inside = false
Return true
End Function
Shared Sub init()
// Initialize the bugreporter, register your MBS Plugins before calling this!
// We store a memoryblock with 1 MB so we can release that buffer when the error happens
// this is to have enough memory for displaying the dialog if the error was caused because of low memory
buf=New MemoryBlock(1024*1024)
#if TargetWin32 then
// Windows
static MyWinException as new MyWinExceptionMBS
#else
// Mac or Linux
static MySignalHandler as new MySignalHandlerMBS
const SIGILL=4
const SIGTRAP=5
const SIGABRT=6
const SIGFPE=8
const SIGKILL=9
const SIGBUS=10
const SIGSEGV=11
const SIGALRM=14 // Alarm
const SIGTERM=15
call MySignalHandler.SetEventHandler SIGILL
call MySignalHandler.SetEventHandler SIGTRAP
call MySignalHandler.SetEventHandler SIGABRT // if we disable this one we can't use AbortMBS in the signal handler
call MySignalHandler.SetEventHandler SIGFPE
call MySignalHandler.SetEventHandler SIGKILL
call MySignalHandler.SetEventHandler SIGBUS
call MySignalHandler.SetEventHandler SIGSEGV
call MySignalHandler.SetEventHandler SIGTERM
call MySignalHandler.SetEventHandler SIGALRM
#endif
static MyGlobalExceptionHandler as new MyGlobalExceptionHandlerMBS
#Pragma unused MyGlobalExceptionHandler
// call once to initialize
dim r as new RuntimeException
call GetObjectClassName(r)
End Sub
Private Function log(s as string = "") As string
// as app may crash getting details we copy them to the console
print s
Return s
End Function
Shared Sub showBugReport()
// shows bug report so customer can enter his own bug
dim w as new BugReporterConsole
w.SetDetails
w.Reason=kReasonBugReport
'w.SetClassificationBugReport
w.CheckSending
w.ShowModal
End Sub
Property Private BackTraceLines() As string
Property Private Shared CompanyName As String
Property Private Shared CompanyNameReadOnly As Boolean
Property Private Shared CustomData As string
Property Private Shared EmailAddress As string
Property Private Shared EmailAddressReadonly As Boolean
Property Private HaveInternet As Boolean
Property Shared LastJSON As String
Property Protected Reason As string
Property Private ReasonText As string
Property Private SharedInstance As BugReporterConsole
Property Private Shared buf As MemoryBlock
Property Private iDetails As string
Property Private sock As BugReporterHTTPSocket
End Class
End Project
See also:
The items on this page are in the following plugins: MBS Util Plugin.