کد:'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
