source: Include/basic/command.sbp@ 167

Last change on this file since 167 was 165, checked in by dai, 18 years ago

Endステートメントで_System_EndProgram関数が呼ばれるように修正

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