source: Include/basic/command.sbp@ 179

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

_SystemEnd関数を追加(コンパイラが内部的に使います)。
WCHAR、Charをbasic.sbpで定義した。
LONGLONG、LONG、DWORD、WORD、BYTEなどのTypeDefを有効にした(#92に関連する変更)。
その他タイプミスを修正。

File size: 11.9 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
[142]76 retAns = _System_MessageBox(hwnd, str, title, boxType)
[1]77 Else
[142]78 _System_MessageBox(hwnd, str, 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
172 buffer=ZeroString(GetFileSize(_System_hFile[FileNumber],0))
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
268Dim _System_UsingStrData[_System_MAX_PARMSNUM] As String
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 '通常時
[123]335 _System_FillChar(VarPtr(buffer[i3]), length_buf - length_num, &h20) 'Asc(" ")
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
[142]347 memcpy(VarPtr(buffer[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 '表示桁が足りないとき
[123]355 _System_FillChar(VarPtr(buffer[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
[123]380 'lstrcat(StrPtr(buffer)+i3,_System_UsingStrData[ParmNum])
381 memcpy(VarPtr(buffer[i3 + lstrlen(VarPtr(buffer[i3]))]), _System_UsingStrData[ParmNum], _
[142]382 SizeOf (StrChar) * lstrlen(_System_UsingStrData[ParmNum]))
[123]383 i3 += lstrlen(_System_UsingStrData[ParmNum])
[1]384 ElseIf UsingStr[i2]=Asc("&") Then
385 i4=0
386 Do
[90]387 i4++
388 i2++
[1]389 Loop While UsingStr[i2]=Asc(" ")
390
391 If UsingStr[i2]=Asc("&") Then
[90]392 i4++
393 i2++
[1]394 i5=lstrlen(_System_UsingStrData[ParmNum])
395 If i4<=i5 Then
396 i5=i4
397 Else
[123]398 _System_FillChar(VarPtr(buffer[i3]), i4, &h20) 'Asc(" ")
[1]399 End If
[142]400 memcpy(VarPtr(buffer[i3]), _System_UsingStrData[ParmNum], SizeOf (StrChar) * i5)
[90]401 i3 += i4
[1]402 Else
[90]403 i2 -= i4
[123]404 buffer[i3] = Asc("&")
[90]405 i2++
406 i3++
[1]407 Continue
408 End If
409 End If
410
[90]411 ParmNum++
[1]412 Wend
413
[123]414 _System_GetUsingFormat = Left$(buffer, lstrlen(buffer))
[1]415End Function
416Sub PRINTUSING_ToFile(FileNumber As Long, UsingStr As String)
417 Dim dwAccessByte As DWord
418 Dim buf As String
419
[90]420 FileNumber--
[1]421 buf=_System_GetUsingFormat(UsingStr)
422
423 WriteFile(_System_hFile(FileNumber),buf,Len(buf),VarPtr(dwAccessByte),ByVal NULL)
424End Sub
425
426Dim _System_FieldSize(255) As Long
427Macro FIELD(FileNumber As Long, FieldSize As Long)
[90]428 FileNumber--
[1]429
430 _System_FieldSize(FileNumber)=FieldSize
431End Macro
432Macro GET(FileNumber As Long, RecodeNumber As Long, ByRef lpBuffer As String)
433 Dim dwAccessByte As Long
434
[90]435 FileNumber--
436 RecodeNumber--
[1]437
[142]438 SetFilePointer(_System_hFile(FileNumber), SizeOf (StrChar) * RecodeNumber * _System_FieldSize(FileNumber), 0, FILE_BEGIN)
439 lpBuffer = ZeroString(_System_FieldSize(FileNumber))
440 ReadFile(_System_hFile(FileNumber), StrPtr(lpBuffer), SizeOf (StrChar) * _System_FieldSize(FileNumber), VarPtr(dwAccessByte),ByVal 0)
[1]441 If Not dwAccessByte=_System_FieldSize(FileNumber) Then
[142]442 lpBuffer = Left$(lpBuffer, dwAccessByte)
[1]443 End If
444End Macro
445Macro PUT(FileNumber As Long, RecodeNumber As Long, ByRef lpBuffer As String)
446 Dim dwAccessByte As Long
447
[90]448 FileNumber--
449 RecodeNumber--
[1]450
[142]451 SetFilePointer(_System_hFile(FileNumber), SizeOf (StrChar) * RecodeNumber*_System_FieldSize(FileNumber), 0, FILE_BEGIN)
452 WriteFile(_System_hFile(FileNumber), StrPtr(lpBuffer),SizeOf (StrChar) * _System_FieldSize(FileNumber), VarPtr(dwAccessByte), ByVal 0)
[1]453End Macro
454
[21]455Macro CHDIR(path As String)
[142]456 SetCurrentDirectory(ToTCStr(path))
[1]457End Macro
[21]458Macro MKDIR(path As String)
[142]459 CreateDirectory(ToTCStr(path), 0)
[1]460End Macro
[21]461Macro KILL(path As String)
[142]462 DeleteFile(ToTCStr(path))
[1]463End Macro
464
465
466#endif '_INC_COMMAND
Note: See TracBrowser for help on using the repository browser.