search.frm

通信录

         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 : [e-mail] , [e-mail]
''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