Context Navigation

command.sbp@ 21

Last change on this file since 21 was 21, checked in by dai, 17 years ago
String型パラメータのByRef指定がリテラル値指定を不可能にしていましたので、ファイルを前のバージョンに戻します。
File size: 11.2 KB

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

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

Download in other formats:

Original Format