source: Include/basic/command.sbp@ 175

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

Variant, VBObjectの追加

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