Changeset 246
- Timestamp:
- May 12, 2007, 6:31:13 PM (18 years ago)
- Files:
-
- 12 edited
Legend:
- Unmodified
- Added
- Removed
-
Include/Classes/System/DateTime.ab
r237 r246 426 426 Return DateTimeKind.Utc 427 427 End If 428 429 ' ここにはこないはず 430 debug 428 431 End Function 429 432 -
Include/Classes/System/Diagnostics/Debug.ab
r69 r246 1 Namespace System 2 Namespace Diagnostics 3 4 1 5 #ifdef _DEBUG 2 6 3 Class Debug4 Static base As _System_TraceBase()5 6 Public7 8 '----------------------------------------------------------------9 ' パブリック メソッド10 '----------------------------------------------------------------11 12 ' アサート(コールスタックを表示)13 Static Sub Assert( condition As Boolean )14 base.Assert( condition )15 End Sub16 17 ' アサート(メッセージ文字列を表示)18 Static Sub Assert( condition As Boolean, message As String )19 base.Assert( condition, message )20 End Sub21 22 ' アサート(メッセージ文字列と詳細文字列を表示)23 Static Sub Assert( condition As Boolean, message As String, detailMessage As String )24 base.Assert( condition, message, detailMessage )25 End Sub26 27 28 ' インデントレベルを上げる29 Static Sub Indent()30 base.Indent()31 End Sub32 33 ' インデントレベルを下げる34 Static Sub Unindent()35 base.Unindent()36 End Sub37 38 ' 文字列を出力39 Static Sub Write( value As Object )40 base.Write( value )41 End Sub42 Static Sub Write( message As String )43 base.Write( message )44 End Sub45 Static Sub Write( value As Object, category As String )46 base.Write( value, category )47 End Sub48 Static Sub Write( message As String, category As String )49 base.Write( message, category )50 End Sub51 52 ' 一行の文字列を出力53 Static Sub WriteLine( value As Object )54 base.WriteLine( value )55 End Sub56 Static Sub WriteLine( message As String )57 base.WriteLine( message )58 End Sub59 Static Sub WriteLine( value As Object, category As String )60 base.WriteLine( value, category )61 End Sub62 Static Sub WriteLine( message As String, category As String )63 base.WriteLine( message, category )64 End Sub65 66 ' 条件をもとに文字列を出力67 Static Sub WriteIf( condition As Boolean, value As Object )68 base.WriteIf( condition, value )69 End Sub70 Static Sub WriteIf( condition As Boolean, message As String )71 base.WriteIf( condition, message )72 End Sub73 Static Sub WriteIf( condition As Boolean, value As Object, category As String )74 base.WriteIf( condition, value, category )75 End Sub76 Static Sub WriteIf( condition As Boolean, message As String, category As String )77 base.WriteIf( condition, message, category )78 End Sub79 80 ' 条件をもとに一行の文字列を出力81 Static Sub WriteLineIf( condition As Boolean, message As String )82 base.WriteLineIf( condition, message )83 End Sub84 Static Sub WriteLineIf( condition As Boolean, value As Object )85 base.WriteLineIf( condition, value )86 End Sub87 Static Sub WriteLineIf( condition As Boolean, value As Object, category As String )88 base.WriteLineIf( condition, value, category )89 End Sub90 Static Sub WriteLineIf( condition As Boolean, message As String, category As String )91 base.WriteLineIf( condition, message, category )92 End Sub93 94 95 '----------------------------------------------------------------96 ' パブリック プロパティ97 '----------------------------------------------------------------98 99 ' IndentLevelプロパティ100 Static Function IndentLevel() As Long101 Return base.IndentLevel102 End Function103 Static Sub IndentLevel( indentLevel As Long )104 base.IndentLevel = indentLevel105 End Sub106 107 ' IndentSizeプロパティ108 Static Function IndentSize() As Long109 Return base.IndentSize110 End Function111 Static Sub IndentSize( size As Long )112 base.IndentSize = size113 End Sub114 115 ' Listenersプロパティ116 Static Function Listeners() As TraceListenerCollection117 Return base.Listeners118 End Function119 End Class7 Class Debug 8 Static base As _System_TraceBase() 9 10 Public 11 12 '---------------------------------------------------------------- 13 ' パブリック メソッド 14 '---------------------------------------------------------------- 15 16 ' アサート(コールスタックを表示) 17 Static Sub Assert( condition As Boolean ) 18 base.Assert( condition ) 19 End Sub 20 21 ' アサート(メッセージ文字列を表示) 22 Static Sub Assert( condition As Boolean, message As String ) 23 base.Assert( condition, message ) 24 End Sub 25 26 ' アサート(メッセージ文字列と詳細文字列を表示) 27 Static Sub Assert( condition As Boolean, message As String, detailMessage As String ) 28 base.Assert( condition, message, detailMessage ) 29 End Sub 30 31 32 ' インデントレベルを上げる 33 Static Sub Indent() 34 base.Indent() 35 End Sub 36 37 ' インデントレベルを下げる 38 Static Sub Unindent() 39 base.Unindent() 40 End Sub 41 42 ' 文字列を出力 43 Static Sub Write( value As Object ) 44 base.Write( value ) 45 End Sub 46 Static Sub Write( message As String ) 47 base.Write( message ) 48 End Sub 49 Static Sub Write( value As Object, category As String ) 50 base.Write( value, category ) 51 End Sub 52 Static Sub Write( message As String, category As String ) 53 base.Write( message, category ) 54 End Sub 55 56 ' 一行の文字列を出力 57 Static Sub WriteLine( value As Object ) 58 base.WriteLine( value ) 59 End Sub 60 Static Sub WriteLine( message As String ) 61 base.WriteLine( message ) 62 End Sub 63 Static Sub WriteLine( value As Object, category As String ) 64 base.WriteLine( value, category ) 65 End Sub 66 Static Sub WriteLine( message As String, category As String ) 67 base.WriteLine( message, category ) 68 End Sub 69 70 ' 条件をもとに文字列を出力 71 Static Sub WriteIf( condition As Boolean, value As Object ) 72 base.WriteIf( condition, value ) 73 End Sub 74 Static Sub WriteIf( condition As Boolean, message As String ) 75 base.WriteIf( condition, message ) 76 End Sub 77 Static Sub WriteIf( condition As Boolean, value As Object, category As String ) 78 base.WriteIf( condition, value, category ) 79 End Sub 80 Static Sub WriteIf( condition As Boolean, message As String, category As String ) 81 base.WriteIf( condition, message, category ) 82 End Sub 83 84 ' 条件をもとに一行の文字列を出力 85 Static Sub WriteLineIf( condition As Boolean, message As String ) 86 base.WriteLineIf( condition, message ) 87 End Sub 88 Static Sub WriteLineIf( condition As Boolean, value As Object ) 89 base.WriteLineIf( condition, value ) 90 End Sub 91 Static Sub WriteLineIf( condition As Boolean, value As Object, category As String ) 92 base.WriteLineIf( condition, value, category ) 93 End Sub 94 Static Sub WriteLineIf( condition As Boolean, message As String, category As String ) 95 base.WriteLineIf( condition, message, category ) 96 End Sub 97 98 99 '---------------------------------------------------------------- 100 ' パブリック プロパティ 101 '---------------------------------------------------------------- 102 103 ' IndentLevelプロパティ 104 Static Function IndentLevel() As Long 105 Return base.IndentLevel 106 End Function 107 Static Sub IndentLevel( indentLevel As Long ) 108 base.IndentLevel = indentLevel 109 End Sub 110 111 ' IndentSizeプロパティ 112 Static Function IndentSize() As Long 113 Return base.IndentSize 114 End Function 115 Static Sub IndentSize( size As Long ) 116 base.IndentSize = size 117 End Sub 118 119 ' Listenersプロパティ 120 Static Function Listeners() As TraceListenerCollection 121 Return base.Listeners 122 End Function 123 End Class 120 124 121 125 #else 122 126 123 Class Debug124 Static base As _System_TraceBase()125 126 Public127 128 '----------------------------------------------------------------129 ' パブリック メソッド130 '----------------------------------------------------------------131 132 ' アサート(コールスタックを表示)133 Static Sub Assert( condition As Boolean )134 'base.Assert( condition )135 End Sub136 137 ' アサート(メッセージ文字列を表示)138 Static Sub Assert( condition As Boolean, message As String )139 'base.Assert( condition, message )140 End Sub141 142 ' アサート(メッセージ文字列と詳細文字列を表示)143 Static Sub Assert( condition As Boolean, message As String, detailMessage As String )144 'base.Assert( condition, message, detailMessage )145 End Sub146 147 148 ' インデントレベルを上げる149 Static Sub Indent()150 base.Indent()151 End Sub152 153 ' インデントレベルを下げる154 Static Sub Unindent()155 base.Unindent()156 End Sub157 158 ' 文字列を出力159 Static Sub Write( value As Object )160 'base.Write( value )161 End Sub162 Static Sub Write( message As String )163 'base.Write( message )164 End Sub165 Static Sub Write( value As Object, category As String )166 'base.Write( value, category )167 End Sub168 Static Sub Write( message As String, category As String )169 'base.Write( message, category )170 End Sub171 172 ' 一行の文字列を出力173 Static Sub WriteLine( value As Object )174 'base.WriteLine( value )175 End Sub176 Static Sub WriteLine( message As String )177 'base.WriteLine( message )178 End Sub179 Static Sub WriteLine( value As Object, category As String )180 'base.WriteLine( value, category )181 End Sub182 Static Sub WriteLine( message As String, category As String )183 'base.WriteLine( message, category )184 End Sub185 186 ' 条件をもとに文字列を出力187 Static Sub WriteIf( condition As Boolean, value As Object )188 'base.WriteIf( condition, value )189 End Sub190 Static Sub WriteIf( condition As Boolean, message As String )191 'base.WriteIf( condition, message )192 End Sub193 Static Sub WriteIf( condition As Boolean, value As Object, category As String )194 'base.WriteIf( condition, value, category )195 End Sub196 Static Sub WriteIf( condition As Boolean, message As String, category As String )197 'base.WriteIf( condition, message, category )198 End Sub199 200 ' 条件をもとに一行の文字列を出力201 Static Sub WriteLineIf( condition As Boolean, message As String )202 'base.WriteLineIf( condition, message )203 End Sub204 Static Sub WriteLineIf( condition As Boolean, value As Object )205 'base.WriteLineIf( condition, value )206 End Sub207 Static Sub WriteLineIf( condition As Boolean, value As Object, category As String )208 'base.WriteLineIf( condition, value, category )209 End Sub210 Static Sub WriteLineIf( condition As Boolean, message As String, category As String )211 'base.WriteLineIf( condition, message, category )212 End Sub213 214 215 '----------------------------------------------------------------216 ' パブリック プロパティ217 '----------------------------------------------------------------218 219 ' IndentLevelプロパティ220 Static Function IndentLevel() As Long221 Return base.IndentLevel222 End Function223 Static Sub IndentLevel( indentLevel As Long )224 base.IndentLevel = indentLevel225 End Sub226 227 ' IndentSizeプロパティ228 Static Function IndentSize() As Long229 Return base.IndentSize230 End Function231 Static Sub IndentSize( size As Long )232 base.IndentSize = size233 End Sub234 235 ' Listenersプロパティ236 Static Function Listeners() As TraceListenerCollection237 Return base.Listeners238 End Function239 End Class127 Class Debug 128 Static base As _System_TraceBase() 129 130 Public 131 132 '---------------------------------------------------------------- 133 ' パブリック メソッド 134 '---------------------------------------------------------------- 135 136 ' アサート(コールスタックを表示) 137 Static Sub Assert( condition As Boolean ) 138 'base.Assert( condition ) 139 End Sub 140 141 ' アサート(メッセージ文字列を表示) 142 Static Sub Assert( condition As Boolean, message As String ) 143 'base.Assert( condition, message ) 144 End Sub 145 146 ' アサート(メッセージ文字列と詳細文字列を表示) 147 Static Sub Assert( condition As Boolean, message As String, detailMessage As String ) 148 'base.Assert( condition, message, detailMessage ) 149 End Sub 150 151 152 ' インデントレベルを上げる 153 Static Sub Indent() 154 base.Indent() 155 End Sub 156 157 ' インデントレベルを下げる 158 Static Sub Unindent() 159 base.Unindent() 160 End Sub 161 162 ' 文字列を出力 163 Static Sub Write( value As Object ) 164 'base.Write( value ) 165 End Sub 166 Static Sub Write( message As String ) 167 'base.Write( message ) 168 End Sub 169 Static Sub Write( value As Object, category As String ) 170 'base.Write( value, category ) 171 End Sub 172 Static Sub Write( message As String, category As String ) 173 'base.Write( message, category ) 174 End Sub 175 176 ' 一行の文字列を出力 177 Static Sub WriteLine( value As Object ) 178 'base.WriteLine( value ) 179 End Sub 180 Static Sub WriteLine( message As String ) 181 'base.WriteLine( message ) 182 End Sub 183 Static Sub WriteLine( value As Object, category As String ) 184 'base.WriteLine( value, category ) 185 End Sub 186 Static Sub WriteLine( message As String, category As String ) 187 'base.WriteLine( message, category ) 188 End Sub 189 190 ' 条件をもとに文字列を出力 191 Static Sub WriteIf( condition As Boolean, value As Object ) 192 'base.WriteIf( condition, value ) 193 End Sub 194 Static Sub WriteIf( condition As Boolean, message As String ) 195 'base.WriteIf( condition, message ) 196 End Sub 197 Static Sub WriteIf( condition As Boolean, value As Object, category As String ) 198 'base.WriteIf( condition, value, category ) 199 End Sub 200 Static Sub WriteIf( condition As Boolean, message As String, category As String ) 201 'base.WriteIf( condition, message, category ) 202 End Sub 203 204 ' 条件をもとに一行の文字列を出力 205 Static Sub WriteLineIf( condition As Boolean, message As String ) 206 'base.WriteLineIf( condition, message ) 207 End Sub 208 Static Sub WriteLineIf( condition As Boolean, value As Object ) 209 'base.WriteLineIf( condition, value ) 210 End Sub 211 Static Sub WriteLineIf( condition As Boolean, value As Object, category As String ) 212 'base.WriteLineIf( condition, value, category ) 213 End Sub 214 Static Sub WriteLineIf( condition As Boolean, message As String, category As String ) 215 'base.WriteLineIf( condition, message, category ) 216 End Sub 217 218 219 '---------------------------------------------------------------- 220 ' パブリック プロパティ 221 '---------------------------------------------------------------- 222 223 ' IndentLevelプロパティ 224 Static Function IndentLevel() As Long 225 Return base.IndentLevel 226 End Function 227 Static Sub IndentLevel( indentLevel As Long ) 228 base.IndentLevel = indentLevel 229 End Sub 230 231 ' IndentSizeプロパティ 232 Static Function IndentSize() As Long 233 Return base.IndentSize 234 End Function 235 Static Sub IndentSize( size As Long ) 236 base.IndentSize = size 237 End Sub 238 239 ' Listenersプロパティ 240 Static Function Listeners() As TraceListenerCollection 241 Return base.Listeners 242 End Function 243 End Class 240 244 241 245 #endif 246 247 End Namespace 248 End Namespace -
Include/Classes/System/Diagnostics/Trace.ab
r69 r246 1 Namespace System 2 Namespace Diagnostics 1 3 2 Class Trace3 Static base As _System_TraceBase()4 Class Trace 5 Static base As _System_TraceBase() 4 6 5 Public7 Public 6 8 7 '----------------------------------------------------------------8 ' パブリック メソッド9 '----------------------------------------------------------------9 '---------------------------------------------------------------- 10 ' パブリック メソッド 11 '---------------------------------------------------------------- 10 12 11 ' アサート(コールスタックを表示)12 Static Sub Assert( condition As Boolean )13 base.Assert( condition )14 End Sub13 ' アサート(コールスタックを表示) 14 Static Sub Assert( condition As Boolean ) 15 base.Assert( condition ) 16 End Sub 15 17 16 ' アサート(メッセージ文字列を表示)17 Static Sub Assert( condition As Boolean, message As String )18 base.Assert( condition, message )19 End Sub18 ' アサート(メッセージ文字列を表示) 19 Static Sub Assert( condition As Boolean, message As String ) 20 base.Assert( condition, message ) 21 End Sub 20 22 21 ' アサート(メッセージ文字列と詳細文字列を表示)22 Static Sub Assert( condition As Boolean, message As String, detailMessage As String )23 base.Assert( condition, message, detailMessage )24 End Sub23 ' アサート(メッセージ文字列と詳細文字列を表示) 24 Static Sub Assert( condition As Boolean, message As String, detailMessage As String ) 25 base.Assert( condition, message, detailMessage ) 26 End Sub 25 27 26 28 27 ' インデントレベルを上げる28 Static Sub Indent()29 base.Indent()30 End Sub29 ' インデントレベルを上げる 30 Static Sub Indent() 31 base.Indent() 32 End Sub 31 33 32 ' インデントレベルを下げる33 Static Sub Unindent()34 base.Unindent()35 End Sub34 ' インデントレベルを下げる 35 Static Sub Unindent() 36 base.Unindent() 37 End Sub 36 38 37 ' 文字列を出力38 Static Sub Write( value As Object )39 base.Write( value )40 End Sub41 Static Sub Write( message As String )42 base.Write( message )43 End Sub44 Static Sub Write( value As Object, category As String )45 base.Write( value, category )46 End Sub47 Static Sub Write( message As String, category As String )48 base.Write( message, category )49 End Sub39 ' 文字列を出力 40 Static Sub Write( value As Object ) 41 base.Write( value ) 42 End Sub 43 Static Sub Write( message As String ) 44 base.Write( message ) 45 End Sub 46 Static Sub Write( value As Object, category As String ) 47 base.Write( value, category ) 48 End Sub 49 Static Sub Write( message As String, category As String ) 50 base.Write( message, category ) 51 End Sub 50 52 51 ' 一行の文字列を出力52 Static Sub WriteLine( value As Object )53 base.WriteLine( value )54 End Sub55 Static Sub WriteLine( message As String )56 base.WriteLine( message )57 End Sub58 Static Sub WriteLine( value As Object, category As String )59 base.WriteLine( value, category )60 End Sub61 Static Sub WriteLine( message As String, category As String )62 base.WriteLine( message, category )63 End Sub53 ' 一行の文字列を出力 54 Static Sub WriteLine( value As Object ) 55 base.WriteLine( value ) 56 End Sub 57 Static Sub WriteLine( message As String ) 58 base.WriteLine( message ) 59 End Sub 60 Static Sub WriteLine( value As Object, category As String ) 61 base.WriteLine( value, category ) 62 End Sub 63 Static Sub WriteLine( message As String, category As String ) 64 base.WriteLine( message, category ) 65 End Sub 64 66 65 ' 条件をもとに文字列を出力66 Static Sub WriteIf( condition As Boolean, value As Object )67 base.WriteIf( condition, value )68 End Sub69 Static Sub WriteIf( condition As Boolean, message As String )70 base.WriteIf( condition, message )71 End Sub72 Static Sub WriteIf( condition As Boolean, value As Object, category As String )73 base.WriteIf( condition, value, category )74 End Sub75 Static Sub WriteIf( condition As Boolean, message As String, category As String )76 base.WriteIf( condition, message, category )77 End Sub67 ' 条件をもとに文字列を出力 68 Static Sub WriteIf( condition As Boolean, value As Object ) 69 base.WriteIf( condition, value ) 70 End Sub 71 Static Sub WriteIf( condition As Boolean, message As String ) 72 base.WriteIf( condition, message ) 73 End Sub 74 Static Sub WriteIf( condition As Boolean, value As Object, category As String ) 75 base.WriteIf( condition, value, category ) 76 End Sub 77 Static Sub WriteIf( condition As Boolean, message As String, category As String ) 78 base.WriteIf( condition, message, category ) 79 End Sub 78 80 79 ' 条件をもとに一行の文字列を出力80 Static Sub WriteLineIf( condition As Boolean, message As String )81 base.WriteLineIf( condition, message )82 End Sub83 Static Sub WriteLineIf( condition As Boolean, value As Object )84 base.WriteLineIf( condition, value )85 End Sub86 Static Sub WriteLineIf( condition As Boolean, value As Object, category As String )87 base.WriteLineIf( condition, value, category )88 End Sub89 Static Sub WriteLineIf( condition As Boolean, message As String, category As String )90 base.WriteLineIf( condition, message, category )91 End Sub81 ' 条件をもとに一行の文字列を出力 82 Static Sub WriteLineIf( condition As Boolean, message As String ) 83 base.WriteLineIf( condition, message ) 84 End Sub 85 Static Sub WriteLineIf( condition As Boolean, value As Object ) 86 base.WriteLineIf( condition, value ) 87 End Sub 88 Static Sub WriteLineIf( condition As Boolean, value As Object, category As String ) 89 base.WriteLineIf( condition, value, category ) 90 End Sub 91 Static Sub WriteLineIf( condition As Boolean, message As String, category As String ) 92 base.WriteLineIf( condition, message, category ) 93 End Sub 92 94 93 95 94 '----------------------------------------------------------------95 ' パブリック プロパティ96 '----------------------------------------------------------------96 '---------------------------------------------------------------- 97 ' パブリック プロパティ 98 '---------------------------------------------------------------- 97 99 98 ' IndentLevelプロパティ99 Static Function IndentLevel() As Long100 Return base.IndentLevel101 End Function102 Static Sub IndentLevel( indentLevel As Long )103 base.IndentLevel = indentLevel104 End Sub100 ' IndentLevelプロパティ 101 Static Function IndentLevel() As Long 102 Return base.IndentLevel 103 End Function 104 Static Sub IndentLevel( indentLevel As Long ) 105 base.IndentLevel = indentLevel 106 End Sub 105 107 106 ' IndentSizeプロパティ107 Static Function IndentSize() As Long108 Return base.IndentSize109 End Function110 Static Sub IndentSize( size As Long )111 base.IndentSize = size112 End Sub108 ' IndentSizeプロパティ 109 Static Function IndentSize() As Long 110 Return base.IndentSize 111 End Function 112 Static Sub IndentSize( size As Long ) 113 base.IndentSize = size 114 End Sub 113 115 114 ' Listenersプロパティ115 Static Function Listeners() As TraceListenerCollection116 Return base.Listeners117 End Function116 ' Listenersプロパティ 117 Static Function Listeners() As TraceListenerCollection 118 Return base.Listeners 119 End Function 118 120 119 End Class 121 End Class 122 123 End Namespace 124 End Namespace -
Include/Classes/System/Diagnostics/TraceListener.ab
r147 r246 1 Namespace System 2 Namespace Diagnostics 1 3 2 ' リスナ3 Class TraceListener4 indentLevel As Long5 indentSize As Long4 ' リスナ 5 Class TraceListener 6 indentLevel As Long 7 indentSize As Long 6 8 7 Protected8 Function GetIndentString() As String9 Dim i As Long9 Protected 10 Function GetIndentString() As String 11 Dim i As Long 10 12 11 Dim IndentStr = ""12 For i = 0 To ELM( indentSize )13 IndentStr = IndentStr + " "14 Next13 Dim IndentStr = "" 14 For i = 0 To ELM( indentSize ) 15 IndentStr = IndentStr + " " 16 Next 15 17 16 Dim ResultStr = ""17 For i = 0 To ELM( indentLevel )18 ResultStr = ResultStr + IndentStr19 Next18 Dim ResultStr = "" 19 For i = 0 To ELM( indentLevel ) 20 ResultStr = ResultStr + IndentStr 21 Next 20 22 21 Return ResultStr22 End Function23 Return ResultStr 24 End Function 23 25 24 Public25 Sub TraceListener()26 indentLevel = 027 indentSize = 428 End Sub26 Public 27 Sub TraceListener() 28 indentLevel = 0 29 indentSize = 4 30 End Sub 29 31 30 ' コピーコンストラクタ31 Sub TraceListener( ByRef listener As TraceListener )32 indentLevel = listener.indentLevel33 indentSize = listener.indentSize34 End Sub32 ' コピーコンストラクタ 33 Sub TraceListener( ByRef listener As TraceListener ) 34 indentLevel = listener.indentLevel 35 indentSize = listener.indentSize 36 End Sub 35 37 36 38 37 '----------------------------------------------------------------38 ' パブリック コンストラクタ39 '----------------------------------------------------------------39 '---------------------------------------------------------------- 40 ' パブリック コンストラクタ 41 '---------------------------------------------------------------- 40 42 41 Virtual Sub Write( message As String )42 '派生クラスで実装 (基底では何もしない)43 End Sub44 Virtual Sub Write( value As Object )45 Write( value.ToString() )46 End Sub47 Virtual Sub Write( value As Object, category As String )48 Write( category + ": " + value.ToString() )49 End Sub50 Virtual Sub Write( message As String, category As String )51 Write( category + ": " + message )52 End Sub43 Virtual Sub Write( message As String ) 44 '派生クラスで実装 (基底では何もしない) 45 End Sub 46 Virtual Sub Write( value As Object ) 47 Write( value.ToString() ) 48 End Sub 49 Virtual Sub Write( value As Object, category As String ) 50 Write( category + ": " + value.ToString() ) 51 End Sub 52 Virtual Sub Write( message As String, category As String ) 53 Write( category + ": " + message ) 54 End Sub 53 55 54 Virtual Sub WriteLine( message As String )55 '派生クラスで実装 (基底では何もしない)56 End Sub57 Virtual Sub WriteLine( value As Object )58 WriteLine( value.ToString() )59 End Sub60 Virtual Sub WriteLine( value As Object, category As String )61 WriteLine( category + ": " + value.ToString() )62 End Sub63 Virtual Sub WriteLine( message As String, category As String )64 WriteLine( category + ": " + message )65 End Sub56 Virtual Sub WriteLine( message As String ) 57 '派生クラスで実装 (基底では何もしない) 58 End Sub 59 Virtual Sub WriteLine( value As Object ) 60 WriteLine( value.ToString() ) 61 End Sub 62 Virtual Sub WriteLine( value As Object, category As String ) 63 WriteLine( category + ": " + value.ToString() ) 64 End Sub 65 Virtual Sub WriteLine( message As String, category As String ) 66 WriteLine( category + ": " + message ) 67 End Sub 66 68 67 69 68 '----------------------------------------------------------------69 ' パブリック プロパティ70 '----------------------------------------------------------------70 '---------------------------------------------------------------- 71 ' パブリック プロパティ 72 '---------------------------------------------------------------- 71 73 72 ' IndentLevelプロパティ73 Function IndentLevel() As Long74 Return indentLevel75 End Function76 Sub IndentLevel( indentLevel As Long )77 This.indentLevel = indentLevel78 End Sub74 ' IndentLevelプロパティ 75 Function IndentLevel() As Long 76 Return indentLevel 77 End Function 78 Sub IndentLevel( indentLevel As Long ) 79 This.indentLevel = indentLevel 80 End Sub 79 81 80 ' IndentSizeプロパティ81 Function IndentSize() As Long82 Return indentSize83 End Function84 Sub IndentSize( size As Long )85 indentSize = size86 End Sub87 End Class82 ' IndentSizeプロパティ 83 Function IndentSize() As Long 84 Return indentSize 85 End Function 86 Sub IndentSize( size As Long ) 87 indentSize = size 88 End Sub 89 End Class 88 90 89 ' デフォルトリスナ(デバッガビューへの出力)90 Class DefaultTraceListener91 Inherits TraceListener92 Public91 ' デフォルトリスナ(デバッガビューへの出力) 92 Class DefaultTraceListener 93 Inherits TraceListener 94 Public 93 95 94 Override Sub Write( message As String )95 ' デバッグビューへ出力96 Dim tempStr = GetIndentString() + message97 OutputDebugString( tempStr )96 Override Sub Write( message As String ) 97 ' デバッグビューへ出力 98 Dim tempStr = GetIndentString() + message 99 OutputDebugString( tempStr ) 98 100 99 ' デバッグログへ書き込む100 ' TODO: 実装101 End Sub101 ' デバッグログへ書き込む 102 ' TODO: 実装 103 End Sub 102 104 103 Override Sub WriteLine( message As String ) 104 Write( GetIndentString() + message + Ex"\r\n" ) 105 End Sub 106 End Class 105 Override Sub WriteLine( message As String ) 106 Write( GetIndentString() + message + Ex"\r\n" ) 107 End Sub 108 End Class 109 110 End Namespace 111 End Namespace -
Include/Classes/System/Diagnostics/TraceListenerCollection.ab
r176 r246 1 ' リスナコレクション 2 Class TraceListenerCollection 3 pListeners As *TraceListener 4 count As Long 5 Public 1 Namespace System 2 Namespace Diagnostics 6 3 7 Sub TraceListenerCollection() 8 pListeners = _System_malloc( 1 ) 9 End Sub 10 Sub ~TraceListenerCollection() 11 _System_free( pListeners ) 12 End Sub 4 ' リスナコレクション 5 Class TraceListenerCollection 6 pListeners As *TraceListener 7 count As Long 8 Public 13 9 14 '---------------------------------------------------------------- 15 ' パブリック メソッド 16 '---------------------------------------------------------------- 10 Sub TraceListenerCollection() 11 pListeners = _System_malloc( 1 ) 12 End Sub 13 Sub ~TraceListenerCollection() 14 _System_free( pListeners ) 15 End Sub 17 16 18 ' リスナを追加 19 Sub Add( listener As TraceListener ) 20 pListeners = _System_realloc( pListeners, ( count + 1 ) * SizeOf( LONG_PTR ) ) 21 pListeners[count] = listener 22 count++ 23 End Sub 17 '---------------------------------------------------------------- 18 ' パブリック メソッド 19 '---------------------------------------------------------------- 24 20 25 ' 複数のリスナを追加 26 Sub AddRange( listeners As TraceListenerCollection ) 27 ' TODO: 実装 28 End Sub 21 ' リスナを追加 22 Sub Add( listener As TraceListener ) 23 pListeners = _System_realloc( pListeners, ( count + 1 ) * SizeOf( LONG_PTR ) ) 24 pListeners[count] = listener 25 count++ 26 End Sub 29 27 30 ' リストからすべてのリスナを削除31 Sub Clear()32 ' TODO: 実装33 End Sub28 ' 複数のリスナを追加 29 Sub AddRange( listeners As TraceListenerCollection ) 30 ' TODO: 実装 31 End Sub 34 32 35 ' 指定したリスナのインデックスを取得36 Function IndexOf( listener As TraceListener)37 ' TODO: 実装38 End Function33 ' リストからすべてのリスナを削除 34 Sub Clear() 35 ' TODO: 実装 36 End Sub 39 37 40 ' リスナを挿入41 Sub Insert( index As Long,listener As TraceListener )42 ' TODO: 実装43 End Sub38 ' 指定したリスナのインデックスを取得 39 Function IndexOf( listener As TraceListener ) 40 ' TODO: 実装 41 End Function 44 42 45 ' リスナを削除 46 Function Remove( name As String ) 47 ' TODO: 実装 48 End Function 49 Function Remove( listener As TraceListener ) 50 ' TODO: 実装 51 End Function 43 ' リスナを挿入 44 Sub Insert( index As Long, listener As TraceListener ) 45 ' TODO: 実装 46 End Sub 47 48 ' リスナを削除 49 Function Remove( name As String ) 50 ' TODO: 実装 51 End Function 52 Function Remove( listener As TraceListener ) 53 ' TODO: 実装 54 End Function 52 55 53 56 54 '----------------------------------------------------------------55 ' パブリック プロパティ56 '----------------------------------------------------------------57 '---------------------------------------------------------------- 58 ' パブリック プロパティ 59 '---------------------------------------------------------------- 57 60 58 ' インデクサ ( Getter )59 Function Operator[] ( index As Long ) As TraceListener60 If index < 0 or count <= index Then61 ' TODO: エラー処理62 debug63 End If61 ' インデクサ ( Getter ) 62 Function Operator[] ( index As Long ) As TraceListener 63 If index < 0 or count <= index Then 64 ' TODO: エラー処理 65 debug 66 End If 64 67 65 Return pListeners[index]66 End Function68 Return pListeners[index] 69 End Function 67 70 68 ' 保有するリスナの数を取得する 69 Function Count() As Long 70 Return count 71 End Function 72 End Class 71 ' 保有するリスナの数を取得する 72 Function Count() As Long 73 Return count 74 End Function 75 End Class 76 77 End Namespace 78 End Namespace -
Include/Classes/System/Diagnostics/base.ab
r207 r246 1 2 Class _System_TraceBase 3 indentLevel As Long 4 indentSize As Long 5 6 7 ' リスナ管理 8 listeners As TraceListenerCollection 9 10 Public 11 12 ' コンストラクタ 13 Sub _System_TraceBase() 14 listeners = New TraceListenerCollection 15 listeners.Add( New DefaultTraceListener() ) 16 17 indentLevel = 0 18 indentSize = 4 19 End Sub 20 21 '---------------------------------------------------------------- 22 ' パブリック メソッド 23 '---------------------------------------------------------------- 24 25 ' アサート(コールスタックを表示) 26 Sub Assert( condition As Boolean ) 27 If condition = False then 28 'TODO: コールスタックを表示 29 End If 30 End Sub 31 32 ' アサート(メッセージ文字列を表示) 33 Sub Assert( condition As Boolean, message As String ) 34 If condition = False then 35 ' TODO: メッセージボックス形式での表示に対応 36 WriteLine( message ) 37 End If 38 End Sub 39 40 ' アサート(メッセージ文字列と詳細文字列を表示) 41 Sub Assert( condition As Boolean, message As String, detailMessage As String ) 42 If condition = False then 43 ' TODO: メッセージボックス形式での表示に対応 44 WriteLine( message ) 45 End If 46 End Sub 47 48 49 ' インデントレベルを上げる 50 Sub Indent() 51 IndentLevel = indentLevel + 1 52 End Sub 53 54 ' インデントレベルを下げる 55 Sub Unindent() 56 If indentLevel <= 0 Then 57 indentLevel = 0 58 Return 59 End If 60 IndentLevel = indentLevel - 1 61 End Sub 62 63 ' 文字列を出力 64 Sub Write( value As Object ) 65 Dim i As Long 66 For i = 0 To ELM( listeners.Count ) 67 Dim listener = listeners[i] 68 listener.Write( value ) 69 Next 70 End Sub 71 Sub Write( message As String ) 72 Dim i As Long 73 For i = 0 To ELM( listeners.Count ) 74 Dim listener = listeners[i] 75 listener.Write( message ) 76 Next 77 End Sub 78 Sub Write( value As Object, category As String ) 79 Dim i As Long 80 For i = 0 To ELM( listeners.Count ) 81 Dim listener = listeners[i] 82 listener.Write( value, category ) 83 Next 84 End Sub 85 Sub Write( message As String, category As String ) 86 Dim i As Long 87 For i = 0 To ELM( listeners.Count ) 88 Dim listener = listeners[i] 89 listener.Write( message, category ) 90 Next 91 End Sub 92 93 ' 一行の文字列を出力 94 Sub WriteLine( value As Object ) 95 Dim i As Long 96 For i = 0 To ELM( listeners.Count ) 97 Dim listener = listeners[i] 98 listener.WriteLine( value ) 99 Next 100 End Sub 101 Sub WriteLine( message As String ) 102 Dim i As Long 103 For i = 0 To ELM( listeners.Count ) 104 Dim listener = listeners[i] 105 listener.WriteLine( message ) 106 Next 107 End Sub 108 Sub WriteLine( value As Object, category As String ) 109 Dim i As Long 110 For i = 0 To ELM( listeners.Count ) 111 Dim listener = listeners[i] 112 listener.WriteLine( value, category ) 113 Next 114 End Sub 115 Sub WriteLine( message As String, category As String ) 116 Dim i As Long 117 For i = 0 To ELM( listeners.Count ) 118 Dim listener = listeners[i] 119 listener.WriteLine( message, category ) 120 Next 121 End Sub 122 123 ' 条件をもとに文字列を出力 124 Sub WriteIf( condition As Boolean, value As Object ) 125 Dim i As Long 126 For i = 0 To ELM( listeners.Count ) 127 Dim listener = listeners[i] 128 listener.WriteIf( condition, value ) 129 Next 130 End Sub 131 Sub WriteIf( condition As Boolean, message As String ) 132 Dim i As Long 133 For i = 0 To ELM( listeners.Count ) 134 Dim listener = listeners[i] 135 listener.WriteIf( condition, message ) 136 Next 137 End Sub 138 Sub WriteIf( condition As Boolean, value As Object, category As String ) 139 Dim i As Long 140 For i = 0 To ELM( listeners.Count ) 141 Dim listener = listeners[i] 142 listener.WriteIf( condition, value, category ) 143 Next 144 End Sub 145 Sub WriteIf( condition As Boolean, message As String, category As String ) 146 Dim i As Long 147 For i = 0 To ELM( listeners.Count ) 148 Dim listener = listeners[i] 149 listener.WriteIf( condition, message, category ) 150 Next 151 End Sub 152 153 ' 条件をもとに一行の文字列を出力 154 Sub WriteLineIf( condition As Boolean, value As Object ) 155 Dim i As Long 156 For i = 0 To ELM( listeners.Count ) 157 Dim listener = listeners[i] 158 listener.WriteLineIf( condition, value ) 159 Next 160 End Sub 161 Sub WriteLineIf( condition As Boolean, message As String ) 162 Dim i As Long 163 For i = 0 To ELM( listeners.Count ) 164 Dim listener = listeners[i] 165 listener.WriteLineIf( condition, message ) 166 Next 167 End Sub 168 Sub WriteLineIf( condition As Boolean, value As Object, category As String ) 169 Dim i As Long 170 For i = 0 To ELM( listeners.Count ) 171 Dim listener = listeners[i] 172 listener.WriteLineIf( condition, value, category ) 173 Next 174 End Sub 175 Sub WriteLineIf( condition As Boolean, message As String, category As String ) 176 Dim i As Long 177 For i = 0 To ELM( listeners.Count ) 178 Dim listener = listeners[i] 179 listener.WriteLineIf( condition, message, category ) 180 Next 181 End Sub 182 183 184 '---------------------------------------------------------------- 185 ' パブリック プロパティ 186 '---------------------------------------------------------------- 187 188 ' IndentLevelプロパティ 189 Function IndentLevel() As Long 190 Return indentLevel 191 End Function 192 Sub IndentLevel( indentLevel As Long ) 193 This.indentLevel = indentLevel 194 195 Dim i As Long 196 For i = 0 To ELM( listeners.Count ) 197 Dim listener = listeners[i] 198 listener.IndentLevel = indentLevel 199 Next 200 End Sub 201 202 ' IndentSizeプロパティ 203 Function IndentSize() As Long 204 Return indentSize 205 End Function 206 Sub IndentSize( size As Long ) 207 indentSize = size 208 209 Dim i As Long 210 For i = 0 To ELM( listeners.Count ) 211 Dim listener = listeners[i] 212 listener.IndentSize = indentSize 213 Next 214 End Sub 215 216 ' Listenersプロパティ 217 Function Listeners() As TraceListenerCollection 218 Return listeners 219 End Function 220 221 End Class 222 1 Namespace System 2 Namespace Diagnostics 3 4 Class _System_TraceBase 5 indentLevel As Long 6 indentSize As Long 7 8 9 ' リスナ管理 10 listeners As TraceListenerCollection 11 12 Public 13 14 ' コンストラクタ 15 Sub _System_TraceBase() 16 listeners = New TraceListenerCollection 17 listeners.Add( New DefaultTraceListener() ) 18 19 indentLevel = 0 20 indentSize = 4 21 End Sub 22 23 '---------------------------------------------------------------- 24 ' パブリック メソッド 25 '---------------------------------------------------------------- 26 27 ' アサート(コールスタックを表示) 28 Sub Assert( condition As Boolean ) 29 If condition = False then 30 'TODO: コールスタックを表示 31 End If 32 End Sub 33 34 ' アサート(メッセージ文字列を表示) 35 Sub Assert( condition As Boolean, message As String ) 36 If condition = False then 37 ' TODO: メッセージボックス形式での表示に対応 38 WriteLine( message ) 39 End If 40 End Sub 41 42 ' アサート(メッセージ文字列と詳細文字列を表示) 43 Sub Assert( condition As Boolean, message As String, detailMessage As String ) 44 If condition = False then 45 ' TODO: メッセージボックス形式での表示に対応 46 WriteLine( message ) 47 End If 48 End Sub 49 50 51 ' インデントレベルを上げる 52 Sub Indent() 53 IndentLevel = indentLevel + 1 54 End Sub 55 56 ' インデントレベルを下げる 57 Sub Unindent() 58 If indentLevel <= 0 Then 59 indentLevel = 0 60 Return 61 End If 62 IndentLevel = indentLevel - 1 63 End Sub 64 65 ' 文字列を出力 66 Sub Write( value As Object ) 67 Dim i As Long 68 For i = 0 To ELM( listeners.Count ) 69 Dim listener = listeners[i] 70 listener.Write( value ) 71 Next 72 End Sub 73 Sub Write( message As String ) 74 Dim i As Long 75 For i = 0 To ELM( listeners.Count ) 76 Dim listener = listeners[i] 77 listener.Write( message ) 78 Next 79 End Sub 80 Sub Write( value As Object, category As String ) 81 Dim i As Long 82 For i = 0 To ELM( listeners.Count ) 83 Dim listener = listeners[i] 84 listener.Write( value, category ) 85 Next 86 End Sub 87 Sub Write( message As String, category As String ) 88 Dim i As Long 89 For i = 0 To ELM( listeners.Count ) 90 Dim listener = listeners[i] 91 listener.Write( message, category ) 92 Next 93 End Sub 94 95 ' 一行の文字列を出力 96 Sub WriteLine( value As Object ) 97 Dim i As Long 98 For i = 0 To ELM( listeners.Count ) 99 Dim listener = listeners[i] 100 listener.WriteLine( value ) 101 Next 102 End Sub 103 Sub WriteLine( message As String ) 104 Dim i As Long 105 For i = 0 To ELM( listeners.Count ) 106 Dim listener = listeners[i] 107 listener.WriteLine( message ) 108 Next 109 End Sub 110 Sub WriteLine( value As Object, category As String ) 111 Dim i As Long 112 For i = 0 To ELM( listeners.Count ) 113 Dim listener = listeners[i] 114 listener.WriteLine( value, category ) 115 Next 116 End Sub 117 Sub WriteLine( message As String, category As String ) 118 Dim i As Long 119 For i = 0 To ELM( listeners.Count ) 120 Dim listener = listeners[i] 121 listener.WriteLine( message, category ) 122 Next 123 End Sub 124 125 ' 条件をもとに文字列を出力 126 Sub WriteIf( condition As Boolean, value As Object ) 127 Dim i As Long 128 For i = 0 To ELM( listeners.Count ) 129 Dim listener = listeners[i] 130 listener.WriteIf( condition, value ) 131 Next 132 End Sub 133 Sub WriteIf( condition As Boolean, message As String ) 134 Dim i As Long 135 For i = 0 To ELM( listeners.Count ) 136 Dim listener = listeners[i] 137 listener.WriteIf( condition, message ) 138 Next 139 End Sub 140 Sub WriteIf( condition As Boolean, value As Object, category As String ) 141 Dim i As Long 142 For i = 0 To ELM( listeners.Count ) 143 Dim listener = listeners[i] 144 listener.WriteIf( condition, value, category ) 145 Next 146 End Sub 147 Sub WriteIf( condition As Boolean, message As String, category As String ) 148 Dim i As Long 149 For i = 0 To ELM( listeners.Count ) 150 Dim listener = listeners[i] 151 listener.WriteIf( condition, message, category ) 152 Next 153 End Sub 154 155 ' 条件をもとに一行の文字列を出力 156 Sub WriteLineIf( condition As Boolean, value As Object ) 157 Dim i As Long 158 For i = 0 To ELM( listeners.Count ) 159 Dim listener = listeners[i] 160 listener.WriteLineIf( condition, value ) 161 Next 162 End Sub 163 Sub WriteLineIf( condition As Boolean, message As String ) 164 Dim i As Long 165 For i = 0 To ELM( listeners.Count ) 166 Dim listener = listeners[i] 167 listener.WriteLineIf( condition, message ) 168 Next 169 End Sub 170 Sub WriteLineIf( condition As Boolean, value As Object, category As String ) 171 Dim i As Long 172 For i = 0 To ELM( listeners.Count ) 173 Dim listener = listeners[i] 174 listener.WriteLineIf( condition, value, category ) 175 Next 176 End Sub 177 Sub WriteLineIf( condition As Boolean, message As String, category As String ) 178 Dim i As Long 179 For i = 0 To ELM( listeners.Count ) 180 Dim listener = listeners[i] 181 listener.WriteLineIf( condition, message, category ) 182 Next 183 End Sub 184 185 186 '---------------------------------------------------------------- 187 ' パブリック プロパティ 188 '---------------------------------------------------------------- 189 190 ' IndentLevelプロパティ 191 Function IndentLevel() As Long 192 Return indentLevel 193 End Function 194 Sub IndentLevel( indentLevel As Long ) 195 This.indentLevel = indentLevel 196 197 Dim i As Long 198 For i = 0 To ELM( listeners.Count ) 199 Dim listener = listeners[i] 200 listener.IndentLevel = indentLevel 201 Next 202 End Sub 203 204 ' IndentSizeプロパティ 205 Function IndentSize() As Long 206 Return indentSize 207 End Function 208 Sub IndentSize( size As Long ) 209 indentSize = size 210 211 Dim i As Long 212 For i = 0 To ELM( listeners.Count ) 213 Dim listener = listeners[i] 214 listener.IndentSize = indentSize 215 Next 216 End Sub 217 218 ' Listenersプロパティ 219 Function Listeners() As TraceListenerCollection 220 Return listeners 221 End Function 222 223 End Class 224 225 End Namespace 226 End Namespace -
Include/Classes/System/Object.ab
r237 r246 1 Class Object2 1 3 Public 2 Namespace System 4 3 5 Sub Object() 6 End Sub 7 Sub ~Object() 8 End Sub 4 Class Object 9 5 10 ' 2つのオブジェクトが等しいかどうかを判断する 11 Virtual Function Equals( object As Object ) As Boolean 12 If ObjPtr(This) = ObjPtr(object) Then 13 ' If This.GetHashCode() = object.GetHashCode() Then 14 Return True 15 Else 16 Return False 17 End If 18 End Function 19 20 Static Function Equals( objectA As Object, objectB As Object ) As Boolean 21 If ObjPtr(objectA) = NULL /*objectA = Nothing*/ Then 22 Return ObjPtr(objectB) = NULL 'objectB = Nothing 23 Else 24 Return objectA.Equals(objectB) 25 End If 26 End Function 6 Public 27 7 28 ' 参照先が等しいか判断する 29 Static Function ReferenceEquals(objectA As Object, objectB As Object) As Boolean 30 If ObjPtr( objectA ) = ObjPtr( objectB) Then 31 Return True 32 Else 33 Return False 34 End If 35 End Function 8 Sub Object() 9 End Sub 10 Sub ~Object() 11 End Sub 36 12 37 ' ハッシュコードを取得する 38 Virtual Function GetHashCode() As Long 39 Return ObjPtr( This ) As Long 40 End Function 13 ' 2つのオブジェクトが等しいかどうかを判断する 14 Virtual Function Equals( object As Object ) As Boolean 15 If ObjPtr(This) = ObjPtr(object) Then 16 ' If This.GetHashCode() = object.GetHashCode() Then 17 Return True 18 Else 19 Return False 20 End If 21 End Function 22 23 Static Function Equals( objectA As Object, objectB As Object ) As Boolean 24 If ObjPtr(objectA) = NULL /*objectA = Nothing*/ Then 25 Return ObjPtr(objectB) = NULL 'objectB = Nothing 26 Else 27 Return objectA.Equals(objectB) 28 End If 29 End Function 41 30 42 ' オブジェクトに関係する文字列を返す 43 Virtual Function ToString() As String 44 Return GetType().Name 45 End Function 31 ' 参照先が等しいか判断する 32 Static Function ReferenceEquals(objectA As Object, objectB As Object) As Boolean 33 If ObjPtr( objectA ) = ObjPtr( objectB) Then 34 Return True 35 Else 36 Return False 37 End If 38 End Function 46 39 47 /* 48 Function Operator Downcast() As VoidPtr 49 End Function 50 */ 40 ' ハッシュコードを取得する 41 Virtual Function GetHashCode() As Long 42 Return ObjPtr( This ) As Long 43 End Function 44 45 ' オブジェクトに関係する文字列を返す 46 Virtual Function ToString() As String 47 Return GetType().Name 48 End Function 49 50 /* 51 Function Operator Downcast() As VoidPtr 52 End Function 53 */ 51 54 52 55 53 '----------------------------------------------------------------54 ' 実行時型情報55 '----------------------------------------------------------------56 '---------------------------------------------------------------- 57 ' 実行時型情報 58 '---------------------------------------------------------------- 56 59 57 Private58 typeInfo As TypeInfo60 Private 61 typeInfo As TypeInfo 59 62 60 Public61 Sub _System_SetType( typeInfo As TypeInfo )62 If _System_TypeBase.IsReady() = False Then63 Return64 End If63 Public 64 Sub _System_SetType( typeInfo As TypeInfo ) 65 If _System_TypeBase.IsReady() = False Then 66 Return 67 End If 65 68 66 This.typeInfo = typeInfo67 End Sub69 This.typeInfo = typeInfo 70 End Sub 68 71 69 Virtual Function GetType() As TypeInfo70 Return typeInfo71 End Function72 Virtual Function GetType() As TypeInfo 73 Return typeInfo 74 End Function 72 75 73 End Class 74 Dim aaa As Long 76 End Class 77 78 End Namespace -
Include/Classes/System/String.ab
r237 r246 15 15 #endif 16 16 17 Class String 18 ' Inherits IComparable, ICloneable, IConvertible, IEnumerable 19 20 m_Length As Long 21 Public 22 Chars As *StrChar 23 24 Sub String() 25 Chars = _System_malloc(SizeOf (StrChar)) 26 Chars[0] = 0 27 m_Length = 0 28 End Sub 29 30 Sub String(initStr As PCSTR) 31 Assign(initStr) 32 End Sub 33 34 Sub String(initStr As PCSTR, length As Long) 35 Assign(initStr, length) 36 End Sub 37 38 Sub String(initStr As PCWSTR) 39 Assign(initStr) 40 End Sub 41 42 Sub String(initStr As PCWSTR, length As Long) 43 Assign(initStr, length) 44 End Sub 45 46 Sub String(ByRef initStr As String) 47 Assign(initStr) 48 End Sub 49 50 Sub String(length As Long) 51 ReSize(length) 52 End Sub 53 54 Sub String(initChar As StrChar, length As Long) 55 ReSize(length, initChar) 56 End Sub 57 58 Sub ~String() 59 _System_free(Chars) 60 Chars = 0 17 Namespace System 18 19 Class String 20 ' Inherits IComparable, ICloneable, IConvertible, IEnumerable 21 22 m_Length As Long 23 Public 24 Chars As *StrChar 25 26 Sub String() 27 Chars = _System_malloc(SizeOf (StrChar)) 28 Chars[0] = 0 29 m_Length = 0 30 End Sub 31 32 Sub String(initStr As PCSTR) 33 Assign(initStr) 34 End Sub 35 36 Sub String(initStr As PCSTR, length As Long) 37 Assign(initStr, length) 38 End Sub 39 40 Sub String(initStr As PCWSTR) 41 Assign(initStr) 42 End Sub 43 44 Sub String(initStr As PCWSTR, length As Long) 45 Assign(initStr, length) 46 End Sub 47 48 Sub String(ByRef initStr As String) 49 Assign(initStr) 50 End Sub 51 52 Sub String(length As Long) 53 ReSize(length) 54 End Sub 55 56 Sub String(initChar As StrChar, length As Long) 57 ReSize(length, initChar) 58 End Sub 59 60 Sub ~String() 61 _System_free(Chars) 62 Chars = 0 61 63 #ifdef _DEBUG 62 m_Length = 063 #endif 64 End Sub65 66 Const Function Length() As Long67 Return m_Length68 End Function69 70 Function Operator() As *StrChar71 Return Chars72 End Function73 74 Const Function Operator [] (n As Long) As StrChar64 m_Length = 0 65 #endif 66 End Sub 67 68 Const Function Length() As Long 69 Return m_Length 70 End Function 71 72 Function Operator() As *StrChar 73 Return Chars 74 End Function 75 76 Const Function Operator [] (n As Long) As StrChar 75 77 #ifdef _DEBUG 76 If n > Length Then77 'Throw ArgumentOutOfRangeException78 Debug79 End If80 #endif 81 Return Chars[n]82 End Function83 84 Sub Operator []= (n As Long, c As StrChar)78 If n > Length Then 79 'Throw ArgumentOutOfRangeException 80 Debug 81 End If 82 #endif 83 Return Chars[n] 84 End Function 85 86 Sub Operator []= (n As Long, c As StrChar) 85 87 #ifdef _DEBUG 86 If n >= Length Then 87 'Throw ArgumentOutOfRangeException 88 Debug 89 End If 90 #endif 91 Chars[n] = c 92 End Sub 93 94 /* Const Function Operator + (text As *Byte) As String 95 Return Concat(text As PCTSTR, lstrlen(text)) 96 End Function*/ 97 98 Const Function Operator + (text As PCSTR) As String 99 Return Concat(text, lstrlenA(text)) 100 End Function 101 102 Const Function Operator + (text As PCWSTR) As String 103 Return Concat(text, lstrlenW(text)) 104 End Function 105 106 Const Function Operator + (objString As String) As String 107 Return Concat(objString.Chars, objString.m_Length) 108 End Function 109 110 Const Function Operator & (text As PCSTR) As String 111 Dim tempString = This + text 112 Return tempString 113 End Function 114 115 Const Function Operator & (text As PCWSTR) As String 116 Dim tempString = This + text 117 Return tempString 118 End Function 119 120 Const Function Operator & (objString As String) As String 121 Dim tempString = This + objString 122 Return tempString 123 End Function 124 125 Const Function Operator == (objString As String) As Boolean 126 Return String.Compare(This, objString) = 0 127 End Function 128 129 Const Function Operator == (text As *StrChar) As Boolean 130 Return _System_StrCmp(This.Chars, text) = 0 131 End Function 132 133 Const Function Operator <> (objString As String) As Boolean 134 Return String.Compare(This, objString) <> 0 135 End Function 136 137 Const Function Operator <> (text As *StrChar) As Boolean 138 Return _System_StrCmp(This.Chars, text) <> 0 139 End Function 140 141 Const Function Operator < (objString As String) As Boolean 142 Return String.Compare(This, objString) < 0 143 End Function 144 145 Const Function Operator < (text As *StrChar) As Boolean 146 Return _System_StrCmp(This.Chars, text) < 0 147 End Function 148 149 Const Function Operator > (objString As String) As Boolean 150 Return String.Compare(This, objString) > 0 151 End Function 152 153 Const Function Operator > (text As *StrChar) As Boolean 154 Return _System_StrCmp(This.Chars, text) > 0 155 End Function 156 157 Const Function Operator <= (objString As String) As Boolean 158 Return String.Compare(This, objString) <= 0 159 End Function 160 161 Const Function Operator <= (text As *StrChar) As Boolean 162 Return _System_StrCmp(This.Chars, text) <= 0 163 End Function 164 165 Const Function Operator >= (objString As String) As Boolean 166 Return String.Compare(This, objString) >= 0 167 End Function 168 169 Const Function Operator >= (text As *StrChar) As Boolean 170 Return _System_StrCmp(This.Chars, text) >= 0 171 End Function 172 173 Static Function Compare(x As String, y As String) As Long 174 Return CompareOrdinal(x, y) 175 End Function 176 177 Static Function Compare(x As String, indexX As Long, y As String, indexY As Long, length As Long) As Long 178 Return CompareOrdinal(x, indexX, y, indexY, length) 179 End Function 180 181 Static Function CompareOrdinal(x As String, y As String) As Long 182 Return _System_StrCmp(x.Chars, y.Chars) 183 End Function 184 185 Static Function CompareOrdinal(x As String, indexX As Long, y As String, indexY As Long, length As Long) As Long 186 If Object.ReferenceEquals(x, Nothing) Then 187 If Object.ReferenceEquals(y, Nothing) Then 88 If n >= Length Then 89 'Throw ArgumentOutOfRangeException 90 Debug 91 End If 92 #endif 93 Chars[n] = c 94 End Sub 95 96 /* Const Function Operator + (text As *Byte) As String 97 Return Concat(text As PCTSTR, lstrlen(text)) 98 End Function*/ 99 100 Const Function Operator + (text As PCSTR) As String 101 Return Concat(text, lstrlenA(text)) 102 End Function 103 104 Const Function Operator + (text As PCWSTR) As String 105 Return Concat(text, lstrlenW(text)) 106 End Function 107 108 Const Function Operator + (objString As String) As String 109 Return Concat(objString.Chars, objString.m_Length) 110 End Function 111 112 Const Function Operator & (text As PCSTR) As String 113 Dim tempString = This + text 114 Return tempString 115 End Function 116 117 Const Function Operator & (text As PCWSTR) As String 118 Dim tempString = This + text 119 Return tempString 120 End Function 121 122 Const Function Operator & (objString As String) As String 123 Dim tempString = This + objString 124 Return tempString 125 End Function 126 127 Const Function Operator == (objString As String) As Boolean 128 Return String.Compare(This, objString) = 0 129 End Function 130 131 Const Function Operator == (text As *StrChar) As Boolean 132 Return _System_StrCmp(This.Chars, text) = 0 133 End Function 134 135 Const Function Operator <> (objString As String) As Boolean 136 Return String.Compare(This, objString) <> 0 137 End Function 138 139 Const Function Operator <> (text As *StrChar) As Boolean 140 Return _System_StrCmp(This.Chars, text) <> 0 141 End Function 142 143 Const Function Operator < (objString As String) As Boolean 144 Return String.Compare(This, objString) < 0 145 End Function 146 147 Const Function Operator < (text As *StrChar) As Boolean 148 Return _System_StrCmp(This.Chars, text) < 0 149 End Function 150 151 Const Function Operator > (objString As String) As Boolean 152 Return String.Compare(This, objString) > 0 153 End Function 154 155 Const Function Operator > (text As *StrChar) As Boolean 156 Return _System_StrCmp(This.Chars, text) > 0 157 End Function 158 159 Const Function Operator <= (objString As String) As Boolean 160 Return String.Compare(This, objString) <= 0 161 End Function 162 163 Const Function Operator <= (text As *StrChar) As Boolean 164 Return _System_StrCmp(This.Chars, text) <= 0 165 End Function 166 167 Const Function Operator >= (objString As String) As Boolean 168 Return String.Compare(This, objString) >= 0 169 End Function 170 171 Const Function Operator >= (text As *StrChar) As Boolean 172 Return _System_StrCmp(This.Chars, text) >= 0 173 End Function 174 175 Static Function Compare(x As String, y As String) As Long 176 Return CompareOrdinal(x, y) 177 End Function 178 179 Static Function Compare(x As String, indexX As Long, y As String, indexY As Long, length As Long) As Long 180 Return CompareOrdinal(x, indexX, y, indexY, length) 181 End Function 182 183 Static Function CompareOrdinal(x As String, y As String) As Long 184 Return _System_StrCmp(x.Chars, y.Chars) 185 End Function 186 187 Static Function CompareOrdinal(x As String, indexX As Long, y As String, indexY As Long, length As Long) As Long 188 If Object.ReferenceEquals(x, Nothing) Then 189 If Object.ReferenceEquals(y, Nothing) Then 190 Return 0 191 Else 192 Return -1 193 End If 194 ElseIf Object.ReferenceEquals(y, Nothing) Then 195 Return 1 196 End If 197 Return _System_StrCmpN(VarPtr(x.Chars[indexX]), VarPtr(y.Chars[indexY]), length As SIZE_T) 198 End Function 199 200 Function CompareTo(y As String) As Long 201 Return String.Compare(This, y) 202 End Function 203 204 Function CompareTo(y As Object) As Long 205 Dim s = y As String 206 ' If y is not String Then 207 ' Throw New ArgumentException 208 ' End If 209 Return CompareTo(y) 210 End Function 211 212 Const Function StrPtr() As *StrChar 213 Return Chars 214 End Function 215 216 Sub ReSize(allocLength As Long) 217 If allocLength < 0 Then Exit Sub 218 If allocLength > m_Length Then 219 Dim oldLength As Long 220 oldLength = m_Length 221 If AllocStringBuffer(allocLength) <> 0 Then 222 ZeroMemory(VarPtr(Chars[oldLength]), SizeOf (StrChar) * (m_Length - oldLength + 1)) 223 End If 224 Else 225 m_Length = allocLength 226 Chars[m_Length] = 0 227 End If 228 End Sub 229 230 Sub ReSize(allocLength As Long, c As StrChar) 231 If allocLength < 0 Then 232 Exit Sub 233 ElseIf allocLength > m_Length Then 234 Dim oldLength As Long 235 oldLength = m_Length 236 If AllocStringBuffer(allocLength) <> 0 Then 237 Dim p = VarPtr(Chars[oldLength]) As *StrChar 238 Dim fillLen = m_Length - oldLength 239 Dim i As Long 240 For i = 0 To ELM(fillLen) 241 p[i] = c 242 Next 243 End If 244 Else 245 m_Length = allocLength 246 End If 247 Chars[m_Length] = 0 248 End Sub 249 250 Sub Assign(text As PCSTR, textLengthA As Long) 251 #ifdef __STRING_IS_NOT_UNICODE 252 AssignFromStrChar(text, textLengthA) 253 #else 254 Dim textLengthW = MultiByteToWideChar(CP_THREAD_ACP, 0, text, textLengthA, 0, 0) 255 If AllocStringBuffer(textLengthW) <> 0 Then 256 MultiByteToWideChar(CP_THREAD_ACP, 0, text, textLengthA, Chars, textLengthW) 257 Chars[textLengthW] = 0 258 End If 259 #endif 260 End Sub 261 262 Sub Assign(text As PCWSTR, textLengthW As Long) 263 #ifdef __STRING_IS_NOT_UNICODE 264 Dim textLengthA = WideCharToMultiByte(CP_THREAD_ACP, 0, text, textLengthW, 0, 0, 0, 0) 265 If AllocStringBuffer(textLengthA) <> 0 Then 266 WideCharToMultiByte(CP_THREAD_ACP, 0, text, textLengthW, Chars, textLengthA, 0, 0) 267 Chars[textLengthA] = 0 268 End If 269 #else 270 AssignFromStrChar(text, textLengthW) 271 #endif 272 End Sub 273 274 Sub Assign(ByRef objString As String) 275 Assign(objString.Chars, objString.m_Length) 276 End Sub 277 278 Sub Assign(text As PCSTR) 279 If text Then 280 Assign(text, lstrlenA(text)) 281 Else 282 If Chars <> 0 Then 283 Chars[0] = 0 284 End If 285 m_Length = 0 286 End If 287 End Sub 288 289 Sub Assign(text As PCWSTR) 290 If text Then 291 Assign(text, lstrlenW(text)) 292 Else 293 If Chars <> 0 Then 294 Chars[0] = 0 295 End If 296 m_Length = 0 297 End If 298 End Sub 299 300 Sub Append(text As *StrChar, textLength As Long) 301 Dim prevLen As Long 302 prevLen = m_Length 303 If AllocStringBuffer(m_Length + textLength) <> 0 Then 304 memcpy(VarPtr(Chars[prevLen]), text, SizeOf (StrChar) * textLength) 305 Chars[m_Length] = 0 306 End If 307 End Sub 308 309 Sub Append(text As *StrChar) 310 Append(text, lstrlen(text)) 311 End Sub 312 313 Sub Append(ByRef str As String) 314 Append(str.Chars, str.m_Length) 315 End Sub 316 317 Const Function Clone() As String 318 Return This 319 End Function 320 Private 321 Static Function ConcatStrChar(text1 As *StrChar, text1Length As Long, text2 As *StrChar, text2Length As Long) As String 322 ConcatStrChar = New String() 323 With ConcatStrChar 324 .AllocStringBuffer(text1Length + text2Length) 325 memcpy(.Chars, text1, SizeOf (StrChar) * text1Length) 326 memcpy(VarPtr(.Chars[text1Length]), text2, SizeOf (StrChar) * text2Length) 327 .Chars[text1Length + text2Length] = 0 328 End With 329 End Function 330 Public 331 Const Function Concat(text As PCSTR, len As Long) As String 332 #ifdef __STRING_IS_NOT_UNICODE 333 Return ConcatStrChar(This.Chars, m_Length, text, len) 334 #else 335 With Concat 336 Dim lenW = MultiByteToWideChar(CP_THREAD_ACP, 0, text, len, 0, 0) 337 .AllocStringBuffer(m_Length + lenW) 338 memcpy(.Chars, This.Chars, m_Length) 339 MultiByteToWideChar(CP_THREAD_ACP, 0, text, len, VarPtr(.Chars[m_Length]), lenW) 340 .Chars[m_Length + lenW] = 0 341 End With 342 #endif 343 End Function 344 345 Const Function Concat(text As PCWSTR, len As Long) As String 346 #ifdef __STRING_IS_NOT_UNICODE 347 With Concat 348 Dim lenA = WideCharToMultiByte(CP_THREAD_ACP, 0, text, len, 0, 0, 0, 0) 349 .AllocStringBuffer(m_Length + lenA) 350 memcpy(.Chars, This.Chars, m_Length) 351 WideCharToMultiByte(CP_THREAD_ACP, 0, text, len, VarPtr(.Chars[m_Length]), lenA, 0, 0) 352 .Chars[m_Length + lenA] = 0 353 End With 354 #else 355 Return ConcatStrChar(This.Chars, m_Length, text, len) 356 #endif 357 End Function 358 359 Static Function Concat(x As String, y As String) As String 360 If String.IsNullOrEmpty(x) Then 361 Return y 362 Else 363 Return x.Concat(y.Chars, y.m_Length) 364 End If 365 End Function 366 367 Static Function Concat(x As Object, y As Object) As String 368 Return String.Concat(x.ToString, y.ToString) 369 End Function 370 371 Const Function Contains(objString As String) As Boolean 372 Return IndexOf(objString, 0, m_Length) >= 0 373 End Function 374 375 Const Function Contains(lpszText As *StrChar) As Boolean 376 Return IndexOf(lpszText, 0, m_Length) >= 0 377 End Function 378 379 Const Function IndexOf(lpszText As *StrChar) As Long 380 Return IndexOf(lpszText, 0, m_Length) 381 End Function 382 383 Const Function IndexOf(lpszText As *StrChar, startIndex As Long) As Long 384 Return IndexOf(lpszText, startIndex, m_Length - startIndex) 385 End Function 386 387 Const Function IndexOf(lpszText As *StrChar, startIndex As Long, count As Long) As Long 388 Dim length = lstrlen(lpszText) 389 390 If startIndex < 0 Then Return -1 391 If count < 1 Or count + startIndex > m_Length Then Return -1 392 If length > m_Length Then Return -1 393 394 If length = 0 Then Return startIndex 395 396 Dim i As Long, j As Long 397 For i = startIndex To startIndex + count - 1 398 For j = 0 To length - 1 399 If Chars[i + j] = lpszText[j] Then 400 If j = length - 1 Then Return i 401 Else 402 Exit For 403 End If 404 Next 405 Next 406 Return -1 407 End Function 408 409 Const Function LastIndexOf(lpszText As *StrChar) As Long 410 Return LastIndexOf(lpszText, m_Length - 1, m_Length) 411 End Function 412 413 Const Function LastIndexOf(lpszText As *StrChar, startIndex As Long) As Long 414 Return LastIndexOf(lpszText As *StrChar, startIndex, startIndex + 1) 415 End Function 416 417 Const Function LastIndexOf(lpszText As *StrChar, startIndex As Long, count As Long) As Long 418 Dim length = lstrlen(lpszText) 419 420 If startIndex < 0 Or startIndex > m_Length - 1 Then Return -1 421 If count < 1 Or count > startIndex + 2 Then Return -1 422 If length > m_Length Then Return -1 423 424 If length = 0 Then Return startIndex 425 426 Dim i As Long, j As Long 427 For i = startIndex To startIndex - count + 1 Step -1 428 For j = length - 1 To 0 Step -1 429 If Chars[i + j] = lpszText[j] Then 430 If j = 0 Then Return i 431 Else 432 Exit For 433 End If 434 Next 435 Next 436 Return -1 437 End Function 438 439 Const Function StartsWith(lpszText As *StrChar) As Boolean 440 Return IndexOf(lpszText) = 0 441 End Function 442 443 Const Function EndsWith(lpszText As *StrChar) As Boolean 444 Return LastIndexOf(lpszText) = m_Length - lstrlen(lpszText) 445 End Function 446 447 Const Function Insert(startIndex As Long, text As String) As String 448 Return Insert(startIndex, text.Chars, text.Length) 449 End Function 450 451 Const Function Insert(startIndex As Long, text As *StrChar) As String 452 Return Insert(startIndex, text, lstrlen(text)) 453 End Function 454 455 Const Function Insert(startIndex As Long, text As *StrChar, length As Long) As String 456 If startIndex < 0 Or startIndex > m_Length Or length < 0 Then 457 Debug 'ArgumentOutOfRangeException 458 459 End If 460 Insert.ReSize(m_Length + length) 461 memcpy(Insert.Chars, Chars, SizeOf (StrChar) * startIndex) 462 memcpy(VarPtr(Insert.Chars[startIndex]), text, SizeOf (StrChar) * length) 463 memcpy(VarPtr(Insert.Chars[startIndex + length]), VarPtr(Chars[startIndex]), SizeOf (StrChar) * (m_Length - startIndex + 1)) 464 End Function 465 466 Const Function SubString(startIndex As Long) As String 467 Return SubString(startIndex, m_Length - startIndex) 468 End Function 469 470 Const Function SubString(startIndex As Long, length As Long) As String 471 If startIndex < 0 Or length <= 0 Then Return "" 472 If startIndex + length > m_Length Then Return "" 473 474 Dim temp As String 475 temp.AllocStringBuffer(length) 476 memcpy(temp.Chars, VarPtr(Chars[startIndex]), SizeOf (StrChar) * length) 477 temp.Chars[m_Length] = 0 478 Return temp 479 End Function 480 481 Const Function Remove(startIndex As Long) As String 482 If startIndex < 0 Or startIndex > m_Length Then 483 Debug 'ArgumentOutOfRangeException 484 End If 485 486 Remove.ReSize(startIndex) 487 memcpy(Remove.Chars, This.Chars, SizeOf (StrChar) * startIndex) 488 End Function 489 490 Const Function Remove(startIndex As Long, count As Long) As String 491 If startIndex < 0 Or count < 0 Or startIndex + count > m_Length Then 492 Debug 'ArgumentOutOfRangeException 493 End If 494 495 Remove.ReSize(m_Length - count) 496 memcpy(Remove.Chars, This.Chars, SizeOf (StrChar) * startIndex) 497 memcpy(VarPtr(Remove.Chars[startIndex]), VarPtr(This.Chars[startIndex + count]), SizeOf (StrChar) * (m_Length - startIndex - count)) 498 End Function 499 500 Static Function IsNullOrEmpty(s As String) As Boolean 501 If Not Object.ReferenceEquals(s, Nothing) Then 502 If s.m_Length > 0 Then 503 Return False 504 End If 505 End If 506 Return True 507 End Function 508 509 Const Function Replace(oldChar As StrChar, newChar As StrChar) As String 510 Replace = Copy(This) 511 With Replace 512 Dim i As Long 513 For i = 0 To ELM(.m_Length) 514 If .Chars[i] = oldChar Then 515 .Chars[i] = newChar 516 End If 517 Next 518 End With 519 End Function 520 521 Const Function Replace(ByRef oldStr As String, ByRef newStr As String) As String 522 ' If oldStr = Nothing Then Throw ArgumentNullException 523 ' 524 ' If newStr = Nothing Then 525 ' Return ReplaceCore(oldStr, oldStr.m_Length, "", 0) 526 ' Else 527 Return ReplaceCore(oldStr, oldStr.m_Length, newStr, newStr.m_Length) 528 ' End If 529 End Function 530 531 Const Function Replace(oldStr As *StrChar, newStr As *StrChar) As String 532 If oldStr = 0 Then Debug 'Throw ArgumentNullException 533 If newStr = 0 Then newStr = "" 534 Return ReplaceCore(oldStr, lstrlen(oldStr), newStr, lstrlen(newStr)) 535 End Function 536 537 Const Function Replace(oldStr As *StrChar, oldLen As Long, newStr As *StrChar, newLen As Long) As String 538 If oldStr = 0 Then Debug 'Throw ArgumentNullException 539 If newStr = 0 Then 540 newStr = "" 541 newLen = 0 542 End If 543 Return ReplaceCore(oldStr, oldLen, newStr, newLen) 544 End Function 545 546 Const Function ToLower() As String 547 ToLower.ReSize(m_Length) 548 Dim i As Long 549 For i = 0 To ELM(m_Length) 550 ToLower.Chars[i] = _System_ASCII_ToLower(Chars[i]) 551 Next 552 End Function 553 554 Const Function ToUpper() As String 555 ToUpper.ReSize(m_Length) 556 Dim i As Long 557 For i = 0 To ELM(m_Length) 558 ToUpper.Chars[i] = _System_ASCII_ToUpper(Chars[i]) 559 Next 560 End Function 561 /* 562 Sub Swap(ByRef x As String) 563 Dim tempLen As Long 564 Dim tempChars As *StrChar 565 tempLen = x.m_Length 566 tempChars = x.Chars 567 x.m_Length = This.m_Length 568 x.Chars = This.Chars 569 This.m_Length = tempLen 570 This.Chars = tempChars 571 End Sub 572 */ 573 Override Function ToString() As String 574 Return This 575 End Function 576 577 Static Function Copy(s As String) As String 578 Copy.ReSize(s.m_Length) 579 memcpy(Copy.Chars, This.Chars, SizeOf (StrChar) * m_Length) 580 End Function 581 582 Override Function GetHashCode() As Long 583 #ifdef __STRING_IS_NOT_UNICODE 584 Dim size = (m_Length + 1) >> 1 585 #else 586 Dim size = m_Length 587 #endif 588 Return _System_GetHashFromWordArray(Chars As *Word, size) 589 End Function 590 Private 591 ' メモリ確保に失敗すると元の文字列は失われない。(例外安全でいう強い保障) 592 Function AllocStringBuffer(textLength As Long) As *StrChar 593 If textLength < 0 Then 188 594 Return 0 595 ElseIf textLength > m_Length or Chars = 0 Then 596 AllocStringBuffer = _System_realloc(Chars, SizeOf(StrChar) * (textLength + 1)) 597 If AllocStringBuffer <> 0 Then 598 m_Length = textLength 599 Chars = AllocStringBuffer 600 End If 189 601 Else 190 Return -1191 End If192 ElseIf Object.ReferenceEquals(y, Nothing) Then193 Return 1194 End If195 Return _System_StrCmpN(VarPtr(x.Chars[indexX]), VarPtr(y.Chars[indexY]), length As SIZE_T)196 End Function197 198 Function CompareTo(y As String) As Long199 Return String.Compare(This, y)200 End Function201 202 Function CompareTo(y As Object) As Long203 Dim s = y As String204 ' If y is not String Then205 ' Throw New ArgumentException206 ' End If207 Return CompareTo(y)208 End Function209 210 Const Function StrPtr() As *StrChar211 Return Chars212 End Function213 214 Sub ReSize(allocLength As Long)215 If allocLength < 0 Then Exit Sub216 If allocLength > m_Length Then217 Dim oldLength As Long218 oldLength = m_Length219 If AllocStringBuffer(allocLength) <> 0 Then220 ZeroMemory(VarPtr(Chars[oldLength]), SizeOf (StrChar) * (m_Length - oldLength + 1))221 End If222 Else223 m_Length = allocLength224 Chars[m_Length] = 0225 End If226 End Sub227 228 Sub ReSize(allocLength As Long, c As StrChar)229 If allocLength < 0 Then230 Exit Sub231 ElseIf allocLength > m_Length Then232 Dim oldLength As Long233 oldLength = m_Length234 If AllocStringBuffer(allocLength) <> 0 Then235 Dim p = VarPtr(Chars[oldLength]) As *StrChar236 Dim fillLen = m_Length - oldLength237 Dim i As Long238 For i = 0 To ELM(fillLen)239 p[i] = c240 Next241 End If242 Else243 m_Length = allocLength244 End If245 Chars[m_Length] = 0246 End Sub247 248 Sub Assign(text As PCSTR, textLengthA As Long)249 #ifdef __STRING_IS_NOT_UNICODE250 AssignFromStrChar(text, textLengthA)251 #else252 Dim textLengthW = MultiByteToWideChar(CP_THREAD_ACP, 0, text, textLengthA, 0, 0)253 If AllocStringBuffer(textLengthW) <> 0 Then254 MultiByteToWideChar(CP_THREAD_ACP, 0, text, textLengthA, Chars, textLengthW)255 Chars[textLengthW] = 0256 End If257 #endif258 End Sub259 260 Sub Assign(text As PCWSTR, textLengthW As Long)261 #ifdef __STRING_IS_NOT_UNICODE262 Dim textLengthA = WideCharToMultiByte(CP_THREAD_ACP, 0, text, textLengthW, 0, 0, 0, 0)263 If AllocStringBuffer(textLengthA) <> 0 Then264 WideCharToMultiByte(CP_THREAD_ACP, 0, text, textLengthW, Chars, textLengthA, 0, 0)265 Chars[textLengthA] = 0266 End If267 #else268 AssignFromStrChar(text, textLengthW)269 #endif270 End Sub271 272 Sub Assign(ByRef objString As String)273 Assign(objString.Chars, objString.m_Length)274 End Sub275 276 Sub Assign(text As PCSTR)277 If text Then278 Assign(text, lstrlenA(text))279 Else280 If Chars <> 0 Then281 Chars[0] = 0282 End If283 m_Length = 0284 End If285 End Sub286 287 Sub Assign(text As PCWSTR)288 If text Then289 Assign(text, lstrlenW(text))290 Else291 If Chars <> 0 Then292 Chars[0] = 0293 End If294 m_Length = 0295 End If296 End Sub297 298 Sub Append(text As *StrChar, textLength As Long)299 Dim prevLen As Long300 prevLen = m_Length301 If AllocStringBuffer(m_Length + textLength) <> 0 Then302 memcpy(VarPtr(Chars[prevLen]), text, SizeOf (StrChar) * textLength)303 Chars[m_Length] = 0304 End If305 End Sub306 307 Sub Append(text As *StrChar)308 Append(text, lstrlen(text))309 End Sub310 311 Sub Append(ByRef str As String)312 Append(str.Chars, str.m_Length)313 End Sub314 315 Const Function Clone() As String316 Return This317 End Function318 Private319 Static Function ConcatStrChar(text1 As *StrChar, text1Length As Long, text2 As *StrChar, text2Length As Long) As String320 ConcatStrChar = New String()321 With ConcatStrChar322 .AllocStringBuffer(text1Length + text2Length)323 memcpy(.Chars, text1, SizeOf (StrChar) * text1Length)324 memcpy(VarPtr(.Chars[text1Length]), text2, SizeOf (StrChar) * text2Length)325 .Chars[text1Length + text2Length] = 0326 End With327 End Function328 Public329 Const Function Concat(text As PCSTR, len As Long) As String330 #ifdef __STRING_IS_NOT_UNICODE331 Return ConcatStrChar(This.Chars, m_Length, text, len)332 #else333 With Concat334 Dim lenW = MultiByteToWideChar(CP_THREAD_ACP, 0, text, len, 0, 0)335 .AllocStringBuffer(m_Length + lenW)336 memcpy(.Chars, This.Chars, m_Length)337 MultiByteToWideChar(CP_THREAD_ACP, 0, text, len, VarPtr(.Chars[m_Length]), lenW)338 .Chars[m_Length + lenW] = 0339 End With340 #endif341 End Function342 343 Const Function Concat(text As PCWSTR, len As Long) As String344 #ifdef __STRING_IS_NOT_UNICODE345 With Concat346 Dim lenA = WideCharToMultiByte(CP_THREAD_ACP, 0, text, len, 0, 0, 0, 0)347 .AllocStringBuffer(m_Length + lenA)348 memcpy(.Chars, This.Chars, m_Length)349 WideCharToMultiByte(CP_THREAD_ACP, 0, text, len, VarPtr(.Chars[m_Length]), lenA, 0, 0)350 .Chars[m_Length + lenA] = 0351 End With352 #else353 Return ConcatStrChar(This.Chars, m_Length, text, len)354 #endif355 End Function356 357 Static Function Concat(x As String, y As String) As String358 If String.IsNullOrEmpty(x) Then359 Return y360 Else361 Return x.Concat(y.Chars, y.m_Length)362 End If363 End Function364 365 Static Function Concat(x As Object, y As Object) As String366 Return String.Concat(x.ToString, y.ToString)367 End Function368 369 Const Function Contains(objString As String) As Boolean370 Return IndexOf(objString, 0, m_Length) >= 0371 End Function372 373 Const Function Contains(lpszText As *StrChar) As Boolean374 Return IndexOf(lpszText, 0, m_Length) >= 0375 End Function376 377 Const Function IndexOf(lpszText As *StrChar) As Long378 Return IndexOf(lpszText, 0, m_Length)379 End Function380 381 Const Function IndexOf(lpszText As *StrChar, startIndex As Long) As Long382 Return IndexOf(lpszText, startIndex, m_Length - startIndex)383 End Function384 385 Const Function IndexOf(lpszText As *StrChar, startIndex As Long, count As Long) As Long386 Dim length = lstrlen(lpszText)387 388 If startIndex < 0 Then Return -1389 If count < 1 Or count + startIndex > m_Length Then Return -1390 If length > m_Length Then Return -1391 392 If length = 0 Then Return startIndex393 394 Dim i As Long, j As Long395 For i = startIndex To startIndex + count - 1396 For j = 0 To length - 1397 If Chars[i + j] = lpszText[j] Then398 If j = length - 1 Then Return i399 Else400 Exit For401 End If402 Next403 Next404 Return -1405 End Function406 407 Const Function LastIndexOf(lpszText As *StrChar) As Long408 Return LastIndexOf(lpszText, m_Length - 1, m_Length)409 End Function410 411 Const Function LastIndexOf(lpszText As *StrChar, startIndex As Long) As Long412 Return LastIndexOf(lpszText As *StrChar, startIndex, startIndex + 1)413 End Function414 415 Const Function LastIndexOf(lpszText As *StrChar, startIndex As Long, count As Long) As Long416 Dim length = lstrlen(lpszText)417 418 If startIndex < 0 Or startIndex > m_Length - 1 Then Return -1419 If count < 1 Or count > startIndex + 2 Then Return -1420 If length > m_Length Then Return -1421 422 If length = 0 Then Return startIndex423 424 Dim i As Long, j As Long425 For i = startIndex To startIndex - count + 1 Step -1426 For j = length - 1 To 0 Step -1427 If Chars[i + j] = lpszText[j] Then428 If j = 0 Then Return i429 Else430 Exit For431 End If432 Next433 Next434 Return -1435 End Function436 437 Const Function StartsWith(lpszText As *StrChar) As Boolean438 Return IndexOf(lpszText) = 0439 End Function440 441 Const Function EndsWith(lpszText As *StrChar) As Boolean442 Return LastIndexOf(lpszText) = m_Length - lstrlen(lpszText)443 End Function444 445 Const Function Insert(startIndex As Long, text As String) As String446 Return Insert(startIndex, text.Chars, text.Length)447 End Function448 449 Const Function Insert(startIndex As Long, text As *StrChar) As String450 Return Insert(startIndex, text, lstrlen(text))451 End Function452 453 Const Function Insert(startIndex As Long, text As *StrChar, length As Long) As String454 If startIndex < 0 Or startIndex > m_Length Or length < 0 Then455 Debug 'ArgumentOutOfRangeException456 457 End If458 Insert.ReSize(m_Length + length)459 memcpy(Insert.Chars, Chars, SizeOf (StrChar) * startIndex)460 memcpy(VarPtr(Insert.Chars[startIndex]), text, SizeOf (StrChar) * length)461 memcpy(VarPtr(Insert.Chars[startIndex + length]), VarPtr(Chars[startIndex]), SizeOf (StrChar) * (m_Length - startIndex + 1))462 End Function463 464 Const Function SubString(startIndex As Long) As String465 Return SubString(startIndex, m_Length - startIndex)466 End Function467 468 Const Function SubString(startIndex As Long, length As Long) As String469 If startIndex < 0 Or length <= 0 Then Return ""470 If startIndex + length > m_Length Then Return ""471 472 Dim temp As String473 temp.AllocStringBuffer(length)474 memcpy(temp.Chars, VarPtr(Chars[startIndex]), SizeOf (StrChar) * length)475 temp.Chars[m_Length] = 0476 Return temp477 End Function478 479 Const Function Remove(startIndex As Long) As String480 If startIndex < 0 Or startIndex > m_Length Then481 Debug 'ArgumentOutOfRangeException482 End If483 484 Remove.ReSize(startIndex)485 memcpy(Remove.Chars, This.Chars, SizeOf (StrChar) * startIndex)486 End Function487 488 Const Function Remove(startIndex As Long, count As Long) As String489 If startIndex < 0 Or count < 0 Or startIndex + count > m_Length Then490 Debug 'ArgumentOutOfRangeException491 End If492 493 Remove.ReSize(m_Length - count)494 memcpy(Remove.Chars, This.Chars, SizeOf (StrChar) * startIndex)495 memcpy(VarPtr(Remove.Chars[startIndex]), VarPtr(This.Chars[startIndex + count]), SizeOf (StrChar) * (m_Length - startIndex - count))496 End Function497 498 Static Function IsNullOrEmpty(s As String) As Boolean499 If Not Object.ReferenceEquals(s, Nothing) Then500 If s.m_Length > 0 Then501 Return False502 End If503 End If504 Return True505 End Function506 507 Const Function Replace(oldChar As StrChar, newChar As StrChar) As String508 Replace = Copy(This)509 With Replace510 Dim i As Long511 For i = 0 To ELM(.m_Length)512 If .Chars[i] = oldChar Then513 .Chars[i] = newChar514 End If515 Next516 End With517 End Function518 519 Const Function Replace(ByRef oldStr As String, ByRef newStr As String) As String520 ' If oldStr = Nothing Then Throw ArgumentNullException521 '522 ' If newStr = Nothing Then523 ' Return ReplaceCore(oldStr, oldStr.m_Length, "", 0)524 ' Else525 Return ReplaceCore(oldStr, oldStr.m_Length, newStr, newStr.m_Length)526 ' End If527 End Function528 529 Const Function Replace(oldStr As *StrChar, newStr As *StrChar) As String530 If oldStr = 0 Then Debug 'Throw ArgumentNullException531 If newStr = 0 Then newStr = ""532 Return ReplaceCore(oldStr, lstrlen(oldStr), newStr, lstrlen(newStr))533 End Function534 535 Const Function Replace(oldStr As *StrChar, oldLen As Long, newStr As *StrChar, newLen As Long) As String536 If oldStr = 0 Then Debug 'Throw ArgumentNullException537 If newStr = 0 Then538 newStr = ""539 newLen = 0540 End If541 Return ReplaceCore(oldStr, oldLen, newStr, newLen)542 End Function543 544 Const Function ToLower() As String545 ToLower.ReSize(m_Length)546 Dim i As Long547 For i = 0 To ELM(m_Length)548 ToLower.Chars[i] = _System_ASCII_ToLower(Chars[i])549 Next550 End Function551 552 Const Function ToUpper() As String553 ToUpper.ReSize(m_Length)554 Dim i As Long555 For i = 0 To ELM(m_Length)556 ToUpper.Chars[i] = _System_ASCII_ToUpper(Chars[i])557 Next558 End Function559 /*560 Sub Swap(ByRef x As String)561 Dim tempLen As Long562 Dim tempChars As *StrChar563 tempLen = x.m_Length564 tempChars = x.Chars565 x.m_Length = This.m_Length566 x.Chars = This.Chars567 This.m_Length = tempLen568 This.Chars = tempChars569 End Sub570 */571 Override Function ToString() As String572 Return This573 End Function574 575 Static Function Copy(s As String) As String576 Copy.ReSize(s.m_Length)577 memcpy(Copy.Chars, This.Chars, SizeOf (StrChar) * m_Length)578 End Function579 580 Override Function GetHashCode() As Long581 #ifdef __STRING_IS_NOT_UNICODE582 Dim size = (m_Length + 1) >> 1583 #else584 Dim size = m_Length585 #endif586 Return _System_GetHashFromWordArray(Chars As *Word, size)587 End Function588 Private589 ' メモリ確保に失敗すると元の文字列は失われない。(例外安全でいう強い保障)590 Function AllocStringBuffer(textLength As Long) As *StrChar591 If textLength < 0 Then592 Return 0593 ElseIf textLength > m_Length or Chars = 0 Then594 AllocStringBuffer = _System_realloc(Chars, SizeOf(StrChar) * (textLength + 1))595 If AllocStringBuffer <> 0 Then596 602 m_Length = textLength 597 Chars = AllocStringBuffer 598 End If 599 Else 600 m_Length = textLength 601 AllocStringBuffer = Chars 602 End If 603 End Function 604 605 Function ReplaceCore(oldStr As *StrChar, oldLen As Long, newStr As *StrChar, newLen As Long) As String 606 If oldLen = 0 Then 607 Debug 'Throw ArgumentException 608 End If 609 Dim tmp As String 610 With tmp 611 Dim current = 0 As Long 612 Do 613 Dim pos = IndexOf(oldStr, current) 614 If pos = -1 Then 615 Exit Do 616 End If 617 .Append(VarPtr(Chars[current]), pos - current) 618 .Append(newStr, newLen) 619 current = pos + oldLen 620 Loop 621 .Append(VarPtr(Chars[current]), m_Length - current) 622 End With 623 Return tmp 624 End Function 625 626 Sub AssignFromStrChar(text As *StrChar, textLength As Long) 627 If text = Chars Then Exit Sub 628 If AllocStringBuffer(textLength) <> 0 Then 629 memcpy(Chars, text, SizeOf (StrChar) * textLength) 630 Chars[m_Length] = 0 631 End If 632 End Sub 633 End Class 603 AllocStringBuffer = Chars 604 End If 605 End Function 606 607 Function ReplaceCore(oldStr As *StrChar, oldLen As Long, newStr As *StrChar, newLen As Long) As String 608 If oldLen = 0 Then 609 Debug 'Throw ArgumentException 610 End If 611 Dim tmp As String 612 With tmp 613 Dim current = 0 As Long 614 Do 615 Dim pos = IndexOf(oldStr, current) 616 If pos = -1 Then 617 Exit Do 618 End If 619 .Append(VarPtr(Chars[current]), pos - current) 620 .Append(newStr, newLen) 621 current = pos + oldLen 622 Loop 623 .Append(VarPtr(Chars[current]), m_Length - current) 624 End With 625 Return tmp 626 End Function 627 628 Sub AssignFromStrChar(text As *StrChar, textLength As Long) 629 If text = Chars Then Exit Sub 630 If AllocStringBuffer(textLength) <> 0 Then 631 memcpy(Chars, text, SizeOf (StrChar) * textLength) 632 Chars[m_Length] = 0 633 End If 634 End Sub 635 End Class 636 637 End Namespace -
TestCase/SimpleTestCase/SimpleTestCase.idx
r230 r246 7 7 'プロジェクト内のプログラム ファイル 8 8 #include "ObjectTest.ab" 9 _ClearNamespaceImported 9 10 #include "StringTest.ab" 11 _ClearNamespaceImported 10 12 #include "GCHandleTest.ab" 13 _ClearNamespaceImported
Note:
See TracChangeset
for help on using the changeset viewer.