source: trunk/ab5.0/ablib/src/basic/command.sbp@ 560

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

インクルードガードとその他不要な前処理定義などの削除

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