Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- ' http://sourceforge.net/projects/russfiles2trans/
- ' подправил для Directory Opus http://www.gpsoft.com.au/
- ' Tilks
- @script vbscript
- Option Explicit
- Dim russArr, latinArr, x, mapRu2Lat
- ' абвгдеёжзийклмнопрстуфхцчшщъыьэюя
- russArr = Array(" ", "а", "б", "в", "г", "д", "е", "ё", "ж", "з", "и", "й", "к", "л", "м", "н", "о", "п", "р", "с", "т", "у", "ф", "х", "ц", "ч", "ш", "щ", "ъ", "ы", "ь", "э", "ю", "я",_
- "А", "Б", "В", "Г", "Д", "Е", "Ё", "Ж", "З", "И", "Й", "К", "Л", "М", "Н", "О", "П", "Р", "С", "Т", "У", "Ф", "Х", "Ц", "Ч", "Ш", "Щ", "Ъ", "Ы", "Ь", "Э", "Ю", "Я")
- latinArr = Array("_", "a", "b", "v", "g", "d", "e", "jo", "zh", "z", "i", "j", "k", "l", "m", "n", "o", "p", "r", "s", "t", "u", "f", "h", "c", "ch", "sh", "w", "#", "y", "'", "je", "ju", "ja",_
- "A", "B", "V", "G", "D", "E", "Jo", "Zh", "Z", "I", "J", "K", "L", "M", "N", "O", "P", "R", "S", "T", "U", "F", "H", "C", "Ch", "Sh", "W", "#", "Y", "'", "Je", "Ju", "Ja")
- Set mapRu2Lat = CreateObject("Scripting.Dictionary")
- For x = 0 To UBound(russArr)
- mapRu2Lat.Add russArr(x), latinArr(x)
- Next
- Function russToTranslit(aStr)
- Dim x, ch, chMapped
- russToTranslit = ""
- For x = 1 To Len(aStr)
- ch = Mid(aStr,x,1)
- If mapRu2Lat.Exists(ch) Then
- chMapped = mapRu2Lat.item(ch)
- russToTranslit = russToTranslit & chMapped
- Else
- russToTranslit = russToTranslit & ch
- End If
- Next
- 'DOpus.OutputString "translited: " & russToTranslit
- End Function
- Function Rename_GetNewName ( strFileName, strFilePath, fIsFolder, strOldName, ByRef strNewName )
- 'DOpus.OutputString strFileName
- strNewName = russToTranslit (strFileName)
- End Function
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement