VERSION 5.00
Begin VB.Form Form3
BackColor = &H00404080&
Caption = "Form3"
ClientHeight = 6510
ClientLeft = 60
ClientTop = 345
ClientWidth = 5625
HelpContextID = 460
LinkTopic = "Form3"
MaxButton = 0 'False
MDIChild = -1 'True
MinButton = 0 'False
ScaleHeight = 6510
ScaleWidth = 5625
Begin VB.Frame Frame1
Height = 6495
Left = -120
TabIndex = 8
Top = 0
Visible = 0 'False
Width = 5775
Begin VB.Frame Frame3
Height = 8175
Left = 120
TabIndex = 14
Top = 0
Visible = 0 'False
Width = 5775
Begin VB.CommandButton Command7
Caption = "&Undelete It"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 3960
TabIndex = 36
Top = 720
Visible = 0 'False
WhatsThisHelpID = 460
Width = 1575
End
Begin VB.CommandButton Command5
Caption = "&Delete It"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 3960
TabIndex = 35
Top = 240
Visible = 0 'False
WhatsThisHelpID = 460
Width = 1575
End
Begin VB.TextBox Text1
BackColor = &H00E0E0E0&
BorderStyle = 0 'None
Height = 315
Left = 1320
TabIndex = 22
Top = 1440
Width = 3255
End
Begin VB.TextBox Text2
BackColor = &H00E0E0E0&
BorderStyle = 0 'None
Height = 315
Left = 1320
TabIndex = 21
Top = 1920
Width = 3255
End
Begin VB.TextBox Text3
BackColor = &H00E0E0E0&
BorderStyle = 0 'None
Height = 315
Left = 1320
TabIndex = 20
Top = 2520
Width = 3255
End
Begin VB.TextBox Text4
BackColor = &H00E0E0E0&
BorderStyle = 0 'None
Height = 315
Left = 1320
TabIndex = 19
Top = 3000
Width = 3255
End
Begin VB.TextBox Text5
BackColor = &H00E0E0E0&
BorderStyle = 0 'None
Height = 315
Left = 1320
TabIndex = 18
Top = 3600
Width = 3255
End
Begin VB.TextBox Text6
BackColor = &H00E0E0E0&
BorderStyle = 0 'None
Height = 315
Left = 1320
TabIndex = 17
Top = 4200
Width = 3255
End
Begin VB.TextBox Text7
BackColor = &H00E0E0E0&
BorderStyle = 0 'None
Height = 315
Left = 1320
TabIndex = 16
Top = 4800
Width = 3255
End
Begin VB.CommandButton Command6
Caption = "&Close "
BeginProperty Font
Name = "MS Sans Serif"
Size = 13.5
Charset = 0
Weight = 700
Underline = -1 'True
Italic = -1 'True
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 1920
Picture = "Search.frx":0000
TabIndex = 15
Top = 5520
WhatsThisHelpID = 460
Width = 1335
End
Begin VB.Label Label11
Caption = "Searched Record Summary/Details"
BeginProperty Font
Name = "MS Sans Serif"
Size = 13.5
Charset = 0
Weight = 700
Underline = -1 'True
Italic = -1 'True
Strikethrough = 0 'False
EndProperty
ForeColor = &H00C000C0&
Height = 855
Left = 120
TabIndex = 30
Top = 240
Width = 3735
End
Begin VB.Label Label10
BackStyle = 0 'Transparent
Caption = "S/No :"
Height = 255
Left = 360
TabIndex = 29
Top = 1440
Width = 855
End
Begin VB.Label Label9
BackStyle = 0 'Transparent
Caption = "&Name :"
Height = 255
Left = 360
TabIndex = 28
Top = 1920
Width = 855
End
Begin VB.Label Label8
BackStyle = 0 'Transparent
Caption = "&Address :"
Height = 255
Left = 360
TabIndex = 27
Top = 2520
Width = 855
End
Begin VB.Label Label4
BackStyle = 0 'Transparent
Caption = "&City :"
Height = 255
Left = 360
TabIndex = 26
Top = 3000
Width = 855
End
Begin VB.Label Label5
BackStyle = 0 'Transparent
Caption = "&State :"
Height = 255
Left = 360
TabIndex = 25
Top = 3600
Width = 855
End
Begin VB.Label Label6
BackStyle = 0 'Transparent
Caption = "&Phone 1 :"
Height = 255
Left = 360
TabIndex = 24
Top = 4200
Width = 855
End
Begin VB.Label Label7
BackStyle = 0 'Transparent
Caption = "&Phone 2 :"
Height = 255
Left = 360
TabIndex = 23
Top = 4800
Width = 855
End
End
Begin VB.CommandButton Command3
Caption = "&Close"
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 700
Underline = -1 'True
Italic = -1 'True
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 3600
TabIndex = 13
Top = 120
WhatsThisHelpID = 460
Width = 1695
End
Begin VB.Frame Frame2
BackColor = &H00FFFFFF&
Height = 5655
Left = 120
TabIndex = 10
Top = 720
Width = 5055
Begin VB.ListBox List1
BeginProperty Font
Name = "MS Sans Serif"
Size = 13.5
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00000080&
Height = 4380
ItemData = "Search.frx":2C704
Left = 120
List = "Search.frx":2C706
TabIndex = 12
Top = 1080
Width = 4815
End
Begin VB.Label Label13
BackStyle = 0 'Transparent
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H000000C0&
Height = 375
Left = 4320
TabIndex = 32
Top = 120
Width = 735
End
Begin VB.Label Label12
BackStyle = 0 'Transparent
Caption = "Found Records ="
BeginProperty Font
Name = "MS Sans Serif"
Size = 13.5
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00404080&
Height = 375
Left = 1680
TabIndex = 31
Top = 120
Width = 2535
End
Begin VB.Label Label3
Caption = "Record No. Name "
BeginProperty Font
Name = "MS Sans Serif"
Size = 13.5
Charset = 0
Weight = 700
Underline = -1 'True
Italic = -1 'True
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 120
TabIndex = 11
Top = 720
Width = 4815
End
End
Begin VB.Label Label2
Alignment = 2 'Center
BackStyle = 0 'Transparent
Caption = "Search Results"
BeginProperty Font
Name = "MS Sans Serif"
Size = 18
Charset = 0
Weight = 700
Underline = -1 'True
Italic = -1 'True
Strikethrough = 0 'False
EndProperty
ForeColor = &H00C00000&
Height = 615
Left = 600
TabIndex = 9
Top = 240
Width = 3135
End
End
Begin VB.CommandButton Command2
Caption = "Cancel"
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 700
Underline = 0 'False
Italic = -1 'True
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 1920
TabIndex = 7
Top = 5160
WhatsThisHelpID = 460
Width = 1455
End
Begin VB.CommandButton Command1
BackColor = &H00808080&
Caption = "Ok"
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 700
Underline = 0 'False
Italic = -1 'True
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 360
TabIndex = 6
Top = 5160
WhatsThisHelpID = 460
Width = 1455
End
Begin VB.CheckBox Check5
BackColor = &H00404080&
Caption = "&Phone No."
Height = 615
Left = 600
TabIndex = 5
Top = 3960
Width = 2415
End
Begin VB.CheckBox Check4
BackColor = &H00404080&
Caption = " &State"
Height = 615
Left = 600
TabIndex = 4
Top = 3240
Width = 2415
End
Begin VB.CheckBox Check3
BackColor = &H00404080&
Caption = " &City"
Height = 615
Left = 600
TabIndex = 3
Top = 2520
Width = 2415
End
Begin VB.CheckBox Check2
BackColor = &H00404080&
Caption = " &Name"
Height = 615
Left = 600
TabIndex = 2
Top = 1800
Width = 2415
End
Begin VB.CheckBox Check1
BackColor = &H00404080&
Caption = " &Record No."
Height = 615
Left = 600
TabIndex = 1
Top = 1080
Width = 2415
End
Begin VB.CommandButton Command4
Caption = "&Close"
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 700
Underline = 0 'False
Italic = -1 'True
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 3480
TabIndex = 33
Top = 5160
WhatsThisHelpID = 460
Width = 1455
End
Begin VB.CheckBox Check7
BackColor = &H00404080&
Caption = " &Exact Match."
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 700
Underline = 0 'False
Italic = -1 'True
Strikethrough = 0 'False
EndProperty
ForeColor = &H00800000&
Height = 615
Left = 3120
TabIndex = 34
Top = 1080
Width = 2415
End
Begin VB.Label Label1
Alignment = 2 'Center
BackStyle = 0 'Transparent
Caption = "Search On Field(s)"
BeginProperty Font
Name = "MS Sans Serif"
Size = 18
Charset = 0
Weight = 700
Underline = -1 'True
Italic = -1 'True
Strikethrough = 0 'False
EndProperty
ForeColor = &H00800080&
Height = 615
Left = 480
TabIndex = 0
Top = 360
Width = 3855
End
End
Attribute VB_Name = "Form3"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
''Description: This is small program to handle address records of friends or contacts
''I call this project as My Address Diary
''Author : Sanjay Sharma Contact No:9419118285(M)
''Sainik Colony , Jammu , India
''E-Mail : Sanjay79t@yahoo.co.in , Sanjay79t@hotmail.com
''Bugs , Suggestions & Comments are well come
''This was my App. I own my PC.
''Please vote
Dim spvalu3 As String
Dim valu As String
Dim ctr, totrec As Long
Dim spvalu1 As String
Dim result As String
Dim fnum As Integer
Dim fnum1 As Integer
Dim rec_val As rec_data
Dim rec_temp As rec_data
Dim value As Integer
Private Sub Check1_Click()
Dim pos As Integer
If Check1 Then
value = value + 1
valu = valu & "r"
Else
pos = getloct("r", valu)
If pos > 0 Then
valu = Rem_str("r", valu)
value = value - 1
End If
End If
End Sub
Private Sub Check2_Click()
Dim pos As Integer
If Check2 Then
value = value + 1
valu = valu & "n"
Else
pos = getloct("n", valu)
If pos > 0 Then
valu = Rem_str("n", valu)
value = value - 1
MsgBox ">>valu" & valu
End If
End If
End Sub
Private Sub Check3_Click()
Dim pos As Integer
If Check3 Then
value = value + 1
valu = valu & "c"
Else
pos = getloct("c", valu)
If pos > 0 Then
valu = Rem_str("c", valu)
value = value - 1
End If
End If
End Sub
Private Sub Check4_Click()
If Check4 Then
value = value + 1
valu = valu & "s"
Else
pos = getloct("s", valu)
If pos > 0 Then
valu = Rem_str("s", valu)
value = value - 1
End If
End If
End Sub
Private Sub Check5_Click()
If Check5 Then
value = value + 1
valu = valu & "p"
Else
pos = getloct("p", valu)
If pos > 0 Then
valu = Rem_str("p", valu)
value = value - 1
End If
End If
End Sub
Private Sub Check6_Click()
''check later
''If Check6 Then
''List1.Sorted = True
''Else
''List1.Sorted = False
''End If
End Sub
Private Sub Check7_Click()
If Check7 Then
spvalu1 = "e"
Else
spvalu1 = "i"
End If
End Sub
Private Sub Command1_Click()
If value > 0 Then
fun_go
End If
valu = ""
value = 0
Check1 = 0
Check2 = 0
Check3 = 0
Check4 = 0
Check5 = 0
Check7 = 0
End Sub
Private Sub Command2_Click()
Unload Me
End Sub
Private Sub Command3_Click()
Frame1.Visible = False
List1.Clear
End Sub
Private Sub Command4_Click()
Unload Me
End Sub
Private Sub Command5_Click()
del_recs
End Sub
Private Sub Command6_Click()
Frame3.Visible = False
End Sub
Private Sub Form_Load()
Form3.Top = -400
Form3.Left = 0
Form3.Width = 5445
Form3.Height = 6780
Select Case d_val
Case "se"
Label1.Caption = "Search "
Case "del"
Label1.Caption = "Delete "
Command5.Visible = True
Command7.Visible = True
Case "qu"
Label1.Caption = "Query "
End Select
Label1.Caption = Label1.Caption & " On Fields "
valu = ""
value = 0
spvalu1 = "i"
End Sub
Private Sub fun_go()
Dim us_recno As Long
Dim us_name, us_city, us_state, us_ph As String
Dim res As Boolean
fnum = FreeFile
Open "address.san" For Random As #fnum Len = Len(rec_val)
totrec = LOF(fnum) / Len(rec_val)
rows = totrec
If totrec > 0 Then
For j = 1 To Len(valu)
Select Case Mid(valu, j, 1)
Case "r"
us_recno = InputBox("Enter record no", "Search Specifications dialog box")
Case "n"
us_name = InputBox("Enter Name ", "Search Specifications dialog box")
Case "c"
us_city = InputBox("Enter city no", "Search Specifications dialog box")
Case "s"
us_state = InputBox("Enter State ", "Search Specifications dialog box")
Case "p"
us_ph = InputBox("Enter Phone no", "Search Specifications dialog box")
End Select
Next j
ctr = 0
For i = 1 To totrec
Get #fnum, i, rec_val
res = False
For j = 1 To Len(valu)
Select Case Mid(valu, j, 1)
Case "r"
If rec_val.s_no = us_recno Then
res = True
Else
res = False
End If
Case "n"
If spvalu1 = "e" And Trim(rec_val.name) = Trim(us_name) Then
res = True
ElseIf spvalu1 = "i" And getloct(cvt_lower(Trim(us_name)), cvt_lower(Trim(rec_val.name))) > 0 Then
res = True
Else
res = False
End If
Case "c"
If spvalu1 = "e" And Trim(rec_val.city) = Trim(us_city) Then
res = True
ElseIf spvalu1 = "i" And getloct(cvt_lower(Trim(us_city)), cvt_lower(Trim(rec_val.city))) > 0 Then
res = True
Else
res = False
End If
Case "s"
If spvalu1 = "e" And Trim(rec_val.stat) = Trim(us_state) Then
res = True
ElseIf spvalu1 = "i" And getloct(cvt_lower(Trim(us_state)), cvt_lower(Trim(rec_val.stat))) > 0 Then
res = True
Else
res = False
End If
Case "p"
If spvalu1 = "e" And (Trim(rec_val.ph1) = Trim(us_ph) Or Trim(rec_val.ph2) = Trim(us_ph)) Then
res = True
ElseIf spvalu1 = "i" And (getloct(cvt_lower(Trim(us_ph)), cvt_lower(Trim(rec_val.ph1))) > 0 Or getloct(cvt_lower(Trim(us_ph)), cvt_lower(Trim(rec_val.ph2))) > 0) Then
res = True
Else
res = False
End If
End Select
If res = False Then
Exit For
End If
Next j
If res = True Then
ctr = ctr + 1
List1.AddItem " " & rec_val.s_no & " " & rec_val.name
End If
Next i
End If
If ctr > 0 Then
Label13 = ctr
Frame1.Visible = True
Else
MsgBox "Search Fails ! No Record found"
End If
End Sub
Private Sub List1_Click()
Dim k As Long
k = Val(Left(Trim(List1.List(List1.ListIndex)), 5))
Get #fnum, k, rec_val
Text1.Text = rec_val.s_no
Text2.Text = rec_val.name
Text3.Text = rec_val.addr
Text4.Text = rec_val.city
Text5.Text = rec_val.stat
Text6.Text = rec_val.ph1
Text7.Text = rec_val.ph2
Frame3.Visible = True
End Sub
Function res_funval(u As String, hh As String) As Boolean
Dim i As Integer
For i = 1 To Len(hh) - (Len(u) - 1)
If Mid(hh, i, Len(u)) = u Then
res_funval = True
End If
Next i
End Function
Function getloct(u As String, s As String) As Integer
Dim i As Integer
For i = 1 To Len(s) - (Len(u) - 1)
If Mid(s, i, Len(u)) = u Then
getloct = i
End If
Next i
End Function
Function Rem_str(u As String, s As String) As String
Dim i As Integer
Dim str As String
str = ""
For i = 1 To Len(s)
If Mid(s, i, Len(u)) <> u Then
str = str & Mid(s, i, Len(u))
End If
Next i
Rem_str = str
End Function
Function cvt_lower(s As String) As String
Dim i As Integer
Dim str As String
'MsgBox "Str to cvt lower " & s
str = ""
For i = 1 To Len(s)
'MsgBox "CHARCTER =" & Mid(s, i, 1) & "ASCII VALUE = " & Asc(Mid(s, i, 1))
If Asc(Mid(s, i, 1)) >= 65 And Asc(Mid(s, i, 1)) <= 92 Then
str = str & Chr(Asc(Mid(s, i, 1)) + 32)
'MsgBox "HTT"
Else
str = str & Mid(s, i, 1)
End If
Next i
cvt_lower = str
'MsgBox "Str resulted " & s
End Function
Private Sub del_recs()
Dim k, i, ct As Long
ct = 1
fnum1 = 0
fnum1 = FreeFile
k = Val(Left(Trim(List1.List(List1.ListIndex)), 5))
MsgBox "record to be deleted" & k
MsgBox " file1 : " & fnum1 & "file2: " & fnum
Open "temp.san" For Random As #fnum1 Len = Len(rec_temp)
If LOF(fnum) / Len(rec_val) > 0 Then
Close fnum1
Kill "temp.san"
fnum1 = 0
fnum1 = FreeFile
Open "temp.san" For Random As #fnum1 Len = Len(rec_temp)
End If
For i = 1 To totrec
Get #fnum, i, rec_val
If i <> k Then
MsgBox " i : : " & i
rec_temp.s_no = ct
rec_temp.name = rec_val.name
rec_temp.city = rec_val.city
rec_temp.addr = rec_val.addr
rec_temp.stat = rec_val.stat
rec_temp.ph1 = rec_val.ph1
rec_temp.ph2 = rec_val.ph2
MsgBox "kkm"
Put #fnum1, ct, rec_temp
ct = ct + 1
End If
Next i
Close #fnum
Close #fnum1
Close
'FileCopy "address.san", "temp1.san"
Kill "address.san"
FileCopy "temp.san", "address.san"
Open "address.san" For Random As #fnum Len = Len(rec_val)
MsgBox "fnum" & fnum
spvalu3 = "und"
End Sub
Private Sub un_del_recs()
If spvalu3 = "und" Then
Close #fnum1
Kill "address.san"
FileCopy "temp1.san", "address.san"
Open "address.san" For Random As #fnum Len = Len(rec_val)
End If
End Sub
