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
RevLine 
[1]1'command.sbp
2
3
4#ifndef _INC_COMMAND
5#define _INC_COMMAND
6
7
[119]8Const _System_Type_SByte = 1
[89]9Const _System_Type_Byte = 2
[1]10Const _System_Type_Integer = 3
[89]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
[1]16Const _System_Type_Single = 9
17Const _System_Type_Double = 10
[119]18Const _System_Type_Char = 11
19Const _System_Type_String = 13
20Const _System_Type_VoidPtr = 14
[1]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)
[21]39 ShellExecute(0,"open",lpFilePath,lpCmdLine,0,SW_SHOWNORMAL)
[1]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
[21]60Macro MSGBOX(hWnd As HWND, lpStr As String)(lpTitle As String, BoxType As DWord, ByRef retAns As DWord)
[1]61 If VarPtr(retAns) Then
[21]62 retAns=MessageBox(hWnd,lpStr,lpTitle,BoxType)
[1]63 Else
[21]64 MessageBox(hWnd,lpStr,lpTitle,BoxType)
[1]65 End If
66End Macro
67
[89]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)
[1]69 If VarPtr(hWnd) Then
[21]70 hWnd=CreateWindowEx(dwExStyle,lpClass,lpTitle,dwStyle,x,y,nWidth,nHeight,hOwner,id,GetModuleHandle(0),NULL)
[1]71 Else
[21]72 CreateWindowEx(dwExStyle,lpClass,lpTitle,dwStyle,x,y,nWidth,nHeight,hOwner,id,GetModuleHandle(0),NULL)
[1]73 End If
74End Macro
75
76Macro DELWND(hWnd As HWND)
77 DestroyWindow(hWnd)
78End Macro
79
[21]80Macro INSMENU(hMenu As HMENU, PosID As Long, flag As Long)(lpString As String, id As Long, hSubMenu As HMENU, state As Long)
[1]81 Dim mii As MENUITEMINFO
82
[21]83 FillMemory(VarPtr(mii),Len(mii),0)
84 mii.cbSize=Len(mii)
85 mii.fMask=MIIM_TYPE
[1]86
[21]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
[1]97 End If
[21]98 mii.fState=state
99 End If
[1]100
[21]101 InsertMenuItem(hMenu,PosID,flag,mii)
[1]102End Macro
103
104
105'--------------
106' ファイル関連
107'--------------
108
[90]109Dim _System_hFile(255) As HANDLE
[21]110Macro OPEN(lpFileName As String, AccessFor As Long, FileNumber As Long)
[1]111 Dim dwAccess As Long
[90]112 Dim bAppend = 0 As Long
[1]113 Dim dwCreationDisposition As Long
114
[90]115 FileNumber--
[1]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
[21]133 _System_hFile(FileNumber)=CreateFile(lpFileName,dwAccess,0,ByVal NULL,dwCreationDisposition,FILE_ATTRIBUTE_NORMAL,NULL)
[1]134
[21]135 If bAppend Then SetFilePointer(_System_hFile(FileNumber),0,NULL,FILE_END)
[1]136End Macro
[90]137
[1]138Macro CLOSE()(FileNumber As Long)
[90]139 FileNumber--
[1]140
141 If _System_hFile(FileNumber) Then
[21]142 CloseHandle(_System_hFile(FileNumber))
143 _System_hFile(FileNumber)=0
[1]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)
[21]151 Dim i As Long ,i2 As Long, i3 As Long
[1]152 Dim buffer As String
[110]153 Dim temp[1] As Char
[1]154 Dim dwAccessBytes As DWord
155 Dim IsStr As Long
156
[90]157 FileNumber--
[1]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
[90]177 i3++
[1]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
[21]201 If Not(temp[0]=32 or temp[0]=9) Then
[1]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 'データを変数に格納
[121]214 _System_Input_SetArgument(_System_InputDataPtr[i], _System_InputDataType[i], buffer, i3)
[1]215
[21]216
[121]217 i++
[1]218 If _System_InputDataPtr[i]=0 Then Exit While
219 Wend
220End Sub
221
[121]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
[1]247Sub PRINT_ToFile(FileNumber As Long, buf As String)
248 Dim dwAccessByte As DWord
[21]249 FileNumber=FileNumber-1
[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
[110]259 Dim temporary[255] As Char
[1]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
[90]271 i2++
272 i3++
[1]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
[110]279 Dim temp2 As *Char
[1]280
281 Dim length_num As Long, length_buf As Long
[21]282 Dim dblRoundOff=0 As Double
[1]283
284
285 '----------------------
286 ' 四捨五入を考慮
287 '----------------------
288
289 i4=i2
290 While UsingStr[i4]=Asc("#")
[90]291 i4++
[1]292 Wend
293 If UsingStr[i4]=Asc(".") Then
[90]294 i4++
[1]295
296 dblRoundOff=0.5
297 While UsingStr[i4]=Asc("#")
[90]298 i4++
299 dblRoundOff /= 10
[1]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 '符号が有る場合は、一文字分のスペースを考慮する
[90]312 If sign Then length_num++
[1]313
314 length_buf=0
315 Do
[90]316 i2++
317 length_buf++
[1]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(" "))
[90]323 i3 += length_buf - length_num
[1]324
325 If sign Then
326 buffer[i3]=Asc("-")
[90]327 i3++
[1]328
[90]329 length_num--
[1]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
[90]338 i3 += length_num
[1]339 Else
340 '表示桁が足りないとき
341 FillMemory(StrPtr(buffer)+i3,length_buf,Asc("#"))
[90]342 i3 += length_buf
[1]343 End If
344
345 If UsingStr[i2]=Asc(".") Then
346 buffer[i3]=UsingStr[i2]
[90]347 i2++
348 i3++
[1]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
[90]357 i3++
358 i4++
[1]359
[90]360 i2++
[1]361 Wend
362 End If
363 ElseIf UsingStr[i2]=Asc("@") Then
[90]364 i2++
[1]365
366 lstrcat(StrPtr(buffer)+i3,_System_UsingStrData[ParmNum])
[21]367 i3=i3+lstrlen(_System_UsingStrData[ParmNum])
[1]368 ElseIf UsingStr[i2]=Asc("&") Then
369 i4=0
370 Do
[90]371 i4++
372 i2++
[1]373 Loop While UsingStr[i2]=Asc(" ")
374
375 If UsingStr[i2]=Asc("&") Then
[90]376 i4++
377 i2++
[1]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)
[90]385 i3 += i4
[1]386 Else
[90]387 i2 -= i4
[1]388 buffer[i3]=Asc("&")
[90]389 i2++
390 i3++
[1]391 Continue
392 End If
393 End If
394
[90]395 ParmNum++
[1]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
[90]404 FileNumber--
[1]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)
[90]412 FileNumber--
[1]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
[90]419 FileNumber--
420 RecodeNumber--
[1]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
[90]432 FileNumber--
433 RecodeNumber--
[1]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
[21]439Macro CHDIR(path As String)
[1]440 SetCurrentDirectory(path)
441End Macro
[21]442Macro MKDIR(path As String)
[90]443 CreateDirectory(path, 0)
[1]444End Macro
[21]445Macro KILL(path As String)
[1]446 DeleteFile(path)
447End Macro
448
449
450#endif '_INC_COMMAND
Note: See TracBrowser for help on using the repository browser.