source: Include/basic/command.sbp@ 149

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

Environment, OperatingSystem, Versionの追加、Unicode対応修正ほか

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