?? form1.frm
字號:
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
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -