source: Include/basic/command.sbp@ 13

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