by Omar & Moh'd ()
Category: String Manipulation
Compatability: VB 6.0
Difficulty: Unknown Difficulty
Originally Published: Mon 16th June 2003
Date Added: Mon 8th February 2021
Rating:
(1 Votes)
this code used to search in arabic text, by appling SOUNDEX technique for arabic searching and for arabs. i hope to help u :-) the function is
Dim Result As String, c As String * 1
Dim Location As Integer
Surname = UCase(Surname)
' remove Çá from the word
'****************************************************
If Left(Surname, 2) = "Çá" Then
Surname = Mid(Surname, 3)
End If
'****************************************************
' get the code for each character in the word
'****************************************************
Result = ""
For Location = 1 To Len(Surname)
Result = Result & Category(Mid(Surname, Location, 1))
Next Location
'****************************************************
'Remove the repeated character
'****************************************************
Location = 1
Do While Location < Len(Result)
If Mid(Result, Location, 1) = Mid(Result, Location + 1, 1) Then
Result = Left(Result, Location) & Mid(Result, Location + 2)
Else
Location = Location + 1
End If
Loop
'****************************************************
'
'****************************************************
If Category(Left(Result, 1)) = Mid(Result, 2, 1) Then
Result = Left(Result, 1) & Mid(Result, 3)
End If
'****************************************************
'remove the unkown characeter
'*****************************************************
For Location = 1 To Len(Result)
If Mid(Result, Location, 1) = "/" Then
Result = Left(Result, Location - 1) & Mid(Result, Location + 1)
End If
Next
'*****************************************************
'get the first 4 haracters
'*****************************************************
Select Case Len(Result)
Case 4
SOUNDEX = Result
Case Is < 4
SOUNDEX = Result & String(4 - Len(Result), "0")
Case Is > 4
SOUNDEX = Left(Result, 4)
End Select
'*****************************************************
End Function
Private Function Category(c) As String
Select Case True
Case c Like "[åÍ]"
Category = "1"
Case c Like "[ËÓÕ]"
Category = "2"
Case c Like "[ßÞ]"
Category = "3"
Case c Like "[ÐÒ]"
Category = "4"
Case c Like "[ÚÁ]"
Category = "5"
Case c Like "[ÖÙØ]"
Category = "6"
Case c Like "[áäÑ]"
Category = "7"
Case c Like "[ÛÎ]"
Category = "8"
Case c Like "[Ô]"
Category = "9"
Case c Like "[ÊÏÌ]"
Category = "A"
Case c Like "[í]"
Category = "B"
Case c Like "[ãÈ]"
Category = "C"
Case c Like "[Ý]"
Category = "D"
Case Else
Category = ""
End Select
End Function
No comments have been posted about this code used to search in arabic text, by appling SOUNDEX technique for arabic searching and for . Why not be the first to post a comment about this code used to search in arabic text, by appling SOUNDEX technique for arabic searching and for .