求关于VB监视一个文件夹的代码
楼主你好,我测试了一下OK的,想了挺长时间的 代码如下
控件.filelistbox
Dim sua As Integer 'sua是存放上次的文件数的,所以必须为通用,静态，不然会丢失
Private Sub Form_Load()
File1.FileName = App.Path "\" "新建文件夹" '这里写你的那个什么数据库的地址
For i = 0 To File1.ListCount - 1 '循环我就不说了吧
If Right(File1.List(i), 4) = ".txt" Then sua = sua + 1 '在加载的时候 先算出文件夹里德文件数,这是sua的第一次赋值（即文件夹文件数）
Next i
End Sub
Private Sub 监视_Click()
File1.Refresh '每次按下去 都要先刷新一次,因为这样的话就可以更新文件数了
For i = 0 To File1.ListCount - 1
If Right(File1.List(i), 4) = ".txt" Then s = s + 1 '这里是算出 后缀是.txt的文件数
Next i
If s sua Then MsgBox "文件更新了" '判断 文件数是否 大于上一次的，,第一次按下按钮的时候 上一次 就是加载时候的文件数啦~
sua = s '在判断后 将s(这次的文件数)赋值给sua 那么在下次的上一句里sua 值就是 你这次的 值啦（储存s）
End Sub
如果有什么问题的话 hi我好了
vb获取硬件信息的代码
tmpstr=""
set fso=createObject("scripting.filesystemObject")
Set dc = fso.Drives
for each d in dc
If d.isReady Then
tmpstr=tmpstr "磁盘" d.DriveLetter ":" vbcrlf _
"可用空间：" (d.AvailableSpace/1024/1024/1024) " GB" vbcrlf _
"空余空间：" (d.FreeSpace/1024/1024/1024) " GB" vbcrlf _
"总空间大小：" (d.TotalSize/1024/1024/1024) " GB" vbcrlf _
"文件系统：" d.FileSystem vbcrlf _
"驱动器类型：" d.DriveType vbcrlf _
"是否就绪：" d.IsReady vbcrlf _
"路径：" d.Path vbcrlf _
"根目录：" d.RootFolder vbcrlf _
"序列号：" d.SerialNumber vbcrlf _
"共享名：" d.ShareName vbcrlf _
"卷名：" d.VolumeName vbcrlf vbcrlf
End If
Next
msgbox tmpstr
如何用VB编写关闭所有端口,只剩下80,21端口
用以下代码检查你机器有几个COM口,那些COM口可用,那些不存在,
Option Explicit
Dim a As Integer
Private Sub Command1_Click()
On Error GoTo uerror
For a = 1 To 4
MSComm1.CommPort = a
MSComm1.PortOpen = True '当True时是打开
If MSComm1.PortOpen = True Then
Print "可用Com号= "; a
MSComm1.PortOpen = False 当False时是关闭
Else
End If
Next
Exit Sub
uerror:
If Err.Number = 8005 Then
Print "端口" a "已打开，请关闭其它应用程序占用的端口" a
ElseIf Err.Number = 8002 Then
Print "出错Com号= "; a
End If
Resume Next
End Sub
以下代码使用COM2口和COM3口通信:
Option Explicit
Dim strData As String
Dim bytInput() As Byte
Dim dataSend() As Byte
Dim sj() As Byte
Dim i As Long
Dim Ulen As Long
Dim Llen As Long
Dim for_Sum As Long
Dim Yu_sum As Integer
Private Sub Form_Load() '初始化
Timer2.Interval = 10
MSComm1.Settings = "9600,n,8,1"
MSComm1.CommPort = 2
MSComm1.RThreshold = 1
MSComm1.PortOpen = True
MSComm2.Settings = "9600,n,8,1"
MSComm2.CommPort = 3
MSComm2.RThreshold = 1
MSComm2.PortOpen = True
End Sub
Private Sub MsComm1_OnComm()
Dim intInputLen As Integer
Select Case Me.MSComm1.CommEvent
Case comEvReceive
'此处添加处理接收的代码
Me.MSComm1.InputMode = comInputModeBinary '二进制接收
intInputLen = Me.MSComm1.InBufferCount
ReDim bytInput(intInputLen)
bytInput = Me.MSComm1.Input
jieshou
End Select
End Sub
Public Function jieshou() '接收数据处理为16进制字符
Dim i As Integer
For i = 0 To UBound(bytInput)
If Len(Hex(bytInput(i))) = 1 Then
strData = strData "0" Hex(bytInput(i))
Else
strData = strData Hex(bytInput(i))
End If
Next
RichTextBox1 = strData
Text1 = Len(strData) \ 2
End Function
Private Sub Command2_Click()
Dim byts(131) As Byte
Dim l As Integer
byts(0) = H1
byts(1) = H39
byts(2) = H0
byts(3) = H0
byts(4) = HFF
For l = 5 To 131
byts(l) = 131 - l + 5
Next
MSComm2.Output = byts
End Sub
vb中怎么用MSCOMM控件获取COM端口的数据,并实时存入access，最好有代码和详细解释
这个涉及到你的COM端口的数据协议，然后用MSCOMM控件把从COM端口获取的数据根据协议解析出来再存入数据库。下面是我以前项目的一些代码，给你参考
'设置MSCOMM控件
Public Sub psubInitComPort(intMsCommIndex As Integer, intComNo As Integer, strSettings As String, intInBuffSize As Integer, intRThreshold As Integer, blnPortOpen As Boolean)
On Error GoTo err_proc
If blnPortOpen Then '--打开串口
MSComm(intMsCommIndex).CommPort = intComNo '--使用端口Com1~8
MSComm(intMsCommIndex).Settings = strSettings '"1200,N,8,1" '--设置端口属性,设置波特率1200、无奇偶校验、8数据位和1停止位
MSComm(intMsCommIndex).InBufferSize = intInBuffSize '1024 '--设置接收缓冲区大小为1024个字节
MSComm(intMsCommIndex).RThreshold = intRThreshold ' 12 '--设置每接收n个字节触发OnComm()事件
MSComm(intMsCommIndex).InBufferCount = 0 '--清空接收缓冲区
MSComm(intMsCommIndex).InputLen = 0 '--使用Input属性时在接收缓冲区读取的字符数，0为读取整个接收缓冲区内容
MSComm(intMsCommIndex).InputMode = comInputModeBinary '--Input属性取的数据是二进制数据
If Not MSComm(intMsCommIndex).PortOpen Then '--打开串口
MSComm(intMsCommIndex).PortOpen = True
End If
Else
If MSComm(intMsCommIndex).PortOpen Then '--关闭串口
MSComm(intMsCommIndex).PortOpen = False
End If
End If
Exit Sub
err_proc:
End Sub
'MSCOMM控件接收数据
Private Sub MSComm_OnComm(Index As Integer)
On Error Resume Next
If MSComm(Index).CommEvent = comEvReceive Then '接收缓冲区收到已设定的n个字节
Select Case Index
Case 1 '→1#站加水
Call psubProcComDataCar(Index)
Case 2 '--2#站加水
Call psubProcComDataCar(Index)
Case 3 '--3#站加钢
Call psubProcComDataCar(Index)
' Case 5 '--
'
' Case 6 '--
'
' Case 7 '--
'
' Case 8 '--
End Select
End If
End Sub
'处理串口接收的数据
Public Sub psubProcComDataCar(intComPortNum As Integer)
Dim intTmpi As Integer
Dim bytTmp() As Byte
Dim strtmp As String
On Error GoTo err_proc
bytTmp = Me.MSComm(intComPortNum).Input
For intTmpi = 0 To UBound(bytTmp)
strtmp = strtmp " " Format(bytTmp(intTmpi), "00")
Next intTmpi
'--显示原始数据文件
Me.txtTmpRecv(intComPortNum) = Me.txtTmpRecv(intComPortNum) strtmp
If Len(Me.txtTmpRecv(intComPortNum).Text) 600 Then
Me.txtTmpRecv(intComPortNum).Text = ""
End If
'--写数据库
Call UpdateDatebase(strtmp)
Exit Sub
err_proc:
End Sub
'--写数据库
Public Sub UpdateDatebase(strData As String)
Dim gadoConnLocal As New ADODB.Connection
Dim gadoCmdLocal As New ADODB.Command
On Error Resume Next
gadoConnLocal.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=C:\db1.mdb;Persist Security Info=False" '假设数据库名为db1,存放在C盘下
gadoConnLocal.CursorLocation = adUseClient
gadoConnLocal.Mode = adModeReadWrite '打开数据库为读写模式
gadoConnLocal.Open '连接数据库
gadoCmdLocal.ActiveConnection = gadoConnLocal
gadoCmdLocal.CommandType = adCmdText
gadoCmdLocal.CommandText = " insert into [数据表名] (字段1) values('" strData "')" '写入数据库
gadoCmdLocal.Execute
gadoConnLocal.Close '关闭数据库
Set gadoConnLocal = Nothing
Set gadoCmdLocal = Nothing
End Sub
VB判读代码
简单代码如下 退出窗体用 end 或者 unload me msgbox inputbox 就不需要退出。。自己再修改吧
Dim i As Integer
Private Sub Command1_Click()
Dim StrQ(1, 2) As String, StrTemp As String
'声明一个数组变量'strq(0,0)存问题 strq(1,0)存答案
StrQ(0, 0) = "你叫？": StrQ(1, 0) = "你猜"
StrQ(0, 1) = "你是？": StrQ(1, 1) = "嘛人"
StrQ(0, 2) = "我说？": StrQ(1, 2) = "对头"
StrTemp = InputBox(StrQ(0, i), "问题")
If StrTemp = StrQ(1, i) Then
MsgBox "回答正确", , "标题"
Else
MsgBox "回答错误", , "警示"
End If
End Sub
Private Sub Command2_Click() '下一题
i = i + 1
End Sub
0条大神的评论