解决方案 »
- 还是刚才的字符串问题,谢谢
- 菜鸟问:WinSock控件怎样绑定IP和端口?
- 为什么 handle = CreateFile("COM1", GENERIC_READ Or GENERIC_WRITE, 0, s, OPEN_EXISTING, 0, 0)总是返回-1?
- 请问:菜单就是文件夹下exe名称
- 求助:怎样逐行读取TXT文件,并把一部份分别添加到combo中?
- 好东西继续与CSDN的兄弟们分享:能够阻止用户在系统里创建,打开,删除文件等操作,要的留下邮箱
- VBWIN2000下截获数据包问题,
- 怎样将ACCESS某一表格或DATAGRID导出为EXCEL文件?
- lanren_me(阿波) 请进来一下
- 我是一个运维,对于VB是小白,有一个问题需要大神帮忙
- 救命!答辩的日子要到了,帮帮忙!
- 100分的VBA小程序
Open "d:\tt" For Binary Access _
Write As #1
改为 Open "d:\tt.txt" For Binary Access _
Write As #1
另外声明一下,不是我编的的什么控件,是vb自带的microsoft internet transfer control 6.0控件。
http://jinesc.6600.org/myweb/main.asp?room=1030&page=1
http://jinesc.6600.org/myweb/disp.asp?idd=277&room=00
Dim strData As String
Dim Conn As New ADODB.Connection
Dim Rst As New ADODB.Recordset, Rst1 As New ADODB.Recordset
Dim MaxNumber As Long
Dim OldInfo As String
Dim OldTime As Date, CurTime As Date
Dim State As Boolean
'*************
Dim RecTime '记录时间
Dim RecNumber As Long
'*************
On Error GoTo Err:
strData = ""
Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\db2.mdb;"
Rst.CursorLocation = adUseClient
Rst.Open "Select Id,AllInfo,QueryTime From FtpRecord Order By Id Desc", Conn, adOpenDynamic, adLockOptimistic, adCmdText
If Rst.EOF = False Then '读出来原有信息最后一条
OldInfo = Rst!AllInfo
OldTime = Rst!QueryTime
Else
OldInfo = ""
End If
Rst.Close
MaxNumber = MaxID(Conn, "FtpRecord") '准备好增加的数据新的Id
State = False
Rst.CursorLocation = adUseClient
Rst.Open "Select * From FtpRecord", Conn, adOpenDynamic, adLockOptimistic, adCmdText
RecTime = Timer
Open App.Path & "\ttt.txt" For Input As #1
If OldInfo <> "" Then
Do While Not EOF(1)
Line Input #1, strData '读入一行
CurTime = ChangeTime(Trim(Mid(strData, 41, 17)))
If OldTime < CurTime Then '是新的记录了
Rst.AddNew
Rst!Id = MaxNumber
Rst!Address = Trim(Left$(strData, 10))
Rst!AboutInfo = Trim(Mid(strData, 11, 30))
Rst!BeginTime = Trim(Mid(strData, 41, 17))
If LCase(Mid(strData, 60, 1)) = "s" Then
' Rst!EndTime = Space(6)
Rst!Status = Mid(strData, 60, 16)
Else
Rst!EndTime = Mid(strData, 60, 5)
Rst!Status = Mid(strData, 67, 7)
End If
Rst!QueryTime = ChangeTime(Rst!BeginTime)
Rst!AllInfo = strData
Rst.Update
MaxNumber = MaxNumber + 1
RecNumber = RecNumber + 1
State = True
Exit Do
Else
If OldTime = CurTime Then '时间相等的时候
If strData = OldInfo Then '判断是否真的完全相等
State = True
Exit Do
Else '只是时间相等而已,判断是否已经有这个记录了
Rst1.CursorLocation = adUseClient
Rst1.Open "Select AllInfo From FtpRecord Where AllInfo='" & strData & "'", Conn, adOpenDynamic, adLockOptimistic, adCmdText
If Rst1.EOF = True Then '虽然时间开始相等,还没有这一条记录,是新的了
Rst.AddNew
Rst!Id = MaxNumber
Rst!Address = Trim(Left$(strData, 10))
Rst!AboutInfo = Trim(Mid(strData, 11, 30))
Rst!BeginTime = Trim(Mid(strData, 41, 17))
If LCase(Mid(strData, 60, 1)) = "s" Then
' Rst!EndTime = Space(6)
Rst!Status = Mid(strData, 60, 16)
Else
Rst!EndTime = Mid(strData, 60, 5)
Rst!Status = Mid(strData, 67, 7)
End If
Rst!QueryTime = ChangeTime(Rst!BeginTime)
Rst!AllInfo = strData
Rst.Update
MaxNumber = MaxNumber + 1
RecNumber = RecNumber + 1
State = True
Exit Do
End If
Rst1.Close
End If
End If
End If
Loop
Else
State = True
End If
If State = True Then '有新的数据
Do While Not EOF(1)
Line Input #1, strData '读入一行
If strData = "" Then Exit Do '写到了最后的空行,就不用写了
Rst.AddNew
Rst!Id = MaxNumber
Rst!Address = Trim(Left$(strData, 10))
Rst!AboutInfo = Trim(Mid(strData, 11, 30))
Rst!BeginTime = Trim(Mid(strData, 41, 17))
If LCase(Mid(strData, 60, 1)) = "s" Then
' Rst!EndTime = Space(6)
Rst!Status = Mid(strData, 60, 16)
Else
Rst!EndTime = Mid(strData, 60, 5)
Rst!Status = Mid(strData, 67, 7)
End If
Rst!QueryTime = ChangeTime(Rst!BeginTime)
Rst!AllInfo = strData
Rst.Update
RecNumber = RecNumber + 1
MaxNumber = MaxNumber + 1
Loop
End If
Close #1
Rst.Close
Conn.Close
Set Conn = Nothing '关闭后要释放内存
MsgBox "写入" & RecNumber & "条记录完毕:共用时间" & Format((Timer - RecTime), "0.00000") & "秒"
Exit Sub
Err:
MsgBox "出现错误:" & Err.Description