source: Include/basic/command.sbp@ 251

Last change on this file since 251 was 251, checked in by dai, 17 years ago

INPUT#ステートメントにおいて、内部バッファのサイズが1バイト分足りないバグを修正。
Val関数で指数部分が読み取れないバグを修正。
sscanf関数(Cランタイム)の定義文を追加。

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