📄 frmsearch.frm
字号:
End
Begin VB.Label Label10
AutoSize = -1 'True
BackColor = &H00FF7722&
Caption = "传呼号码"
ForeColor = &H00FFFFFF&
Height = 180
Left = 2640
TabIndex = 29
Top = 765
Width = 720
End
Begin VB.Label Label11
AutoSize = -1 'True
BackColor = &H00FF7722&
Caption = "OICQ号码"
ForeColor = &H00FFFFFF&
Height = 180
Left = 2640
TabIndex = 28
Top = 1845
Width = 720
End
Begin VB.Label Label12
AutoSize = -1 'True
BackColor = &H00FF7722&
Caption = "MSN I D"
ForeColor = &H00FFFFFF&
Height = 180
Left = 2640
TabIndex = 27
Top = 2205
Width = 720
End
Begin VB.Label Label13
AutoSize = -1 'True
BackColor = &H00FF7722&
Caption = "主 页"
ForeColor = &H00FFFFFF&
Height = 180
Left = 2640
TabIndex = 26
Top = 2565
Width = 720
End
Begin VB.Label Label14
AutoSize = -1 'True
BackColor = &H00FF7722&
Caption = "网 名"
ForeColor = &H00FFFFFF&
Height = 180
Left = 2640
TabIndex = 25
Top = 1125
Width = 720
End
Begin VB.Label Label15
AutoSize = -1 'True
BackColor = &H00FF7722&
Caption = "备 注"
ForeColor = &H00FFFFFF&
Height = 180
Left = 2640
TabIndex = 24
Top = 2925
Width = 720
End
Begin VB.Label Label16
AutoSize = -1 'True
BackColor = &H00FF7722&
Caption = "手机号码"
ForeColor = &H00FFFFFF&
Height = 180
Left = 2640
TabIndex = 23
Top = 405
Width = 720
End
Begin VB.Label Label17
AutoSize = -1 'True
BackColor = &H00FF7722&
Caption = "籍 贯"
ForeColor = &H00FFFFFF&
Height = 180
Left = 120
TabIndex = 15
Top = 1485
Width = 720
End
End
Attribute VB_Name = "frmsearch"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim rst As ADODB.Recordset
Dim mycnn As ADODB.Connection
Dim str As String
Dim bln As Boolean
Private Sub cmdback_Click()
aa.SetFocus
If rst.AbsolutePosition <> 2 Then
rst.MovePrevious
Else
rst.MoveFirst
cmdback.Enabled = False
cmdnext.Enabled = True
End If
fill
labrs.Caption = rst.AbsolutePosition & " / " & rst.RecordCount
End Sub
Private Sub cmdclear_Click()
aa.SetFocus
clsall
labrs.Caption = "0 / 0"
End Sub
Private Sub cmddel_Click()
aa.SetFocus
If MsgBox("确定删除？", vbOKCancel + vbDefaultButton2 + vbQuestion, "删除记录") = vbOK Then
If rst.AbsolutePosition <> rst.RecordCount Then
rst.Delete adAffectCurrent
rst.MovePrevious
If rst.BOF Then
rst.MoveFirst
cmdnext.Enabled = False
fill
labrs.Caption = rst.AbsolutePosition & " / " & rst.RecordCount
Else
cmdnext_Click
End If
Else
rst.Delete adAffectCurrent
rst.MoveNext
If rst.RecordCount <> 0 Then
rst.MoveLast
cmdnext.Enabled = False
If rst.RecordCount = 1 Then
cmdback.Enabled = False
End If
fill
labrs.Caption = rst.AbsolutePosition & " / " & rst.RecordCount
Else
clsall
labrs.Caption = "0 / 0"
cmdback.Enabled = False
cmdnext.Enabled = False
cmdedit.Enabled = False
cmddel.Enabled = False
MsgBox "目前没有任何记录！", vbOKOnly + vbExclamation, "提示"
End If
End If
End If
End Sub
Private Sub cmdedit_Click()
aa.SetFocus
If cmdedit.Caption = "编辑" Then
cmdedit.Caption = "保存"
cmdout.Enabled = False
cmdsearch.Enabled = False
cmddel.Enabled = False
Else
If MsgBox("确定添加该记录？", vbOKCancel + vbDefaultButton2 + vbQuestion, "添加记录") = vbOK Then
change
rst.Update
fill
End If
cmdedit.Caption = "编辑"
cmdout.Enabled = True
cmdsearch.Enabled = True
cmddel.Enabled = True
End If
End Sub
Private Sub cmdnext_Click()
aa.SetFocus
If rst.AbsolutePosition <> rst.RecordCount - 1 Then
rst.MoveNext
cmdback.Enabled = True
Else
rst.MoveLast
cmdnext.Enabled = False
cmdback.Enabled = True
End If
fill
labrs.Caption = rst.AbsolutePosition & " / " & rst.RecordCount
End Sub
Private Sub cmdout_Click()
Unload Me
Set frmsearch = Nothing
End Sub
Private Sub cmdsearch_Click()
Dim strsql As String
Dim i As Integer
Dim st As String
aa.SetFocus
If bln = False Then
rst.Close
bln = True
cmdsearch_Click
Exit Sub
End If
strsql = "select * from firend where owner='" & struser & "'"
If txtname <> "" Then
strsql = strsql & "and vname=" & "'" & txtname & "'"
End If
If txtsex <> "" Then
strsql = strsql & "and sex=" & "'" & txtsex & "'"
End If
If txtbir <> "" Then
strsql = strsql & "and bir=" & "'" & txtbir & "'"
End If
If txtjg <> "" Then
strsql = strsql & "and jg=" & "'" & txtjg & "'"
End If
If txtjob <> "" Then
strsql = strsql & "and job=" & "'" & txtjob & "'"
End If
If txtwhere <> "" Then
strsql = strsql & "and where=" & "'" & txtwhere & "'"
End If
If txtadd <> "" Then
strsql = strsql & "and add=" & "'" & txtadd & "'"
End If
If txtphone <> "" Then
strsql = strsql & "and phone=" & "'" & txtphone & "'"
End If
If txtmphone <> "" Then
strsql = strsql & "and mphone=" & "'" & txtmphone & "'"
End If
If txtbp <> "" Then
strsql = strsql & "and bp=" & "'" & txtbp & "'"
End If
If txtid <> "" Then
strsql = strsql & "and id=" & "'" & txtid & "'"
End If
If txtem <> "" Then
strsql = strsql & "and email=" & "'" & txtem & "'"
End If
If txtqq <> "" Then
strsql = strsql & "and qq=" & "'" & txtqq & "'"
End If
If txtmsn <> "" Then
strsql = strsql & "and msn=" & "'" & txtmsn & "'"
End If
If txtweb <> "" Then
strsql = strsql & "and web=" & "'" & txtweb & "'"
End If
If txtmemo <> "" Then
strsql = strsql & "and memo=" & "'" & txtmemo & "'"
End If
If strsql = "select * from firend where owner='" & struser & "'" Then
MsgBox "请填写至少一个查询条件！", vbOKOnly + vbExclamation, "没有查询条件"
Exit Sub
End If
rst.Open strsql, mycnn, , , adCmdText
If rst.RecordCount = 0 Then
MsgBox "没有符合条件的记录，请改变条件再试！", vbOKOnly + vbExclamation, "记录不存在"
clsall
labrs.Caption = "0 / 0"
rst.Close
Exit Sub
End If
For i = rst.AbsolutePosition To rst.RecordCount
If i < 10 Then
st = "0" & i
Else
st = CStr(i)
End If
txtres.Text = txtres.Text & "*********" & st & "*********" & vbCrLf _
& "姓 名： " & Trim(rst!vname) & vbCrLf & "性 别： " & Trim(rst!sex) & vbCrLf _
& "生 日： " & Trim(rst!bir) & vbCrLf & "籍 贯： " & Trim(rst!jg) & vbCrLf _
& "工 作： " & Trim(rst!job) & vbCrLf & "工作地点： " & Trim(rst!Where) & vbCrLf _
& "联系地址： " & Trim(rst!Add) & vbCrLf & "联系电话： " & Trim(rst!phone) & vbCrLf _
& "手机号码： " & Trim(rst!mphone) & vbCrLf & "传呼号码： " & Trim(rst!bp) & vbCrLf _
& "网 名： " & Trim(rst!Id) & vbCrLf & "E - MAIL： " & Trim(rst!email) & vbCrLf _
& "OICQ号码： " & Trim(rst!qq) & vbCrLf & "MSN I D： " & Trim(rst!msn) & vbCrLf _
& "主 页： " & Trim(rst!web) & vbCrLf & "备 注： " & Trim(rst!Memo) & vbCrLf _
& "********Over********" & vbCrLf
rst.MoveNext
Next i
rst.MoveFirst
cmdedit.Enabled = True
cmddel.Enabled = True
If rst.RecordCount > 1 Then
cmdnext.Enabled = True
End If
fill
labrs.Caption = rst.AbsolutePosition & " / " & rst.RecordCount
bln = False
End Sub
Private Sub Form_Load()
txtres.Text = ""
labrs.Caption = "0 / 0"
cmdedit.Enabled = False
cmddel.Enabled = False
cmdback.Enabled = False
cmdnext.Enabled = False
bln = True
str = "provider=microsoft.jet.oledb.4.0;" _
& "data source= " & App.Path & "\data\data.mdb"
Set mycnn = New ADODB.Connection
mycnn.Open str
Set rst = New ADODB.Recordset
rst.CursorType = adOpenDynamic
rst.LockType = adLockOptimistic
rst.CursorLocation = adUseClient
End Sub
Private Sub fill()
txtname = Trim(rst!vname)
txtsex = Trim(rst!sex)
txtbir = Trim(rst!bir)
txtjg = Trim(rst!jg)
txtjob = Trim(rst!job)
txtwhere = Trim(rst!Where)
txtadd = Trim(rst!Add)
txtphone = Trim(rst!phone)
txtmphone = Trim(rst!mphone)
txtbp = Trim(rst!bp)
txtid = Trim(rst!Id)
txtem = Trim(rst!email)
txtqq = Trim(rst!qq)
txtmsn = Trim(rst!msn)
txtweb = Trim(rst!web)
txtmemo = Trim(rst!Memo)
End Sub
Private Sub change()
rst!vname = txtname.Text
rst!sex = txtsex.Text
rst!bir = txtbir.Text
rst!jg = txtjg.Text
rst!job = txtjob.Text
rst!Where = txtwhere.Text
rst!Add = txtadd.Text
rst!phone = txtphone.Text
rst!mphone = txtmphone.Text
rst!bp = txtbp.Text
rst!Id = txtid.Text
rst!email = txtem.Text
rst!qq = txtqq.Text
rst!msn = txtmsn.Text
rst!web = txtweb.Text
rst!Memo = txtmemo.Text
End Sub
Private Sub clsall()
txtname = ""
txtsex = ""
txtbir = ""
txtjg = ""
txtjob = ""
txtwhere = ""
txtadd = ""
txtphone = ""
txtmphone = ""
txtbp = ""
txtid = ""
txtem = ""
txtqq = ""
txtmsn = ""
txtweb = ""
txtmemo = ""
txtres.Text = ""
End Sub
Private Sub Form_Unload(Cancel As Integer)
rst.Close
mycnn.Close
Set rst = Nothing
Set mycnn = Nothing
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -