source: Include/basic/command.sbp@ 269

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

basicディレクトリの一部の_System関数をActiveBasic名前空間へ入れた

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