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
|