Context Navigation

command.sbp@ 232

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

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

Download in other formats:

Original Format