Context Navigation

command.sbp@ 628

Last change on this file since 628 was 628, checked in by イグトランス (egtra), 16 years ago
winnls.ab, winsvc.abを追加
File size: 11.6 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)
[628]	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--
[628]	138	ActiveBasic.Detail.ThrowIfInvaildFileNum(FileNumber)
[1]	139
	140	If _System_hFile(FileNumber) Then
[21]	141	CloseHandle(_System_hFile(FileNumber))
	142	_System_hFile(FileNumber)=0
[1]	143	End If
	144	End Macro
	145
	146	'INPUT Command Data
	147	Dim _System_InputDataPtr[_System_MAX_PARMSNUM] As VoidPtr
	148	Dim _System_InputDataType[_System_MAX_PARMSNUM] As DWord
	149	Sub INPUT_FromFile(FileNumber As Long)
[272]	150	FileNumber--
[628]	151	ActiveBasic.Detail.ThrowIfInvaildFileNum(FileNumber)
[497]	152
[272]	153	Dim i = 0 As Long
[391]	154	Dim buffer = New System.Text.StringBuilder(256)
[497]	155	Dim temp[1] As Char
[1]	156	Dim dwAccessBytes As DWord
	157	Dim IsStr As Long
	158
	159	While 1
	160	'次のデータをサーチ
	161	Do
[497]	162	Dim ret = ReadFile(_System_hFile[FileNumber],temp,SizeOf (Char),VarPtr(dwAccessBytes),ByVal 0)
[391]	163	If ret=0 or dwAccessBytes=0 Then
[1]	164	'error
	165	Exit Macro
	166	End If
	167	Loop While temp[0]=32 or temp[0]=9
	168	SetFilePointer(_System_hFile[FileNumber],-1,0,FILE_CURRENT)
	169
	170	'読み込み
	171	IsStr=0
	172	While 1
[497]	173	Dim ret = ReadFile(_System_hFile[FileNumber],temp,SizeOf (Char),VarPtr(dwAccessBytes),ByVal 0)
[391]	174	If ret = 0 or dwAccessBytes = 0 Then
[1]	175	'error
	176	Exit Macro
	177	End If
	178	If temp[0]=34 Then IsStr=IsStr xor 1
	179
[391]	180	buffer.Append(temp[0])
[1]	181	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
	182	If temp[0]=13 Then
[497]	183	ReadFile(_System_hFile[FileNumber],temp,SizeOf (Char),VarPtr(dwAccessBytes),ByVal 0)
[1]	184	If Not(dwAccessBytes<>0 And temp[0]=10) Then
	185	SetFilePointer(_System_hFile[FileNumber],-1,0,FILE_CURRENT)
	186	Continue
	187	End If
	188	End If
	189
	190	If temp[0]=32 or temp[0]=9 Then
	191	While 1
	192	ReadFile(_System_hFile[FileNumber],temp,1,VarPtr(dwAccessBytes),ByVal 0)
	193	If dwAccessBytes=0 Then Exit While
	194	If temp[0]=Asc(",") Then Exit While
[21]	195	If Not(temp[0]=32 or temp[0]=9) Then
[1]	196	SetFilePointer(_System_hFile[FileNumber],-1,0,FILE_CURRENT)
	197	Exit While
	198	End If
	199	Wend
	200	End If
	201
[497]	202	buffer.Append(0 As Char)
[1]	203	Exit While
	204	End If
	205	Wend
	206
	207	'データを変数に格納
[272]	208	_System_Input_SetArgument(_System_InputDataPtr[i], _System_InputDataType[i], buffer.ToString)
[1]	209
[21]	210
[121]	211	i++
[1]	212	If _System_InputDataPtr[i]=0 Then Exit While
	213	Wend
	214	End Sub
	215
[272]	216	Sub _System_Input_SetArgument(arg As VoidPtr, dataType As DWord, buf As String)
[121]	217	Select Case dataType
	218	Case _System_Type_Double
	219	SetDouble(arg, Val(buf))
	220	Case _System_Type_Single
	221	SetSingle(arg, Val(buf))
	222	Case _System_Type_Int64,_System_Type_QWord
	223	SetQWord(arg, Val(buf))
	224	Case _System_Type_Long,_System_Type_DWord
	225	SetDWord(arg, Val(buf))
	226	Case _System_Type_Integer,_System_Type_Word
	227	SetWord(arg, Val(buf))
	228	Case _System_Type_SByte,_System_Type_Byte
	229	SetByte(arg, Val(buf))
	230	Case _System_Type_Char
	231	SetChar(arg, buf[0])
	232	Case _System_Type_String
	233	Dim pTempStr As *String
	234	pTempStr = arg As *String
[272]	235	pTempStr[0] = buf
[121]	236	End Select
[123]	237	End Sub
[121]	238
[1]	239	Sub PRINT_ToFile(FileNumber As Long, buf As String)
	240	Dim dwAccessByte As DWord
[123]	241	FileNumber--
[628]	242	ActiveBasic.Detail.ThrowIfInvaildFileNum(FileNumber)
[1]	243
[457]	244	WriteFile(_System_hFile(FileNumber), StrPtr(buf), Len(buf), VarPtr(dwAccessByte), ByVal 0)
[1]	245	End Sub
	246
	247	Dim _System_UsingDblData[_System_MAX_PARMSNUM] As Double
[214]	248	Dim _System_UsingStrData[_System_MAX_PARMSNUM] As *Char 'TODO: 暫定対応（動作未確認）
[1]	249	Dim _System_UsingDataType[_System_MAX_PARMSNUM] As DWord
[272]	250	/*
[1]	251	Function _System_GetUsingFormat(UsingStr As String) As String
	252	Dim i2 As Long, i3 As Long, i4 As Long, i5 As Long, ParmNum As Long
[497]	253	Dim temporary[255] As Char
[272]	254	Dim buffer = New System.Text.StringBuilder(1024)
[1]	255
[142]	256	ParmNum = 0
	257	i2 = 0
[1]	258	While 1
	259	While 1
	260	If UsingStr[i2]=Asc("#") or UsingStr[i2]=Asc("@") or UsingStr[i2]=Asc("&") Then Exit While
	261	buffer[i3]=UsingStr[i2]
	262	If UsingStr[i2]=0 Then Exit While
[90]	263	i2++
	264	i3++
[1]	265	Wend
	266
	267	If UsingStr[i2]=0 Then Exit While
	268
	269	If UsingStr[i2]=Asc("#") Then
	270	Dim dec As Long, sign As Long
[497]	271	Dim temp2 As *Char
[1]	272
	273	Dim length_num As Long, length_buf As Long
[21]	274	Dim dblRoundOff=0 As Double
[1]	275
	276
	277	'----------------------
	278	' 四捨五入を考慮
	279	'----------------------
	280
	281	i4=i2
	282	While UsingStr[i4]=Asc("#")
[90]	283	i4++
[1]	284	Wend
	285	If UsingStr[i4]=Asc(".") Then
[90]	286	i4++
[1]	287
	288	dblRoundOff=0.5
	289	While UsingStr[i4]=Asc("#")
[90]	290	i4++
	291	dblRoundOff /= 10
[1]	292	Wend
	293	End If
	294
	295
	296	'浮動小数点を文字列に変換
	297	temp2=_ecvt(_System_UsingDblData[ParmNum]+dblRoundOff,15,dec,sign)
	298
	299	'整数部
	300	length_num=dec
	301	If length_num<=0 Then length_num=1
	302
	303	'符号が有る場合は、一文字分のスペースを考慮する
[90]	304	If sign Then length_num++
[1]	305
	306	length_buf=0
	307	Do
[90]	308	i2++
	309	length_buf++
[1]	310	Loop While UsingStr[i2]=Asc("#")
	311
	312	If length_buf>=length_num Then
	313	'通常時
[272]	314	ActiveBasic.Strings.Detail.ChrFill(VarPtr(buffer.Chars[i3]), length_buf - length_num, &h20) 'Asc(" ")
[123]	315
[90]	316	i3 += length_buf - length_num
[1]	317
	318	If sign Then
[123]	319	buffer[i3] = Asc("-")
[90]	320	i3++
[1]	321
[90]	322	length_num--
[1]	323	End If
	324
[123]	325	If dec > 0 Then
[497]	326	memcpy(VarPtr(buffer.Chars[i3]), temp2, SizeOf (Char) * length_num)
[1]	327	Else
[123]	328	buffer[i3] = &H30
[1]	329	End If
	330
[90]	331	i3 += length_num
[1]	332	Else
	333	'表示桁が足りないとき
[272]	334	ActiveBasic.Strings.Detail.ChrFill(VarPtr(buffer.Chars[i3]), length_buf, &h23) 'Asc("#")
[90]	335	i3 += length_buf
[1]	336	End If
	337
[123]	338	If UsingStr[i2] = Asc(".") Then
	339	buffer[i3] = UsingStr[i2]
[90]	340	i2++
	341	i3++
[1]	342
	343	i4=dec
[123]	344	While UsingStr[i2] = Asc("#")
[1]	345	If i4<0 Then
	346	buffer[i3]=&H30
	347	Else
	348	buffer[i3]=temp2[i4]
	349	End If
[90]	350	i3++
	351	i4++
[1]	352
[90]	353	i2++
[1]	354	Wend
	355	End If
	356	ElseIf UsingStr[i2]=Asc("@") Then
[90]	357	i2++
[1]	358
[237]	359	lstrcat(VarPtr(buffer.Chars[i3]), _System_UsingStrData[ParmNum])
[123]	360	i3 += lstrlen(_System_UsingStrData[ParmNum])
[1]	361	ElseIf UsingStr[i2]=Asc("&") Then
	362	i4=0
	363	Do
[90]	364	i4++
	365	i2++
[1]	366	Loop While UsingStr[i2]=Asc(" ")
	367
	368	If UsingStr[i2]=Asc("&") Then
[90]	369	i4++
	370	i2++
[1]	371	i5=lstrlen(_System_UsingStrData[ParmNum])
	372	If i4<=i5 Then
	373	i5=i4
	374	Else
[272]	375	ActiveBasic.Strings.Detail.ChrFill(VarPtr(buffer.Chars[i3]), i4, &h20) 'Asc(" ")
[1]	376	End If
[497]	377	memcpy(VarPtr(buffer.Chars[i3]), _System_UsingStrData[ParmNum], SizeOf (Char) * i5)
[90]	378	i3 += i4
[1]	379	Else
[90]	380	i2 -= i4
[123]	381	buffer[i3] = Asc("&")
[90]	382	i2++
	383	i3++
[1]	384	Continue
	385	End If
	386	End If
	387
[90]	388	ParmNum++
[1]	389	Wend
	390
[272]	391	_System_GetUsingFormat = buffer.ToString(0, lstrlen(StrBPtr(buffer)))
[1]	392	End Function
[288]	393
	394	' TODO: _System_GetUsingFormatを用意して実装する
[1]	395	Sub PRINTUSING_ToFile(FileNumber As Long, UsingStr As String)
	396	Dim dwAccessByte As DWord
	397	Dim buf As String
	398
[90]	399	FileNumber--
[1]	400	buf=_System_GetUsingFormat(UsingStr)
	401
	402	WriteFile(_System_hFile(FileNumber),buf,Len(buf),VarPtr(dwAccessByte),ByVal NULL)
	403	End Sub
[288]	404	*/
[1]	405
	406	Dim _System_FieldSize(255) As Long
	407	Macro FIELD(FileNumber As Long, FieldSize As Long)
[90]	408	FileNumber--
[628]	409	ActiveBasic.Detail.ThrowIfInvaildFileNum(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--
[628]	416	ActiveBasic.Detail.ThrowIfInvaildFileNum(FileNumber)
[90]	417	RecodeNumber--
[1]	418
[497]	419	SetFilePointer(_System_hFile(FileNumber), SizeOf (Char) * RecodeNumber * _System_FieldSize(FileNumber), 0, FILE_BEGIN)
[303]	420	Dim t = ZeroString(_System_FieldSize(FileNumber))
[497]	421	ReadFile(_System_hFile(FileNumber), StrPtr(t), SizeOf (Char) * _System_FieldSize(FileNumber), VarPtr(dwAccessByte), ByVal 0)
[303]	422	If dwAccessByte = _System_FieldSize(FileNumber) Then
	423	buffer = t.ToString
	424	Else
	425	buffer = Left$(t.ToString, dwAccessByte)
[1]	426	End If
	427	End Macro
[303]	428	Macro PUT(FileNumber As Long, RecodeNumber As Long, buffer As String)
[237]	429	Dim dwAccessByte As DWord
[1]	430
[90]	431	FileNumber--
[628]	432	ActiveBasic.Detail.ThrowIfInvaildFileNum(FileNumber)
[90]	433	RecodeNumber--
[1]	434
[497]	435	SetFilePointer(_System_hFile(FileNumber), SizeOf (Char) * RecodeNumber*_System_FieldSize(FileNumber), 0, FILE_BEGIN)
	436	WriteFile(_System_hFile(FileNumber), StrPtr(buffer), SizeOf (Char) * _System_FieldSize(FileNumber), VarPtr(dwAccessByte), ByVal 0)
[1]	437	End Macro
	438
[21]	439	Macro CHDIR(path As String)
[142]	440	SetCurrentDirectory(ToTCStr(path))
[1]	441	End Macro
[21]	442	Macro MKDIR(path As String)
[142]	443	CreateDirectory(ToTCStr(path), 0)
[1]	444	End Macro
[21]	445	Macro KILL(path As String)
[142]	446	DeleteFile(ToTCStr(path))
[1]	447	End Macro

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

Download in other formats:

Original Format