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
RevLine 
[1]1'command.sbp
2
3
4#ifndef _INC_COMMAND
5#define _INC_COMMAND
6
[142]7#require <windows.sbp>
8#require <Classes/System/Environment.ab>
[1]9
[119]10Const _System_Type_SByte = 1
[89]11Const _System_Type_Byte = 2
[1]12Const _System_Type_Integer = 3
[89]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
[1]18Const _System_Type_Single = 9
19Const _System_Type_Double = 10
[119]20Const _System_Type_Char = 11
21Const _System_Type_String = 13
22Const _System_Type_VoidPtr = 14
[1]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
[179]35Sub _System_End()
[269]36 System.Detail.hasShutdownStarted = True
[258]37 Dim exitCode = System.Environment.ExitCode
[165]38 _System_EndProgram()
[175]39 ExitProcess(exitCode)
[179]40End Sub
41
42Macro END()
43 _System_End()
[1]44End Macro
45
[142]46Macro EXEC(filePath As String)(cmdLine As String)
47 ShellExecute(0, "open", ToTCStr(filePath), ToTCStr(cmdLine), 0, SW_SHOWNORMAL)
[1]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
[142]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)
[1]76 If VarPtr(retAns) Then
[237]77 retAns = _System_MessageBox(hwnd, ToSCStr(str), ToSCStr(title), boxType)
[1]78 Else
[237]79 _System_MessageBox(hwnd, ToSCStr(str), ToSCStr(title), boxType)
[1]80 End If
81End Macro
82
[142]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
[1]87 End If
88End Macro
89
90Macro DELWND(hWnd As HWND)
91 DestroyWindow(hWnd)
92End Macro
93
[142]94Macro INSMENU(hMenu As HMENU, PosID As Long, flag As Long)(str As String, id As Long, hSubMenu As HMENU, state As Long)
[1]95 Dim mii As MENUITEMINFO
[123]96 ZeroMemory(VarPtr(mii), Len(mii))
97 With mii
98 .cbSize = Len(mii)
99 .fMask = MIIM_TYPE
[1]100
[173]101 If str.Length = 0 Then
[123]102 mii.fType = MFT_SEPARATOR
103 Else
104 .fType = MFT_STRING
105 .fMask = .fMask or MIIM_STATE or MIIM_ID
[142]106 .dwTypeData = ToTCStr(str)
[123]107 .wID = id
108 If hSubMenu Then
109 .fMask = .fMask or MIIM_SUBMENU
110 .hSubMenu = hSubMenu
111 End If
[142]112 .fState = state
[1]113 End If
[123]114 End With
115 InsertMenuItem(hMenu, PosID, flag, mii)
[1]116End Macro
117
118
119'--------------
120' ファイル関連
121'--------------
122
[90]123Dim _System_hFile(255) As HANDLE
[142]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
[1]128
[90]129 FileNumber--
[1]130
131 Select Case AccessFor
132 Case 0
[142]133 access = GENERIC_READ or GENERIC_WRITE
134 creationDisposition = OPEN_ALWAYS
[1]135 Case 1
[142]136 access = GENERIC_READ
137 creationDisposition = OPEN_EXISTING
[1]138 Case 2
[142]139 access = GENERIC_WRITE
140 creationDisposition = CREATE_ALWAYS
[1]141 Case 3
[142]142 access = GENERIC_WRITE
143 creationDisposition = OPEN_ALWAYS
144 bAppend = True
[1]145 End Select
146
[142]147 _System_hFile(FileNumber) = CreateFile(ToTCStr(fileName), access, 0, ByVal 0, creationDisposition, FILE_ATTRIBUTE_NORMAL, 0)
[1]148
[142]149 If bAppend Then SetFilePointer(_System_hFile(FileNumber), 0, 0, FILE_END)
[1]150End Macro
[90]151
[1]152Macro CLOSE()(FileNumber As Long)
[90]153 FileNumber--
[1]154
155 If _System_hFile(FileNumber) Then
[21]156 CloseHandle(_System_hFile(FileNumber))
157 _System_hFile(FileNumber)=0
[1]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)
[21]165 Dim i As Long ,i2 As Long, i3 As Long
[1]166 Dim buffer As String
[142]167 Dim temp[1] As StrChar
[1]168 Dim dwAccessBytes As DWord
169 Dim IsStr As Long
170
[90]171 FileNumber--
[1]172
[251]173 buffer=ZeroString(GetFileSize(_System_hFile[FileNumber],0) + 1)
[1]174
175 i=0
176 While 1
177 '次のデータをサーチ
178 Do
[142]179 i2=ReadFile(_System_hFile[FileNumber],temp,SizeOf (StrChar),VarPtr(dwAccessBytes),ByVal 0)
[1]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
[90]191 i3++
[1]192
[142]193 i2=ReadFile(_System_hFile[FileNumber],temp,SizeOf (StrChar),VarPtr(dwAccessBytes),ByVal 0)
[1]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
[142]203 ReadFile(_System_hFile[FileNumber],temp,SizeOf (StrChar),VarPtr(dwAccessBytes),ByVal 0)
[1]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
[21]215 If Not(temp[0]=32 or temp[0]=9) Then
[1]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 'データを変数に格納
[121]228 _System_Input_SetArgument(_System_InputDataPtr[i], _System_InputDataType[i], buffer, i3)
[1]229
[21]230
[121]231 i++
[1]232 If _System_InputDataPtr[i]=0 Then Exit While
233 Wend
234End Sub
235
[123]236Sub _System_Input_SetArgument(arg As VoidPtr, dataType As DWord, ByRef buf As String, bufLen As Long)
[121]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)
[142]256 memcpy(pTempStr->Chars, buf.Chars, SizeOf (StrChar) * pTempStr->Length)
[121]257 pTempStr->Chars[pTempStr->Length] = 0
258 End Select
[123]259End Sub
[121]260
[1]261Sub PRINT_ToFile(FileNumber As Long, buf As String)
262 Dim dwAccessByte As DWord
[123]263 FileNumber--
[1]264
[142]265 WriteFile(_System_hFile(FileNumber), buf, Len(buf), VarPtr(dwAccessByte), ByVal 0)
[1]266End Sub
267
268Dim _System_UsingDblData[_System_MAX_PARMSNUM] As Double
[214]269Dim _System_UsingStrData[_System_MAX_PARMSNUM] As *Char 'TODO: 暫定対応(動作未確認)
[1]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
[142]273 Dim temporary[255] As StrChar
[1]274 Dim buffer As String
275
[142]276 buffer = ZeroString(1024)
[1]277
[142]278 ParmNum = 0
279 i2 = 0
[1]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
[90]285 i2++
286 i3++
[1]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
[142]293 Dim temp2 As *StrChar
[1]294
295 Dim length_num As Long, length_buf As Long
[21]296 Dim dblRoundOff=0 As Double
[1]297
298
299 '----------------------
300 ' 四捨五入を考慮
301 '----------------------
302
303 i4=i2
304 While UsingStr[i4]=Asc("#")
[90]305 i4++
[1]306 Wend
307 If UsingStr[i4]=Asc(".") Then
[90]308 i4++
[1]309
310 dblRoundOff=0.5
311 While UsingStr[i4]=Asc("#")
[90]312 i4++
313 dblRoundOff /= 10
[1]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 '符号が有る場合は、一文字分のスペースを考慮する
[90]326 If sign Then length_num++
[1]327
328 length_buf=0
329 Do
[90]330 i2++
331 length_buf++
[1]332 Loop While UsingStr[i2]=Asc("#")
333
334 If length_buf>=length_num Then
335 '通常時
[237]336 _System_FillChar(VarPtr(buffer.Chars[i3]), length_buf - length_num, &h20) 'Asc(" ")
[123]337
[90]338 i3 += length_buf - length_num
[1]339
340 If sign Then
[123]341 buffer[i3] = Asc("-")
[90]342 i3++
[1]343
[90]344 length_num--
[1]345 End If
346
[123]347 If dec > 0 Then
[237]348 memcpy(VarPtr(buffer.Chars[i3]), temp2, SizeOf (StrChar) * length_num)
[1]349 Else
[123]350 buffer[i3] = &H30
[1]351 End If
352
[90]353 i3 += length_num
[1]354 Else
355 '表示桁が足りないとき
[237]356 _System_FillChar(VarPtr(buffer.Chars[i3]), length_buf, &h23) 'Asc("#")
[90]357 i3 += length_buf
[1]358 End If
359
[123]360 If UsingStr[i2] = Asc(".") Then
361 buffer[i3] = UsingStr[i2]
[90]362 i2++
363 i3++
[1]364
365 i4=dec
[123]366 While UsingStr[i2] = Asc("#")
[1]367 If i4<0 Then
368 buffer[i3]=&H30
369 Else
370 buffer[i3]=temp2[i4]
371 End If
[90]372 i3++
373 i4++
[1]374
[90]375 i2++
[1]376 Wend
377 End If
378 ElseIf UsingStr[i2]=Asc("@") Then
[90]379 i2++
[1]380
[237]381 lstrcat(VarPtr(buffer.Chars[i3]), _System_UsingStrData[ParmNum])
[123]382 i3 += lstrlen(_System_UsingStrData[ParmNum])
[1]383 ElseIf UsingStr[i2]=Asc("&") Then
384 i4=0
385 Do
[90]386 i4++
387 i2++
[1]388 Loop While UsingStr[i2]=Asc(" ")
389
390 If UsingStr[i2]=Asc("&") Then
[90]391 i4++
392 i2++
[1]393 i5=lstrlen(_System_UsingStrData[ParmNum])
394 If i4<=i5 Then
395 i5=i4
396 Else
[237]397 _System_FillChar(VarPtr(buffer.Chars[i3]), i4, &h20) 'Asc(" ")
[1]398 End If
[237]399 memcpy(VarPtr(buffer.Chars[i3]), _System_UsingStrData[ParmNum], SizeOf (StrChar) * i5)
[90]400 i3 += i4
[1]401 Else
[90]402 i2 -= i4
[123]403 buffer[i3] = Asc("&")
[90]404 i2++
405 i3++
[1]406 Continue
407 End If
408 End If
409
[90]410 ParmNum++
[1]411 Wend
412
[123]413 _System_GetUsingFormat = Left$(buffer, lstrlen(buffer))
[1]414End Function
415Sub PRINTUSING_ToFile(FileNumber As Long, UsingStr As String)
416 Dim dwAccessByte As DWord
417 Dim buf As String
418
[90]419 FileNumber--
[1]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)
[90]427 FileNumber--
[1]428
429 _System_FieldSize(FileNumber)=FieldSize
430End Macro
431Macro GET(FileNumber As Long, RecodeNumber As Long, ByRef lpBuffer As String)
[237]432 Dim dwAccessByte As DWord
[1]433
[90]434 FileNumber--
435 RecodeNumber--
[1]436
[142]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)
[1]440 If Not dwAccessByte=_System_FieldSize(FileNumber) Then
[142]441 lpBuffer = Left$(lpBuffer, dwAccessByte)
[1]442 End If
443End Macro
444Macro PUT(FileNumber As Long, RecodeNumber As Long, ByRef lpBuffer As String)
[237]445 Dim dwAccessByte As DWord
[1]446
[90]447 FileNumber--
448 RecodeNumber--
[1]449
[142]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)
[1]452End Macro
453
[21]454Macro CHDIR(path As String)
[142]455 SetCurrentDirectory(ToTCStr(path))
[1]456End Macro
[21]457Macro MKDIR(path As String)
[142]458 CreateDirectory(ToTCStr(path), 0)
[1]459End Macro
[21]460Macro KILL(path As String)
[142]461 DeleteFile(ToTCStr(path))
[1]462End Macro
463
464
465#endif '_INC_COMMAND
Note: See TracBrowser for help on using the repository browser.