VBcoders Guest



Don't have an account yet? Register
 


Forgot Password?



this code used to search in arabic text, by appling SOUNDEX technique for arabic searching and for

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

Rate this code used to search in arabic text, by appling SOUNDEX technique for arabic searching and for




    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



Download this snippet    Add to My Saved Code

this code used to search in arabic text, by appling SOUNDEX technique for arabic searching and for Comments

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 .

Post your comment

Subject:
Message:
0/1000 characters