Тема: VBS: транслитерация строки по ГОСТ 7.79 2000
Переписал это http://forum.script-coding.com/viewtopic.php?id=2384 на VBS
Dim tr, tl
tr="а б в г д е ё ж з и й к л м н о п р с т у ф х ц ч ш щ ъ ы ь э ю я А Б В Г Д Е Ё Ж З И Й К Л М Н О П Р С Т У Ф Х Ц Ч Ш Щ Ъ Ы Ь Э Ю Я "
tl="аaбbвvгgдdеeёjoжzhзzиiйjjкkлlмmнnоoпpрrсsтtуuфfхkhцcчchшshщshhъ''ыyь'эehюjuяjaАAБBВVГGДDЕEЁJoЖZhЗZИIЙJjКKЛLМMНNОOПPРRСSТTУUФFХKhЦCЧChШShЩShhЪ''ЫYЬ'ЭEhЮJuЯJa"
'=============================================================================
' функция транслитерации строки по ГОСТ 7.79 2000
Function translit(ByVal sIncoming)
Dim pos, findpos, sSymbol
translit=""
For pos = 1 To len(sIncoming) Step 1
sSymbol=mid(sIncoming,pos,1)
findpos=InStr(1, tr, sSymbol)
If findpos=0 or sSymbol=" " Then
' ***** В транслитерации не нуждается
translit=translit+sSymbol
Else
' ***** Первый символ
translit=translit+mid(tl,findpos+1,1)
' ***** Второй символ
If mid(tr,findpos+2,1)=" " Then
translit=translit+mid(tl,findpos+2,1)
' ***** Третий символ
If mid(tr,findpos+3,1)=" " Then
translit=translit+mid(tl,findpos+3,1)
End If
End If
End If
Next
End Function
Может пригодится кому.