我用VB写了个调用TRACERT生成文件,因为TRACERT没有当前时间所以我在生成记事本里面最后写了个当前时间进去,但是现在的问题是如何判断tracert已经写完了TXT,我现在用的SLEEP等待,这个不好用,有的时候也出错误."运行时出错'70'拒绝的权限"出这错误的原因就是文件还没生成这边就去写了.我用的下面代码请问如何改能避免这个问题或者这么判断一下.
Shell "cmd /c tracert 181.60.10.10 > C:\35.txt", 0
Shell "cmd /c tracert 182.60.10.39> C:\36.txt", 0
Shell "cmd /c tracert 34.61.33.31 > C:\32.txt", 0
DoEvents
Sleep 110000
Open "c:\35.txt" For Append As #1
Open "c:\36.txt" For Append As #2
Open "c:\32.txt" For Append As #3
Print #1, Now(),
Print #2, Now(),
Print #3, Now(),
Close #1
Close #2
Close #3
Shell "cmd /c tracert 181.60.10.10 > C:\35.txt", 0
Shell "cmd /c tracert 182.60.10.39> C:\36.txt", 0
Shell "cmd /c tracert 34.61.33.31 > C:\32.txt", 0
DoEvents
Sleep 110000
Open "c:\35.txt" For Append As #1
Open "c:\36.txt" For Append As #2
Open "c:\32.txt" For Append As #3
Print #1, Now(),
Print #2, Now(),
Print #3, Now(),
Close #1
Close #2
Close #3
if aa = 0 then
msgbox "没写完"
endif
1：窗体调用：Option Explicit
Private WithEvents cmdText As clsOutPutCmdTxtPrivate Sub Command1_Click()
Dim strCommandText As String
Set cmdText = New clsOutPutCmdTxt
cmdText.CommandLine = "cmd /c tracert 181.60.10.10"
strCommandText = cmdText.ExecuteCommand
MsgBox strCommandText
End Sub
2：创建类模块，名称为：clsOutPutCmdTxt
代码：Option Explicit'系统常量
Private Const NORMAL_PRIORITY_CLASS = &H20&
Private Const STARTF_USESTDHANDLES = &H100&
Private Const STARTF_USESHOWWINDOW = &H1'系统结构体
Private Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Long
End TypePrivate Type STARTUPINFO
cb As Long
lpReserved As Long
lpDesktop As Long
lpTitle As Long
dwX As Long
dwY As Long
dwXSize As Long
dwYSize As Long
dwXCountChars As Long
dwYCountChars As Long
dwFillAttribute As Long
dwFlags As Long
wShowWindow As Integer
cbReserved2 As Integer
lpReserved2 As Long
hStdInput As Long
hStdOutput As Long
hStdError As Long
End TypePrivate Type PROCESS_INFORMATION
hProcess As Long
hThread As Long
dwProcessID As Long
dwThreadID As Long
End Type'系统API声明
Private Declare Function CreatePipe Lib "kernel32" (phReadPipe As Long, phWritePipe As Long, lpPipeAttributes As Any, ByVal nSize As Long) As Long
Private Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long, ByVal lpBuffer As String, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, ByVal lpOverlapped As Any) As Long
Private Declare Function CreateProcessA Lib "kernel32" (ByVal lpApplicationName As Long, ByVal lpCommandLine As String, lpProcessAttributes As SECURITY_ATTRIBUTES, lpThreadAttributes As SECURITY_ATTRIBUTES, ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, ByVal lpEnvironment As Long, ByVal lpCurrentDirectory As Long, lpStartupInfo As STARTUPINFO, lpProcessInformation As PROCESS_INFORMATION) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hHandle As Long) As Long'用户变量
Private mCommand As String '命令行
Private mOutputs As String '返回结果'用户定义事件
Public Event ReceiveOutputs(CommandOutputs As String)Public Property Let CommandLine(DOSCommand As String)
mCommand = DOSCommand
End PropertyPublic Property Get CommandLine() As String
CommandLine = mCommand
End PropertyPublic Property Get Outputs()
Outputs = mOutputs
End PropertyPublic Function ExecuteCommand(Optional CommandLine As String) As String
Dim proc As PROCESS_INFORMATION
Dim ret As Long
Dim start As STARTUPINFO
Dim sa As SECURITY_ATTRIBUTES
Dim hReadPipe As Long
Dim hWritePipe As Long
Dim lngBytesread As Long
Dim strBuff As String * 256 If Len(CommandLine) > 0 Then
mCommand = CommandLine
End If
If Len(mCommand) = 0 Then
MsgBox "命令行为空。", vbCritical
Exit Function
End If
sa.nLength = Len(sa)
sa.bInheritHandle = 1&
sa.lpSecurityDescriptor = 0&
ret = CreatePipe(hReadPipe, hWritePipe, sa, 0)
If ret = 0 Then
MsgBox "创建管道失败。错误：" & Err.LastDllError, vbCritical
Exit Function
End If
start.cb = Len(start)
start.dwFlags = STARTF_USESTDHANDLES Or STARTF_USESHOWWINDOW
start.hStdOutput = hWritePipe
start.hStdError = hWritePipe
ret& = CreateProcessA(0&, mCommand, sa, sa, 1&, NORMAL_PRIORITY_CLASS, 0&, 0&, start, proc)
If ret <> 1 Then
MsgBox "文件或命令没有找到。", vbCritical
Exit Function
End If
ret = CloseHandle(hWritePipe)
mOutputs = ""
Do
ret = ReadFile(hReadPipe, strBuff, 256, lngBytesread, 0&)
mOutputs = mOutputs & Left(strBuff, lngBytesread)
RaiseEvent ReceiveOutputs(Left(strBuff, lngBytesread))
Loop While ret <> 0
ret = CloseHandle(proc.hProcess)
ret = CloseHandle(proc.hThread)
ret = CloseHandle(hReadPipe)
ExecuteCommand = mOutputs
End Function
Private Sub Command1_Click()'找出文件夹内文件最新的更新时间(包括里面的子文件夹的文件哈) 要把这个文件夹内的所有文件的最后修改时间都要检查一次,并取出近的一个时间,(主要是检查这个文件夹里面的内容有没有更新),并取出这个文件最后一次的更新时间.环境是VB6
Dim after As Double
Dim f As Integer
Dim dn As String
Dim fn As String
Dim ft As String
Dim ft_date As Date
Command1.Enabled = FalseOn Error GoTo ERR0
Kill "c:\files.txt"dn = "c:\windows"
On Error GoTo ERR1
Shell ("cmd /c dir " & dn & "\*.* /a-d /b /s /o-d >c:\files.txt")
after = Now + 60# / 3600# / 24#
f = FreeFile()
Do
REOPEN1:
DoEvents
If Now > after Then
MsgBox "Wait c:\files.txt 60s overtime!"
Exit Sub
End If
Open "c:\files.txt" For Input Lock Read Write As #f
Line Input #f, fn
Close #f
Exit Do
LoopOn Error GoTo ERR0
Kill "c:\files.txt"On Error GoTo ERR2
Shell ("cmd /c dir " & Chr(34) & fn & Chr(34) & ">c:\files.txt")
after = Now + 60# / 3600# / 24#
f = FreeFile()
Do
REOPEN2:
DoEvents
If Now > after Then
MsgBox "Wait c:\files.txt 60s overtime!"
Exit Sub
End If
Open "c:\files.txt" For Input Lock Read Write As #f
Line Input #f, ft
Line Input #f, ft
Line Input #f, ft
Line Input #f, ft
Line Input #f, ft
Line Input #f, ft
Close #f
Kill "c:\files.txt"
Exit Do
Loop
ft = Left(ft, 17)
ft_date=CDate(ft)
MsgBox "The newest file in [" & dn & "] is [" & fn & "], datetime is [" & ft_date & "]"
Command1.Enabled = True
Exit Sub
ERR0:
Resume Next
ERR1:
Resume REOPEN1
ERR2:
Resume REOPEN2
End Sub