برنامه دفترچه تلفن

سلام به اهالی خوب پی سی ورلد

من یه برنامه ی ساده دفتر چه تلفن نوشتم با وی بی که امکان جستجو از طریق شماره تلفن رو داشته باشه.
حالا میخوام یه جوری بشه که این امکان جستجو از طریق دیگر گزینه های اون یعنی : اسم، فامیل، آدرس وجود داشته باشه

ممنون میشم سریعتر کمکم کنین



کد برنامه برای کلید جستجو :

Private Sub Command3_Click()
Open "D:\test.txt" For Input As #1
Do While Not EOF(1)
Input #1, a, b, c
If c = "" & Text3.Text & "" Then
Text1.Text = a
Text2.Text = b
Exit Do
End If
Loop
Close
End Sub

کد برنامه برای کلید ثبت :

Private Sub Command1_Click()
Open "D:\test.txt" For Append As #1
Write #1, Text1.Text, Text2.Text, Text3.Text, Text4.Text
Close #1
Text1.Text = ""
Text2.Text = ""
Text3.Text = ""
Text4.Text = ""
End Sub

اگر امكان داره كل كد برنامه رو بزاريد تا ويرايش كنم و بهتون بدم

سلام دوست عزيز من يه نمونه سورس برات گزاشتم كه فكر كنم وقتي بري داخل اين سورس بقير از اينكه سورس مورد نظر خودت را پيدا مي كني يكسري ايدهاي جديد هم در سرت قلومبه مي شه شك ندارم . با اين حال كه كار ساده اي است ولي مي ارزه
[ برای مشاهده لینک ، با نام کاربری خود وارد شوید یا ثبت نام کنید ]
اين برنامه خودش دفترچه تلفنه بنظرم رو همين كار كون يا حالا ولي نتيجه كارتو به من بده

جناب هکر
کل کد برنامه همینی هیت که اینجا گذاشتم

[ برای مشاهده لینک ، با نام کاربری خود وارد شوید یا ثبت نام کنید ]

برنامه ای رو که نوشتم می تونین از اینجا دانلود کنین.
پایگاه داده اش نمیخوام پیشرفته باشه، با نوت پد باشه لطفن !

یکی به داد من بدبخت برسه
کمکککککک

Phone Book :

[ برای مشاهده لینک ، با نام کاربری خود وارد شوید یا ثبت نام کنید ]

دانلود می کنیم ! D:

رومینا2006 :
1) مرسی برای لینک
2) برنامه را دانلود کردم، از این خطش قبل از اجرای برنامه خطا می گیره :

Private Sub Form_Load()
On Error GoTo file
Center Me

نقل قول:

---

نوشته شده توسط abanmah_83 [ برای مشاهده لینک ، با نام کاربری خود وارد شوید یا ثبت نام کنید ]

دانلود می کنیم ! D:

رومینا2006 :
1) مرسی برای لینک
2) برنامه را دانلود کردم، از این خطش قبل از اجرای برنامه خطا می گیره :

Private Sub Form_Load()
On Error GoTo file
Center Me

---

برنامه درسته ، چه خطایی می گیره ،میشه اون خطا رو بنویسی

Compile Error:
Sub or Function not defined

از همون دو خطی که توی پست قبلی نوشته بودم، خطا میگیره

من دوباره برنامه رو دانلود کردم و اجراش کردم ، برنامه اجرا میشه و مشکلی نداره

آیا این کد در ماژول برنامه وجود داره؟ اگه نیست , این کد در داخل ماژول بنویس

کد:

---

Type Phone
fname As String * 20
lname As String * 20
tel As String * 20
shop As String * 20
mobile As String * 20
city As String * 20
address As String * 20
End Type
Global Record As Phone
Global Num As Integer

Public Sub Center(Center As Object)
Center.Move (Screen.Width - Center.Width) / 2, (Screen.Height - Center.Height) / 2
End Sub

---

دقیقن میشه معلوم کنین کجای برنامه بنویسم؟
آخه من توی ماژول که می نویسم، از هر گوشه برنامه یه خطا میگیره.
کلافم کرده ...

کد:

---

'In Module

Type Phone
fname As String * 20
lname As String * 20
tel As String * 20
shop As String * 20
mobile As String * 20
city As String * 20
address As String * 20
End Type
Global Record As Phone
Global Num As Integer

Public Sub Center(Center As Object)
Center.Move (Screen.Width - Center.Width) / 2, (Screen.Height - Center.Height) / 2
End Sub

---

کد:

---

Private Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Dim Path As String
Dim Buffer As String
Dim RetVal As String

Private Sub ExitCmd_Click()
End
End Sub

Private Sub FirstCmd_Click()
On Error GoTo file
NextCmd.Enabled = True
BackCmd.Enabled = False
filenum = FreeFile
Open "C:\tel.txt" For Input As filenum
If Int(LOF(filenum) / Len(Record)) = 1 Then
NextCmd.Enabled = False
BackCmd.Enabled = False
End If
Line Input #filenum, a
Text1.Text = Trim(Mid$(a, 1, 20))
Text2.Text = Trim(Mid$(a, 21, 20))
Text3.Text = Trim(Mid$(a, 41, 20))
Text4.Text = Trim(Mid$(a, 61, 20))
Text5.Text = Trim(Mid$(a, 81, 20))
Text6.Text = Trim(Mid$(a, 101, 20))
Text7.Text = Trim(Mid$(a, 121, 20))
Close #filenum
Num = 1
file:
End Sub

Private Sub Load_Click()
On Error GoTo file
Path = Buffer & "\Notepad.exe c:\Tel.txt"
RetVal = Shell(Path, 1)
file:
End Sub

Private Sub LoadCmd_Click()
MsgBox "Coded By Romina2006 In Visual Basic 6.0", vbInformation, "About"
End Sub

Private Sub NextCmd_Click()
On Error GoTo file
If Num = 1 Then BackCmd.Enabled = True
filenum = FreeFile
Open "C:\tel.txt" For Input As filenum
If Num + 1 = Int(LOF(filenum) / Len(Record)) Then
For I = 1 To Int(LOF(filenum) / Len(Record))
Line Input #filenum, a
Text1.Text = Trim(Mid$(a, 1, 20))
Text2.Text = Trim(Mid$(a, 21, 20))
Text3.Text = Trim(Mid$(a, 41, 20))
Text4.Text = Trim(Mid$(a, 61, 20))
Text5.Text = Trim(Mid$(a, 81, 20))
Text6.Text = Trim(Mid$(a, 101, 20))
Text7.Text = Trim(Mid$(a, 121, 20))
Next I
Num = Num + 1
NextCmd.Enabled = False
Close #filenum
Exit Sub
End If
For I = 1 To Num + 1
Line Input #filenum, a
Text1.Text = Trim(Mid$(a, 1, 20))
Text2.Text = Trim(Mid$(a, 21, 20))
Text3.Text = Trim(Mid$(a, 41, 20))
Text4.Text = Trim(Mid$(a, 61, 20))
Text5.Text = Trim(Mid$(a, 81, 20))
Text6.Text = Trim(Mid$(a, 101, 20))
Text7.Text = Trim(Mid$(a, 121, 20))
Next I
Close #filenum
Num = Num + 1
file:
End Sub

Private Sub BackCmd_Click()
On Error GoTo file
filenum = FreeFile
Open "C:\tel.txt" For Input As filenum
If Num <= Int(LOF(filenum) / Len(Record)) Then
NextCmd.Enabled = True
End If
If Num = 2 Then
For I = 1 To Num - 1
Line Input #filenum, a
Text1.Text = Trim(Mid$(a, 1, 20))
Text2.Text = Trim(Mid$(a, 21, 20))
Text3.Text = Trim(Mid$(a, 41, 20))
Text4.Text = Trim(Mid$(a, 61, 20))
Text5.Text = Trim(Mid$(a, 81, 20))
Text6.Text = Trim(Mid$(a, 101, 20))
Text7.Text = Trim(Mid$(a, 121, 20))
Next I
Num = Num - 1
NextCmd.Enabled = True
BackCmd.Enabled = False
Close #filenum
Exit Sub
End If
For I = 1 To Num - 1
Line Input #filenum, a
Text1.Text = Trim(Mid$(a, 1, 20))
Text2.Text = Trim(Mid$(a, 21, 20))
Text3.Text = Trim(Mid$(a, 41, 20))
Text4.Text = Trim(Mid$(a, 61, 20))
Text5.Text = Trim(Mid$(a, 81, 20))
Text6.Text = Trim(Mid$(a, 101, 20))
Text7.Text = Trim(Mid$(a, 121, 20))
Next I
Close #filenum
Num = Num - 1
file:
End Sub

Private Sub LastCmd_Click()
On Error GoTo file
NextCmd.Enabled = False
BackCmd.Enabled = True
filenum = FreeFile
Open "C:\tel.txt" For Input As filenum
If Int(LOF(filenum) / Len(Record)) = 1 Then
NextCmd.Enabled = False
BackCmd.Enabled = False
End If
For I = 1 To Int(LOF(filenum) / Len(Record))
Line Input #filenum, a
Text1.Text = Trim(Mid$(a, 1, 20))
Text2.Text = Trim(Mid$(a, 21, 20))
Text3.Text = Trim(Mid$(a, 41, 20))
Text4.Text = Trim(Mid$(a, 61, 20))
Text5.Text = Trim(Mid$(a, 81, 20))
Text6.Text = Trim(Mid$(a, 101, 20))
Text7.Text = Trim(Mid$(a, 121, 20))
Next I
Num = Int(LOF(filenum) / Len(Record))
Close #filenum
file:
End Sub

Private Sub Form_Load()
On Error GoTo file
Center Me
Buffer = String(200, 0)
GetWindowsDirectory Buffer, Len(Buffer)
Buffer = Left$(Buffer, InStr(1, Buffer, Chr$(0)) - 1)
NextCmd.Enabled = False
BackCmd.Enabled = False
filenum = FreeFile
Open "C:\tel.txt" For Input As filenum
If LOF(filenum) > 0 Then
FirstCmd.Enabled = True
LastCmd.Enabled = True
Else
FirstCmd.Enabled = False
NextCmd.Enabled = False
BackCmd.Enabled = False
LastCmd.Enabled = False
SearchCmd.Enabled = False
End If
Close #filenum
file:
Select Case Err
Case 53
MsgBox "C:\Tel.txt is not exists", vbCritical, "Phone Book"
AddCmd.Enabled = False
FirstCmd.Enabled = False
NextCmd.Enabled = False
BackCmd.Enabled = False
LastCmd.Enabled = False
SearchCmd.Enabled = False
End Select
End Sub

Private Sub AddCmd_Click()
On Error GoTo file
Dim Find
If Text1.Text = "" Then
MsgBox "áØÝÇ ÇØáÇÚÇÊ ÑÇ Ê˜ãíá æ ÓÓ Âä ÑÇ ËÈÊ äãÇííÏ", vbExclamation, "Phone Book"
Text1.SetFocus
Else
filenum = FreeFile
Open "C:\tel.txt" For Input As filenum
For I = 1 To Int(LOF(filenum) / Len(Record))
Line Input #filenum, a
Find = Trim(Mid$(a, 21, 20))
If Text2.Text = Find Then
MsgBox "ÇØáÇÚÇÊ Ê˜ÑÇÑí ãí ÈÇÔäÏ.áØÝÇ ÇØáÇÚÇÊ ÌÏíÏ ÑÇ æÇÑÏ äãÇííÏ", vbExclamation, "Phone Book"
Close #filenum
Text1.Text = ""
Text2.Text = ""
Text3.Text = ""
Text4.Text = ""
Text5.Text = ""
Text6.Text = ""
Text7.Text = ""
Text1.SetFocus
Exit Sub
Else
End If
Next I
Close #filenum
Open "C:\tel.txt" For Append As filenum
Record.fname = Trim(Text1.Text)
Record.lname = Trim(Text2.Text)
Record.tel = Trim(Text3.Text)
Record.shop = Trim(Text4.Text)
Record.mobile = Trim(Text5.Text)
Record.city = Trim(Text6.Text)
Record.address = Trim(Text7.Text)
Print #filenum, Record.fname; Record.lname; Record.tel; Record.shop; Record.mobile; Record.city; Record.address
MsgBox "ËÈÊ ÔÏ", vbInformation, "Phone Book"
Close #filenum
FirstCmd.Enabled = True
LastCmd.Enabled = True
SearchCmd.Enabled = True
Text1.Text = ""
Text2.Text = ""
Text3.Text = ""
Text4.Text = ""
Text5.Text = ""
Text6.Text = ""
Text7.Text = ""
Text1.SetFocus
End If
file:
End Sub

Private Sub SearchCmd_Click()
Dim Find As String
Dim Find1 As String
Dim Find2 As String
MyValue = InputBox("Please Type First Name")
MyValue1 = InputBox("Please Type Last Name")
MyValue2 = InputBox("Please Type Address")
filenum = FreeFile
Open "C:\tel.txt" For Input As filenum
For I = 1 To Int(LOF(filenum) / Len(Record))
Line Input #filenum, a
Find = Trim(Mid$(a, 1, 20))
Find1 = Trim(Mid$(a, 21, 20))
Find2 = Trim(Mid$(a, 121, 20))
If Find = MyValue And Find1 = MyValue1 And Find2 = MyValue2 Then
Text1.Text = Trim(Mid$(a, 1, 20))
Text2.Text = Trim(Mid$(a, 21, 20))
Text3.Text = Trim(Mid$(a, 41, 20))
Text4.Text = Trim(Mid$(a, 61, 20))
Text5.Text = Trim(Mid$(a, 81, 20))
Text6.Text = Trim(Mid$(a, 101, 20))
Text7.Text = Trim(Mid$(a, 121, 20))
Else
MsgBox "Record Can not Find", vbExclamation, "Phone Book"
End If
Next I
Close #filenum
End Sub

Private Sub Timer1_Timer()
Dim DoesFileExist As Boolean
DoesFileExist = Dir("C:\Tel.txt") <> ""
If DoesFileExist Then
AddCmd.Enabled = True
Else
AddCmd.Enabled = False
FirstCmd.Enabled = False
NextCmd.Enabled = False
BackCmd.Enabled = False
LastCmd.Enabled = False
SearchCmd.Enabled = False
End If
End Sub

---

دوست عزیز ؛ رومینا 2006

ممنون از همه زحماتی که کشیدی .... !

خواهش می کنم،تونستی ازش استفاده کنی؟

بله دوست من
عااااااااااااااااااااالی بود
دست شما درد نکنه

سلام . من با VisData يک پايگاه اطلاعاتي از نوع اکسس 7 ساختم و از اون در برنامه دفترچه تلفنم استفاده کردم . حالا مي خواهم در يک textbox با نوشتن اسم يا فاميل يا تلفن و يا آدرس آن را به طور هم زمان که من تايپ مي کنم پيدا کند . مرا راهنمايي کنيد. يا به عبارتي جستجوي همزمان داشته باشم :)

سلام
من یک دفتر تلفن میخوام با استفاده از ساختار فایل نه پایگاه داده که بتونه اسم و شماره تلفن را ذخیره کنه و جستجو کنه
در همین حد اگه میتونید من را یاری کنید با تشکر
:19::19::19:

این سورس دفترچه تلفن جالب و کاملی است یکی از دوستان زحمت کشیدن

آدرس دانلود :

[ برای مشاهده لینک ، با نام کاربری خود وارد شوید یا ثبت نام کنید ]