source: branch/egtra-stream-without-en_dec/basic/command.sbp@ 673

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

winnls.ab, winsvc.abを追加

File size: 11.6 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 ActiveBasic.Detail.ThrowIfInvaildFileNum(FileNumber)
139
140 If _System_hFile(FileNumber) Then
141 CloseHandle(_System_hFile(FileNumber))
142 _System_hFile(FileNumber)=0
143 End If
144End Macro
145
146'INPUT Command Data
147Dim _System_InputDataPtr[_System_MAX_PARMSNUM] As VoidPtr
148Dim _System_InputDataType[_System_MAX_PARMSNUM] As DWord
149Sub INPUT_FromFile(FileNumber As Long)
150 FileNumber--
151 ActiveBasic.Detail.ThrowIfInvaildFileNum(FileNumber)
152
153 Dim i = 0 As Long
154 Dim buffer = New System.Text.StringBuilder(256)
155 Dim temp[1] As Char
156 Dim dwAccessBytes As DWord
157 Dim IsStr As Long
158
159 While 1
160 '次のデータをサーチ
161 Do
162 Dim ret = ReadFile(_System_hFile[FileNumber],temp,SizeOf (Char),VarPtr(dwAccessBytes),ByVal 0)
163 If ret=0 or dwAccessBytes=0 Then
164 'error
165 Exit Macro
166 End If
167 Loop While temp[0]=32 or temp[0]=9
168 SetFilePointer(_System_hFile[FileNumber],-1,0,FILE_CURRENT)
169
170 '読み込み
171 IsStr=0
172 While 1
173 Dim ret = ReadFile(_System_hFile[FileNumber],temp,SizeOf (Char),VarPtr(dwAccessBytes),ByVal 0)
174 If ret = 0 or dwAccessBytes = 0 Then
175 'error
176 Exit Macro
177 End If
178 If temp[0]=34 Then IsStr=IsStr xor 1
179
180 buffer.Append(temp[0])
181 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
182 If temp[0]=13 Then
183 ReadFile(_System_hFile[FileNumber],temp,SizeOf (Char),VarPtr(dwAccessBytes),ByVal 0)
184 If Not(dwAccessBytes<>0 And temp[0]=10) Then
185 SetFilePointer(_System_hFile[FileNumber],-1,0,FILE_CURRENT)
186 Continue
187 End If
188 End If
189
190 If temp[0]=32 or temp[0]=9 Then
191 While 1
192 ReadFile(_System_hFile[FileNumber],temp,1,VarPtr(dwAccessBytes),ByVal 0)
193 If dwAccessBytes=0 Then Exit While
194 If temp[0]=Asc(",") Then Exit While
195 If Not(temp[0]=32 or temp[0]=9) Then
196 SetFilePointer(_System_hFile[FileNumber],-1,0,FILE_CURRENT)
197 Exit While
198 End If
199 Wend
200 End If
201
202 buffer.Append(0 As Char)
203 Exit While
204 End If
205 Wend
206
207 'データを変数に格納
208 _System_Input_SetArgument(_System_InputDataPtr[i], _System_InputDataType[i], buffer.ToString)
209
210
211 i++
212 If _System_InputDataPtr[i]=0 Then Exit While
213 Wend
214End Sub
215
216Sub _System_Input_SetArgument(arg As VoidPtr, dataType As DWord, buf As String)
217 Select Case dataType
218 Case _System_Type_Double
219 SetDouble(arg, Val(buf))
220 Case _System_Type_Single
221 SetSingle(arg, Val(buf))
222 Case _System_Type_Int64,_System_Type_QWord
223 SetQWord(arg, Val(buf))
224 Case _System_Type_Long,_System_Type_DWord
225 SetDWord(arg, Val(buf))
226 Case _System_Type_Integer,_System_Type_Word
227 SetWord(arg, Val(buf))
228 Case _System_Type_SByte,_System_Type_Byte
229 SetByte(arg, Val(buf))
230 Case _System_Type_Char
231 SetChar(arg, buf[0])
232 Case _System_Type_String
233 Dim pTempStr As *String
234 pTempStr = arg As *String
235 pTempStr[0] = buf
236 End Select
237End Sub
238
239Sub PRINT_ToFile(FileNumber As Long, buf As String)
240 Dim dwAccessByte As DWord
241 FileNumber--
242 ActiveBasic.Detail.ThrowIfInvaildFileNum(FileNumber)
243
244 WriteFile(_System_hFile(FileNumber), StrPtr(buf), Len(buf), VarPtr(dwAccessByte), ByVal 0)
245End Sub
246
247Dim _System_UsingDblData[_System_MAX_PARMSNUM] As Double
248Dim _System_UsingStrData[_System_MAX_PARMSNUM] As *Char 'TODO: 暫定対応(動作未確認)
249Dim _System_UsingDataType[_System_MAX_PARMSNUM] As DWord
250/*
251Function _System_GetUsingFormat(UsingStr As String) As String
252 Dim i2 As Long, i3 As Long, i4 As Long, i5 As Long, ParmNum As Long
253 Dim temporary[255] As Char
254 Dim buffer = New System.Text.StringBuilder(1024)
255
256 ParmNum = 0
257 i2 = 0
258 While 1
259 While 1
260 If UsingStr[i2]=Asc("#") or UsingStr[i2]=Asc("@") or UsingStr[i2]=Asc("&") Then Exit While
261 buffer[i3]=UsingStr[i2]
262 If UsingStr[i2]=0 Then Exit While
263 i2++
264 i3++
265 Wend
266
267 If UsingStr[i2]=0 Then Exit While
268
269 If UsingStr[i2]=Asc("#") Then
270 Dim dec As Long, sign As Long
271 Dim temp2 As *Char
272
273 Dim length_num As Long, length_buf As Long
274 Dim dblRoundOff=0 As Double
275
276
277 '----------------------
278 ' 四捨五入を考慮
279 '----------------------
280
281 i4=i2
282 While UsingStr[i4]=Asc("#")
283 i4++
284 Wend
285 If UsingStr[i4]=Asc(".") Then
286 i4++
287
288 dblRoundOff=0.5
289 While UsingStr[i4]=Asc("#")
290 i4++
291 dblRoundOff /= 10
292 Wend
293 End If
294
295
296 '浮動小数点を文字列に変換
297 temp2=_ecvt(_System_UsingDblData[ParmNum]+dblRoundOff,15,dec,sign)
298
299 '整数部
300 length_num=dec
301 If length_num<=0 Then length_num=1
302
303 '符号が有る場合は、一文字分のスペースを考慮する
304 If sign Then length_num++
305
306 length_buf=0
307 Do
308 i2++
309 length_buf++
310 Loop While UsingStr[i2]=Asc("#")
311
312 If length_buf>=length_num Then
313 '通常時
314 ActiveBasic.Strings.Detail.ChrFill(VarPtr(buffer.Chars[i3]), length_buf - length_num, &h20) 'Asc(" ")
315
316 i3 += length_buf - length_num
317
318 If sign Then
319 buffer[i3] = Asc("-")
320 i3++
321
322 length_num--
323 End If
324
325 If dec > 0 Then
326 memcpy(VarPtr(buffer.Chars[i3]), temp2, SizeOf (Char) * length_num)
327 Else
328 buffer[i3] = &H30
329 End If
330
331 i3 += length_num
332 Else
333 '表示桁が足りないとき
334 ActiveBasic.Strings.Detail.ChrFill(VarPtr(buffer.Chars[i3]), length_buf, &h23) 'Asc("#")
335 i3 += length_buf
336 End If
337
338 If UsingStr[i2] = Asc(".") Then
339 buffer[i3] = UsingStr[i2]
340 i2++
341 i3++
342
343 i4=dec
344 While UsingStr[i2] = Asc("#")
345 If i4<0 Then
346 buffer[i3]=&H30
347 Else
348 buffer[i3]=temp2[i4]
349 End If
350 i3++
351 i4++
352
353 i2++
354 Wend
355 End If
356 ElseIf UsingStr[i2]=Asc("@") Then
357 i2++
358
359 lstrcat(VarPtr(buffer.Chars[i3]), _System_UsingStrData[ParmNum])
360 i3 += lstrlen(_System_UsingStrData[ParmNum])
361 ElseIf UsingStr[i2]=Asc("&") Then
362 i4=0
363 Do
364 i4++
365 i2++
366 Loop While UsingStr[i2]=Asc(" ")
367
368 If UsingStr[i2]=Asc("&") Then
369 i4++
370 i2++
371 i5=lstrlen(_System_UsingStrData[ParmNum])
372 If i4<=i5 Then
373 i5=i4
374 Else
375 ActiveBasic.Strings.Detail.ChrFill(VarPtr(buffer.Chars[i3]), i4, &h20) 'Asc(" ")
376 End If
377 memcpy(VarPtr(buffer.Chars[i3]), _System_UsingStrData[ParmNum], SizeOf (Char) * i5)
378 i3 += i4
379 Else
380 i2 -= i4
381 buffer[i3] = Asc("&")
382 i2++
383 i3++
384 Continue
385 End If
386 End If
387
388 ParmNum++
389 Wend
390
391 _System_GetUsingFormat = buffer.ToString(0, lstrlen(StrBPtr(buffer)))
392End Function
393
394' TODO: _System_GetUsingFormatを用意して実装する
395Sub PRINTUSING_ToFile(FileNumber As Long, UsingStr As String)
396 Dim dwAccessByte As DWord
397 Dim buf As String
398
399 FileNumber--
400 buf=_System_GetUsingFormat(UsingStr)
401
402 WriteFile(_System_hFile(FileNumber),buf,Len(buf),VarPtr(dwAccessByte),ByVal NULL)
403End Sub
404*/
405
406Dim _System_FieldSize(255) As Long
407Macro FIELD(FileNumber As Long, FieldSize As Long)
408 FileNumber--
409 ActiveBasic.Detail.ThrowIfInvaildFileNum(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 ActiveBasic.Detail.ThrowIfInvaildFileNum(FileNumber)
417 RecodeNumber--
418
419 SetFilePointer(_System_hFile(FileNumber), SizeOf (Char) * RecodeNumber * _System_FieldSize(FileNumber), 0, FILE_BEGIN)
420 Dim t = ZeroString(_System_FieldSize(FileNumber))
421 ReadFile(_System_hFile(FileNumber), StrPtr(t), SizeOf (Char) * _System_FieldSize(FileNumber), VarPtr(dwAccessByte), ByVal 0)
422 If dwAccessByte = _System_FieldSize(FileNumber) Then
423 buffer = t.ToString
424 Else
425 buffer = Left$(t.ToString, dwAccessByte)
426 End If
427End Macro
428Macro PUT(FileNumber As Long, RecodeNumber As Long, buffer As String)
429 Dim dwAccessByte As DWord
430
431 FileNumber--
432 ActiveBasic.Detail.ThrowIfInvaildFileNum(FileNumber)
433 RecodeNumber--
434
435 SetFilePointer(_System_hFile(FileNumber), SizeOf (Char) * RecodeNumber*_System_FieldSize(FileNumber), 0, FILE_BEGIN)
436 WriteFile(_System_hFile(FileNumber), StrPtr(buffer), SizeOf (Char) * _System_FieldSize(FileNumber), VarPtr(dwAccessByte), ByVal 0)
437End Macro
438
439Macro CHDIR(path As String)
440 SetCurrentDirectory(ToTCStr(path))
441End Macro
442Macro MKDIR(path As String)
443 CreateDirectory(ToTCStr(path), 0)
444End Macro
445Macro KILL(path As String)
446 DeleteFile(ToTCStr(path))
447End Macro
Note: See TracBrowser for help on using the repository browser.