Листинг 3. Мой вариант программы
Sub MyDecodeProcedure()
'
' MyDecodeProcedure Macro
' Macro created 02.08.00 by
'
' Макрокоманда перекодировки из DOS-овского текста
' на англо-русско-латышском языках
'
Dim SourceFile&, LenS&, i&, OneChar&, OneByte&
Dim ResultString$
' чтение данных в массив
SourceFile = "c:\Text1.dat"
Open SourceFile$ For Binary As #1
LenS = LOF(1)
If LenS = 0 Then ' нет файла
Close #1: Kill SourceFile$
Exit Sub
End If
ReDim SourceArray(1 To LenS) As Byte
Get #1, , SourceArray
Close #1
'
' Формирование строки:
ResultString = Space$(LenS) ' начальное значение
For i = 1 To LenS
OneByte = SourceArray(i)
' преобразование из DOS в Unicode
Select Case OneByte
Case Is < 128 ' не обращаем внимание на коду нижней половины
OneChar = OneByte
Case 128 To 175 ' Русские буквы
OneChar = OneByte + 64 + 848
Case 224 To 239 ' Русские буквы
OneChar = OneByte + 16 + 848
'
' Латышские буквы:
' DOS Unicode Windows
Case 240: OneChar = 274 ' E = 199
Case 222: OneChar = 362 ' U = 219
Case 215: OneChar = 298 ' I = 206
Case 181: OneChar = 256 ' A = 194
Case 208: OneChar = 352 ' S = 208
Case 242: OneChar = 290 ' G = 204
Case 244: OneChar = 310 ' K = 205
Case 246: OneChar = 315 ' L = 207
Case 248: OneChar = 381 ' Z = 222
Case 211: OneChar = 268 ' C = 200
Case 252: OneChar = 325 ' N = 210
Case 241: OneChar = 275 ' e = 231
Case 221: OneChar = 363 ' u = 251
Case 216: OneChar = 299 ' i = 238
Case 198: OneChar = 257 ' a = 226
Case 253: OneChar = 353 ' s = 240
Case 214: OneChar = 291 ' g = 236
Case 243: OneChar = 311 ' k = 237
Case 245: OneChar = 316 ' l = 239
Case 246: OneChar = 382 ' z = 254
Case 210: OneChar = 269 ' c = 232
Case 183: OneChar = 326 ' n = 242
Case Else
' это нужно сделать, на случай, если попадутся еще какие-то
' "левые символы
OneChar = AscW(Chr$(OneByte))
End Select
Mid(ResultString, i) = ChrW(OneChar)
Next
'
' А здесь можно выполнить преобразование спецкомбинаций в спецсимволы
ResultString = Replace(ResultString, "__O", Chr$(187))
'....
' выводим результат
Selection.TypeText ResultString
' Все!
End Sub