urgent help

[jihan13]

I have a database that with two fields, NamaFail and Ciri. Ciri is a filed that contains 00110002 data. So, we get the file name from the user. Using this file name we will compare the Ciri field of this file name with all the field Ciri. We want to compare string by string…
Please help me

[Iouri]

open a re cordset with your field and browse to the recordset comparing your string


do while not rs.eof

call ProcCompareRSfieldWithYourString(rs!Field)'send the field value as param

loop


'here are several examples how to compare strings

1. if you need exact match
If StrComp(String1, String2, vbTextCompare) = 0 Then
Call MsgBox ("Match")
Else
Call MsgBox ("do not match")
End If
-------------------------------------------------------------

2.If you need % alike

'**************************************
' Description:This takes 2 strings and r
' eturns the percent alike that they are.
' (i.e. "test string number 1" is 86.48% similar to "teststring numb 2")

Private b1() As Byte
Private b2() As Byte


Public Function Simil(String1 As String, String2 As String) As Double
Dim l1 As Long
Dim l2 As Long
Dim l As Long
Dim r As Double


If UCase(String1) = UCase(String2) Then
r = 1
Else
l1 = Len(String1)
l2 = Len(String2)
If l1 = 0 Or l2 = 0 Then
r = 0
Else
ReDim b1(1 To l1): ReDim b2(1 To l2)
For l = 1 To l1
b1(l) = Asc(UCase(Mid(String1, l, 1)))
Next
For l = 1 To l2
b2(l) = Asc(UCase(Mid(String2, l, 1)))
Next
r = SubSim(1, l1, 1, l2) / (l1 + l2) * 2
End If
End If
Simil = r
Erase b1
Erase b2
End Function


Private Function SubSim(st1 As Long, end1 As Long, st2 As Long, end2 As Long) As Long
Dim c1 As Long
Dim c2 As Long
Dim ns1 As Long
Dim ns2 As Long
Dim i As Long
Dim max As Long
If st1 > end1 Or st2 > end2 Or st1 <= 0 Or st2 <= 0 Then Exit Function


For c1 = st1 To end1
For c2 = st2 To end2
i = 0
Do Until b1(c1 + i) <> b2(c2 + i)
i = i + 1
If i > max Then
ns1 = c1
ns2 = c2
max = i
End If
If c1 + i > end1 Or c2 + i > end2 Then Exit Do
Loop
Next
Next
max = max + SubSim(ns1 + max, end1, ns2 + max, end2)
max = max + SubSim(st1, ns1 - 1, st2, ns2 - 1)
SubSim = max
End Function

-------------------------------------------------------------
3.Compare strings including case sensitivity

Private Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long
Private Declare Function lstrcmp Lib "kernel32" Alias "lstrcmpA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long
Private Declare Function lstrcmpi Lib "kernel32" Alias "lstrcmpiA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long
Private Declare Function lstrcpy Lib "kernel32" Alias "lstrcpyA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long
Private Declare Function lstrcpyn Lib "kernel32" Alias "lstrcpynA" (ByVal lpString1 As String, ByVal lpString2 As String, ByVal iMaxLength As Long) As Long
Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As String) As Long
Private Declare Function CharLowerBuff Lib "user32" Alias "CharLowerBuffA" (ByVal lpsz As String, ByVal cchLength As Long) As Long
Private Sub Form_Paint()
Dim TestStr As String, CaseStr As String
Const sKPD = "KPD-Team "
Const sDate = "1999"
Me.Cls
'Create a buffer
TestStr = String(lstrlen(sKPD) + lstrlen(sDate), 0)
'Append two strings
lstrcat TestStr, sKPD
lstrcat TestStr, sDate
'Print the result on the form
Me.Print TestStr
'Create a buffer
CaseStr = String(lstrlen(TestStr), 0)
'Copy the string into the buffer
lstrcpy CaseStr, TestStr
Me.Print CaseStr
'Check if the strings are the same
If lstrcmp(TestStr, CaseStr) = 0 Then
Me.Print "The strings are the same (case sensitive)"
End If
'convert the string to lowercase
CharLowerBuff CaseStr, lstrlen(CaseStr)
Me.Print CaseStr
'Check if the strings are the same
If lstrcmpi(TestStr, CaseStr) = 0 Then
Me.Print "The strings are the same (case insensitive)"
End If
Me.Print "Our original string: " + TestStr
'Copy the string
lstrcpyn TestStr, sDate, lstrlen(sDate) + 1
Me.Print "Our altered string: " + TestStr
End Sub





Iouri Boutchkine
iouri@hotsheet.com

[jihan13]

it is compare the string one by one that we read from the field?

[jihan13]

I've tried like this. But it just compare the first record only.

vbcode
Private Sub MatchImage_Click()
Dim DBConnect As New ADODB.Connection
Dim RSOpen As New ADODB.Recordset
Dim RSCheck As New ADODB.Recordset

Dim huruf1 As Integer, huruf2 As Integer
Dim PictureName As String, objek As String
Dim panjang1 As Integer, panjang2 As Integer
Dim data1 As String, data2 As String
Dim i As Integer, j As Integer, k As Integer
Dim sql1 As String, sql2 As String
Dim jumpanjang As Integer
Dim beza As Integer, jumbeza As Integer

Set DBConnect = New ADODB.Connection
DBConnect.Provider = "Microsoft.Jet.OLEDB.4.0"
DBConnect.Open "c:\Projek\Imej.mdb"

PictureName = CommonDialog1.FileName
objek = Replace(PictureName, "C:\Projek\marin\", "")
panjang1 = 0
panjang2 = 0

sql1 = "select Ciri from SenaraiImej where NamaFail='" & objek & "'"
RSOpen.Open sql1, DBConnect
data1 = RSOpen("Ciri")
panjang1 = Len(data1)
Text4.Text = panjang1

ReDim CiriImej1(1 To panjang1) As String
For i = 1 To panjang1
huruf1 = Mid(data1, i, 1)
CiriImej1(i) = huruf1
List1.AddItem huruf1
Next i

RSOpen.Close

sql2 = "select Ciri from SenaraiImej"
RSCheck.Open sql2, DBConnect

'Do Until RSCheck.EOF
data2 = RSCheck("Ciri")
panjang2 = Len(data2)
Text5.Text = panjang2

ReDim CiriImej2(1 To panjang2) As String
For j = 1 To panjang2
huruf2 = Mid(data2, j, 1)
CiriImej2(j) = huruf2
List2.AddItem huruf2
Next
jumpanjang = panjang2
jumbeza = 0
For k = 1 To jumpanjang
If CiriImej1(k) = CiriImej2(k) Then
beza = 0
ElseIf CiriImej1(k) > CiriImej2(k) Then
beza = CiriImej1(k) - CiriImej2(k)
Else
beza = CiriImej2(k) - CiriImej1(k)
End If
jumbeza = jumbeza + beza
Next
Text6.Text = jumbeza
'Loop
RSCheck.Close
End Sub
/vbcode

[Iouri]

You have to move through the recordset
In the Do while Loop include rs.MoveNext

Iouri Boutchkine
iouri@hotsheet.com

[jihan13]

Yes, I've realize that I didn't include rs.movenext.

thank you