请高手指教!!!
lhgs 2003-06-26 09:50:08 下面这段代码有什么地方错了,运行不正常?
Option Explicit
Private Declare Function FindWindow Lib "User32" Alias "FindWindowA" (ByVal lpclassname As String, ByVal lpwindowname As String) As Long
Private Declare Function ShowWindow Lib "User32" (ByVal hwnd As Long, ByVal ncmdshow As Long) As Long
Private Const SW_SHOW = 5
Private Const rascs_done = &H2000&
Private Const ras_maxentryname = 256
Private Const ras_maxdevicetype = 16
Private Const ras_maxdevicename = 128
Private Type rasconn
dwsize As Long
hrasconn As Long
szentryname(ras_maxentryname) As Byte
szdevicetype(ras_maxdevicetype) As Byte
szdevicename(ras_maxdevicename) As Byte
End Type
Private Type rasconnstatus
dwsize As Long
rasconnstate As Long
dwerror As Long
szdevicetype(ras_maxdevicetype) As Byte
szdevicename(ras_maxdevicename) As Byte
End Type
Private ras_buf(255) As rasconn
Private ras_status As rasconnstatus
Private lpcb As Long
Private lpcconnections As Long
Private Declare Function rasenumconnections Lib "rasapi32.dll" Alias "rasenumconnectionsa" (lprasconn As Any, lpcb As Long, lpcconnections As Long) As Long
Private Declare Function rasgetconnectstatus Lib "rasapi32.dll" Alias "rasgetconnectstatusa" (ByVal hrasconn As Long, lprasconnstatus As Any) As Long
Private Declare Function rashangup Lib "rasapi32.dll" Alias "rashangupa" (ByVal hrasconn As Long) As Long
Dim ret As Long
Dim time1 As Date
Dim time2 As Date
Dim flag As Boolean, add_flag As Boolean
Dim a As Long, total_time As Long
Private Sub Command1_Click()
ret = Shell("Rundll32.exe Rnaui.dll,Rnadial" + Text1, 1): DoEvents
SendKeys "{enter}", True: DoEvents
End Sub
Private Sub Command2_Click()
ret = FindWindow("#32770", "连接到" + Text1)
If ret <> 0 Then
Call ShowWindow(ret, SW_SHOW)
SendKeys "%c", True
MsgBox "已挂断"
End If
End Sub
Private Sub Command3_Click()
FileName = App.Path & "\line_time.txt"
If Dir(FileName) <> "" Then
a = MsgBox("是否删除记录", , "确认")
If a = 1 Then
Kill FileName
Kill App.Path & "\total_time.txt"
End If
End If
End Sub
Private Sub Command4_Click()
Text3 = ""
If Dir(App.Path & "\line_time.txt") <> "" Then
Open App.Path & "\line_time.txt" For Input As #1
Do
Input #1, str1
Text3 = Text3 & str1 & vbCrLf
Loop Until EOF(1)
Open App.Path & "\total_time.txt" For Input As #2
Input #2, a
Text3 = Text3 & Int(a / 3600) & "小时" & Int(a / 60) & "分" & Str(a Mod 60) & "秒"
Text3 = Text3 & a & "超时费是" & IIf(a < 36000, , (a - 36000) / 3600 * 2.1) & "元"
Text3 = Text3 & "费用是" & Round(Str(a / 3600 * 3), 2) & "元"
Close #1, #2
Else
Text3 = "无历史记录"
End If
End Sub
Public Sub save()
FileName = App.Path & "\line_time.txt"
If total_time <> 0 And flag = True Then
If Dir(FileName) <> "" Then
Open FileName For Append As #1
Else
Open FileName For Output As #1
End If
Print Date & "从"; time1 & "到" & time2 & "总计" & cael_time()
Write #1, Date & "从"; time1 & "到" & time2 & "总计" & cael_time()
Close #1
flag = False
FileName = App.Path & "\total_time.txt"
If Dir(FileName) <> "" Then
Open FileName For Input As #1
Input #1, a
a = a + total_time
Close #1
Open FileName For Output As #1
Else
Open FileName For Output As #1
a = total_time
End If
Write #1, a
Close #1
End If
End Sub
Public Function cael_time()
Dim s As Integer
s = total_time Mod 60
cael_time = Int(total_time / 3600) & "小时" & Int(total_time / 60) & "分" & s & "秒"
End Function
Private Sub Form_Click()
Call save
End Sub
Private Sub Form_Load()
flag = False
add_flag = False
Timer1.Interval = 1000
End Sub
Private Sub Form_Unload(Cancel As Integer)
Call save
End Sub
Private Sub Timer1_Timer()
ret = FindWindow("#32770", "连接到" + Text1)
If ret <> 0 Then
If flag = False Then
time1 = Time
flag = True
add_flag = True
Else
time2 = Time
total_time = DateDiff("s", time1, time2)
Me.Caption = cael_time()
Text2 = cael_time()
If total_time = 60 * 10 Or total_time = 60 * 60 Then
MsgBox "你已经上网" & Int(total_time / 60) & "分"
End If
End If
Else
If add_flag = True Then Call save: add_flag = False
End If
End Sub
我是全部写在窗体中的。
请高手指教!谢谢