Context Navigation

command.sbp@ 303

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

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

Download in other formats:

Original Format