source: Include/basic/command.sbp@ 272

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

StringBuilderを追加。String不変へ。共通の文字列操作関数をActiveBasic.Strings内に配置(設計に検討の余地あり)。

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