Context Navigation

command.sbp@ 497

Last change on this file since 497 was 497, checked in by イグトランス (egtra), 16 years ago
インクルードガードとその他不要な前処理定義などの削除
File size: 11.3 KB

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

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

Download in other formats:

Original Format