⭐ 欢迎来到虫虫下载站！ | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站
📤 上传资源

📄 bht8000.src.bak

📁 BHT8000数据采集器源码。本程序是串口通信。是一个最通用的程序。
💻 BAK
📖 第 1 页 / 共 3 页
字号:
🔍
123 
						Exit Sub
					Case Else
						If arySys$(i,3)="1" Then
							For j=Len(s$) To Val(arySys$(i,2))-1
								s$=S$+" "
							Next
						End If
						stock$(i)=s$
				End Select
			Next
	'********** If Trigger be press **********'
			While (INP(0) AND &h04)<>0
			Wend
	'**********  Write Into records  **********'
			Open pathfile$ As #1
			Open "A:STOCK.DAT" As #2
			Select fdCounts%
				Case 1
					Field #1, Val(arySys$(1,2)) As sf1$
					sf1$=stock$(1)
					Field #2, Val(arySys$(1,2)) As sft1$
					sft1$=stock$(1)
				Case 2
					Field #1, Val(arySys$(1,2)) As sf1$,Val(arySys$(2,2)) As sf2$
					sf1$=stock$(1)
					sf2$=stock$(2)
					Field #2, Val(arySys$(1,2)) As sft1$,Val(arySys$(2,2)) As sft2$
					sft1$=stock$(1)
					sft2$=stock$(2)
				Case 3
					Field #1, Val(arySys$(1,2)) As sf1$,Val(arySys$(2,2)) As sf2$,Val(arySys$(3,2)) As sf3$
					sf1$=stock$(1)
					sf2$=stock$(2)
					sf3$=stock$(3)
					Field #2, Val(arySys$(1,2)) As sft1$,Val(arySys$(2,2)) As sft2$,Val(arySys$(3,2)) As sft3$
					sft1$=stock$(1)
					sft2$=stock$(2)
					sft3$=stock$(3)
				Case 4
					Field #1, Val(arySys$(1,2)) As sf1$,Val(arySys$(2,2)) As sf2$,Val(arySys$(3,2)) As sf3$,Val(arySys$(4,2)) As sf4$
					sf1$=stock$(1)
					sf2$=stock$(2)
					sf3$=stock$(3)
					sf4$=stock$(4)
					Field #2, Val(arySys$(1,2)) As sft1$,Val(arySys$(2,2)) As sft2$,Val(arySys$(3,2)) As sft3$,Val(arySys$(4,2)) As sft4$
					sft1$=stock$(1)
					sft2$=stock$(2)
					sft3$=stock$(3)
					sft4$=stock$(4)
			End Select

			For i=1 to FdCounts%
				Select Case arySys$(i,1)
					Case "条码"
						bCode$=stock$(i)
					Case "编号"
						wId$=stock$(i)
				End Select
			Next

			bFound$="False"
			Found%=1
 			While bFound$="False" And Found%>0
				For i=1 to FdCounts%
					If arySys$(i,1)="条码"	Then
						Select i
							Case 1
								Found%=Search(#2,sft1$,stock$(i),Found%)
							Case 2
								Found%=Search(#2,sft2$,stock$(i),Found%)
							Case 3
								Found%=Search(#2,sft3$,stock$(i),Found%)
							Case 4
								Found%=Search(#2,sft4$,stock$(i),Found%)
						End Select
					End If
				Next
				
				If Found%>0 Then
					Get #2,Found%
					For i=1 to FdCounts%
						If arySys$(i,1)="编号"	Then
							Select i
								Case 1
									wTemp$=sft1$
								Case 2
									wTemp$=sft2$
								Case 3
									wTemp$=sft3$
								Case 4
									wTemp$=sft4$
							End Select
						End If
					Next
					If wId$<>wTemp$ Then
						bFound$="False"
						Found%=Found%+1
					Else
						bFound$="True"
					End If
				End If
			Wend
			If bFound$="False" Then
				For i=1 to FdCounts%
					If arySys$(i,1)="编号"	Then
						Select i
							Case 1
								sft1$=wId$
							Case 2
								sft2$=wId$
							Case 3
								sft3$=wId$
							Case 4
								sft4$=wId$
						End Select
					End If
				Next
			End If
			
			If UniqueCode%= 1 Then
				If bFound$="False" Then
					Put #1
					Put #2
				Else
					Print ""
					Screen 1,1	:Print "该条码已存在!"
					Wait 0,1
				End If
			Else
				If bFound$="False" Then
					'sft3$="1"
					If strType$="out" Then
						Print
						Screen 1,1	:Print "库存中无该记录!";
						Wait 0,1
					Else
						Put #1
						Put #2
					End If
				Else
					Get #2,Found%
					For i=1 to FdCounts%
						If arySys$(i,1)="数量"	Then
							If strType$="in" Then
								Select i
									Case 1
										sft1$=Mid$(Str$(Val(sft1$)+Val(sf1$)),2)
									Case 2
										sft2$=Mid$(Str$(Val(sft2$)+Val(sf2$)),2)
									Case 3
										sft3$=Mid$(Str$(Val(sft3$)+Val(sf3$)),2)
									Case 4
										sft4$=Mid$(Str$(Val(sft4$)+Val(sf4$)),2)
								End Select
							Else
								Select i
									Case 1
										If Val(sft1$)-Val(sf1$)=>0 Then
											sft1$=Mid$(Str$(Val(sft1$)-Val(sf1$)),2)
										Else
											flag%=-1
										End If
									Case 2
										If Val(sft2$)-Val(sf2$)=>0 Then
											sft2$=Mid$(Str$(Val(sft2$)-Val(sf2$)),2)
										Else
											flag%=-1
										End If
									Case 3
										If Val(sft3$)-Val(sf3$)=>0 Then
											sft3$=Mid$(Str$(Val(sft3$)-Val(sf3$)),2)
										Else
											flag%=-1
										End If
									Case 4
										If Val(sft4$)-Val(sf4$)=>0 Then
											sft4$=Mid$(Str$(Val(sft4$)-Val(sf4$)),2)
										Else
											flag%=-1
										End If
								End Select
							End If
						End If
					Next
					If flag%=-1 Then
						Print
						Screen 1,1	:Print "出库大于库存量!";
						wait 0,1
					Else
						Put #1
						Put #2,Found%
					End If
				End If
			End If
			Close #1
			Close #2
			Beep
		Wend
	End Sub

'*********************************************************
'			FILE OPERATION
'*********************************************************
	Sub sbDofile(msg$)
		PathFile$=fShowFL$
		If PathFile$=Chr$(27) Then
			Exit Sub
		End If
		Cls
		On Error GoTo FileErr
		Select msg$
			Case "清除"
				Open PathFile$ As #16
				CLFile #16			'Clear File Record
				Close #16
			Case "上传"
				Open PathFile$ As #16
				L%=LOF(16)
				Close #16
				If L%=0 Then
					BEEP:Cls:Locate 3,4,0:Print "文件无记录！"
					Locate 3,7,0:Print "按任意键返回"
					wait 0,1:buf$=Input$(1):Exit sub
				End If
				LOCATE 5,3	:Print "上传中....."
				LOCATE 5,5	:PRINT "00000/";RIGHT$("00000"+MID$(STR$(L%),2),5)
				LOCATE 5,5
				Open "Com:19200,N,8,1" As #16
				XFILE PathFile$,"SPM"
				Close #16
			Case "下载"
				LOCATE 5,3	:Print "下载中....."
				Locate 5,5
				Open "Com:19200,N,8,1" As #16
				XFILE PathFile$ ,"SRM"
				Close #16
		End Select

		Beep
		Cls
		Screen 1,1	:Locate 4,3 	:Print msg$;"成功!"
		Screen 1,0	:Locate 2,7	:Print "  按任意键返回  ";
		Wait 0,&h01
		Beep
		s$=Input$(1)
		Exit Sub
FileErr:
	Cls
	If Hex$(Err)="47" Then
		Locate 6,4,0	:Print "用户取消!"
		Locate 3,7,0	:Print "按任意键返回";
		Beep 1
		Wait 0,3
		Buf$=Input$(1)
		Close #16
		Chain "BHT8000.PD3"
		Exit Sub
	Else
		Beep 8
		'Print "通讯传输失败!"
		'Print 
		'Print "按任意键重新载入";
		'Wait 0,3
		'Buf$=Input$(1)
		Chain "BHT8000.pd3"
		End
	End If
	
	End Sub

'*********************************************************
'			Begin Program
'*********************************************************
	Function fDataMd(msg$,beSel%)
		Cls
		Screen 1,0
		Locate 7,3,0	:Print msg$
		Locate 4,7,0	:Print "ENT确认/F4选择";
		k$=""
		While K$<>Chr$(13)
			If beSel%=1 Then
				Locate 16,3,0	:Print "*"
			Else
				Locate 16,3,0	:Print " "
			End If
			K$=Input$(1)
			If k$=Chr$(68) Then
				If beSel%=1 Then
					beSel%=0
				Else
					beSel%=1
				End If
			End If
		Wend
		Open "A:SYSTEM.INI" As #8

		Field #8, 4 As .sfFdName$, 2 As .sfFdValue$, 1 As .sfScan$
		Select msg$
			Case "数量自增"
				strName$=".ATC"
			Case "条码唯一"
				strName$=".UNI"
			Case "自增可改"
				strName$=".MDQ"
		End Select

		Found%=Search(#8,.sfFdName$,strName$,1) 
		.sfFdValue$=Mid$(str$(beSel%),2)
		.sfFdName$=strName$
		If Found%>0 Then
			Put #8,Found%
		Else
			Put #8
		End If
		Close #8
		fDataMd=beSel%
	End Function

'*********************************************************
'			Begin Program
'*********************************************************
	Sub sbSystem
		While 1
			op$=fChildMenu$("重设系统","数据管理","关    于","")
			If op$=Chr$(27) Then
				Exit Sub
			End If
			Cls
			Select op$
				Case "1"
					Screen 1,1	:Locate 1,1,0	:Print "注意:"
					Screen 1,0	:Locate 1,3,0	:Print "初始化系统将删除所有数据!"
					Locate 1,7,0	:Print  "是否开始?是/";
					Screen 1,1 	:Locate 13,7,0	:print "否";
					k$=""
					select%=0
					While k$<>Chr$(27)
						k$=Input$(1)
						Beep ,,,0
						Select k$
							Case Chr$(13)
								If select%=1 Then
									Call SetSystem
								Else
									k$=Chr$(27)
								End If
							Case Chr$(30)
								Screen 1,1
								Locate 10,7,0	:Print "是";
								Screen 1,0
								Locate 12,7,0	:Print "/否";
								select%=1
							Case Chr$(31)
								Screen 1,0
								Locate 10,7,0	:Print "是/";
								Screen 1,1
								Locate 13,7,0	:Print "否";
								select%=0
						End Select
					Wend
				Case "2"
					While op$<>Chr$(27)
						op$=fChildMenu$("清除数据","输入方式","","")
						Select op$
							Case "1"
								sbDofile("清除")
							Case "2"
								AutoCount%=fDataMd("数量自增",AutoCount%)
								ModiQTY%=fDataMd("自增可改",ModiQTY%)
								UniqueCode%=fDataMd("条码唯一",UniqueCode%)
'							Case "333"
'								While op$<>Chr$(27)
'									op$=fChildMenu$("删除记录","条码修改","","")
'									Select op$
'										Case "1"
'											Key$=""
'											While  Key$=Chr$(27)
'												
'										Case "2"
'									End Select
'								Wend
'								op$=""
						End Select
					Wend
				Case "3"
					Cls:Screen 1,0
					Locate 8,1,0	:Print "东莞宏泰实业有限公司"
					Locate 4,3,0	:Print "地址:东莞石碣镇新城"
					Locate 4,5,0	:Print "Tel:0769-6383699"
					Locate 4,7,0	:Print "Fax:0769-6383669";
					Locate 1,9,0	:Print "Em:ht889@21cn.com";
					wait 0,1:buf$=Input$(1)
			End Select
		Wend
	End Sub
'*********************************************************
'			Begin Program
'*********************************************************

	BEEP
	KEY 5,CHR$(28)
	Key 6,Chr$(29)
	Key 7,Chr$(30)
	Key 8,Chr$(31)
	KEY 30,CHR$(27)	'M1 :ESC键退出键 

MAIN:
	Cls
	Out &H6080,1	'0:standard-size;  1:the small-size
	Call GetSystem
	Call sbMainMenu(0)

	While 1
		k$=Input$(1)
		Beep ,,,0
		Select Case dis%
			Case 0
				Select k$
					Case Chr$(13)
					Select Cur%
						Case 0
							Call sbStock("in")
						Case 1
							Call sbStock("out")
						Case 2
							Call sbDofile("下载")
						Case 3
							Call sbDofile("上传")
						Case 4
							Call sbBrower("")
						Case 5
							Call sbSystem
					End Select
					sbMainMenu(cur%)
					Case Chr$(28)
						sbMainMenu((cur%-2+6) MOD 6)
					Case Chr$(29)
						sbMainMenu((cur%+2+6) MOD 6)
					Case Chr$(30)
						sbMainMenu((cur%-1+6) MOD 6)
					Case Chr$(31)
						sbMainMenu((cur%+1+6) MOD 6)
					Case Chr$(49)
						sbMainMenu(0)
					Case Chr$(50)
						sbMainMenu(1)
					Case Chr$(51)
						sbMainMenu(2)
					Case Chr$(52)
						sbMainMenu(3)
					Case Chr$(53)
						sbMainMenu(4)
					Case Chr$(54)             
						sbMainMenu(5)
				End Select
			Case 1
				Select k$
					Case Chr$(13)
					Select Cur%
						Case 0
							Call sbStock("in")
						Case 1
							Call sbBrower("")
						Case 2
							Call sbDofile("上传")
						Case 3
							Call sbSystem
					End Select
					sbMainMenu(cur%)
					Case Chr$(28)
						sbMainMenu((cur%-1+4) MOD 4)
					Case Chr$(29)
						sbMainMenu((cur%+1+4) MOD 4)
					Case Chr$(49)
						sbMainMenu(0)
					Case Chr$(50)
						sbMainMenu(1)
					Case Chr$(51)
						sbMainMenu(2)
					Case Chr$(52)
						sbMainMenu(3)
				End Select
		End Select
	Wend

ERRCOMM:
	Cls
	Beep 8
	'Print "操作错误:"
	'Print
	'Print "按任意键重新载入";
	'Wait 0,1
	'k$=Input$(1)
	Chain "BHT8000.pd3"
	End
123

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -