1

2

3

4

5

6

7

8

9

10

11

12

13

14

15

16

17

18

19

20

21

22

23

24

25

26

27

28

29

30

31

32

33

34

35

36

37

38

39

40

41

42

43

44

Sub CP1251ToUTF8(sSourceFile As String)

    Dim sTargetFile$

    Dim iFreeFile&, i&, iDec&

    Dim bSource() As Byte, bTarget() As Byte

    If Dir(sSourceFile) = "" Then MsgBox sSourceFile & " not exists": Exit Sub

    i = InStrRev(sSourceFile, ".")

    sTargetFile = Left(sSourceFile, i - 1) & "_ToUtf8" & Right(sSourceFile, Len(sSourceFile) - i   1)

    If Dir(sTargetFile) <> "" Then Kill sTargetFile

    iFreeFile = FreeFile

    Open sSourceFile For Binary As #iFreeFile

        ReDim bSource(1 To LOF(iFreeFile))

        Get #iFreeFile, , bSource

    Close #iFreeFile

    If bSource(1) = &HEF And bSource(2) = &HBB And bSource(3) = &HBF Then _

        MsgBox "Conversion not required": Exit Sub

    ReDim bTarget(1 To 3)

    bTarget(1) = &HEF

    bTarget(2) = &HBB

    bTarget(3) = &HBF

    For i = 1 To UBound(bSource)

        iDec = UBound(bTarget)

        Select Case bSource(i)

        Case 0 To 127

            ReDim Preserve bTarget(1 To iDec   1)

            bTarget(UBound(bTarget)) = bSource(i)

        Case 168, 184, 192 To 239

            ReDim Preserve bTarget(1 To iDec   2)

            bTarget(iDec   1) = 208

            bTarget(iDec   2) = 128   (63 And AscB(Chr$(bSource(i))))

        Case 240 To 255

            ReDim Preserve bTarget(1 To iDec   2)

            bTarget(iDec   1) = 209

            bTarget(iDec   2) = 128   (63 And AscB(Chr$(bSource(i))))

        Case 152, 160, 164, 166, 167, 169, 187

            ReDim Preserve bTarget(1 To iDec   2)

            bTarget(iDec   1) = 194

            bTarget(iDec   2) = 128   (63 And AscB(Chr$(bSource(i))))

        End Select

    Next i

    iFreeFile = FreeFile

    Open sTargetFile For Binary As #iFreeFile

        Put #iFreeFile, , bTarget

    Close #iFreeFile

End Sub