-
Notifications
You must be signed in to change notification settings - Fork 2
/
App.xojo_code
124 lines (102 loc) · 3.31 KB
/
App.xojo_code
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
#tag Class
Protected Class App
Inherits Application
#tag Event
Sub Close()
Prefs.Close
End Sub
#tag EndEvent
#tag Event
Sub EnableMenuItems()
EditPreferences.Enabled = false
ServerConnect.Enabled = true
ServerGetaDeveloperKey.Enabled = true
AboutBox.Enabled = true
End Sub
#tag EndEvent
#tag Event
Sub Open()
call Prefs.Open
End Sub
#tag EndEvent
#tag Event
Function UnhandledException(error As RuntimeException) As Boolean
if (ignoreCrash = false) then
dim stacktrace as string
stacktrace = "Error: " + GetErrorDesc(error) + " (" + error.Message + ")" + EndOfLine
stacktrace = stacktrace + "Error Code " + Str(error.ErrorNumber) + EndOfLine
stacktrace = stacktrace + join(error.cleanStack, endOfLine)
Dim w As Window = New CrashWindow (stacktrace)
end if
return true
End Function
#tag EndEvent
#tag MenuHandler
Function AboutBox() As Boolean Handles AboutBox.Action
AboutBoxWindow.Show
Return True
End Function
#tag EndMenuHandler
#tag MenuHandler
Function ServerConnect() As Boolean Handles ServerConnect.Action
ConnectWindow.Show
Return True
End Function
#tag EndMenuHandler
#tag MenuHandler
Function ServerGetaDeveloperKey() As Boolean Handles ServerGetaDeveloperKey.Action
ShowURL "https://www.sqlabs.com/cubesql_devkey.php"
Return True
End Function
#tag EndMenuHandler
#tag Method, Flags = &h21
Private Function GetErrorDesc(err As RuntimeException) As String
If err IsA NilObjectException Then
Return "Nil Object Exception"
ElseIf err IsA OutOfBoundsException Then
Return "Out of Bounds"
ElseIf err IsA TypeMismatchException Then
Return "Type Mismatch"
ElseIf err IsA illegalCastException Then
Return "llegal Cast"
ElseIf err IsA InvalidParentException Then
Return "Invalid Parent"
ElseIf err IsA KeyNotFoundException Then
Return "Key Not Found Exception"
ElseIf err IsA OutOfMemoryException Then
Return "Out Of Memory"
ElseIf err IsA StackOverflowException Then
Return "Stack Overflow"
ElseIf err IsA ThreadAlreadyRunningException Then
Return "Thread Already Running"
Else
Return "Unknown error"
End If
End Function
#tag EndMethod
#tag Property, Flags = &h0
ignoreCrash As Boolean = false
#tag EndProperty
#tag Constant, Name = kEditClear, Type = String, Dynamic = False, Default = \"&Delete", Scope = Public
#Tag Instance, Platform = Windows, Language = Default, Definition = \"&Delete"
#Tag Instance, Platform = Linux, Language = Default, Definition = \"&Delete"
#tag EndConstant
#tag Constant, Name = kFileQuit, Type = String, Dynamic = False, Default = \"&Quit", Scope = Public
#Tag Instance, Platform = Windows, Language = Default, Definition = \"E&xit"
#tag EndConstant
#tag Constant, Name = kFileQuitShortcut, Type = String, Dynamic = False, Default = \"", Scope = Public
#Tag Instance, Platform = Mac OS, Language = Default, Definition = \"Cmd+Q"
#Tag Instance, Platform = Linux, Language = Default, Definition = \"Ctrl+Q"
#tag EndConstant
#tag ViewBehavior
#tag ViewProperty
Name="ignoreCrash"
Visible=false
Group="Behavior"
InitialValue="false"
Type="Boolean"
EditorType=""
#tag EndViewProperty
#tag EndViewBehavior
End Class
#tag EndClass