form1.frm

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

VERSION 5.00
Begin VB.Form Mainfrm 
   Caption         =   "计费系统"
   ClientHeight    =   4260
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   5340
   BeginProperty Font 
      Name            =   "宋体"
      Size            =   8.25
      Charset         =   134
      Weight          =   400
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   LinkTopic       =   "Form1"
   ScaleHeight     =   4260
   ScaleWidth      =   5340
   StartUpPosition =   3  'Windows Default
   Begin VB.CommandButton Reset 
      Caption         =   "初始化"
      BeginProperty Font 
         Name            =   "隶书"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   1905
      TabIndex        =   3
      Top             =   1080
      Width           =   1695
   End
   Begin VB.CommandButton option 
      Caption         =   "配置"
      BeginProperty Font 
         Name            =   "隶书"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   1935
      TabIndex        =   2
      Top             =   2520
      Width           =   1695
   End
   Begin VB.CommandButton FeeCount 
      Caption         =   "计费"
      BeginProperty Font 
         Name            =   "隶书"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   1920
      TabIndex        =   1
      Top             =   1800
      Width           =   1695
   End
   Begin VB.CommandButton Exit 
      Caption         =   "退出"
      BeginProperty Font 
         Name            =   "隶书"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   1920
      TabIndex        =   0
      Top             =   3240
      Width           =   1695
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "Internet流量计费系统"
      BeginProperty Font 
         Name            =   "隶书"
         Size            =   15
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   300
      Left            =   1320
      TabIndex        =   4
      Top             =   195
      Width           =   3000
   End
End
Attribute VB_Name = "Mainfrm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim db As Database '数据库定义
Dim IPDataRs As Recordset 'IP地址段表
Dim TimeDataRs As Recordset '时间段表
Dim GroupDataRs As Recordset '组用户表
Dim EmailDataRs As Recordset 'Email地址表
Dim Fee_Type As Integer '记录类型
Dim TimeRecord As Integer
Dim IPRecord As Integer
Dim GroupRecord As Integer
Dim EmailRecord As Integer

Private Sub Exit_Click()
'退出
End
End Sub

Private Sub FeeCount_Click()
'计费
If GetSetting(appname:="wsm", Section:="system", Key:="T1") = "" Then
    If MsgBox("您尚未做过初始化操作,要现在开始吗？初始化将清除您做过的所有设置。", vbYesNo, "请选择") = vbYes Then
        Call init
    End If
End If
FeeFrm.Show 1
End Sub

Private Sub Form_Load()
Label1.Caption = GetSetting(appname:="wsm", Section:="system", _
                        Key:="T1")
Me.Show
Me.Refresh
If Label1.Caption = "" Then
    MsgBox "请尽快做初始化", vbOKOnly, "警告"
End If
End Sub

Private Sub option_Click()
'配置
If GetSetting(appname:="wsm", Section:="system", Key:="T1") = "" Then
    If MsgBox("您尚未做过初始化操作,要现在开始吗？初始化将清除您做过的所有设置。", vbYesNo, "请选择") = vbYes Then
        Call init
    End If
End If
Options.Show 1
End Sub

Private Sub Reset_Click()
Dim temp As Integer
If MsgBox("真的要初始化吗？", vbYesNo, "请选择") = vbYes Then
    Call init
End If
Call Form_Load
End Sub

Public Sub init()
Dim TextLine, TrimLine As String
Dim i, LineNum, FileNumber As Integer
Dim EqualSign, DotSign(10) As Integer
Dim SectionName, KeyName, KeyValue As String
i = 0
Set db = OpenDatabase("d:\wsm\wsm.mdb")

Set GroupDataRs = db.OpenRecordset("groups", dbOpenTable)
Set EmailDataRs = db.OpenRecordset("emails", dbOpenTable)
Set TimeDataRs = db.OpenRecordset("timezone", dbOpenTable)
Set IPDataRs = db.OpenRecordset("IPZone", dbOpenTable)

If GroupDataRs.RecordCount > 0 Then
    GroupDataRs.MoveFirst
    Do While Not GroupDataRs.EOF
        i = i + 1
        GroupDataRs.Delete
        GroupDataRs.MoveNext
    Loop
End If
If EmailDataRs.RecordCount > 0 Then
EmailDataRs.MoveFirst
Do While Not EmailDataRs.EOF
    EmailDataRs.Delete
    EmailDataRs.MoveNext
Loop
End If
If TimeDataRs.RecordCount > 0 Then
TimeDataRs.MoveFirst
Do While Not TimeDataRs.EOF
    TimeDataRs.Delete
    TimeDataRs.MoveNext
Loop
End If
If IPDataRs.RecordCount > 0 Then
IPDataRs.MoveFirst
Do While Not IPDataRs.EOF
    IPDataRs.Delete
    IPDataRs.MoveNext
Loop
End If
'MsgBox "已经删除所有的记录"
If GetSetting(appname:="wsm", Section:="startup", _
        Key:="Date", Default:="default") <> "default" _
        Then DeleteSetting "wsm", "startup"
If GetSetting(appname:="wsm", Section:="end", _
        Key:="Date", Default:="default") <> "default" _
        Then DeleteSetting "wsm", "end"
If GetSetting(appname:="wsm", Section:="system", _
        Key:="T1", Default:="default") <> "default" _
        Then DeleteSetting "wsm", "system"
'MsgBox "已经删除注册表所有主键"

FileNumber = FreeFile
Open "d:\wsm\default.ini" For Input As FileNumber
LineNum = 1

'TimeRecord = 0
'IPRecord = 0
'GroupRecord = 0
'EmailRecord = 0

Do While Not EOF(FileNumber)
    Line Input #1, TextLine
    LineNum = LineNum + 1
    TrimLine = Trim(TextLine)
    If Len(TrimLine) <> 0 Then
        Select Case Left(TrimLine, 1)
        Case "["
            'Call newSection
            SectionName = Mid(TrimLine, 2, Len(TrimLine) - 2)
        Case "/"
            If Left(TrimLine, 2) <> "//" Then '注释下一行
                MsgBox "第" & LineNum & "行不是合法注释行！", vbOKOnly + vbExclamation, "错误"
            End If
        Case Else
            '是内容行
            EqualSign = InStr(1, TrimLine, "=", vbTextCompare)
            If EqualSign <> 0 Then
                KeyName = Left(TrimLine, EqualSign - 1)
                KeyValue = Mid(TrimLine, EqualSign + 1, Len(TrimLine) - EqualSign)
                Call ProcessKey(SectionName, KeyName, KeyValue)
            Else
                MsgBox "第" & LineNum & "行未包含等于号", vbOKOnly + vbExclamation, "错误"
            End If
        End Select
    End If
Loop
Close FileNumber
GroupDataRs.Close
EmailDataRs.Close
TimeDataRs.Close
IPDataRs.Close
db.Close
End Sub