以下保存为"通讯录.FRM"即可
VERSION 5.00
Begin VB.Form Form1
Caption = "我的通讯录"
ClientHeight = 2985
ClientLeft = 60
ClientTop = 345
ClientWidth = 8235
LinkTopic = "Form1"
ScaleHeight = 2985
ScaleWidth = 8235
StartUpPosition = 3 '窗口缺省
Begin VB.Frame Frame2
Caption = "提示信息:"
Height = 495
Left = 120
TabIndex = 13
Top = 2400
Width = 8055
Begin VB.Label LabMsg
Height = 240
Left = 480
TabIndex = 14
Top = 200
Width = 7095
End
End
Begin VB.CommandButton cmdAdd
Caption = "增加"
Height = 495
Left = 2400
TabIndex = 12
Top = 1800
Width = 1215
End
Begin VB.CommandButton cmdRef
Caption = "修改"
Height = 495
Left = 6240
TabIndex = 11
Top = 1800
Width = 1215
End
Begin VB.CommandButton cmdDel
Caption = "删除"
Height = 495
Left = 4320
TabIndex = 10
Top = 1800
Width = 1215
End
Begin VB.CommandButton cmdQury
Caption = "查询"
Height = 495
Left = 600
TabIndex = 9
Top = 1800
Width = 1215
End
Begin VB.Frame Frame1
Caption = "人员信息:"
Height = 1455
Left = 120
TabIndex = 0
Top = 120
Width = 7935
Begin VB.TextBox TxtArr
Appearance = 0 'Flat
Height = 375
Index = 3
Left = 3960
TabIndex = 8
Top = 840
Width = 3855
End
Begin VB.TextBox TxtArr
Appearance = 0 'Flat
Height = 375
Index = 2
Left = 840
TabIndex = 5
Top = 840
Width = 2415
End
Begin VB.TextBox TxtArr
Appearance = 0 'Flat
Height = 375
Index = 1
Left = 2760
TabIndex = 3
Top = 240
Width = 5055
End
Begin VB.TextBox TxtArr
Appearance = 0 'Flat
Height = 375
Index = 0
Left = 840
TabIndex = 2
Top = 240
Width = 1095
End
Begin VB.Label Label4
Caption = "公司:"
Height = 375
Left = 3360
TabIndex = 7
Top = 960
Width = 735
End
Begin VB.Label Label3
Caption = "电话:"
Height = 375
Left = 240
TabIndex = 6
Top = 960
Width = 1215
End
Begin VB.Label Label2
Caption = "住址:"
Height = 255
Left = 2160
TabIndex = 4
Top = 360
Width = 735
End
Begin VB.Label Label1
Caption = "姓名:"
Height = 255
Left = 240
TabIndex = 1
Top = 360
Width = 495
End
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim mPathName As String '保存通讯录路径和名称的字符串变量
Private Sub Form_Load()
'首先,为了后面使用方便,也能提高效率,我们把通讯录文件的路径和名称放到一个变量里
mPathName = App.Path & "/通讯录.txt"
'在这里,我们先打开检查一下,我们保存通讯录的文本文件是否存在,如果不存在,就建立它
If Dir(mPathName) = "" Then
Open mPathName For Output As #1 '以顺序输出方式打开文本文件,这时如果文件不存在,将自动建立这个文件
Close #1
End If
End Sub
'接下来,我们实现增加功能
'在这之前,首先要想一下,我们应该如何保存这些信息,不同人的信息之间如何分隔,同一人的不同信息如何分隔,有了分隔的办法,才能实现各种功能
'代码里使用了这样的方法:不同人的记录在不同行里,一行一个人(用回车换行符来分隔),同一人的不同信息之间加分号(用分号分隔)
'也就是用如下形式
'小狗;狗窝;25252525;职业看家有限责任公司
'小猫;狗窝上方;737373;职业偷鱼股份公司
Private Sub cmdAdd_Click()
On Error GoTo mErr '错误处理
'要添加数据,就用顺序输入吧!把各个数据连接起来输入到文本里,中间别忘了加分隔符~~
Open mPathName For Output As #1
Print #1, TxtArr(0).Text & ";" & TxtArr(1).Text & ";" & TxtArr(2).Text & ";" & TxtArr(3).Text
Close #1
'写好了,测试一下吧!
'怎么感觉少点什么...对了,没有信息提示,我们的程序干完活也不会告诉用户,用户就不知道操作怎么样了.
'填加一个信息提示吧,简单点,用一个LABEL控件
LabMsg.Caption = "添加操作完成"
mErr:
MsgBox Err.Number & ":" & Err.Description
LabMsg.Caption = "添加操作失败啦"
Exit Sub
'还有一个问题哦~如果姓名是重复的,是不是可以提示用户是重复添加,还是覆盖呢,留给楼主
End Sub
'***************************************************************************************************************************************
'好了,填加完成,然后做查询吧,这里涉及到一些基本函数,应用了刚才我们设置的分隔
Private Sub cmdQury_Click()
Dim mLineStr As String '用来存储每行数据的变量
Dim mStr() As String '用来存储每个人的各个信息
Dim mIndex As Long 'FOR循环中用到的变量
'首先,打开读如文件内容,然后按分割符分割,进而查找我们要的行,把它显示出来
Open mPathName For Input As #1 '这里,我们行读这个文件,找到符合的就显示,没有就提示没有找到
Do While Not EOF(1)
Line Input #1, mLineStr
If InStr(1, mLineStr, TxtArr(0).Text) Then '如果在这行数据里出现我们要查找的字符串,那么就显示它,并退出循环.
mStr() = Split(mLineStr, ";") '将保存有查询者信息的行中各个信息分离,然后显示出来
For mIndex = 0 To 3
TxtArr(mIndex) = mStr(mIndex)
Next
Exit Do '既然找到了,我们就不用继续读文件了,但是不要用EXIT SUB,那样CLOSE #1 没有执行:)
End If
Loop
Close #1
LabMsg.Caption = "查询完毕"
'恩,又写完一个,可以测试了,但是我们没有考虑到有相同姓名的情况哦!而且,我们还可实现通过用电话等方式查询呢,还可以"模糊查询":因为用的是INSTR函数麻~,可以查找所有姓张的,名字里有三的,等等,这个留给楼主自己做吧
End Sub
'****************************************************************************************************************************************
'接下来写删除吧,因为修改的功能还要用到删除呢
Private Sub cmdDel_Click()
'删除,无非是把已经有的信息替换为空,那么查询到有的信息把它清空再保存到文件就可以了!
'首先,把文件内容都读回来,这里使用一下2进制读,主要是这几个函数的应用
Dim mArray() As Byte, mFileLen As Long, mStr As String, mTmpStr() As String, mIndex As Long 'FOR循环中用到的变量
Open mPathName For Binary As #1 '将文件读入数组
mFileLen = LOF(1)
ReDim mArray(mFileLen - 1)
Get #1, , mArray()
Close #1
mStr = StrConv(mArray(), vbUnicode) '将数组合成为字符串
mTmpStr() = Split(mStr, vbCrLf) '将字符串分离成字符串数组
'查询含有该名字的记录,并删除他们
For mIndex = LBound(mTmpStr) To UBound(mTmpStr)
If InStr(1, mTmpStr(mIndex), TxtArr(0)) Then mTmpStr(mIndex) = "" '如果含有指定名,就将这个变量清空,我们不退出循环,将把全部含有这个名字的记录都删除
Next
'把剩余的记录写到文件里
Open mPathName For Output As #1
For mIndex = LBound(mTmpStr) To UBound(mTmpStr)
Print #1, mTmpStr(mIndex)
Next
Close #1
LabMsg.Caption = "删除完毕"
'测试一下吧
End Sub
'****************************************************************************************************************************************
'下面...我们写修改
Private Sub cmdRef_Click()
'修改啊,就是把原来的替换为空,然后写一个新的进去~所以操作先是删除~直接调用cmdDel_Click,然后调用cmdAdd_Click就可以了
cmdDel_Click
cmdAdd_Click
End Sub
'好了,就写到这里吧,基本功能还将就着能用,错误处理很多没写的!留给楼主自己做~~~
'文件操作部分需要学习的东西结合字符处理函数其实也不少,但是常用的可以写到一起,做一个工程,以后常看看,可能有不少启示,至少忘记怎么用的时候可以拿来复制!哈哈
注释非常全面了..涉及的基本函数不少,已经介绍的比较清楚了...实际上,我们可以在FORM_LOAD事件里打开文件,而不关闭它,并在FORM_UNLOAD事件里面关闭....就这么点要补充的了...