Context Navigation

command.sbp@ 451

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

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

Download in other formats:

Original Format