Context Navigation

command.sbp@ 288

Last change on this file since 288 was 288, checked in by dai, 17 years ago
いくつかタイプミスを修正。エラーになるコードを排除、 enumクラスのビット演算メソッドをコメントアウト（仕様未確定なため）。
File size: 11.9 KB

Rev	Line
[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]	10	Const _System_Type_SByte = 1
[89]	11	Const _System_Type_Byte = 2
[1]	12	Const _System_Type_Integer = 3
[89]	13	Const _System_Type_Word = 4
	14	Const _System_Type_Long = 5
	15	Const _System_Type_DWord = 6
	16	Const _System_Type_Int64 = 7
	17	Const _System_Type_QWord = 8
[1]	18	Const _System_Type_Single = 9
	19	Const _System_Type_Double = 10
[119]	20	Const _System_Type_Char = 11
	21	Const _System_Type_String = 13
	22	Const _System_Type_VoidPtr = 14
[1]	23	Const _System_MAX_PARMSNUM = 32-1
	24
	25	Dim _System_DummyStr As String
	26	Dim _System_DummyStr2 As String
	27
	28	Macro BEEP()
	29	MessageBeep(MB_OK)
	30	End Macro
	31
	32	Sub _System_Call_Destructor_of_GlobalObject() 'dummy
	33	End Sub
	34
[179]	35	Sub _System_End()
[269]	36	System.Detail.hasShutdownStarted = True
[258]	37	Dim exitCode = System.Environment.ExitCode
[165]	38	_System_EndProgram()
[175]	39	ExitProcess(exitCode)
[179]	40	End Sub
	41
	42	Macro END()
	43	_System_End()
[1]	44	End Macro
	45
[142]	46	Macro EXEC(filePath As String)(cmdLine As String)
[281]	47	ShellExecute(0, ToTCStr("open"), ToTCStr(filePath), ToTCStr(cmdLine), 0, SW_SHOWNORMAL)
[1]	48	End Macro
	49
	50	Macro INPUT() 'dummy（INPUT_FromFile、INPUT_FromPromptを参照）
	51	End Macro
	52
	53	Macro PRINT() 'dummy（PRINT_ToFile、PRINT_ToPromptを参照）
	54	End Macro
	55
	56	Macro RANDOMIZE()
	57	srand(GetTickCount())
	58	End Macro
	59
	60	Macro WRITE() 'dummy（PRINT_ToFile、PRINT_ToPromptを参照）
	61	End Macro
	62
	63	'----------------
	64	' ウィンドウ関連
	65	'----------------
	66
[142]	67	Function _System_MessageBox(hw As HWND, s As PCSTR, t As PCSTR, b As DWord) As DWord
	68	Return MessageBoxA(hw, s, t, b)
	69	End Function
	70
	71	Function _System_MessageBox(hw As HWND, s As PCWSTR, t As PCWSTR, b As DWord) As DWord
	72	Return MessageBoxW(hw, s, t, b)
	73	End Function
	74
	75	Macro MSGBOX(hwnd As HWND, str As String)(title As String, boxType As DWord, ByRef retAns As DWord)
[1]	76	If VarPtr(retAns) Then
[237]	77	retAns = _System_MessageBox(hwnd, ToSCStr(str), ToSCStr(title), boxType)
[1]	78	Else
[237]	79	_System_MessageBox(hwnd, ToSCStr(str), ToSCStr(title), boxType)
[1]	80	End If
	81	End Macro
	82
[142]	83	Macro 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)
	84	Dim hwnd = CreateWindowEx(dwExStyle, ToTCStr(className), ToTCStr(title), dwStyle, x, y, width, height, hOwner, id, GetModuleHandle(0), 0)
	85	If VarPtr(hwndRet) Then
	86	hwndRet = hwnd
[1]	87	End If
	88	End Macro
	89
	90	Macro DELWND(hWnd As HWND)
	91	DestroyWindow(hWnd)
	92	End Macro
	93
[142]	94	Macro INSMENU(hMenu As HMENU, PosID As Long, flag As Long)(str As String, id As Long, hSubMenu As HMENU, state As Long)
[1]	95	Dim mii As MENUITEMINFO
[123]	96	ZeroMemory(VarPtr(mii), Len(mii))
	97	With mii
	98	.cbSize = Len(mii)
	99	.fMask = MIIM_TYPE
[1]	100
[173]	101	If str.Length = 0 Then
[123]	102	mii.fType = MFT_SEPARATOR
	103	Else
	104	.fType = MFT_STRING
	105	.fMask = .fMask or MIIM_STATE or MIIM_ID
[142]	106	.dwTypeData = ToTCStr(str)
[123]	107	.wID = id
	108	If hSubMenu Then
	109	.fMask = .fMask or MIIM_SUBMENU
	110	.hSubMenu = hSubMenu
	111	End If
[142]	112	.fState = state
[1]	113	End If
[123]	114	End With
	115	InsertMenuItem(hMenu, PosID, flag, mii)
[1]	116	End Macro
	117
	118
	119	'--------------
	120	' ファイル関連
	121	'--------------
	122
[90]	123	Dim _System_hFile(255) As HANDLE
[142]	124	Macro OPEN(fileName As String, AccessFor As Long, FileNumber As Long)
	125	Dim access As Long
	126	Dim bAppend = False As Boolean
	127	Dim creationDisposition As Long
[1]	128
[90]	129	FileNumber--
[1]	130
	131	Select Case AccessFor
	132	Case 0
[142]	133	access = GENERIC_READ or GENERIC_WRITE
	134	creationDisposition = OPEN_ALWAYS
[1]	135	Case 1
[142]	136	access = GENERIC_READ
	137	creationDisposition = OPEN_EXISTING
[1]	138	Case 2
[142]	139	access = GENERIC_WRITE
	140	creationDisposition = CREATE_ALWAYS
[1]	141	Case 3
[142]	142	access = GENERIC_WRITE
	143	creationDisposition = OPEN_ALWAYS
	144	bAppend = True
[1]	145	End Select
	146
[142]	147	_System_hFile(FileNumber) = CreateFile(ToTCStr(fileName), access, 0, ByVal 0, creationDisposition, FILE_ATTRIBUTE_NORMAL, 0)
[1]	148
[142]	149	If bAppend Then SetFilePointer(_System_hFile(FileNumber), 0, 0, FILE_END)
[1]	150	End Macro
[90]	151
[1]	152	Macro CLOSE()(FileNumber As Long)
[90]	153	FileNumber--
[1]	154
	155	If _System_hFile(FileNumber) Then
[21]	156	CloseHandle(_System_hFile(FileNumber))
	157	_System_hFile(FileNumber)=0
[1]	158	End If
	159	End Macro
	160
	161	'INPUT Command Data
	162	Dim _System_InputDataPtr[_System_MAX_PARMSNUM] As VoidPtr
	163	Dim _System_InputDataType[_System_MAX_PARMSNUM] As DWord
	164	Sub INPUT_FromFile(FileNumber As Long)
[272]	165	FileNumber--
	166
	167	Dim i = 0 As Long
	168	Dim i2 As Long, i3 As Long
	169	Dim buffer = New System.Text.StringBuilder(GetFileSize(_System_hFile[FileNumber], 0) + 1)
[142]	170	Dim temp[1] As StrChar
[1]	171	Dim dwAccessBytes As DWord
	172	Dim IsStr As Long
	173
	174	While 1
	175	'次のデータをサーチ
	176	Do
[142]	177	i2=ReadFile(_System_hFile[FileNumber],temp,SizeOf (StrChar),VarPtr(dwAccessBytes),ByVal 0)
[1]	178	If i2=0 or dwAccessBytes=0 Then
	179	'error
	180	Exit Macro
	181	End If
	182	Loop While temp[0]=32 or temp[0]=9
	183	SetFilePointer(_System_hFile[FileNumber],-1,0,FILE_CURRENT)
	184
	185	'読み込み
	186	i3=-1
	187	IsStr=0
	188	While 1
[90]	189	i3++
[1]	190
[142]	191	i2=ReadFile(_System_hFile[FileNumber],temp,SizeOf (StrChar),VarPtr(dwAccessBytes),ByVal 0)
[1]	192	If i2=0 or (i3=0 and dwAccessBytes=0) Then
	193	'error
	194	Exit Macro
	195	End If
	196	If temp[0]=34 Then IsStr=IsStr xor 1
	197
	198	buffer[i3]=temp[0]
	199	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
	200	If temp[0]=13 Then
[142]	201	ReadFile(_System_hFile[FileNumber],temp,SizeOf (StrChar),VarPtr(dwAccessBytes),ByVal 0)
[1]	202	If Not(dwAccessBytes<>0 And temp[0]=10) Then
	203	SetFilePointer(_System_hFile[FileNumber],-1,0,FILE_CURRENT)
	204	Continue
	205	End If
	206	End If
	207
	208	If temp[0]=32 or temp[0]=9 Then
	209	While 1
	210	ReadFile(_System_hFile[FileNumber],temp,1,VarPtr(dwAccessBytes),ByVal 0)
	211	If dwAccessBytes=0 Then Exit While
	212	If temp[0]=Asc(",") Then Exit While
[21]	213	If Not(temp[0]=32 or temp[0]=9) Then
[1]	214	SetFilePointer(_System_hFile[FileNumber],-1,0,FILE_CURRENT)
	215	Exit While
	216	End If
	217	Wend
	218	End If
	219
	220	buffer[i3]=0
	221	Exit While
	222	End If
	223	Wend
	224
	225	'データを変数に格納
[272]	226	_System_Input_SetArgument(_System_InputDataPtr[i], _System_InputDataType[i], buffer.ToString)
[1]	227
[21]	228
[121]	229	i++
[1]	230	If _System_InputDataPtr[i]=0 Then Exit While
	231	Wend
	232	End Sub
	233
[272]	234	Sub _System_Input_SetArgument(arg As VoidPtr, dataType As DWord, buf As String)
[121]	235	Select Case dataType
	236	Case _System_Type_Double
	237	SetDouble(arg, Val(buf))
	238	Case _System_Type_Single
	239	SetSingle(arg, Val(buf))
	240	Case _System_Type_Int64,_System_Type_QWord
	241	SetQWord(arg, Val(buf))
	242	Case _System_Type_Long,_System_Type_DWord
	243	SetDWord(arg, Val(buf))
	244	Case _System_Type_Integer,_System_Type_Word
	245	SetWord(arg, Val(buf))
	246	Case _System_Type_SByte,_System_Type_Byte
	247	SetByte(arg, Val(buf))
	248	Case _System_Type_Char
	249	SetChar(arg, buf[0])
	250	Case _System_Type_String
	251	Dim pTempStr As *String
	252	pTempStr = arg As *String
[272]	253	pTempStr[0] = buf
[121]	254	End Select
[123]	255	End Sub
[121]	256
[1]	257	Sub PRINT_ToFile(FileNumber As Long, buf As String)
	258	Dim dwAccessByte As DWord
[123]	259	FileNumber--
[1]	260
[142]	261	WriteFile(_System_hFile(FileNumber), buf, Len(buf), VarPtr(dwAccessByte), ByVal 0)
[1]	262	End Sub
	263
	264	Dim _System_UsingDblData[_System_MAX_PARMSNUM] As Double
[214]	265	Dim _System_UsingStrData[_System_MAX_PARMSNUM] As *Char 'TODO: 暫定対応（動作未確認）
[1]	266	Dim _System_UsingDataType[_System_MAX_PARMSNUM] As DWord
[272]	267	/*
[1]	268	Function _System_GetUsingFormat(UsingStr As String) As String
	269	Dim i2 As Long, i3 As Long, i4 As Long, i5 As Long, ParmNum As Long
[142]	270	Dim temporary[255] As StrChar
[272]	271	Dim buffer = New System.Text.StringBuilder(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	'通常時
[272]	331	ActiveBasic.Strings.Detail.ChrFill(VarPtr(buffer.Chars[i3]), length_buf - length_num, &h20) 'Asc(" ")
[123]	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
[237]	343	memcpy(VarPtr(buffer.Chars[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	'表示桁が足りないとき
[272]	351	ActiveBasic.Strings.Detail.ChrFill(VarPtr(buffer.Chars[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
[237]	376	lstrcat(VarPtr(buffer.Chars[i3]), _System_UsingStrData[ParmNum])
[123]	377	i3 += lstrlen(_System_UsingStrData[ParmNum])
[1]	378	ElseIf UsingStr[i2]=Asc("&") Then
	379	i4=0
	380	Do
[90]	381	i4++
	382	i2++
[1]	383	Loop While UsingStr[i2]=Asc(" ")
	384
	385	If UsingStr[i2]=Asc("&") Then
[90]	386	i4++
	387	i2++
[1]	388	i5=lstrlen(_System_UsingStrData[ParmNum])
	389	If i4<=i5 Then
	390	i5=i4
	391	Else
[272]	392	ActiveBasic.Strings.Detail.ChrFill(VarPtr(buffer.Chars[i3]), i4, &h20) 'Asc(" ")
[1]	393	End If
[237]	394	memcpy(VarPtr(buffer.Chars[i3]), _System_UsingStrData[ParmNum], SizeOf (StrChar) * i5)
[90]	395	i3 += i4
[1]	396	Else
[90]	397	i2 -= i4
[123]	398	buffer[i3] = Asc("&")
[90]	399	i2++
	400	i3++
[1]	401	Continue
	402	End If
	403	End If
	404
[90]	405	ParmNum++
[1]	406	Wend
	407
[272]	408	_System_GetUsingFormat = buffer.ToString(0, lstrlen(StrBPtr(buffer)))
[1]	409	End Function
[288]	410
	411	' TODO: _System_GetUsingFormatを用意して実装する
[1]	412	Sub 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)
	420	End Sub
[288]	421	*/
[1]	422
	423	Dim _System_FieldSize(255) As Long
	424	Macro FIELD(FileNumber As Long, FieldSize As Long)
[90]	425	FileNumber--
[1]	426
	427	_System_FieldSize(FileNumber)=FieldSize
	428	End Macro
	429	Macro GET(FileNumber As Long, RecodeNumber As Long, ByRef lpBuffer As String)
[237]	430	Dim dwAccessByte As DWord
[1]	431
[90]	432	FileNumber--
	433	RecodeNumber--
[1]	434
[142]	435	SetFilePointer(_System_hFile(FileNumber), SizeOf (StrChar) * RecodeNumber * _System_FieldSize(FileNumber), 0, FILE_BEGIN)
	436	lpBuffer = ZeroString(_System_FieldSize(FileNumber))
	437	ReadFile(_System_hFile(FileNumber), StrPtr(lpBuffer), SizeOf (StrChar) * _System_FieldSize(FileNumber), VarPtr(dwAccessByte),ByVal 0)
[1]	438	If Not dwAccessByte=_System_FieldSize(FileNumber) Then
[142]	439	lpBuffer = Left$(lpBuffer, dwAccessByte)
[1]	440	End If
	441	End Macro
	442	Macro PUT(FileNumber As Long, RecodeNumber As Long, ByRef lpBuffer As String)
[237]	443	Dim dwAccessByte As DWord
[1]	444
[90]	445	FileNumber--
	446	RecodeNumber--
[1]	447
[142]	448	SetFilePointer(_System_hFile(FileNumber), SizeOf (StrChar) * RecodeNumber*_System_FieldSize(FileNumber), 0, FILE_BEGIN)
	449	WriteFile(_System_hFile(FileNumber), StrPtr(lpBuffer),SizeOf (StrChar) * _System_FieldSize(FileNumber), VarPtr(dwAccessByte), ByVal 0)
[1]	450	End Macro
	451
[21]	452	Macro CHDIR(path As String)
[142]	453	SetCurrentDirectory(ToTCStr(path))
[1]	454	End Macro
[21]	455	Macro MKDIR(path As String)
[142]	456	CreateDirectory(ToTCStr(path), 0)
[1]	457	End Macro
[21]	458	Macro KILL(path As String)
[142]	459	DeleteFile(ToTCStr(path))
[1]	460	End Macro
	461
	462
	463	#endif '_INC_COMMAND

Note: See TracBrowser for help on using the repository browser.

Download in other formats:

Original Format