'MacroName:Latin2Urdu
'MacroDescription:Automatically untransliterate a field with Latin characters into Urdu characters
'Macro created by: Joel Hahn, Niles Public Library District
'Macro last modified: 15 December 2011

Option Explicit
Option Compare Binary

Declare Function TransUrdu(sField As String) As String

Sub Main
   Dim sField As String
   Dim bool As Integer
   Dim sTranslit As String
   Dim i As Integer
   Dim CharacterSet As Integer
   Dim sLang As String
   Dim sAlignRight As String

   Dim CS As Object
   On Error Resume Next
   Set CS  = GetObject(,"Connex.Client")
   On Error GoTo 0
   If CS  Is Nothing Then
      Set CS  = CreateObject("Connex.Client")
   End If

   sAlignRight = "Y"

'   Select Case CS.ItemType
'     Case -1, 5 To 13, 15 To 16, 21 To 25
'       MsgBox "Not viewing a MARC record. Exiting..."
'       Exit Sub
'   End Select

   bool = CS.GetFieldLine(CS.CursorRow, sField)
   If InStr(sField, "Data contains non-latin script") Then
     MsgBox "The selected field already contains vernacular data. Exiting..."
     Exit Sub
   ElseIf sField = Chr(252) & Chr(252) & Chr(252) & "  "  Or Trim(Mid(sField, 6)) = "" Then
     MsgBox "The selected field contains no data. Exiting..."
     Exit Sub
   End If

   For i = 1 to 5
     If Asc(Mid(sField, i, 1)) = 252 Then
       sTranslit = sTranslit & "∎" 
     Else
       sTranslit = sTranslit & Mid(sField, i, 1)
     End If
   Next

   sTranslit = sTranslit & TransUrdu(sField)

   bool = CS.AddFieldLine(CS.CursorRow, sTranslit)

   CS.SendKeys "%ekl", -1

   If sAlignRight = "Y" Then
      CS.SendKeys "%vi", -1
      CS.SendKeys "%vi", -1
   End If

End Sub

'################################################################################

Function TransUrdu(sField As String) As String
  Dim i As Long
  Dim sNewField As String
  sNewField = ""
  Dim sTransNumbers As String
  sTransNumbers = "N"
  Dim sShaddah As String

  i = 6
  Do
    If Mid(sField, i, 1) = Chr(223) Then
      sNewField = sNewField & "ǂ" & Mid(sField, i+1, 1)
      i = i + 2

    Else
       If UCase(Mid(sField, i, 1)) Like "[A-Z]" Then
          If Mid(sField, i, 1) = Mid(sField, i+1, 1) Then
             sShaddah = "Y"
          ElseIf Asc(Mid(sField, i+1, 1)) > 127 And Mid(sField, i, 1) = Mid(sField, i+2, 1) and Mid(sField, i+1, 1) = Mid(sField, i+3, 1) Then
             sShaddah = "Y"
          Else
             sShaddah = "N"
          End If
       End If
       If InStr(" !@#$^&*()[]{}:./\=+'" & Chr(34), Mid(sField, i, 1)) Then
         sNewField = sNewField & Mid(sField, i, 1)
       
       ElseIf Mid(sField, i, 1) = "," Then
          sNewField = sNewField & "،"
       ElseIf Mid(sField, i, 1) = ";" Then
          sNewField = sNewField & "؛"
       ElseIf Mid(sField, i, 1) = "?" Then
          sNewField = sNewField & "؟"
       ElseIf Mid(sField, i, 1) = "%" Then
          sNewField = sNewField & "٪"
       ElseIf Mid(sField, i, 1) = "-" Then
          If LCase(Mid(sField, i+1, 2)) = "yi" Then
             sNewField = sNewField & "ٴ"  'Or 0621 (hamza)
          ElseIf LCase(Mid(sField, i+1, 1)) = "i" Then
             'Do nothing (ALA/LC Rule 17(a)
          Else
             sNewField = sNewField & Mid(sField, i, 1)
          End If

       ElseIf InStr("0123456789", Mid(sField, i, 1)) Then
         If sTransNumbers = "N" Then
           sNewField = sNewField & Mid(sField, i, 1)
         Else
           If Mid(sField, i, 1) = "0" Then
             sNewField = sNewField & "۰"
           ElseIf Mid(sField, i, 1) = "1" Then
             sNewField = sNewField & "۱"
           ElseIf Mid(sField, i, 1) = "2" Then
             sNewField = sNewField & "۲"
           ElseIf Mid(sField, i, 1) = "3" Then
             sNewField = sNewField & "۳"
           ElseIf Mid(sField, i, 1) = "4" Then
             sNewField = sNewField & "۴"
           ElseIf Mid(sField, i, 1) = "5" Then
             sNewField = sNewField & "۵"
           ElseIf Mid(sField, i, 1) = "6" Then
             sNewField = sNewField & "۶"
           ElseIf Mid(sField, i, 1) = "7" Then
             sNewField = sNewField & "۷"
           ElseIf Mid(sField, i, 1) = "8" Then
             sNewField = sNewField & "۸"
           ElseIf Mid(sField, i, 1) = "9" Then
             sNewField = sNewField & "۹"
           End If
         End If

       ElseIf UCase(Mid(sField, i, 1)) = "B" Then
          sNewField = sNewField & "ب"
          If LCase(Mid(sField, i+1, 1)) = "h" Then
             sNewField = sNewField & "ھ"
             If LCase(Mid(sField, i+2, 1)) = " " Or LCase(Mid(sField, i+2, 1)) = "," Or LCase(Mid(sField, i+2, 1)) = "." Then
                sNewField = sNewField & "ه"
             End If
             i = i + 1
          End If
       ElseIf UCase(Mid(sField, i, 1)) = "P" Then
          sNewField = sNewField & "پ"
          If LCase(Mid(sField, i+1, 1)) = "h" Then
             sNewField = sNewField & "ھ"
             If LCase(Mid(sField, i+2, 1)) = " " Or LCase(Mid(sField, i+2, 1)) = "," Or LCase(Mid(sField, i+2, 1)) = "." Then
                sNewField = sNewField & "ه"
             End If
             i = i + 1
          End If
       ElseIf UCase(Mid(sField, i, 1)) = "T" Then
          If LCase(Mid(sField, i+1, 1)) = Chr(242) Then
             sNewField = sNewField & "ٰ"
             i = i + 1
             If LCase(Mid(sField, i+1, 1)) = "h" Then
                sNewField = sNewField & "ھ"
                If LCase(Mid(sField, i+2, 1)) = " " Or LCase(Mid(sField, i+2, 1)) = "," Or LCase(Mid(sField, i+2, 1)) = "." Then
                   sNewField = sNewField & "ه"
                End If
                i = i + 1
             End If
          ElseIf LCase(Mid(sField, i+1, 1)) = Chr(243) Then
             sNewField = sNewField & "ط"
             i = i + 1
          Else
             sNewField = sNewField & "ت"   'or 0629 if used as "Teh Marbuta" instead of just "Teh"
             If LCase(Mid(sField, i+1, 1)) = "h" Then
                sNewField = sNewField & "ھ"
                If LCase(Mid(sField, i+2, 1)) = " " Or LCase(Mid(sField, i+2, 1)) = "," Or LCase(Mid(sField, i+2, 1)) = "." Then
                   sNewField = sNewField & "ه"
                End If
                i = i + 1
             End If
          End If
       ElseIf UCase(Mid(sField, i, 1)) = "S" Then
          If LCase(Mid(sField, i+1, 1)) = Chr(242) Then
             sNewField = sNewField & "ص"
             i = i + 1
          ElseIf LCase(Mid(sField, i+1, 1)) = Chr(246) Then
             sNewField = sNewField & "ث"
             i = i + 1
          ElseIf LCase(Mid(sField, i+1, 1)) = "h" Then
             sNewField = sNewField & "ش"
             i = i + 1
          Else
             sNewField = sNewField & "س"
          End If
       ElseIf UCase(Mid(sField, i, 1)) = "J" Then
          sNewField = sNewField & "ج"
          If LCase(Mid(sField, i+1, 1)) = "h" Then
             sNewField = sNewField & "ھ"
             If LCase(Mid(sField, i+2, 1)) = " " Or LCase(Mid(sField, i+2, 1)) = "," Or LCase(Mid(sField, i+2, 1)) = "." Then
                sNewField = sNewField & "ه"
             End If
             i = i + 1
          End If
       ElseIf UCase(Mid(sField, i, 1)) = "C" Then
          sNewField = sNewField & "چ"
          If LCase(Mid(sField, i+1, 1)) = "h" Then
             sNewField = sNewField & "ھ"
             If LCase(Mid(sField, i+2, 1)) = " " Or LCase(Mid(sField, i+2, 1)) = "," Or LCase(Mid(sField, i+2, 1)) = "." Then
                sNewField = sNewField & "ه"
             End If
             i = i + 1
          End If
       ElseIf UCase(Mid(sField, i, 1)) = "H" Then
          If LCase(Mid(sField, i+1, 1)) = Chr(242) Then
             sNewField = sNewField & "ح"
             i = i + 1
          Else
             sNewField = sNewField & "ه"
          End If
       ElseIf UCase(Mid(sField, i, 1)) = "K" Then
          If LCase(Mid(sField, i+1, 3)) = Chr(246) & "h" & Chr(246) Then
             sNewField = sNewField & "خ"
             i = i + 3
          Else
             sNewField = sNewField & "ک"
             If LCase(Mid(sField, i+1, 1)) = "h" Then
                sNewField = sNewField & "ھ"
                If LCase(Mid(sField, i+2, 1)) = " " Or LCase(Mid(sField, i+2, 1)) = "," Or LCase(Mid(sField, i+2, 1)) = "." Then
                   sNewField = sNewField & "ه"
                End If
                i = i + 1
             End If
         End If
       ElseIf UCase(Mid(sField, i, 1)) = "D" Then
          If LCase(Mid(sField, i+1, 1)) = Chr(242) Then
             sNewField = sNewField & "ڈ"
             i = i + 1
             If LCase(Mid(sField, i+1, 1)) = "h" Then
                sNewField = sNewField & "ھ"
                If LCase(Mid(sField, i+2, 1)) = " " Or LCase(Mid(sField, i+2, 1)) = "," Or LCase(Mid(sField, i+2, 1)) = "." Then
                   sNewField = sNewField & "ه"
                End If
                i = i + 1
             End If
          Else
             sNewField = sNewField & "د"
             If LCase(Mid(sField, i+1, 1)) = "h" Then
                sNewField = sNewField & "ھ"
                If LCase(Mid(sField, i+2, 1)) = " " Or LCase(Mid(sField, i+2, 1)) = "," Or LCase(Mid(sField, i+2, 1)) = "." Then
                   sNewField = sNewField & "ه"
                End If
                i = i + 1
             End If
         End If
       ElseIf UCase(Mid(sField, i, 1)) = "Z" Then
          If LCase(Mid(sField, i+1, 1)) = Chr(242) Then
             sNewField = sNewField & "ظ"
             i = i + 1
          ElseIf LCase(Mid(sField, i+1, 1)) = Chr(243) Then
             sNewField = sNewField & "ض"
             i = i + 1
          ElseIf LCase(Mid(sField, i+1, 1)) = Chr(246) Then
             sNewField = sNewField & "ذ"
             i = i + 1
          ElseIf LCase(Mid(sField, i+1, 1)) = "h" Then
             sNewField = sNewField & "ژ"
             i = i + 1
          Else
             sNewField = sNewField & "ز"
          End If
       ElseIf UCase(Mid(sField, i, 1)) = "R" Then
          If LCase(Mid(sField, i+1, 1)) = Chr(242) Then
             sNewField = sNewField & "ڑ"
             i = i + 1
             If LCase(Mid(sField, i+1, 1)) = "h" Then
                sNewField = sNewField & "ھ"
                If LCase(Mid(sField, i+2, 1)) = " " Or LCase(Mid(sField, i+2, 1)) = "," Or LCase(Mid(sField, i+2, 1)) = "." Then
                   sNewField = sNewField & "ه"
                End If
                i = i + 1
             End If
          Else
             sNewField = sNewField & "ر"
          End If
       ElseIf UCase(Mid(sField, i, 1)) = "G" Then
          If LCase(Mid(sField, i+1, 3)) = Chr(246) & "h" & Chr(246) Then
             sNewField = sNewField & "غ"
             i = i + 3
          Else
             sNewField = sNewField & "گ"
             If LCase(Mid(sField, i+1, 1)) = "h" Then
                sNewField = sNewField & "ھ"
                If LCase(Mid(sField, i+2, 1)) = " " Or LCase(Mid(sField, i+2, 1)) = "," Or LCase(Mid(sField, i+2, 1)) = "." Then
                   sNewField = sNewField & "ه"
                End If
                i = i + 1
             End If
          End If
       ElseIf UCase(Mid(sField, i, 1)) = "F" Then
          sNewField = sNewField & "ف"
       ElseIf UCase(Mid(sField, i, 1)) = "Q" Then
          sNewField = sNewField & "ق"
       ElseIf UCase(Mid(sField, i, 1)) = "L" Then
          sNewField = sNewField & "ل"
       ElseIf UCase(Mid(sField, i, 1)) = "M" Then
          sNewField = sNewField & "م"
       ElseIf UCase(Mid(sField, i, 1)) = "N" Then
          If LCase(Mid(sField, i+1, 1)) = Chr(246) Then
             sNewField = sNewField & "ں"
             i = i + 1
          Else
             sNewField = sNewField & "ن"
          End If
       ElseIf UCase(Mid(sField, i, 1)) = "V" Then
          sNewField = sNewField & "و"
       ElseIf UCase(Mid(sField, i, 1)) = "Y" Then
          sNewField = sNewField & "ى"   'Or 06CC or 06D2
       ElseIf UCase(Mid(sField, i, 1)) = Chr(176) Then
          If LCase(Mid(sField, i+1, 2)) = "a" & Chr(229) Then
             sNewField = sNewField & "آ"
             i = i + 2
          Else
             sNewField = sNewField & "ع"
          End If
       ElseIf UCase(Mid(sField, i, 1)) = Chr(174) Then
          If LCase(Mid(sField, i+1, 2)) = "i" & Chr(229) Then
             sNewField = sNewField & "ئ"
          ElseIf LCase(Mid(sField, i+1, 2)) = "u" & Chr(229) Then
             sNewField = sNewField & "ؤ"
             i = i + 2
          Else
             sNewField = sNewField & "ا"
          End If

'Vowels
       ElseIf UCase(Mid(sField, i, 1)) = "A" Then
          If LCase(Mid(sField, i+1, 1)) = Chr(229) Then
             If i = 6 or Right(sNewfield, 1) = " " Then
                sNewField = sNewField & "آ"  'beginning of word only
             Else
                sNewField = sNewField & "ا"  'middle/end of word only
             End If   
             i = i + 1
          ElseIf LCase(Mid(sField, i+1, 1)) = Chr(226) Then
             sNewField = sNewField & "ى"
             i = i + 1
          ElseIf LCase(Mid(sField, i+1, 1)) = "i" Then
             sNewField = sNewField & "ى"
             i = i + 1
          ElseIf LCase(Mid(sField, i+1, 1)) = "u" Then
             sNewField = sNewField & "و"
             i = i + 1
          'ElseIf LCase(Mid(sField, i+1, 2)) = "l-" And (i = 6 Or Right (sNewField, 1) = " ") Then
          '   sNewField = sNewField & "ال"
          '   i = i + 2
          ElseIf LCase(Mid(sField, i+2, 1)) = "-" And (i = 6 Or Right (sNewField, 1) = " ")  Then
             sNewField = sNewField & "ال"
             i = i + 2
          Else
             sNewField = sNewField & ""
          End If
       ElseIf UCase(Mid(sField, i, 1)) = "E" Then
          sNewField = sNewField & "و"
       ElseIf UCase(Mid(sField, i, 1)) = "I" Then
          If LCase(Mid(sField, i+1, 1)) = Chr(229) Then
             sNewField = sNewField & "ى"
             i = i + 1
          'ElseIf LCase(Mid(sField, i+1, 1)) = "n" Then  'Tanvin -- see ALA/LC Urdu Rule 16
          '   sNewField = sNewField & "ً"
          '   i = i + 1
          Else
             sNewField = sNewField & ""
          End If
       ElseIf UCase(Mid(sField, i, 1)) = "O" Then
          sNewField = sNewField & "و"
       ElseIf UCase(Mid(sField, i, 1)) = "U" Then
          If LCase(Mid(sField, i+1, 1)) = Chr(229) Then
             sNewField = sNewField & "و"
             i = i + 1
          Else
             sNewField = sNewField & ""
          End If
       Else
         sNewField = sNewField & "∎"
       End If
       i = i + 1

      If sShaddah = "Y" Then
         sNewField = sNewField & "ّ"
      End If
   End If

  Loop While i <= Len(sField)
  
  TransUrdu = sNewField
End Function