form6.frm

根据MS Proxy的日志文件进行计费的程序

        LTime = ProxyDataRs.Fields("logtime")
        Call SignDateFee
    End If
    ProxyDataRs.MoveNext
Loop
Unload Me
If RecordNumber > 0 Then
    UserMail.Show 1
Else
    MsgBox "没有合乎条件的记录", vbOKOnly, "查询失败"
End If
End Sub

Private Function DTCompare(date1 As Date, time1 As Date, date2 As Date, time2 As Date) As Integer
If (date1 * 24 + time1) > (date2 * 24 + time2) Then
    DTCompare = 1
Else
    If (date1 * 24 + time1) < (date2 * 24 + time2) Then
        DTCompare = 2
    Else
        DTCompare = 0
    End If
End If
End Function

Private Sub SignDateFee()
    If PTime > 86400000 Then
        'MsgBox "时间长于一天"
        For i = 0 To PTime Step 86400000
            Call SignTimeFee(8640000, 86400000)
        Next i
        PTime = PTime Mod 86400000
    End If
    If PTime > ConvertMill(LTime) Then
        Call SignTimeFee(PTime - ConvertMill(LTime), 86400000)
        Call SignTimeFee(ConvertMill(LTime), ConvertMill(LTime))
    Else
        Call SignTimeFee(PTime, ConvertMill(LTime))
    End If
End Sub

Private Sub SignTimeFee(ByVal PTimeRec As Long, LTimeRec As Long)
            'ptimerec为处理时间, ltimerec为产生记录的时间
Dim StartupTime As Long '开始时间，为记录产生时间减处理时间
Dim EndTime As Long '结束时间，为记录产生时间
Dim StartupZone As Long '计费开始点所在的时间段
Dim EndZone As Long '计费结束点所在的时间段
Dim FindBound As Boolean
Dim varBookmark As Variant

FindBound = False

StartupTime = LTimeRec - PTimeRec
EndTime = LTimeRec

Set TimeDataRs = db.OpenRecordset("timezone2", dbOpenSnapshot)

TimeDataRs.MoveFirst
Do '首先查出开始连接的时间在什么时间区段里
If StartupTime >= ConvertMill(TimeDataRs.Fields("StartUpTime")) And _
            StartupTime <= ConvertMill(TimeDataRs.Fields("EndTime")) And _
            Fee_Type = TimeDataRs.Fields("type") Then
    StartupZone = TimeDataRs.Fields("ID") 'StartupZone=时间段序号
    varBookmark = TimeDataRs.Bookmark
    'MsgBox "startup zone =" & CStr(StartupZone)
End If
TimeDataRs.MoveNext
Loop While (Not TimeDataRs.EOF)
TimeDataRs.Bookmark = varBookmark
            
If EndTime >= ConvertMill(TimeDataRs.Fields("startuptime")) And _
            EndTime <= ConvertMill(TimeDataRs.Fields("EndTime")) And _
            Fee_Type = TimeDataRs.Fields("type") Then
    '结束时间和开始时间处在同一时间段里
    Call addfee(PTimeRec)
Else
    Call addfee(ConvertMill(TimeDataRs.Fields("endtime")) - StartupTime)
    Call SignTimeFee(EndTime - ProxyDataRs.Fields("endtime"), EndTime)
End If
    
    'Do While Not FindBound
    
    'If EndTime <= ConvertMill(TimeDataRs.Fields("endtime")) And _
                Fee_Type = TimeDataRs.Fields("type") Then
    '    FindBound = True
    '    EndZone = TimeDataRs.Fields("id")
    '    Call addfee(ProxyDataRs.Fields("clientusername"), _
    '            EndTime - ConvertMill(TimeDataRs.Fields("startuptime")))
    'Else
    '    Call addfee(ProxyDataRs.Fields("clientusername"), _
    '            ConvertMill(TimeDataRs.Fields("endtime")) - _
    '            ConvertMill(TimeDataRs.Fields("startuptime")))
    '    TimeDataRs.MoveNext
    'End If
    'Loop
    
    'TimeDataRs.MoveFirst '移动记录到时间段开始的位置
    'Do While Not (TimeDataRs.EOF)
    '    If TimeDataRs.Fields("ID") <> StartupZone Then TimeDataRs.MoveNext
    'Loop
   'Money = IPFeePrice * IPCountRate * (时间段结束-StartupTime) _
                 * TimeFeePrice * TimeCountRate / 10000
   'AddFee(user,money,1)
        
    'For i = StartupZone To EndZone - 1 Step 1
    '    TimeDataRs.MoveNext '从开始的时间区段计算
    '    TimeFeePrice = TimeDataRs.Fields("TimeFee") 'TimeFeePrice = 时间段费率
    '    TimeCountRate = TimeDataRs.Fields("Rate") 'TimeCountRate = 时间段因子
    '    'Money = IPFeePrice * IPCountRate * (时间段结束-时间段开始) _
    '                * TimeFeePrice * TimeCountRate / 10000
    '    'AddFee(User,money,0)
    'Next i

    'TimeDataRs.MoveNext '移动记录到时间段结束的位置
    'TimeFeePrice = TimeDataRs.Fields("TimeFee") 'TimeFeePrice = 时间段费率
    'TimeCountRate = TimeDataRs.Fields("Rate") 'TimeCountRate = 时间段因子
    'Money = IPFeePrice * IPCountRate * (LTimeRec-时间段开始) * _
                    TimeFeePrice * TimeCountRate / 10000
    'AddFee(username,money,0)
End Sub

Private Sub addfee(ProTime As Long)
Dim money As Double
Set OutDataRs = db.OpenRecordset("output", dbOpenTable)
Set GroupDataRs = db.OpenRecordset("groups", dbOpenSnapshot)
Dim FoundName As Boolean
Dim temp21, temp22 As Integer

TimeFeePrice = TimeDataRs.Fields("TimeFee") 'TimeFeePrice = 时间段费率
TimeCountRate = TimeDataRs.Fields("Rate") 'TimeCountRate = 时间段因子

money = (SInt(ProxyDataRs.Fields("bytessent")) * SendFeePrice) / 1000000 + _
        (SInt(ProxyDataRs.Fields("bytesrecvd")) * RecvdFeePrice) / 1000000 + _
            (TimeFeePrice * (ProTime / 1000) * TimeCountRate + _
            IPTimePrice * (ProTime / 1000)) / 3600

FoundName = False
If OutDataRs.RecordCount > 0 Then
    OutDataRs.MoveFirst
    Do
    If OutDataRs.Fields("name") = ProxyDataRs.Fields("clientusername") Then
        FoundName = True
        Exit Do
    Else
        OutDataRs.MoveNext
    End If
    Loop While Not OutDataRs.EOF
    If FoundName = True Then
        OutDataRs.Edit
    Else
        OutDataRs.AddNew
    End If
Else
    OutDataRs.AddNew
End If
OutDataRs.Fields("name") = ProxyDataRs.Fields("clientusername")
GroupDataRs.FindFirst ("name = '" & Trim(ProxyDataRs.Fields("clientusername")) & "'")
If Not GroupDataRs.NoMatch Then
    OutDataRs.Fields("groupname") = GroupDataRs.Fields("group")
'Else
    'MsgBox "包含未找到该用户的组:" & ProxyDataRs.Fields("clientusername"), vbOKOnly
End If
    OutDataRs.Fields("totalfee") = 0
    OutDataRs.Fields("cheapsent") = 0
    OutDataRs.Fields("cheaprecvd") = 0
    OutDataRs.Fields("cheapconnect") = 0
    OutDataRs.Fields("freesent") = 0
    OutDataRs.Fields("freerecvd") = 0
    OutDataRs.Fields("freeconnect") = 0
    OutDataRs.Fields("expensivesent") = 0
    OutDataRs.Fields("expensiverecvd") = 0
    OutDataRs.Fields("expensiveconnect") = 0
    OutDataRs.Fields("totalsent") = 0
    OutDataRs.Fields("totalrecvd") = 0
    OutDataRs.Fields("totalconnect") = 0
    
    OutDataRs.Fields("TotalFee") = OutDataRs.Fields("TotalFee") + money
    Select Case Fee_Type
    Case 1
        OutDataRs.Fields("CheapSent") = OutDataRs.Fields("CheapSent") + _
                SInt(ProxyDataRs.Fields("bytessent"))
        OutDataRs.Fields("TotalSent") = OutDataRs.Fields("TotalSent") + _
                SInt(ProxyDataRs.Fields("bytessent"))
        
        OutDataRs.Fields("CheapRecvd") = OutDataRs.Fields("CheapRecvd") + _
                SInt(ProxyDataRs.Fields("bytesrecvd"))
        OutDataRs.Fields("totalrecvd") = OutDataRs.Fields("totalrecvd") + _
                SInt(ProxyDataRs.Fields("bytesrecvd"))
                
        OutDataRs.Fields("CheapConnect") = OutDataRs.Fields("CheapConnect") + _
                ProTime
        OutDataRs.Fields("TotalConnect") = OutDataRs.Fields("totalconnect") + _
                ProTime
    
    Case 2
        OutDataRs.Fields("freeSent") = OutDataRs.Fields("freeSent") + _
                SInt(ProxyDataRs.Fields("bytessent"))
        OutDataRs.Fields("TotalSent") = OutDataRs.Fields("TotalSent") + _
                SInt(ProxyDataRs.Fields("bytessent"))
        
        OutDataRs.Fields("freeRecvd") = OutDataRs.Fields("freeRecvd") + _
                SInt(ProxyDataRs.Fields("bytesrecvd"))
        OutDataRs.Fields("totalrecvd") = OutDataRs.Fields("totalrecvd") + _
                SInt(ProxyDataRs.Fields("bytesrecvd"))
        
        OutDataRs.Fields("freeConnect") = OutDataRs.Fields("freeConnect") + _
                ProTime
        OutDataRs.Fields("TotalConnect") = OutDataRs.Fields("totalconnect") + _
                ProTime
    
    Case 3
        OutDataRs.Fields("expensiveSent") = OutDataRs.Fields("expensiveSent") + _
                SInt(ProxyDataRs.Fields("bytessent"))
        OutDataRs.Fields("TotalSent") = OutDataRs.Fields("TotalSent") + _
                SInt(ProxyDataRs.Fields("bytessent"))
        
        OutDataRs.Fields("expensiveRecvd") = OutDataRs.Fields("expensiveRecvd") + _
                SInt(ProxyDataRs.Fields("bytesrecvd"))
        OutDataRs.Fields("totalrecvd") = OutDataRs.Fields("totalrecvd") + _
                SInt(ProxyDataRs.Fields("bytesrecvd"))
        
        OutDataRs.Fields("expensiveConnect") = OutDataRs.Fields("expensiveConnect") + _
                ProTime
        OutDataRs.Fields("TotalConnect") = OutDataRs.Fields("totalconnect") + _
                ProTime
    End Select
    OutDataRs.Update
End Sub

Private Function SInt(dest As String) As Long
If dest = "-" Then
    SInt = 0
Else
    SInt = CLng(dest)
End If
End Function

Private Sub SignIPFee(ByVal IPAddr)
Dim CannotFound As Boolean
Dim comp1, comp2 As Integer
CannotFound = True
'MsgBox "正在查找地址： " & IPAddr
Set IPDataRs = db.OpenRecordset("IPZone2", dbOpenSnapshot)
With IPDataRs
.MoveFirst
Do While (Not .EOF)
comp1 = CompIP(IPAddr, .Fields("StartupAddr"))
comp2 = CompIP(IPAddr, .Fields("EndAddr"))
If (comp1 = 1 Or comp1 = 0) And (comp2 = 2 Or comp2 = 0) Then
    CannotFound = False
    Fee_Type = .Fields("type")
    
    SendFeePrice = .Fields("SendFee")
    RecvdFeePrice = .Fields("recvdFee")
    IPTimePrice = .Fields("timefee")

'    MsgBox "查到 " & IPAddr & " 为" & typeop(.Fields("type")) _
            & Chr(13) & "发送收费为 " & CStr(SendFeePrice) & _
            " 接收收费为 " & CStr(RecvdFeePrice), vbOKOnly, "搜寻结果"
    Exit Do
Else
    .MoveNext
End If
Loop
End With
If CannotFound Then MsgBox "此记录的IP地址不在数据库中。", vbOKOnly, "查询失败"
End Sub

Public Function typeop(ByVal tp As Integer) '返回IP计费类型的中文名称
If tp = 1 Then typeop = "廉价地址"
If tp = 2 Then typeop = "免费地址"
If tp = 3 Then typeop = "收费地址"
End Function

Public Function CompIP(ByVal SrcIP As String, ByVal DesIP As String)
            '比较两个IP地址的大小：返回的数字表示该序号的参数大
Dim SRCsec, DESsec, src1, src2, des1, des2 As Long
Dim temp As String
Dim Jjj As Integer
Dim dot As String
CompIP = 0
dot = "."
src1 = 0
des1 = 0
For Jjj = 1 To 4
src2 = InStr(src1 + 1, SrcIP, dot, vbBinaryCompare)
If src2 = 0 Then
    SRCsec = CInt(Mid(SrcIP, src1 + 1))
'    MsgBox SRCsec
Else
    SRCsec = CInt(Mid(SrcIP, src1 + 1, src2 - src1))
'    MsgBox SRCsec
End If

des2 = InStr(des1 + 1, DesIP, dot, vbBinaryCompare)
If des2 = 0 Then
    DESsec = CInt(Mid(DesIP, des1 + 1, Len(DesIP) - des1))
Else
    DESsec = CInt(Mid(DesIP, des1 + 1, des2 - des1))
End If
If SRCsec > DESsec Then
    CompIP = 1
    Exit Function
Else
    If SRCsec < DESsec Then
        CompIP = 2
        Exit Function
    End If
End If
src1 = src2
des1 = des2
Next Jjj
End Function

Private Function ConvertMill(ByVal timerec As Date) As Long
ConvertMill = Hour(timerec) * 3600000 + Minute(timerec) * 60000 _
            + Second(timerec) * 1000
End Function