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

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

インクルードガードとその他不要な前処理定義などの削除

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