source: Include/basic/command.sbp@ 21

Last change on this file since 21 was 21, checked in by dai, 17 years ago

String型パラメータのByRef指定がリテラル値指定を不可能にしていましたので、ファイルを前のバージョンに戻します。

File size: 11.2 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, lpStr As String)(lpTitle As String, BoxType As DWord, ByRef retAns As DWord)
59 If VarPtr(retAns) Then
60 retAns=MessageBox(hWnd,lpStr,lpTitle,BoxType)
61 Else
62 MessageBox(hWnd,lpStr,lpTitle,BoxType)
63 End If
64End Macro
65
66Macro WINDOW(ByRef hWnd As Long, hOwner As Long, x As Long, y As Long, nWidth As Long, nHeight As Long, lpTitle As String, dwStyle As DWord)(lpClass As String, id As DWord, lpFunc As DWord, dwExStyle As DWord)
67 If VarPtr(hWnd) Then
68 hWnd=CreateWindowEx(dwExStyle,lpClass,lpTitle,dwStyle,x,y,nWidth,nHeight,hOwner,id,GetModuleHandle(0),NULL)
69 Else
70 CreateWindowEx(dwExStyle,lpClass,lpTitle,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)(lpString As String, id As Long, hSubMenu As HMENU, state As Long)
79 Dim mii As MENUITEMINFO
80
81 FillMemory(VarPtr(mii),Len(mii),0)
82 mii.cbSize=Len(mii)
83 mii.fMask=MIIM_TYPE
84
85 If lpString.Length=0 Then
86 mii.fType=MFT_SEPARATOR
87 Else
88 mii.fType=MFT_STRING
89 mii.fMask=mii.fMask or MIIM_STATE or MIIM_ID
90 mii.dwTypeData=StrPtr(lpString)
91 mii.wID=id
92 If hSubMenu Then
93 mii.fMask=mii.fMask or MIIM_SUBMENU
94 mii.hSubMenu=hSubMenu
95 End If
96 mii.fState=state
97 End If
98
99 InsertMenuItem(hMenu,PosID,flag,mii)
100End Macro
101
102
103'--------------
104' ファイル関連
105'--------------
106
107Dim _System_hFile(255) As Long
108Macro OPEN(lpFileName As String, AccessFor As Long, FileNumber As Long)
109 Dim dwAccess As Long
110 Dim bAppend As Long
111 Dim dwCreationDisposition As Long
112
113 FileNumber=FileNumber-1
114
115 bAppend=0
116 Select Case AccessFor
117 Case 0
118 dwAccess=GENERIC_READ or GENERIC_WRITE
119 dwCreationDisposition=OPEN_ALWAYS
120 Case 1
121 dwAccess=GENERIC_READ
122 dwCreationDisposition=OPEN_EXISTING
123 Case 2
124 dwAccess=GENERIC_WRITE
125 dwCreationDisposition=CREATE_ALWAYS
126 Case 3
127 dwAccess=GENERIC_WRITE
128 dwCreationDisposition=OPEN_ALWAYS
129 bAppend=1
130 End Select
131
132 _System_hFile(FileNumber)=CreateFile(lpFileName,dwAccess,0,ByVal NULL,dwCreationDisposition,FILE_ATTRIBUTE_NORMAL,NULL)
133
134 If bAppend Then SetFilePointer(_System_hFile(FileNumber),0,NULL,FILE_END)
135End Macro
136Macro CLOSE()(FileNumber As Long)
137 FileNumber=FileNumber-1
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 Dim i As Long ,i2 As Long, i3 As Long
150 Dim buffer As String
151 Dim temp[1] As Byte
152 Dim dwAccessBytes As DWord
153 Dim IsStr As Long
154
155 FileNumber=FileNumber-1
156
157 buffer=ZeroString(GetFileSize(_System_hFile[FileNumber],0))
158
159 i=0
160 While 1
161 '次のデータをサーチ
162 Do
163 i2=ReadFile(_System_hFile[FileNumber],temp,1,VarPtr(dwAccessBytes),ByVal 0)
164 If i2=0 or dwAccessBytes=0 Then
165 'error
166 Exit Macro
167 End If
168 Loop While temp[0]=32 or temp[0]=9
169 SetFilePointer(_System_hFile[FileNumber],-1,0,FILE_CURRENT)
170
171 '読み込み
172 i3=-1
173 IsStr=0
174 While 1
175 i3=i3+1
176
177 i2=ReadFile(_System_hFile[FileNumber],temp,1,VarPtr(dwAccessBytes),ByVal 0)
178 If i2=0 or (i3=0 and dwAccessBytes=0) Then
179 'error
180 Exit Macro
181 End If
182 If temp[0]=34 Then IsStr=IsStr xor 1
183
184 buffer[i3]=temp[0]
185 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
186 If temp[0]=13 Then
187 ReadFile(_System_hFile[FileNumber],temp,1,VarPtr(dwAccessBytes),ByVal 0)
188 If Not(dwAccessBytes<>0 And temp[0]=10) Then
189 SetFilePointer(_System_hFile[FileNumber],-1,0,FILE_CURRENT)
190 Continue
191 End If
192 End If
193
194 If temp[0]=32 or temp[0]=9 Then
195 While 1
196 ReadFile(_System_hFile[FileNumber],temp,1,VarPtr(dwAccessBytes),ByVal 0)
197 If dwAccessBytes=0 Then Exit While
198 If temp[0]=Asc(",") Then Exit While
199 If Not(temp[0]=32 or temp[0]=9) Then
200 SetFilePointer(_System_hFile[FileNumber],-1,0,FILE_CURRENT)
201 Exit While
202 End If
203 Wend
204 End If
205
206 buffer[i3]=0
207 Exit While
208 End If
209 Wend
210
211 'データを変数に格納
212 Select Case _System_InputDataType[i]
213 Case _System_Type_Double
214 SetDouble(_System_InputDataPtr[i],Val(buffer))
215 Case _System_Type_Single
216 SetSingle(_System_InputDataPtr[i],Val(buffer))
217 Case _System_Type_Int64,_System_Type_QWord
218 SetQWord(_System_InputDataPtr[i],Val(buffer))
219 Case _System_Type_Long,_System_Type_DWord
220 SetDWord(_System_InputDataPtr[i],Val(buffer))
221 Case _System_Type_Integer,_System_Type_Word
222 SetWord(_System_InputDataPtr[i],Val(buffer))
223 Case _System_Type_Char,_System_Type_Byte
224 SetByte(_System_InputDataPtr[i],Val(buffer))
225
226 Case _System_Type_String
227 Dim pTempStr As *String
228 pTempStr=_System_InputDataPtr[i] As *String
229
230 pTempStr->Length=i3
231 pTempStr->Chars=_System_realloc(pTempStr->Chars,pTempStr->Length+1)
232 memcpy(pTempStr->Chars,buffer.Chars,pTempStr->Length)
233 pTempStr->Chars[pTempStr->Length]=0
234 End Select
235
236 i=i+1
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=FileNumber-1
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=i2+1
266 i3=i3+1
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=i4+1
286 Wend
287 If UsingStr[i4]=Asc(".") Then
288 i4=i4+1
289
290 dblRoundOff=0.5
291 While UsingStr[i4]=Asc("#")
292 i4=i4+1
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=length_num+1
307
308 length_buf=0
309 Do
310 i2=i2+1
311 length_buf=length_buf+1
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=i3+(length_buf-length_num)
318
319 If sign Then
320 buffer[i3]=Asc("-")
321 i3=i3+1
322
323 length_num=length_num-1
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=i3+length_num
333 Else
334 '表示桁が足りないとき
335 FillMemory(StrPtr(buffer)+i3,length_buf,Asc("#"))
336 i3=i3+length_buf
337 End If
338
339 If UsingStr[i2]=Asc(".") Then
340 buffer[i3]=UsingStr[i2]
341 i2=i2+1
342 i3=i3+1
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=i3+1
352 i4=i4+1
353
354 i2=i2+1
355 Wend
356 End If
357 ElseIf UsingStr[i2]=Asc("@") Then
358 i2=i2+1
359
360 lstrcat(StrPtr(buffer)+i3,_System_UsingStrData[ParmNum])
361 i3=i3+lstrlen(_System_UsingStrData[ParmNum])
362 ElseIf UsingStr[i2]=Asc("&") Then
363 i4=0
364 Do
365 i4=i4+1
366 i2=i2+1
367 Loop While UsingStr[i2]=Asc(" ")
368
369 If UsingStr[i2]=Asc("&") Then
370 i4=i4+1
371 i2=i2+1
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=i3+i4
380 Else
381 i2=i2-i4
382 buffer[i3]=Asc("&")
383 i2=i2+1
384 i3=i3+1
385 Continue
386 End If
387 End If
388
389 ParmNum=ParmNum+1
390 Wend
391
392 _System_GetUsingFormat=Left$(buffer,lstrlen(buffer))
393End Function
394Sub PRINTUSING_ToFile(FileNumber As Long, UsingStr As String)
395 Dim dwAccessByte As DWord
396 Dim buf As String
397
398 FileNumber=FileNumber-1
399 buf=_System_GetUsingFormat(UsingStr)
400
401 WriteFile(_System_hFile(FileNumber),buf,Len(buf),VarPtr(dwAccessByte),ByVal NULL)
402End Sub
403
404Dim _System_FieldSize(255) As Long
405Macro FIELD(FileNumber As Long, FieldSize As Long)
406 FileNumber=FileNumber-1
407
408 _System_FieldSize(FileNumber)=FieldSize
409End Macro
410Macro GET(FileNumber As Long, RecodeNumber As Long, ByRef lpBuffer As String)
411 Dim dwAccessByte As Long
412
413 FileNumber=FileNumber-1
414 RecodeNumber=RecodeNumber-1
415
416 SetFilePointer(_System_hFile(FileNumber),RecodeNumber*_System_FieldSize(FileNumber),NULL,FILE_BEGIN)
417 lpBuffer=ZeroString(_System_FieldSize(FileNumber))
418 ReadFile(_System_hFile(FileNumber),StrPtr(lpBuffer),_System_FieldSize(FileNumber),VarPtr(dwAccessByte),ByVal NULL)
419 If Not dwAccessByte=_System_FieldSize(FileNumber) Then
420 lpBuffer=Left$(lpBuffer,dwAccessByte)
421 End If
422End Macro
423Macro PUT(FileNumber As Long, RecodeNumber As Long, ByRef lpBuffer As String)
424 Dim dwAccessByte As Long
425
426 FileNumber=FileNumber-1
427 RecodeNumber=RecodeNumber-1
428
429 SetFilePointer(_System_hFile(FileNumber),RecodeNumber*_System_FieldSize(FileNumber),NULL,FILE_BEGIN)
430 WriteFile(_System_hFile(FileNumber),StrPtr(lpBuffer),_System_FieldSize(FileNumber),VarPtr(dwAccessByte),ByVal NULL)
431End Macro
432
433Macro CHDIR(path As String)
434 SetCurrentDirectory(path)
435End Macro
436Macro MKDIR(path As String)
437 CreateDirectory(path,ByVal 0)
438End Macro
439Macro KILL(path As String)
440 DeleteFile(path)
441End Macro
442
443
444#endif '_INC_COMMAND
445
Note: See TracBrowser for help on using the repository browser.