Context Navigation

command.sbp@ 478

Last change on this file since 478 was 478, checked in by イグトランス (egtra), 16 years ago
現在向けに修正（参照型のポインタの排除など）
File size: 11.4 KB

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

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

Download in other formats:

Original Format