Kirjautuminen

Haku

Tehtävät

Keskustelu: Ohjelmointikysymykset: VB.NET: UTF-8 To ANSI

Sivun loppuun

ucsjsa [26.10.2007 15:41:57]

#

Konvertointi UTF-8 to Ansi vb:ssä?

Miten onnistuu siten että merkistö menee oikein?

Kiitos,

-Jarmo-

Merri [26.10.2007 16:17:47]

# 

Declare Function MultiByteToWideChar Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpMultiByteStr As Long, ByVal cchMultiByte As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long) As Long

Declare Function WideCharToMultiByte Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long, ByVal lpMultiByteStr As Long, ByVal cchMultiByte As Long, ByVal lpDefaultChar As Long, lpUsedDefaultChar As Long) As Long
Function UTF8decode(ByRef Text As String) As String
    Dim bytText() As Byte, bytOut() As Byte, lngOut As Long
    ' muunna tavutaulukoksi
    bytText = StrConv(Text, vbFromUnicode)
    ' varataan tilaa
    lngOut = LenB(Text) * 2
    ReDim bytOut(lngOut - 1)
    ' suoritetaan muunnos
    lngOut = MultiByteToWideChar(65001&, 0&, ByVal VarPtr(bytText(0)), Len(Text), ByVal VarPtr(bytOut(0)), lngOut)
    ' lopputuloksen pituus
    If lngOut > 0 Then
        ReDim Preserve bytOut(lngOut * 2 - 1)
        UTF8decode = bytOut
    End If
End Function

Testaamaton.

neau33 [26.10.2007 19:11:33]

#

Moikka ucsjsa!

tässä olis samaa jutskaa ilman API-vääntöä...

'Testi: avaa muistiolla uusi tekstitiedosto
'kirjoittele jotain jossa on ääkkösiä seassa
'tallenna työpöydälle nimellä testi.txt / UTF-8 muodossa
Private Sub Command1_Click()

Dim tiedosto As String, pituus As Long, tavut() As Byte, teksti As String
tiedosto = Environ$("userprofile") & "\Työpöytä\testi.txt"
pituus = FileLen(tiedosto)

ReDim tavut(1 To pituus)
Open tiedosto For Binary Access Read As #1
Get #1, 4, tavut: Close #1

  For i = 1 To UBound(tavut)

   Select Case Val(Format$(tavut(i)))

    Case 32 To 127

     teksti = teksti + Chr(Val(Format$(tavut(i))))

    'ääkköset
    Case 132

     teksti = teksti + "Ä"

    Case 133

     teksti = teksti + "Ö"

    Case 150

     teksti = teksti + "Å"

    Case 164

     teksti = teksti + "ä"

    Case 165

     teksti = teksti + "å"

    Case 182

     teksti = teksti + "ö"

    End Select

  Next i

  MsgBox teksti

End Sub

neau33 [27.10.2007 21:03:21]

#

Heippa!

Sorry, ajatus näköjään kulkee kun väsyttää...

teksti = teksti + Chr(tavut(i))

ucsjsa [29.10.2007 09:01:18]

#

Kiitokset,

Käytössä on Visual Studio 2005 ja se ei ainakaan suoraan syönyt
kumpaakaan noista malleista. Ihmetyttää ettei tuohon ole kätevämpää
muunnosta olemassa...voisi kuvitella että olisi valmis mokkula kun
notepadikin jopa osaa käännön.

Onpas hankala tehdä tätä tuolla visuaalin 2005 versiolla pikku koodia...
Tai sitten oon vaan... =)

-Jarmo-

Merri [29.10.2007 10:17:58]

#

Kannattaa kertoa mitä versiota käyttää, molemmat koodinpätkät olivat perinteiselle VB:lle, eivät .NETille.

neau33 [29.10.2007 21:31:12]

#

Moikka ucsjsa!

testaa - tutki - analysoi...

testi.txt:

abcdefghijklmnopqrstuwxyzåäö
ABCDEFGHIJKLMNOPQRSTUVXYZÅÄÖ
1234567890/+-=*"'$%&()[]{}?!
Imports System
Imports System.IO
Imports System.Text
Imports System.Drawing
Imports System.Windows.Forms
Imports Microsoft.VisualBasic

'...valmiiksi generoidut jutskat

Private Sub Button1Click(sender As System.Object, e As System.EventArgs)

   Dim tiedosto As String = Environ("userprofile") + "\Työpöytä\testi.txt"

   Dim readeri As New StreamReader(tiedosto)
   Dim teksti As String = readeri.ReadToEnd()
   Dim koodaus As String = readeri.CurrentEncoding.EncodingName
   Dim koodisivu As String = readeri.CurrentEncoding.WindowsCodePage.ToString()

      messagebox.Show("koodaus: " + koodaus + " koodisivu: " + koodisivu)
      readeri.Close()
      readeri = Nothing

      messagebox.Show("StreamReaderilla: " + Environment.NewLine + teksti)
      teksti = Nothing

      FileSystem.FileOpen(1, tiedosto, OpenMode.Binary, OpenAccess.Read)

      Dim tavut As New String(" ", LOF(1) - 3) 'tiedoston pituus -3 'välilyönti'
      FileSystem.Seek(1, 4)   'siirtää osoittimen tiedoston 4. merkkiin &
                              'ottaa merkit tiedoston 4. merkistä -> loppuun
      FileSystem.FileGet(1, tavut)
      FileSystem.FileClose(1)

      Dim i As Integer

      For i = 0 To Len(tavut) -1

        Select Case Asc(tavut.Substring(i, 1))

          Case 32 To 127: teksti += tavut.Substring(i, 1)

          'ääkköset
          Case 132: teksti += "Ä"
          Case 133: teksti += "Ö"
          Case 150: teksti += "Å"
          Case 164: teksti += "ä"
          Case 165: teksti += "å"
          Case 182: teksti += "ö"

        End Select


      Next

      messagebox.Show("Binary FileOpen'lla: " + Environment.NewLine + teksti)

End Sub

neau33 [30.10.2007 01:08:52]

#

EDIT: Case 10, 13, 32 to 127 ...

ucsjsa [30.10.2007 10:31:47]

#

Nea, tämä auttoi!

Olen pystyssä kaffeet! =)

-Jrmo-

ucsjsa [30.10.2007 11:40:09]

#

Hei!

Mitähän teen väärin kuin tuolla konvertoitaessa häviää rivin vaihdot?

-Jarmo-

ucsjsa [30.10.2007 14:20:12]

#

Dummy me...

Toimii hienosti! KIITOKSET!!!! Tai no...
Tuo luettava tiedosto on noin 10mt, jääpi jumiin....


-Jarmo-

Merri [30.10.2007 16:40:48]

# 

Imports System
Imports System.IO
Imports System.Text


Public Class MainClass

   Shared Sub Main()
        Dim file_stream As New FileStream("test.txt", FileMode.Create)
        Dim bytes As Byte() = New UTF8Encoding().GetBytes("Hello world!")

        file_stream.Write(bytes, 0, bytes.Length)
        file_stream.Close()
   End Sub

End Class

Ensimmäinen hakutulos sanoilla VB.NET UTF-8 encode

Heitän arvauksen että tämä toimii varmasti ja nopeasti :)

neau33 [03.11.2007 14:06:17]

#

Heippa taas!

tässä olis aiheesta vielä hieman VB4/5/6-vinkkelissä, ilman API-vääntöä

testi.txt:

 1234567890ABCDEFGHIJKLMNOPQRSTUVXYZÅÄÖ
abcdefghijklmnopqrstuvxyzåäö
!"#¤%&/()=?½§'*~¨^{}[]\.:;,-_+=|<>@£$
Private Sub Form_Load()

Dim bstr As String, fStr As String

Open Environ("userprofile") & "\Työpöytä\testi.txt" For Binary Access Read As #1
bstr = String(LOF(1), " ")
Get #1, 1, bstr: Close #1

Select Case AscB(LeftB(bstr, 1))

  Case 49 'ANSI

    For i = 1 To LenB(bstr) Step 2
      fStr = fStr & Chr(AscB(MidB(bstr, i, 1)))
    Next i

      fStr = Replace(fStr, Chr(255), "")

  Case 239 'UTF-8

    For i = 1 To LenB(bstr) Step 2

      Select Case Asc(Chr(AscB(MidB(bstr, i, 1))))

        Case 10, 13, 32 To 127
          fStr = fStr & Chr(AscB(MidB(bstr, i, 1)))

        Case 132: fStr = fStr & "Ä"
        Case 133: fStr = fStr & "Ö"
        Case 150: fStr = fStr & "Å"
        Case 164: fStr = fStr & "ä"
        Case 165: fStr = fStr & "å"
        Case 182: fStr = fStr & "ö"

      End Select

    Next i

  Case 254 'Unicode Big endian

    For i = 1 To LenB(bstr) Step 2

      Select Case Asc(Chr(AscB(MidB(bstr, i, 1))))

        Case 10, 13, 32 To 253

          fStr = fStr + Chr(AscB(MidB(bstr, i, 1)))

      End Select

    Next i

  Case 255 'Unicode

    For i = 1 To LenB(bstr) Step 4

      fStr = fStr & Chr(AscB(MidB(bstr, i, 1)))

    Next i

      fStr = Replace(fStr, Chr(255), "")

  End Select

      Text1.Text = fStr

End Sub

Merri [03.11.2007 17:19:42]

#

Valmis nopsakasti toimiva UTF-8 koodaaja ja dekoodaaja, sekä tarkistusfunktio jolla voi katsoa onko tekstinpätkä UTF-8:aa vaiko ei. Toimii huomattavasti nopeammin kuin Nean yläpuoliset ratkaisut (mutta todennäköisesti hitaammin kuin API).

neau33 [04.11.2007 07:56:37]

#

Heippa taas!

tässä vähän terapiaa:
jos tyydytään vain lukemaan niin tämä riittää mainiosti...

testasin ~6MB tiedostolla ja toimii mielestäni aika kivasti

Private Sub Command1_Click()

ReDim bstr(0) As String

Open Environ("userprofile") & "\Työpöytä\testi.txt" For Binary Access Read As #1

'** eli siis: ei mitän byteArrayta vaan...
bstr(0) = String(LOF(1), " ")

If LOF(1) = 0 Then
 MsgBox "Tyhjä tiedosto!", vbInformation, "Viestiloota"
 Close #1: Erase bstr: Exit Sub
End If

'** lykätään tavut suoraan stringiin...
Get #1, 1, bstr(0): Close #1

Select Case AscB(LeftB(bstr(0), 1))

Case 49 'ANSI

  '** napataan alusta pois muutama merkki
  bstr(0) = Right(bstr(0), Len(bstr(0)) - 3)

  '** ja rtfBoxi nielee kaiken mukisematta
  RichTextBox1 = bstr(0): Erase bstr

  Exit Sub

Case 239 'UTF-8

      bstr(0) = Right(bstr(0), Len(bstr(0)) - 3)

      For i = 128 To 255

       Select Case i

         'jos halutaan esim. à yms niin lista venyy...
         ' (tämä "¤" on tässä tapauksessa syvältä)
         Case 132, 133, 150, 164, 165, 182

           If InStr(bstr(0), CStr(Chr(i))) > 0 Then
             bstr(0) = Replace(bstr(0), CStr(Chr(i)), CStr(Chr(i + 64)))
           End If

         Case 194, 195

           If InStr(bstr(0), CStr(Chr(i))) > 0 Then
             bstr(0) = Replace(bstr(0), CStr(Chr(i)), "")
           End If

         End Select

      Next i


     RichTextBox1 = bstr(0): Erase bstr

  Exit Sub

Case 254 'Unicode Big endian

  bstr(0) = Right(bstr(0), Len(bstr(0)) - 3)
  bstr(0) = Replace(bstr(0), CStr(Chr(10)), "")
  RichTextBox1 = bstr(0): Erase bstr
  Exit Sub

Case 255 'Unicode

  Dim xstep As Integer

    bstr(0) = Right(bstr(0), Len(bstr(0)) - 1)

    xstep = 244

    For i = 10 To 255 Step xstep

      If InStr(bstr(0), CStr(Chr(i))) > 0 Then
        bstr(0) = Replace(bstr(0), CStr(Chr(i)), "")
      End If

      If i = 244 Then xstep = 1

    Next

    RichTextBox1 = bstr(0): Erase bstr
    Exit Sub

End Select

End Sub

-Nea-

neau33 [04.11.2007 09:42:28]

#

Heippa taas!

EDIT: Case Else' ANSI

Sivun alkuun

Vastaus

Aihe on jo aika vanha, joten et voi enää vastata siihen.

Tietoa sivustosta