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
RevLine 
[1]1'command.sbp
2
3
4#ifndef _INC_COMMAND
5#define _INC_COMMAND
6
[142]7#require <windows.sbp>
8#require <Classes/System/Environment.ab>
[1]9
[119]10Const _System_Type_SByte = 1
[89]11Const _System_Type_Byte = 2
[1]12Const _System_Type_Integer = 3
[89]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
[1]18Const _System_Type_Single = 9
19Const _System_Type_Double = 10
[119]20Const _System_Type_Char = 11
21Const _System_Type_String = 13
22Const _System_Type_VoidPtr = 14
[1]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
[179]35Sub _System_End()
[175]36 Dim exitCode = Environment.ExitCode
[165]37 _System_EndProgram()
[175]38 ExitProcess(exitCode)
[179]39End Sub
40
41Macro END()
42 _System_End()
[1]43End Macro
44
[142]45Macro EXEC(filePath As String)(cmdLine As String)
46 ShellExecute(0, "open", ToTCStr(filePath), ToTCStr(cmdLine), 0, SW_SHOWNORMAL)
[1]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
[142]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)
[1]75 If VarPtr(retAns) Then
[237]76 retAns = _System_MessageBox(hwnd, ToSCStr(str), ToSCStr(title), boxType)
[1]77 Else
[237]78 _System_MessageBox(hwnd, ToSCStr(str), ToSCStr(title), boxType)
[1]79 End If
80End Macro
81
[142]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
[1]86 End If
87End Macro
88
89Macro DELWND(hWnd As HWND)
90 DestroyWindow(hWnd)
91End Macro
92
[142]93Macro INSMENU(hMenu As HMENU, PosID As Long, flag As Long)(str As String, id As Long, hSubMenu As HMENU, state As Long)
[1]94 Dim mii As MENUITEMINFO
[123]95 ZeroMemory(VarPtr(mii), Len(mii))
96 With mii
97 .cbSize = Len(mii)
98 .fMask = MIIM_TYPE
[1]99
[173]100 If str.Length = 0 Then
[123]101 mii.fType = MFT_SEPARATOR
102 Else
103 .fType = MFT_STRING
104 .fMask = .fMask or MIIM_STATE or MIIM_ID
[142]105 .dwTypeData = ToTCStr(str)
[123]106 .wID = id
107 If hSubMenu Then
108 .fMask = .fMask or MIIM_SUBMENU
109 .hSubMenu = hSubMenu
110 End If
[142]111 .fState = state
[1]112 End If
[123]113 End With
114 InsertMenuItem(hMenu, PosID, flag, mii)
[1]115End Macro
116
117
118'--------------
119' ファイル関連
120'--------------
121
[90]122Dim _System_hFile(255) As HANDLE
[142]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
[1]127
[90]128 FileNumber--
[1]129
130 Select Case AccessFor
131 Case 0
[142]132 access = GENERIC_READ or GENERIC_WRITE
133 creationDisposition = OPEN_ALWAYS
[1]134 Case 1
[142]135 access = GENERIC_READ
136 creationDisposition = OPEN_EXISTING
[1]137 Case 2
[142]138 access = GENERIC_WRITE
139 creationDisposition = CREATE_ALWAYS
[1]140 Case 3
[142]141 access = GENERIC_WRITE
142 creationDisposition = OPEN_ALWAYS
143 bAppend = True
[1]144 End Select
145
[142]146 _System_hFile(FileNumber) = CreateFile(ToTCStr(fileName), access, 0, ByVal 0, creationDisposition, FILE_ATTRIBUTE_NORMAL, 0)
[1]147
[142]148 If bAppend Then SetFilePointer(_System_hFile(FileNumber), 0, 0, FILE_END)
[1]149End Macro
[90]150
[1]151Macro CLOSE()(FileNumber As Long)
[90]152 FileNumber--
[1]153
154 If _System_hFile(FileNumber) Then
[21]155 CloseHandle(_System_hFile(FileNumber))
156 _System_hFile(FileNumber)=0
[1]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)
[21]164 Dim i As Long ,i2 As Long, i3 As Long
[1]165 Dim buffer As String
[142]166 Dim temp[1] As StrChar
[1]167 Dim dwAccessBytes As DWord
168 Dim IsStr As Long
169
[90]170 FileNumber--
[1]171
[251]172 buffer=ZeroString(GetFileSize(_System_hFile[FileNumber],0) + 1)
[1]173
174 i=0
175 While 1
176 '次のデータをサーチ
177 Do
[142]178 i2=ReadFile(_System_hFile[FileNumber],temp,SizeOf (StrChar),VarPtr(dwAccessBytes),ByVal 0)
[1]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
[90]190 i3++
[1]191
[142]192 i2=ReadFile(_System_hFile[FileNumber],temp,SizeOf (StrChar),VarPtr(dwAccessBytes),ByVal 0)
[1]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
[142]202 ReadFile(_System_hFile[FileNumber],temp,SizeOf (StrChar),VarPtr(dwAccessBytes),ByVal 0)
[1]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
[21]214 If Not(temp[0]=32 or temp[0]=9) Then
[1]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 'データを変数に格納
[121]227 _System_Input_SetArgument(_System_InputDataPtr[i], _System_InputDataType[i], buffer, i3)
[1]228
[21]229
[121]230 i++
[1]231 If _System_InputDataPtr[i]=0 Then Exit While
232 Wend
233End Sub
234
[123]235Sub _System_Input_SetArgument(arg As VoidPtr, dataType As DWord, ByRef buf As String, bufLen As Long)
[121]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)
[142]255 memcpy(pTempStr->Chars, buf.Chars, SizeOf (StrChar) * pTempStr->Length)
[121]256 pTempStr->Chars[pTempStr->Length] = 0
257 End Select
[123]258End Sub
[121]259
[1]260Sub PRINT_ToFile(FileNumber As Long, buf As String)
261 Dim dwAccessByte As DWord
[123]262 FileNumber--
[1]263
[142]264 WriteFile(_System_hFile(FileNumber), buf, Len(buf), VarPtr(dwAccessByte), ByVal 0)
[1]265End Sub
266
267Dim _System_UsingDblData[_System_MAX_PARMSNUM] As Double
[214]268Dim _System_UsingStrData[_System_MAX_PARMSNUM] As *Char 'TODO: 暫定対応(動作未確認)
[1]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
[142]272 Dim temporary[255] As StrChar
[1]273 Dim buffer As String
274
[142]275 buffer = ZeroString(1024)
[1]276
[142]277 ParmNum = 0
278 i2 = 0
[1]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
[90]284 i2++
285 i3++
[1]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
[142]292 Dim temp2 As *StrChar
[1]293
294 Dim length_num As Long, length_buf As Long
[21]295 Dim dblRoundOff=0 As Double
[1]296
297
298 '----------------------
299 ' 四捨五入を考慮
300 '----------------------
301
302 i4=i2
303 While UsingStr[i4]=Asc("#")
[90]304 i4++
[1]305 Wend
306 If UsingStr[i4]=Asc(".") Then
[90]307 i4++
[1]308
309 dblRoundOff=0.5
310 While UsingStr[i4]=Asc("#")
[90]311 i4++
312 dblRoundOff /= 10
[1]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 '符号が有る場合は、一文字分のスペースを考慮する
[90]325 If sign Then length_num++
[1]326
327 length_buf=0
328 Do
[90]329 i2++
330 length_buf++
[1]331 Loop While UsingStr[i2]=Asc("#")
332
333 If length_buf>=length_num Then
334 '通常時
[237]335 _System_FillChar(VarPtr(buffer.Chars[i3]), length_buf - length_num, &h20) 'Asc(" ")
[123]336
[90]337 i3 += length_buf - length_num
[1]338
339 If sign Then
[123]340 buffer[i3] = Asc("-")
[90]341 i3++
[1]342
[90]343 length_num--
[1]344 End If
345
[123]346 If dec > 0 Then
[237]347 memcpy(VarPtr(buffer.Chars[i3]), temp2, SizeOf (StrChar) * length_num)
[1]348 Else
[123]349 buffer[i3] = &H30
[1]350 End If
351
[90]352 i3 += length_num
[1]353 Else
354 '表示桁が足りないとき
[237]355 _System_FillChar(VarPtr(buffer.Chars[i3]), length_buf, &h23) 'Asc("#")
[90]356 i3 += length_buf
[1]357 End If
358
[123]359 If UsingStr[i2] = Asc(".") Then
360 buffer[i3] = UsingStr[i2]
[90]361 i2++
362 i3++
[1]363
364 i4=dec
[123]365 While UsingStr[i2] = Asc("#")
[1]366 If i4<0 Then
367 buffer[i3]=&H30
368 Else
369 buffer[i3]=temp2[i4]
370 End If
[90]371 i3++
372 i4++
[1]373
[90]374 i2++
[1]375 Wend
376 End If
377 ElseIf UsingStr[i2]=Asc("@") Then
[90]378 i2++
[1]379
[237]380 lstrcat(VarPtr(buffer.Chars[i3]), _System_UsingStrData[ParmNum])
[123]381 i3 += lstrlen(_System_UsingStrData[ParmNum])
[1]382 ElseIf UsingStr[i2]=Asc("&") Then
383 i4=0
384 Do
[90]385 i4++
386 i2++
[1]387 Loop While UsingStr[i2]=Asc(" ")
388
389 If UsingStr[i2]=Asc("&") Then
[90]390 i4++
391 i2++
[1]392 i5=lstrlen(_System_UsingStrData[ParmNum])
393 If i4<=i5 Then
394 i5=i4
395 Else
[237]396 _System_FillChar(VarPtr(buffer.Chars[i3]), i4, &h20) 'Asc(" ")
[1]397 End If
[237]398 memcpy(VarPtr(buffer.Chars[i3]), _System_UsingStrData[ParmNum], SizeOf (StrChar) * i5)
[90]399 i3 += i4
[1]400 Else
[90]401 i2 -= i4
[123]402 buffer[i3] = Asc("&")
[90]403 i2++
404 i3++
[1]405 Continue
406 End If
407 End If
408
[90]409 ParmNum++
[1]410 Wend
411
[123]412 _System_GetUsingFormat = Left$(buffer, lstrlen(buffer))
[1]413End Function
414Sub PRINTUSING_ToFile(FileNumber As Long, UsingStr As String)
415 Dim dwAccessByte As DWord
416 Dim buf As String
417
[90]418 FileNumber--
[1]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)
[90]426 FileNumber--
[1]427
428 _System_FieldSize(FileNumber)=FieldSize
429End Macro
430Macro GET(FileNumber As Long, RecodeNumber As Long, ByRef lpBuffer As String)
[237]431 Dim dwAccessByte As DWord
[1]432
[90]433 FileNumber--
434 RecodeNumber--
[1]435
[142]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)
[1]439 If Not dwAccessByte=_System_FieldSize(FileNumber) Then
[142]440 lpBuffer = Left$(lpBuffer, dwAccessByte)
[1]441 End If
442End Macro
443Macro PUT(FileNumber As Long, RecodeNumber As Long, ByRef lpBuffer As String)
[237]444 Dim dwAccessByte As DWord
[1]445
[90]446 FileNumber--
447 RecodeNumber--
[1]448
[142]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)
[1]451End Macro
452
[21]453Macro CHDIR(path As String)
[142]454 SetCurrentDirectory(ToTCStr(path))
[1]455End Macro
[21]456Macro MKDIR(path As String)
[142]457 CreateDirectory(ToTCStr(path), 0)
[1]458End Macro
[21]459Macro KILL(path As String)
[142]460 DeleteFile(ToTCStr(path))
[1]461End Macro
462
463
464#endif '_INC_COMMAND
Note: See TracBrowser for help on using the repository browser.