source: trunk/Include/basic/command.sbp@ 303

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

フルコンパイルでのミスあぶり出し。註:修正は全て@300や@301以前に行われた。

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