source: trunk/Include/basic/command.sbp@ 478

Last change on this file since 478 was 478, checked in by イグトランス (egtra), 16 years ago

現在向けに修正(参照型のポインタの排除など)

File size: 11.4 KB
Line 
1'command.sbp
2
3
4#ifndef _INC_COMMAND
5#define _INC_COMMAND
6
7Const _System_Type_SByte = 1
8Const _System_Type_Byte = 2
9Const _System_Type_Integer = 3
10Const _System_Type_Word = 4
11Const _System_Type_Long = 5
12Const _System_Type_DWord = 6
13Const _System_Type_Int64 = 7
14Const _System_Type_QWord = 8
15Const _System_Type_Single = 9
16Const _System_Type_Double = 10
17Const _System_Type_Char = 11
18Const _System_Type_String = 13
19Const _System_Type_VoidPtr = 14
20Const _System_MAX_PARMSNUM = 32-1
21
22Dim _System_DummyStr As String
23Dim _System_DummyStr2 As String
24
25Macro BEEP()
26 MessageBeep(MB_OK)
27End Macro
28
29Sub _System_Call_Destructor_of_GlobalObject() 'dummy
30End Sub
31
32Sub _System_End()
33 System.Detail.hasShutdownStarted = True
34 Dim exitCode = System.Environment.ExitCode
35 _System_EndProgram()
36 ExitProcess(exitCode)
37End Sub
38
39Macro END()
40 _System_End()
41End Macro
42
43Macro EXEC(filePath As String)(cmdLine As String)
44 ShellExecute(0, "open", ToTCStr(filePath), ToTCStr(cmdLine), 0, SW_SHOWNORMAL)
45End Macro
46
47Macro INPUT() 'dummy(INPUT_FromFile、INPUT_FromPromptを参照)
48End Macro
49
50Macro PRINT() 'dummy(PRINT_ToFile、PRINT_ToPromptを参照)
51End Macro
52
53Macro RANDOMIZE()
54 srand(GetTickCount())
55End Macro
56
57Macro WRITE() 'dummy(PRINT_ToFile、PRINT_ToPromptを参照)
58End Macro
59
60'----------------
61' ウィンドウ関連
62'----------------
63
64Macro MSGBOX(hwnd As HWND, str As String)(title As String, boxType As DWord, ByRef retAns As DWord)
65' Dim ret = MessageBox(hwnd, ToTCStr(str), ToTCStr(title), boxType)
66' If VarPtr(retAns) Then
67' retAns = ret
68' End If
69End Macro
70
71Macro WINDOW(ByRef hwndRet As HWND, hOwner As HWND, x As Long, y As Long, width As Long, height As Long, title As String, dwStyle As DWord)(className As String, id As HMENU, lpFunc As DWord, dwExStyle As DWord)
72 Dim hwnd = CreateWindowEx(dwExStyle, ToTCStr(className), ToTCStr(title), dwStyle, x, y, width, height, hOwner, id, GetModuleHandle(0), 0)
73 If VarPtr(hwndRet) Then
74 hwndRet = hwnd
75 End If
76End Macro
77
78Macro DELWND(hWnd As HWND)
79 DestroyWindow(hWnd)
80End Macro
81
82Macro INSMENU(hMenu As HMENU, PosID As Long, flag As Long)(str As String, id As Long, hSubMenu As HMENU, state As Long)
83 Dim mii As MENUITEMINFO
84 ZeroMemory(VarPtr(mii), Len(mii))
85 With mii
86 .cbSize = Len(mii)
87 .fMask = MIIM_TYPE
88
89 If str.Length = 0 Then
90 mii.fType = MFT_SEPARATOR
91 Else
92 .fType = MFT_STRING
93 .fMask = .fMask or MIIM_STATE or MIIM_ID
94 .dwTypeData = ToTCStr(str)
95 .wID = id
96 If hSubMenu Then
97 .fMask = .fMask or MIIM_SUBMENU
98 .hSubMenu = hSubMenu
99 End If
100 .fState = state
101 End If
102 End With
103 InsertMenuItem(hMenu, PosID, flag, mii)
104End Macro
105
106
107'--------------
108' ファイル関連
109'--------------
110
111Dim _System_hFile(255) As HANDLE
112Macro OPEN(fileName As String, AccessFor As Long, FileNumber As Long)
113 Dim access As Long
114 Dim bAppend = False As Boolean
115 Dim creationDisposition As Long
116
117 FileNumber--
118
119 Select Case AccessFor
120 Case 0
121 access = GENERIC_READ or GENERIC_WRITE
122 creationDisposition = OPEN_ALWAYS
123 Case 1
124 access = GENERIC_READ
125 creationDisposition = OPEN_EXISTING
126 Case 2
127 access = GENERIC_WRITE
128 creationDisposition = CREATE_ALWAYS
129 Case 3
130 access = GENERIC_WRITE
131 creationDisposition = OPEN_ALWAYS
132 bAppend = True
133 End Select
134
135 _System_hFile(FileNumber) = CreateFile(ToTCStr(fileName), access, 0, ByVal 0, creationDisposition, FILE_ATTRIBUTE_NORMAL, 0)
136
137 If bAppend Then SetFilePointer(_System_hFile(FileNumber), 0, 0, FILE_END)
138End Macro
139
140Macro CLOSE()(FileNumber As Long)
141 FileNumber--
142
143 If _System_hFile(FileNumber) Then
144 CloseHandle(_System_hFile(FileNumber))
145 _System_hFile(FileNumber)=0
146 End If
147End Macro
148
149'INPUT Command Data
150Dim _System_InputDataPtr[_System_MAX_PARMSNUM] As VoidPtr
151Dim _System_InputDataType[_System_MAX_PARMSNUM] As DWord
152Sub INPUT_FromFile(FileNumber As Long)
153 FileNumber--
154
155 Dim i = 0 As Long
156 Dim buffer = New System.Text.StringBuilder(256)
157 Dim temp[1] As StrChar
158 Dim dwAccessBytes As DWord
159 Dim IsStr As Long
160
161 While 1
162 '次のデータをサーチ
163 Do
164 Dim ret = ReadFile(_System_hFile[FileNumber],temp,SizeOf (StrChar),VarPtr(dwAccessBytes),ByVal 0)
165 If ret=0 or dwAccessBytes=0 Then
166 'error
167 Exit Macro
168 End If
169 Loop While temp[0]=32 or temp[0]=9
170 SetFilePointer(_System_hFile[FileNumber],-1,0,FILE_CURRENT)
171
172 '読み込み
173 IsStr=0
174 While 1
175 Dim ret = ReadFile(_System_hFile[FileNumber],temp,SizeOf (StrChar),VarPtr(dwAccessBytes),ByVal 0)
176 If ret = 0 or dwAccessBytes = 0 Then
177 'error
178 Exit Macro
179 End If
180 If temp[0]=34 Then IsStr=IsStr xor 1
181
182 buffer.Append(temp[0])
183 If dwAccessBytes=0 or temp[0]=0 or temp[0]=13 or temp[0]=10 or (IsStr=0 and temp[0]=Asc(",")) or (IsStr=0 and (temp[0]=32 or temp[0]=9) and _System_InputDataType[i]<>_System_Type_String) Then
184 If temp[0]=13 Then
185 ReadFile(_System_hFile[FileNumber],temp,SizeOf (StrChar),VarPtr(dwAccessBytes),ByVal 0)
186 If Not(dwAccessBytes<>0 And temp[0]=10) Then
187 SetFilePointer(_System_hFile[FileNumber],-1,0,FILE_CURRENT)
188 Continue
189 End If
190 End If
191
192 If temp[0]=32 or temp[0]=9 Then
193 While 1
194 ReadFile(_System_hFile[FileNumber],temp,1,VarPtr(dwAccessBytes),ByVal 0)
195 If dwAccessBytes=0 Then Exit While
196 If temp[0]=Asc(",") Then Exit While
197 If Not(temp[0]=32 or temp[0]=9) Then
198 SetFilePointer(_System_hFile[FileNumber],-1,0,FILE_CURRENT)
199 Exit While
200 End If
201 Wend
202 End If
203
204 buffer.Append(0 As StrChar)
205 Exit While
206 End If
207 Wend
208
209 'データを変数に格納
210 _System_Input_SetArgument(_System_InputDataPtr[i], _System_InputDataType[i], buffer.ToString)
211
212
213 i++
214 If _System_InputDataPtr[i]=0 Then Exit While
215 Wend
216End Sub
217
218Sub _System_Input_SetArgument(arg As VoidPtr, dataType As DWord, buf As String)
219 Select Case dataType
220 Case _System_Type_Double
221 SetDouble(arg, Val(buf))
222 Case _System_Type_Single
223 SetSingle(arg, Val(buf))
224 Case _System_Type_Int64,_System_Type_QWord
225 SetQWord(arg, Val(buf))
226 Case _System_Type_Long,_System_Type_DWord
227 SetDWord(arg, Val(buf))
228 Case _System_Type_Integer,_System_Type_Word
229 SetWord(arg, Val(buf))
230 Case _System_Type_SByte,_System_Type_Byte
231 SetByte(arg, Val(buf))
232 Case _System_Type_Char
233 SetChar(arg, buf[0])
234 Case _System_Type_String
235 Dim pTempStr As *String
236 pTempStr = arg As *String
237 pTempStr[0] = buf
238 End Select
239End Sub
240
241Sub PRINT_ToFile(FileNumber As Long, buf As String)
242 Dim dwAccessByte As DWord
243 FileNumber--
244
245 WriteFile(_System_hFile(FileNumber), StrPtr(buf), Len(buf), VarPtr(dwAccessByte), ByVal 0)
246End Sub
247
248Dim _System_UsingDblData[_System_MAX_PARMSNUM] As Double
249Dim _System_UsingStrData[_System_MAX_PARMSNUM] As *Char 'TODO: 暫定対応(動作未確認)
250Dim _System_UsingDataType[_System_MAX_PARMSNUM] As DWord
251/*
252Function _System_GetUsingFormat(UsingStr As String) As String
253 Dim i2 As Long, i3 As Long, i4 As Long, i5 As Long, ParmNum As Long
254 Dim temporary[255] As StrChar
255 Dim buffer = New System.Text.StringBuilder(1024)
256
257 ParmNum = 0
258 i2 = 0
259 While 1
260 While 1
261 If UsingStr[i2]=Asc("#") or UsingStr[i2]=Asc("@") or UsingStr[i2]=Asc("&") Then Exit While
262 buffer[i3]=UsingStr[i2]
263 If UsingStr[i2]=0 Then Exit While
264 i2++
265 i3++
266 Wend
267
268 If UsingStr[i2]=0 Then Exit While
269
270 If UsingStr[i2]=Asc("#") Then
271 Dim dec As Long, sign As Long
272 Dim temp2 As *StrChar
273
274 Dim length_num As Long, length_buf As Long
275 Dim dblRoundOff=0 As Double
276
277
278 '----------------------
279 ' 四捨五入を考慮
280 '----------------------
281
282 i4=i2
283 While UsingStr[i4]=Asc("#")
284 i4++
285 Wend
286 If UsingStr[i4]=Asc(".") Then
287 i4++
288
289 dblRoundOff=0.5
290 While UsingStr[i4]=Asc("#")
291 i4++
292 dblRoundOff /= 10
293 Wend
294 End If
295
296
297 '浮動小数点を文字列に変換
298 temp2=_ecvt(_System_UsingDblData[ParmNum]+dblRoundOff,15,dec,sign)
299
300 '整数部
301 length_num=dec
302 If length_num<=0 Then length_num=1
303
304 '符号が有る場合は、一文字分のスペースを考慮する
305 If sign Then length_num++
306
307 length_buf=0
308 Do
309 i2++
310 length_buf++
311 Loop While UsingStr[i2]=Asc("#")
312
313 If length_buf>=length_num Then
314 '通常時
315 ActiveBasic.Strings.Detail.ChrFill(VarPtr(buffer.Chars[i3]), length_buf - length_num, &h20) 'Asc(" ")
316
317 i3 += length_buf - length_num
318
319 If sign Then
320 buffer[i3] = Asc("-")
321 i3++
322
323 length_num--
324 End If
325
326 If dec > 0 Then
327 memcpy(VarPtr(buffer.Chars[i3]), temp2, SizeOf (StrChar) * length_num)
328 Else
329 buffer[i3] = &H30
330 End If
331
332 i3 += length_num
333 Else
334 '表示桁が足りないとき
335 ActiveBasic.Strings.Detail.ChrFill(VarPtr(buffer.Chars[i3]), length_buf, &h23) 'Asc("#")
336 i3 += length_buf
337 End If
338
339 If UsingStr[i2] = Asc(".") Then
340 buffer[i3] = UsingStr[i2]
341 i2++
342 i3++
343
344 i4=dec
345 While UsingStr[i2] = Asc("#")
346 If i4<0 Then
347 buffer[i3]=&H30
348 Else
349 buffer[i3]=temp2[i4]
350 End If
351 i3++
352 i4++
353
354 i2++
355 Wend
356 End If
357 ElseIf UsingStr[i2]=Asc("@") Then
358 i2++
359
360 lstrcat(VarPtr(buffer.Chars[i3]), _System_UsingStrData[ParmNum])
361 i3 += lstrlen(_System_UsingStrData[ParmNum])
362 ElseIf UsingStr[i2]=Asc("&") Then
363 i4=0
364 Do
365 i4++
366 i2++
367 Loop While UsingStr[i2]=Asc(" ")
368
369 If UsingStr[i2]=Asc("&") Then
370 i4++
371 i2++
372 i5=lstrlen(_System_UsingStrData[ParmNum])
373 If i4<=i5 Then
374 i5=i4
375 Else
376 ActiveBasic.Strings.Detail.ChrFill(VarPtr(buffer.Chars[i3]), i4, &h20) 'Asc(" ")
377 End If
378 memcpy(VarPtr(buffer.Chars[i3]), _System_UsingStrData[ParmNum], SizeOf (StrChar) * i5)
379 i3 += i4
380 Else
381 i2 -= i4
382 buffer[i3] = Asc("&")
383 i2++
384 i3++
385 Continue
386 End If
387 End If
388
389 ParmNum++
390 Wend
391
392 _System_GetUsingFormat = buffer.ToString(0, lstrlen(StrBPtr(buffer)))
393End Function
394
395' TODO: _System_GetUsingFormatを用意して実装する
396Sub PRINTUSING_ToFile(FileNumber As Long, UsingStr As String)
397 Dim dwAccessByte As DWord
398 Dim buf As String
399
400 FileNumber--
401 buf=_System_GetUsingFormat(UsingStr)
402
403 WriteFile(_System_hFile(FileNumber),buf,Len(buf),VarPtr(dwAccessByte),ByVal NULL)
404End Sub
405*/
406
407Dim _System_FieldSize(255) As Long
408Macro FIELD(FileNumber As Long, FieldSize As Long)
409 FileNumber--
410 _System_FieldSize(FileNumber)=FieldSize
411End Macro
412Macro GET(FileNumber As Long, RecodeNumber As Long, ByRef buffer As String)
413 Dim dwAccessByte As DWord
414
415 FileNumber--
416 RecodeNumber--
417
418 SetFilePointer(_System_hFile(FileNumber), SizeOf (StrChar) * RecodeNumber * _System_FieldSize(FileNumber), 0, FILE_BEGIN)
419 Dim t = ZeroString(_System_FieldSize(FileNumber))
420 ReadFile(_System_hFile(FileNumber), StrPtr(t), SizeOf (StrChar) * _System_FieldSize(FileNumber), VarPtr(dwAccessByte), ByVal 0)
421 If dwAccessByte = _System_FieldSize(FileNumber) Then
422 buffer = t.ToString
423 Else
424 buffer = Left$(t.ToString, dwAccessByte)
425 End If
426End Macro
427Macro PUT(FileNumber As Long, RecodeNumber As Long, buffer As String)
428 Dim dwAccessByte As DWord
429
430 FileNumber--
431 RecodeNumber--
432
433 SetFilePointer(_System_hFile(FileNumber), SizeOf (StrChar) * RecodeNumber*_System_FieldSize(FileNumber), 0, FILE_BEGIN)
434 WriteFile(_System_hFile(FileNumber), StrPtr(buffer), SizeOf (StrChar) * _System_FieldSize(FileNumber), VarPtr(dwAccessByte), ByVal 0)
435End Macro
436
437Macro CHDIR(path As String)
438 SetCurrentDirectory(ToTCStr(path))
439End Macro
440Macro MKDIR(path As String)
441 CreateDirectory(ToTCStr(path), 0)
442End Macro
443Macro KILL(path As String)
444 DeleteFile(ToTCStr(path))
445End Macro
446
447
448#endif '_INC_COMMAND
Note: See TracBrowser for help on using the repository browser.