source: Include/basic/command.sbp@ 121

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

#51対応

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