📄 main.frm
字号:
VERSION 5.00
Begin VB.Form main
BackColor = &H00FF8080&
BorderStyle = 1 'Fixed Single
Caption = "短信存储器"
ClientHeight = 5745
ClientLeft = 3855
ClientTop = 2670
ClientWidth = 5490
Icon = "main.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 10.134
ScaleMode = 0 'User
ScaleWidth = 9.684
Begin VB.CommandButton Command1
Caption = "退出"
Height = 495
Index = 6
Left = 4440
TabIndex = 18
Top = 5040
Width = 735
End
Begin VB.TextBox txtsmsnum
Appearance = 0 'Flat
Height = 300
Left = 3315
TabIndex = 16
Top = 4530
Width = 735
End
Begin VB.TextBox txtsmscount
Appearance = 0 'Flat
Height = 300
Left = 660
Locked = -1 'True
TabIndex = 15
Top = 4530
Width = 735
End
Begin VB.CommandButton Command1
Caption = "查找"
Height = 495
Index = 5
Left = 3720
TabIndex = 13
Top = 5040
Width = 735
End
Begin VB.CommandButton Command1
Caption = "下一条"
Height = 495
Index = 4
Left = 3000
TabIndex = 12
Top = 5040
Width = 735
End
Begin VB.CommandButton Command1
Caption = "上一条"
Height = 495
Index = 3
Left = 2280
TabIndex = 11
Top = 5040
Width = 735
End
Begin VB.CommandButton Command1
Caption = "修改"
Height = 495
Index = 2
Left = 1560
TabIndex = 10
Top = 5040
Width = 735
End
Begin VB.CommandButton Command1
Caption = "删除"
Height = 495
Index = 1
Left = 840
TabIndex = 9
Top = 5040
Width = 735
End
Begin VB.TextBox txtcontent
Appearance = 0 'Flat
BackColor = &H00C0C0FF&
DataField = "content"
DataSource = "Data1"
Height = 1815
Left = 240
Locked = -1 'True
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 4
Top = 2640
Width = 4935
End
Begin VB.TextBox txttime
Appearance = 0 'Flat
BackColor = &H00FFFFC0&
DataField = "time"
DataSource = "Data1"
Height = 495
Left = 2340
Locked = -1 'True
TabIndex = 3
Top = 1890
Width = 2295
End
Begin VB.TextBox txtname
Appearance = 0 'Flat
BackColor = &H00FFFFC0&
DataField = "name"
DataSource = "Data1"
Height = 495
Left = 2340
Locked = -1 'True
TabIndex = 2
Top = 1290
Width = 2295
End
Begin VB.TextBox txtnum
Appearance = 0 'Flat
BackColor = &H00FFFFC0&
DataField = "number"
DataSource = "Data1"
Height = 495
Left = 2340
Locked = -1 'True
TabIndex = 1
Top = 690
Width = 2295
End
Begin VB.Data Data1
Connect = "Access"
DatabaseName = "F:\PRACTICE\VB\temp\sms\db1.mdb"
DefaultCursorType= 0 '缺省游标
DefaultType = 2 '使用 ODBC
Exclusive = 0 'False
Height = 375
Left = 3840
Options = 0
ReadOnly = 0 'False
RecordsetType = 1 'Dynaset
RecordSource = "sms"
Top = 0
Visible = 0 'False
Width = 1455
End
Begin VB.CommandButton Command1
Caption = "添加"
Height = 495
Index = 0
Left = 120
TabIndex = 8
Top = 5040
Width = 735
End
Begin VB.Label lblpstn
AutoSize = -1 'True
BackColor = &H00FF8080&
Caption = "0"
BeginProperty Font
Name = "华文新魏"
Size = 14.25
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H000000FF&
Height = 285
Left = 240
TabIndex = 19
Top = 2280
Width = 180
End
Begin VB.Label cmdgo
Alignment = 2 'Center
BackColor = &H0080FF80&
Caption = "Go！"
BeginProperty Font
Name = "Bookman Old Style"
Size = 9
Charset = 0
Weight = 600
Underline = 0 'False
Italic = -1 'True
Strikethrough = 0 'False
EndProperty
ForeColor = &H000000FF&
Height = 285
Left = 4620
TabIndex = 17
Top = 4605
Width = 390
End
Begin VB.Shape Shape1
BackColor = &H0080FF80&
BorderColor = &H00FF8080&
BorderStyle = 4 'Dash-Dot
FillColor = &H0080FF80&
FillStyle = 0 'Solid
Height = 495
Left = 4560
Shape = 3 'Circle
Top = 4500
Width = 495
End
Begin VB.Label Label5
BackColor = &H00FF8080&
Caption = "共 条短信 跳转到第 条"
BeginProperty Font
Name = "楷体_GB2312"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 375
TabIndex = 14
Top = 4560
Width = 4200
End
Begin VB.Label Label4
BackColor = &H00FF8080&
Caption = "手机短信存储器"
BeginProperty Font
Name = "楷体_GB2312"
Size = 18
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H000000C0&
Height = 495
Left = 1200
TabIndex = 7
Top = 120
Width = 2655
End
Begin VB.Label Label3
BackColor = &H00FF8080&
Caption = " 接收时间"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 465
TabIndex = 6
Top = 1965
Width = 1695
End
Begin VB.Label Label2
BackColor = &H00FF8080&
Caption = " 对方姓名"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 465
TabIndex = 5
Top = 1365
Width = 1695
End
Begin VB.Label Label1
BackColor = &H00FF8080&
Caption = " 手机号码"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 465
TabIndex = 0
Top = 765
Width = 1695
End
End
Attribute VB_Name = "main"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim msg
Public tempname As String
Public tempnumb As String
Public temptime As String
Public smsnum As Long
Public dbs As Database, rec As Recordset
Public txtflag As Boolean
Private Sub cmdgo_Click()
On Error GoTo error
Data1.Recordset.Move CInt(txtsmsnum.Text)
Exit Sub
error:
MsgBox "你输入的不是数字", 32, "出错"
txtsmsnum.SetFocus
End Sub
Private Sub Command1_Click(Index As Integer)
On Error Resume Next
Select Case Index
Case 0: '添加
On Error Resume Next
If Command1(0).Caption = "添加" Then
Call cmddisable
txtnum.SetFocus
txtflag = True
main.Command1(0).Enabled = True
Command1(0).Caption = "确定"
Data1.Recordset.MoveLast
tempname = Data1.Recordset.Fields("name")
tempnumb = Data1.Recordset.Fields("number")
temptime = Data1.Recordset.Fields("time")
Data1.Recordset.AddNew
check:
Else
Command1(0).Caption = "添加"
If txtnum.Text <> "" And txtname.Text <> "" And txttime.Text <> "" And txtcontent.Text <> "" Then
Call cmdenable
Call add
txtflag = False
Data1.Recordset.MoveLast
MsgBox "添加成功!", , "添加"
txtsmscount.Text = rec.RecordCount
lblpstn.Caption = rec.RecordCount
Else: MsgBox "请核对信息！", , "信息不完整"
End If
End If
Case 1: '删除
On Error Resume Next
Data1.Recordset.Delete
Data1.Recordset.MoveLast
txtsmscount.Text = rec.RecordCount
lblpstn.Caption = rec.RecordCount
If Data1.Recordset.EOF And Data1.Recordset.BOF Then
MsgBox "最后一条纪录已经被删除!", , "确认删除"
Data1.Recordset.AddNew
Data1.Recordset.Fields(0).Value = 1
Data1.Recordset.Fields(1).Value = "number"
Data1.Recordset.Fields(2).Value = "name"
Data1.Recordset.Fields(3).Value = "time"
Data1.Recordset.Fields(4).Value = "content"
Data1.Recordset.Update
Data1.Recordset.MoveLast
End If
Case 2: '修改
On Error Resume Next
Dim book
Call cmddisable
Command1(2).Enabled = True
If Command1(2).Caption = "修改" Then
Command1(2).Caption = "确定"
Else
Command1(2).Caption = "修改"
msg = MsgBox("确定所作的修改吗？(如果改为空，则不作修改)", vbYesNo, "确认")
If msg = vbYes Then
book = Data1.Recordset.Bookmark
Data1.Recordset.MoveLast
Data1.Recordset.Bookmark = book
Data1.UpdateRecord
Else: Data1.UpdateControls
End If
Call cmdenable
End If
Case 3: '上一条
On Error Resume Next
Data1.Recordset.MovePrevious
lblpstn.Caption = lblpstn.Caption - 1
If (Data1.Recordset.Fields(0) = "") Then
Data1.Recordset.MoveFirst
lblpstn.Caption = 1
MsgBox "已经是第一条了！", , "出错"
Else
End If
Case 4: '下一条
On Error Resume Next
Data1.Recordset.MoveNext
lblpstn.Caption = lblpstn.Caption + 1
If Data1.Recordset.EOF Then Data1.Recordset.MoveLast: lblpstn.Caption = rec.RecordCount: MsgBox "已经是最后一条了！", , "出错"
Case 5: '查找
Case 6: '退出
Unload Me
Case Else
End Select
End Sub
Private Sub Form_Load()
Data1.DatabaseName = App.Path & "\smsold.mc"
Set dbs = Workspaces(0).OpenDatabase(Data1.DatabaseName)
Set rec = dbs.OpenRecordset("sms")
txtsmscount.Text = rec.RecordCount
lblpstn.Caption = 1
End Sub
Private Sub txtnum_GotFocus()
txtnum.SelStart = 0: txtnum.SelLength = Len(txtnum.Text)
End Sub
Private Sub txtname_GotFocus()
If main.txtnum.Text = "" And txtflag = True Then txtnum.Text = tempnumb
txtflag = False
txtname.SelStart = 0: txtname.SelLength = Len(txtname.Text)
End Sub
Private Sub txttime_GotFocus()
If main.txtnum.Text = "" And txtflag = True Then txtnum.Text = tempnumb
If txtname.Text = "" And txtflag = True Then txtname.Text = tempname
txtflag = False
txttime.SelStart = 0: txttime.SelLength = Len(txttime.Text)
End Sub
Private Sub txtcontent_GotFocus()
If main.txtnum.Text = "" And txtflag = True Then txtnum.Text = tempnumb
If txtname.Text = "" And txtflag = True Then txtname.Text = tempname
If txttime.Text = "" And txtflag = True Then txttime.Text = temptime
txtcontent.SelStart = 0: txtcontent.SelLength = Len(txtcontent.Text)
txtflag = False
End Sub
Private Sub txtname_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then txttime.SetFocus
End Sub
Private Sub txtnum_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then txtname.SetFocus
End Sub
Private Sub txttime_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then txtcontent.SetFocus
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -