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
RevLine 
[1]1'command.sbp
2
3
4#ifndef _INC_COMMAND
5#define _INC_COMMAND
6
[142]7#require <windows.sbp>
8#require <Classes/System/Environment.ab>
[1]9
[119]10Const _System_Type_SByte = 1
[89]11Const _System_Type_Byte = 2
[1]12Const _System_Type_Integer = 3
[89]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
[1]18Const _System_Type_Single = 9
19Const _System_Type_Double = 10
[119]20Const _System_Type_Char = 11
21Const _System_Type_String = 13
22Const _System_Type_VoidPtr = 14
[1]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()
[175]36 Dim exitCode = Environment.ExitCode
[165]37 _System_EndProgram()
[175]38 ExitProcess(exitCode)
[1]39End Macro
40
[142]41Macro EXEC(filePath As String)(cmdLine As String)
42 ShellExecute(0, "open", ToTCStr(filePath), ToTCStr(cmdLine), 0, SW_SHOWNORMAL)
[1]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
[142]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)
[1]71 If VarPtr(retAns) Then
[142]72 retAns = _System_MessageBox(hwnd, str, title, boxType)
[1]73 Else
[142]74 _System_MessageBox(hwnd, str, title, boxType)
[1]75 End If
76End Macro
77
[142]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
[1]82 End If
83End Macro
84
85Macro DELWND(hWnd As HWND)
86 DestroyWindow(hWnd)
87End Macro
88
[142]89Macro INSMENU(hMenu As HMENU, PosID As Long, flag As Long)(str As String, id As Long, hSubMenu As HMENU, state As Long)
[1]90 Dim mii As MENUITEMINFO
[123]91 ZeroMemory(VarPtr(mii), Len(mii))
92 With mii
93 .cbSize = Len(mii)
94 .fMask = MIIM_TYPE
[1]95
[173]96 If str.Length = 0 Then
[123]97 mii.fType = MFT_SEPARATOR
98 Else
99 .fType = MFT_STRING
100 .fMask = .fMask or MIIM_STATE or MIIM_ID
[142]101 .dwTypeData = ToTCStr(str)
[123]102 .wID = id
103 If hSubMenu Then
104 .fMask = .fMask or MIIM_SUBMENU
105 .hSubMenu = hSubMenu
106 End If
[142]107 .fState = state
[1]108 End If
[123]109 End With
110 InsertMenuItem(hMenu, PosID, flag, mii)
[1]111End Macro
112
113
114'--------------
115' ファイル関連
116'--------------
117
[90]118Dim _System_hFile(255) As HANDLE
[142]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
[1]123
[90]124 FileNumber--
[1]125
126 Select Case AccessFor
127 Case 0
[142]128 access = GENERIC_READ or GENERIC_WRITE
129 creationDisposition = OPEN_ALWAYS
[1]130 Case 1
[142]131 access = GENERIC_READ
132 creationDisposition = OPEN_EXISTING
[1]133 Case 2
[142]134 access = GENERIC_WRITE
135 creationDisposition = CREATE_ALWAYS
[1]136 Case 3
[142]137 access = GENERIC_WRITE
138 creationDisposition = OPEN_ALWAYS
139 bAppend = True
[1]140 End Select
141
[142]142 _System_hFile(FileNumber) = CreateFile(ToTCStr(fileName), access, 0, ByVal 0, creationDisposition, FILE_ATTRIBUTE_NORMAL, 0)
[1]143
[142]144 If bAppend Then SetFilePointer(_System_hFile(FileNumber), 0, 0, FILE_END)
[1]145End Macro
[90]146
[1]147Macro CLOSE()(FileNumber As Long)
[90]148 FileNumber--
[1]149
150 If _System_hFile(FileNumber) Then
[21]151 CloseHandle(_System_hFile(FileNumber))
152 _System_hFile(FileNumber)=0
[1]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)
[21]160 Dim i As Long ,i2 As Long, i3 As Long
[1]161 Dim buffer As String
[142]162 Dim temp[1] As StrChar
[1]163 Dim dwAccessBytes As DWord
164 Dim IsStr As Long
165
[90]166 FileNumber--
[1]167
168 buffer=ZeroString(GetFileSize(_System_hFile[FileNumber],0))
169
170 i=0
171 While 1
172 '次のデータをサーチ
173 Do
[142]174 i2=ReadFile(_System_hFile[FileNumber],temp,SizeOf (StrChar),VarPtr(dwAccessBytes),ByVal 0)
[1]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
[90]186 i3++
[1]187
[142]188 i2=ReadFile(_System_hFile[FileNumber],temp,SizeOf (StrChar),VarPtr(dwAccessBytes),ByVal 0)
[1]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
[142]198 ReadFile(_System_hFile[FileNumber],temp,SizeOf (StrChar),VarPtr(dwAccessBytes),ByVal 0)
[1]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
[21]210 If Not(temp[0]=32 or temp[0]=9) Then
[1]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 'データを変数に格納
[121]223 _System_Input_SetArgument(_System_InputDataPtr[i], _System_InputDataType[i], buffer, i3)
[1]224
[21]225
[121]226 i++
[1]227 If _System_InputDataPtr[i]=0 Then Exit While
228 Wend
229End Sub
230
[123]231Sub _System_Input_SetArgument(arg As VoidPtr, dataType As DWord, ByRef buf As String, bufLen As Long)
[121]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)
[142]251 memcpy(pTempStr->Chars, buf.Chars, SizeOf (StrChar) * pTempStr->Length)
[121]252 pTempStr->Chars[pTempStr->Length] = 0
253 End Select
[123]254End Sub
[121]255
[1]256Sub PRINT_ToFile(FileNumber As Long, buf As String)
257 Dim dwAccessByte As DWord
[123]258 FileNumber--
[1]259
[142]260 WriteFile(_System_hFile(FileNumber), buf, Len(buf), VarPtr(dwAccessByte), ByVal 0)
[1]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
[142]268 Dim temporary[255] As StrChar
[1]269 Dim buffer As String
270
[142]271 buffer = ZeroString(1024)
[1]272
[142]273 ParmNum = 0
274 i2 = 0
[1]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
[90]280 i2++
281 i3++
[1]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
[142]288 Dim temp2 As *StrChar
[1]289
290 Dim length_num As Long, length_buf As Long
[21]291 Dim dblRoundOff=0 As Double
[1]292
293
294 '----------------------
295 ' 四捨五入を考慮
296 '----------------------
297
298 i4=i2
299 While UsingStr[i4]=Asc("#")
[90]300 i4++
[1]301 Wend
302 If UsingStr[i4]=Asc(".") Then
[90]303 i4++
[1]304
305 dblRoundOff=0.5
306 While UsingStr[i4]=Asc("#")
[90]307 i4++
308 dblRoundOff /= 10
[1]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 '符号が有る場合は、一文字分のスペースを考慮する
[90]321 If sign Then length_num++
[1]322
323 length_buf=0
324 Do
[90]325 i2++
326 length_buf++
[1]327 Loop While UsingStr[i2]=Asc("#")
328
329 If length_buf>=length_num Then
330 '通常時
[123]331 _System_FillChar(VarPtr(buffer[i3]), length_buf - length_num, &h20) 'Asc(" ")
332
[90]333 i3 += length_buf - length_num
[1]334
335 If sign Then
[123]336 buffer[i3] = Asc("-")
[90]337 i3++
[1]338
[90]339 length_num--
[1]340 End If
341
[123]342 If dec > 0 Then
[142]343 memcpy(VarPtr(buffer[i3]), temp2, SizeOf (StrChar) * length_num)
[1]344 Else
[123]345 buffer[i3] = &H30
[1]346 End If
347
[90]348 i3 += length_num
[1]349 Else
350 '表示桁が足りないとき
[123]351 _System_FillChar(VarPtr(buffer[i3]), length_buf,&h23) 'Asc("#")
[90]352 i3 += length_buf
[1]353 End If
354
[123]355 If UsingStr[i2] = Asc(".") Then
356 buffer[i3] = UsingStr[i2]
[90]357 i2++
358 i3++
[1]359
360 i4=dec
[123]361 While UsingStr[i2] = Asc("#")
[1]362 If i4<0 Then
363 buffer[i3]=&H30
364 Else
365 buffer[i3]=temp2[i4]
366 End If
[90]367 i3++
368 i4++
[1]369
[90]370 i2++
[1]371 Wend
372 End If
373 ElseIf UsingStr[i2]=Asc("@") Then
[90]374 i2++
[1]375
[123]376 'lstrcat(StrPtr(buffer)+i3,_System_UsingStrData[ParmNum])
377 memcpy(VarPtr(buffer[i3 + lstrlen(VarPtr(buffer[i3]))]), _System_UsingStrData[ParmNum], _
[142]378 SizeOf (StrChar) * lstrlen(_System_UsingStrData[ParmNum]))
[123]379 i3 += lstrlen(_System_UsingStrData[ParmNum])
[1]380 ElseIf UsingStr[i2]=Asc("&") Then
381 i4=0
382 Do
[90]383 i4++
384 i2++
[1]385 Loop While UsingStr[i2]=Asc(" ")
386
387 If UsingStr[i2]=Asc("&") Then
[90]388 i4++
389 i2++
[1]390 i5=lstrlen(_System_UsingStrData[ParmNum])
391 If i4<=i5 Then
392 i5=i4
393 Else
[123]394 _System_FillChar(VarPtr(buffer[i3]), i4, &h20) 'Asc(" ")
[1]395 End If
[142]396 memcpy(VarPtr(buffer[i3]), _System_UsingStrData[ParmNum], SizeOf (StrChar) * i5)
[90]397 i3 += i4
[1]398 Else
[90]399 i2 -= i4
[123]400 buffer[i3] = Asc("&")
[90]401 i2++
402 i3++
[1]403 Continue
404 End If
405 End If
406
[90]407 ParmNum++
[1]408 Wend
409
[123]410 _System_GetUsingFormat = Left$(buffer, lstrlen(buffer))
[1]411End Function
412Sub PRINTUSING_ToFile(FileNumber As Long, UsingStr As String)
413 Dim dwAccessByte As DWord
414 Dim buf As String
415
[90]416 FileNumber--
[1]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)
[90]424 FileNumber--
[1]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
[90]431 FileNumber--
432 RecodeNumber--
[1]433
[142]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)
[1]437 If Not dwAccessByte=_System_FieldSize(FileNumber) Then
[142]438 lpBuffer = Left$(lpBuffer, dwAccessByte)
[1]439 End If
440End Macro
441Macro PUT(FileNumber As Long, RecodeNumber As Long, ByRef lpBuffer As String)
442 Dim dwAccessByte As Long
443
[90]444 FileNumber--
445 RecodeNumber--
[1]446
[142]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)
[1]449End Macro
450
[21]451Macro CHDIR(path As String)
[142]452 SetCurrentDirectory(ToTCStr(path))
[1]453End Macro
[21]454Macro MKDIR(path As String)
[142]455 CreateDirectory(ToTCStr(path), 0)
[1]456End Macro
[21]457Macro KILL(path As String)
[142]458 DeleteFile(ToTCStr(path))
[1]459End Macro
460
461
462#endif '_INC_COMMAND
Note: See TracBrowser for help on using the repository browser.