source: trunk/ab5.0/ablib/src/basic/command.sbp @ 628

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

winnls.ab, winsvc.abを追加

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