📄 form1.frm

📁 根据MS Proxy的日志文件进行计费的程序
💻 FRM
📖 第 1 页 / 共 2 页
字号:
上一页 12

Public Sub ProcessKey(ByVal Section As String, _
        ByVal KeyN As String, ByVal Value As String)
Dim Pos, Deli As Integer
Dim j As Integer
Dim tempchar As String
Dim temp As String
Select Case LCase(Section)
Case "system"
    SaveSetting appname:="wsm", Section:="system", _
                Key:=KeyN, setting:=Value
    'Exit Sub
Case "cheap"
    Fee_Type = 1
    Select Case LCase(KeyN)
    Case "timezone"
        Deli = 4
        TimeDataRs.AddNew
        'TimeRecord = TimeRecord + 1
        'TimeDataRs.Fields(1) = CStr(TimeRecord)
        
        temp = GetDeli(Value, 1)
        If temp = "*" Then temp = "0"
            TimeDataRs.Fields("StartupTime") = SDate(temp)
        
        temp = GetDeli(Value, 2)
        If temp = "*" Or temp = "2400" Then
            temp = "23:59:59"
            TimeDataRs.Fields("EndTime") = CDate(temp)
        Else
            TimeDataRs.Fields("EndTime") = SDate(temp)
        End If
        
        temp = GetDeli(Value, 3)
        TimeDataRs.Fields("TimeFee") = CInt(temp)
        
        temp = GetDeli(Value, 4)
        TimeDataRs.Fields("Rate") = CInt(temp)
        
        TimeDataRs.Fields("Type") = Fee_Type
        TimeDataRs.Update
    Case "ip"
        Deli = 4
        IPDataRs.AddNew
        IPRecord = IPRecord + 1
        'IPDataRs.Fields(1) = CStr(IPRecord)
        temp = GetDeli(Value, 1)
        IPDataRs.Fields("StartUpAddr") = temp
        IPDataRs.Fields("EndAddr") = temp
        temp = GetDeli(Value, 2)
        IPDataRs.Fields("SendFee") = CInt(temp)
        temp = GetDeli(Value, 3)
        IPDataRs.Fields("RecvdFee") = CInt(temp)
        temp = GetDeli(Value, 4)
        IPDataRs.Fields("TimeFee") = CInt(temp)
        IPDataRs.Fields("Type") = Fee_Type
        IPDataRs.Update
    Case "ipzone"
        Deli = 5
        IPDataRs.AddNew
        IPRecord = IPRecord + 1
        'IPDataRs.Fields(1) = CStr(IPRecord)
        temp = GetDeli(Value, 1)
        IPDataRs.Fields("StartupAddr") = temp
        temp = GetDeli(Value, 2)
        IPDataRs.Fields("EndAddr") = temp
        temp = GetDeli(Value, 3)
        IPDataRs.Fields("SendFee") = CInt(temp)
        temp = GetDeli(Value, 4)
        IPDataRs.Fields("RecvdFee") = CInt(temp)
        temp = GetDeli(Value, 5)
        IPDataRs.Fields("TimeFee") = CInt(temp)
        IPDataRs.Fields("Type") = Fee_Type
        IPDataRs.Update
    End Select
Case "free"
    Fee_Type = 2
    Select Case LCase(KeyN)
    Case "timezone"
        Deli = 4
        TimeDataRs.AddNew
        TimeRecord = TimeRecord + 1
        'TimeDataRs.Fields(1) = CStr(TimeRecord)
        
        temp = GetDeli(Value, 1)
        If temp = "*" Then temp = "0"
            TimeDataRs.Fields("StartupTime") = SDate(temp)
        
        temp = GetDeli(Value, 2)
        If temp = "*" Or temp = "2400" Then
            temp = "23:59:59"
            TimeDataRs.Fields("EndTime") = CDate(temp)
        Else
            TimeDataRs.Fields("EndTime") = SDate(temp)
        End If
        
        temp = GetDeli(Value, 3)
        TimeDataRs.Fields("TimeFee") = CInt(temp)
        
        temp = GetDeli(Value, 4)
        TimeDataRs.Fields("Rate") = CInt(temp)
        
        TimeDataRs.Fields("Type") = Fee_Type
        TimeDataRs.Update
    Case "ip"
        Deli = 4
        IPDataRs.AddNew
        IPRecord = IPRecord + 1
        'IPDataRs.Fields(1) = CStr(IPRecord)
        temp = GetDeli(Value, 1)
        IPDataRs.Fields("StartupAddr") = temp
        IPDataRs.Fields("EndAddr") = temp
        temp = GetDeli(Value, 2)
        IPDataRs.Fields("SendFee") = CInt(temp)
        temp = GetDeli(Value, 3)
        IPDataRs.Fields("RecvdFee") = CInt(temp)
        temp = GetDeli(Value, 4)
        IPDataRs.Fields("TimeFee") = CInt(temp)
        IPDataRs.Fields("type") = Fee_Type
        IPDataRs.Update
    Case "ipzone"
        Deli = 5
        IPDataRs.AddNew
        IPRecord = IPRecord + 1
        'IPDataRs.Fields(1) = CStr(IPRecord)
        temp = GetDeli(Value, 1)
        IPDataRs.Fields("StartupAddr") = temp
        temp = GetDeli(Value, 2)
        IPDataRs.Fields("EndAddr") = temp
        temp = GetDeli(Value, 3)
        IPDataRs.Fields("SendFee") = CInt(temp)
        temp = GetDeli(Value, 4)
        IPDataRs.Fields("RecvdFee") = CInt(temp)
        temp = GetDeli(Value, 5)
        IPDataRs.Fields("TimeFee") = CInt(temp)
        IPDataRs.Fields("Type") = Fee_Type
        IPDataRs.Update
    End Select
Case "expensive"
    Fee_Type = 3
    Select Case LCase(KeyN)
    Case "timezone"
        Deli = 4
        TimeDataRs.AddNew
        TimeRecord = TimeRecord + 1
        'TimeDataRs.Fields(1) = CStr(TimeRecord)
        
        temp = GetDeli(Value, 1)
        If temp = "*" Then temp = "0"
            TimeDataRs.Fields("StartupTime") = SDate(temp)
        
        temp = GetDeli(Value, 2)
        If temp = "*" Or temp = "2400" Then
            temp = "23:59:59"
            TimeDataRs.Fields("EndTime") = CDate(temp)
        Else
            TimeDataRs.Fields("EndTime") = SDate(temp)
        End If
        
        temp = GetDeli(Value, 3)
        TimeDataRs.Fields("TimeFee") = CInt(temp)
        
        temp = GetDeli(Value, 4)
        TimeDataRs.Fields("Rate") = CInt(temp)
        
        TimeDataRs.Fields("type") = Fee_Type
        TimeDataRs.Update
    Case "receive"
        Deli = 1
'        IPDataRs.FindFirst "fee_type= 3"
'        If IPDataRs.NoMatch Then
'            MsgBox "没找到已有的Expensive记录，将要增加一个", vbOKOnly
            IPDataRs.AddNew
            IPRecord = IPRecord + 1
            'IPDataRs.Fields(1) = CStr(IPRecord)
            IPDataRs.Fields("StartupAddr") = "0.0.0.0"
            IPDataRs.Fields("EndAddr") = "255.255.255.255"
'        End If
        IPDataRs.Fields("RecvdFee") = CInt(Value)
        'IPDataRs.Update
    Case "send"
        Deli = 1
'        IPDataRs.FindFirst "type= 3"
'        If IPDataRs.NoMatch Then
'            MsgBox "没找到已有的Expensive记录，将要增加一个", vbOKOnly
'            IPDataRs.AddNew
'            IPRecord = IPRecord + 1
            'IPDataRs.Fields(1) = CStr(IPRecord)
'            IPDataRs.Fields("StartupAddr") = "0.0.0.0"
'            IPDataRs.Fields("EndAddr") = "255.255.255.255"
'        End If
        IPDataRs.Fields("SendFee") = CInt(Value)
        IPDataRs.Fields("timefee") = 0
        IPDataRs.Fields("type") = Fee_Type
        IPDataRs.Update
    End Select
Case "email"
    Fee_Type = 0
    EmailDataRs.AddNew
    EmailRecord = EmailRecord + 1
    'EmailDataRs.Fields(1) = CStr(EmailRecord)
    '写入数据库
    EmailDataRs.Fields("Name") = KeyN
    EmailDataRs.Fields("email") = Value
    EmailDataRs.Update
Case "groups"
    Fee_Type = 0
    Deli = 1
    For j = 1 To Len(Value)
        If Mid(Value, j, 1) = "," Then
            Deli = Deli + 1
        End If
    Next
    '写入数据库
    For j = 1 To Deli
        GroupDataRs.AddNew
        GroupRecord = GroupRecord + 1
        'GroupDataRs.Fields(1) = CStr(GroupRecord)
        GroupDataRs.Fields("group") = KeyN
        GroupDataRs.Fields("name") = GetDeli(Value, j)
        GroupDataRs.Update
    Next j
Case Else
    MsgBox "不可识别的段名！ " & Section, vbOKOnly + vbExclamation, "错误"
'如果是cheap等，则传递到加入数据库里去。
End Select

End Sub

'Declare Function GetProfileInt Lib "kernel32" _
' Alias "GetProfileIntA" (ByVal lpAppName As String, ByVal lpKeyName As String, ByVal nDefault As Long) As Long
'Declare Function GetProfileSection Lib "kernel32" Alias "GetProfileSectionA" (ByVal lpAppName As String, ByVal lpReturnedString As String, ByVal nSize As Long) As Long
'Declare Function GetProfileString Lib "kernel32" Alias "GetProfileStringA" (ByVal lpAppName As String, ByVal lpKeyName As String, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long) As Long

Private Function GetDeli(Str1 As String, Position As Integer) As String
Dim aa, bb, cc, dd As Integer
Dim ee As String
bb = 1
If Position < 1 Then MsgBox "程序内部错误！！！", vbOKOnly + vbExclamation, "错误"
If Position < 2 Then
    aa = InStr(bb, Str1, ",", vbTextCompare)
    If aa = 1 Then
        GetDeli = ""
    Else
        GetDeli = Mid(Str1, 1, aa - 1)
    End If
Else
    For cc = 1 To Position - 1 '222,3323,405,333
        aa = InStr(bb, Str1, ",", vbTextCompare)
        bb = InStr(aa + 1, Str1, ",", vbTextCompare)
        If bb = 0 Then bb = Len(Str1) + 1
    Next
    GetDeli = Mid(Str1, aa + 1, bb - aa - 1)
End If
End Function

Private Function SDate(Dateval As String) As Date
Dim temp11, temp12 As Integer
temp11 = Int((CInt(Dateval)) / 100)
temp12 = (CInt(Dateval)) Mod 100
SDate = CDate(CStr(temp11) & ":" & CStr(temp12))
End Function
上一页 12
⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -