by Mohammed Yousif AL-Saadi (1 Submission)
Category: Databases/Data Access/DAO/ADO
Compatability: VB 6.0
Difficulty: Unknown Difficulty
Originally Published: Thu 3rd July 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
VBcoders
Public Function SOUNDEX(Surname As String) As String
' Developed by Richard J. Yanco
' This function follows the Soundex rules given at
' http://home.utah-inter.net/kinsearch/Soundex.html
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 .
