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