vb@rchiv
VB Classic
VB.NET
ADO.NET
VBA
C#
Mails senden, abrufen und decodieren - ganz easy ;-)  
 vb@rchiv Quick-Search: Suche startenErweiterte Suche starten   RSS-Feeds  | Newsletter  | Impressum  | Datenschutz  | vb@rchiv CD Vol.6  | Shop Copyright ©2000-2017
 
zurück
Rubrik: Forms/Controls   |   VB-Versionen: VB603.08.09
Unicodefähiges Label / Unicodefähige Print-Funktion für VB6

Sie wissen wahrscheinlich, dass die VB6-Steuerelemente wie Label, CommandButton usw. kein Unicode unterstützen. Dieser Workshop soll zeigen, wie man zumindest ein Label-Control nachbauen kann, das unicodefähig ist und erklärt einige Sachverhalte zu der Verwendung von Unicode in VB6.

Autor:  Konstantin Prei?erBewertung:     [ Jetzt bewerten ]Views:  14.782 

1. Zunächst einmal: Was ist Unicode?
Wenn man von "Unicode" spricht, meint man normalerweise UTF-16 LE. Bei Unicode (UTF-16 LE) handelt es sich um einen Zeichencode, bei dem immer 2 Bytes für die Darstellung eines Schriftzeichens verwendet werden. Im Gegensatz zum ASCII-/ANSI-Zeichensatz, bei dem für ein Zeichen (in den meisten Ländern) nur ein Byte verwendet wird, lassen sich somit bei Unicode theoretisch bis zu 65536 Zeichen darstellen.

Unicode wurde eingeführt, um die verschiedenen länderspezifischen Kodierungen für 1-Byte-Zeichensätze abzulösen.

Der unter Windows verwendete ANSI-Zeichensatz (windows-1252 in westeuropäischen Ländern) verwendet ja für jedes Zeichen 1 Byte, es lassen sich also nur 256 Zeichen darstellen. Damit man aber auch internationale Zeichen in anderen Ländern darstellen kann, sind nur die Bytes 0-127 eindeutig festgelegt. Die Bytes 128-255 variieren, je nach länderspezifischem Code. Das heißt, wenn man eine Textdatei auf einem deutschsprachigen Windows mit einigen Sonderzeichen speichert, kann dies auf russischen Windows ganz anders aussehen.

Auf einem deutschsprachigen Windows wird z. B. der "ä"-Umlaut durch das Byte 228 dargestellt; auf einem russischen Windows stellt das Byte 228 dagegen den kyrillischen Buchstaben "д" dar.

Es gibt auch noch andere Varianten von Unicode, wie UTF-8, welche vor allem bei Websites eine Rolle spielt. UTF-8 verwendet eine variable Anzahl von Bytes für die Darstellung eines Zeichens, so verwendet es für die Unicode-Werte 0-127 jeweils nur 1 Byte und ist damit "abwärtskompatibel" zum ANSI-Zeichensatz. Gegenüber dem "normalen" Unicode (UTF-16 LE) spart dies somit erheblich Speicherplatz, wenn vor allem lateinische Buchstaben und nur vereinzelt landesspezifische Sonderzeichen vorkommen. Um eine UTF-8 Textdatei in VB einzulesen und mit dem unten beschriebenen, unicodefähigen Label darzustellen, muss man aber selbst eine Konvertierungsfunktion für VB schreiben (diese finden Sie ganz unten).

Damit Text auf internationalen Windows-Versionen (inkl. Sonderzeichen) gleich aussieht und Sie auch verschiedene, länderspezifische Zeichen (z. B. deutsche Umlaute und chinesische Zeichen) in einem Programm verwenden können, sollten Sie Unicode verwenden. VB6 hat zwar leider nur eine geringe Unicode-Unterstützung (intern zwar schon, aber die Steuerelemente nicht), aber mit Hilfe geeigneter API-Funktionen können Sie ihr Programm unicodefähig machen.

2. Verwendung von Unicode in VB6
Beim normalen Umgang mit VB6 gibt es zunächst keinerlei Anzeichen dafür, dass VB6 Unicode unterstützt. Sobald Sie z. B. in die Caption-Eigenschaft eines Labels ein chinesisches Zeichen oder den ☺-Smiley (durch Drücken von Alt+1) eingeben wollen, erscheint nur ein Fragezeichen. Auch wenn Sie im Codefenster solche Zeichen eingeben wollen, erscheinen nur Fragezeichen.

Tatsächlich unterstützt VB6 bei Strings aber Unicode. Wenn Sie im Code einem String Textzuweisen, z. B. durch

Dim sText as String
sText = "Hallo, das kostet 5,00 €."

dann konvertiert VB6 diesen Text intern nach Unicode. Um genauer zu sein: Beim Erstellen einer EXE-Datei wird dieser Text schon als Unicode gespeichert. Theoretisch müsste dann doch der Text, wenn er einem Label zugewiesen wird, auch auf ausländischen Systemen so aussehen? Das würde er auch, wenn der VB-6 Label Unicode unterstützen würde. Leider unterstützt er es nicht, und deswegen konvertiert VB6 bei der Übergabe eines Strings an die .Caption-Eigenschaft eines Labels den String wieder in den lokalen ANSI-Zeichensatz zurück. Das macht sich u. a. daran bemerkbar, dass deutsche Umlaute wie ä, ö und ü, dann z. B. auf einem russischen Windows nur als a, o und u dargestellt werden.

Es kann aber auch passieren, dass plötzlich kyrillische Zeichen statt den Umlauten dargestellt werden. Wie kommt das?
Es macht einen Unterschied, ob Sie einen Text direkt in der Entwicklungsumgebung im Eigenschaften-Fenster in die Caption-Eigenschaft des Labels eingeben, oder im Codefenster schreiben

Label1.Caption = "Hier stehen viele Häuser."

Bei der ersten Variante speichert der Label selbst den String, und da dieser kein Unicode unterstützt, speichert er (der Label) ihn von vornherein im ANSI-Zeichensatz (Anzeige auf russischem Windows: "Hier stehen viele Hдuser."). Bei der 2. Variante speichert VB6 dagegen erst den Unicode-String, und konvertiert ihn dann bei der Übergabe an den Label in den lokalen ANSI-Zeichensatz zurück (Anzeige auf russischem Windows: "Hier stehen viele Hauser.").

Sehen wir uns einmal die Funktionen an, die VB6 für den Umgang mit Strings bereitstellt. Sie kennen sicherlich die Funktionen Chr() und Asc(). Chr() erstellt ein Zeichen anhand des übergebenen Wertes, und Asc() gibt den Wert eines Zeichens zurück. Aber um welchen Wert handelt es sich hier, wenn VB6 Strings ja in Unicode speichert?

Die Chr()- und Asc()-Funktionen arbeiten mit dem ANSI-Zeichensatz. So erstellt Chr(128) das Euro-Zeichen. Da das Euro-Zeichen dann aber in einem Unicode-String ist, bedeutet dies:
Die Chr()-Funktion erstellt das Zeichen, das den angegebenen ANSI-Wert hat, und konvertiert dieses dann unter Verwendung des lokalen ANSI-Zeichensatzes nach Unicode. Die Asc()-Funktion ermittelt das Zeichen, konvertiert dieses zurück nach ANSI und gibt den Wert aus. Und was ist der "lokale ANSI-Zeichensatz"? Das können Sie festlegen, wenn Sie in der Systemsteuerung auf Regions- und Spracheinstellungen doppelklicken (in der klassischen Ansicht unter XP), dann wechseln Sie auf die Registerkarte Erweitert. Ganz oben finden Sie nun eine Festlegung, welchen Zeichensatz Programme verwenden sollen, "die Unicode nicht unterstützen". Wenn Sie hier jetzt testweise mal Russisch auswählen (und den Computer neustarten, wenn Sie dazu aufgefordert werden), dann ergibt Chr(128) plötzlich nicht mehr das €-Zeichen, sondern den kyrillischen Buchstaben "Ђ".

Es gibt aber nicht nur die Chr()- und Asc()-Funktion, sondern auch ChrW(), AscW(), ChrB() und AscB(). Aber was machen diese Funktionen?
ChrW() und AscW() arbeiten mit dem Unicode-Wert, deswegen das W für "Wide". Stellen Sie die Einstellung in den Regions- und Sprachoptionen zurück auf "Deutsch" und öffnen VB6. Wenn Sie jetzt eingeben

MsgBox AscW("€")

dann ergibt das 8364, ein ganz anderer Wert als den, den die Asc()-Funktion zurückgibt (128). 8364 ist der Unicode-Wert des Euro-Zeichens, und den hat es auf jedem anderssprachigen Windows auch. Zum Vergleich:

MsgBox Chr(128)

ergibt auf einem deutschen Windows "€", auf einem russischen "Ђ".

MsgBox ChrW(8364)

ergibt auf einem deutschen Windows "€", auf einem russischen sogar auch "€"! Im russichen ANSI-Zeichensatz kommt das Euro-Zeichen nämlich auch vor, hat aber einen anderen Wert (136) als im deutschen (128).

Um das zu veranschaulichen, öffnen Sie einmal die Zeichentabelle von Windows (Start, Ausführen, "charmap.exe"). Als Schriftart nehmen Sie am besten Arial. Setzten Sie unten einen Haken bei "Erweiterte Ansicht". Bei "Zeichensatz" können Sie nun die verschiedenen ANSI-Zeichensätze von Windows auswählen, nehmen Sie zuerst "Windows: Westlich". Es erscheinen jetzt alle Zeichen, die im ANSI-Zeichensatz westlicher Windows-Versionen enthalten sind. Wenn Sie jetzt das €-Zeichen suchen und auf dieses klicken, steht ganz unten in der Zeile "U+20AC (0x80): Euro-Zeichen". Die Zahlen 20AC und 80 sind Hex-Werte, im Dezimalsystem (das können Sie z. B. schnell mit dem Windows Rechner umrechen) ist 20AC -> 8364 und 80 -> 128. Das sind genau die Werte, die wir bei der ChrW()-Funktion und bei der Chr()-Funktion verwendet haben. Der Wert 8364 ist der Unicode-Wert für das Euro-Zeichen und auf jedem beliebigsprachigen Windows eindeutig. Der Wert 128 ist der ANSI-Wert dieses Zeichens, welcher nur auf westlichen Windows-Versionen das Euro-Zeichen darstellt; auf einem russischen Windows ergibt dieser Wert ein anderes Zeichen.

3. Unicode-Konvertierung
Kommen wir zu den ChrB()- und AscB()-Funktionen. ChrB(128) erstellt einen String mit einem Byte, das den Wert 128 hat. Wenn Sie das mit "MsgBox ChrB(128)" anzeigen, erscheint aber nur ein Fragezeichen. Das kommt daher, dass die ChrB()-Funktion zwar ein Byte mit dem angegebenen Wert erstellt, dieses aber nicht nach Unicode konvertiert (im Gegensatz zur Chr()-Funktion).

VB enthält aber die StrConv-Funktion, mit der sich Strings von ANSI nach Unicode konvertieren lassen und umgekehrt. Schreiben Sie einmal

MsgBox StrConv(ChrB(128), vbUnicode)

dann ergibt das tatsächlich wieder das €-Zeichen. Auch Msgbox Asc(StrConv(ChrB(128), vbUnicode)) ergibt dann 128, da die Asc-Funktion ja das Zeichen vorher wieder nach ANSI zurückkonvertiert. Msgbox AscW(StrConv(ChrB(128), vbUnicode)) ergibt dagegen 8364, den Unicode-Wert des Zeichens.

Unicode-Strings werden (in VB) im UTF-16 LE-Format gespeichert, was bedeutet, dass niederwertige Byte kommt zuerst, dann kommt das höherwertige Byte. Der Wert 8364 ist in Hex 20AC, das bedeutet, ein Byte hat den Hex-Wert 20 (in Dez 32), das andere Byte hat den Hex-Wert AC (in Dez 172). Wir können uns also unser Unicode-€-Zeichen auch selber zusammenbasteln, indem wir die ChrB()-Funktion verwenden. Da das höherwertige Byte den Hex-Wert 20 hat (also das Byte, das dargestellt im Hex-Zahlensystem die höhere Wertigkeit hat), muss es als letztes kommen. Versuchen Sie,

MsgBox ChrB(172) & ChrB(32)

dann ergibt das wieder das €-Zeichen.

Unicode ist für Bytewerte < 128 auch abwärtskompatibel. Ein Byte mit dem Wert 97 (Kleinbuchstabe "a") steht sowohl in anderen ANSI-Zeichensätzen als auch in Unicode für den Buchstaben "a". So ergeben Chr(97) und ChrW(97) das gleiche Zeichen. Wenn wir das Zeichen mit den ChrB-Funktionen darstellen, müssen wir

MsgBox ChrB(97) & ChrB(0)

verwenden, den der Zeichencode (mit führenden Nullen) ist in Hex ja 0061, und da das höherwertige Byte danach kommt, muss ChrB(0) am Schluss stehen.

4. Verwendung von Byte-Arrays und Strings
Sie haben bestimmt schon mal eine Datei mit VB6 geöffnet und binär eingelesen:

Private Sub Command1_Click()
  Dim Dateiinhalt As String
  Open "C:\Datei.txt" For Binary As 1
  Dateiinhalt = Space(LOF(1))
  Get 1, , Dateiinhalt
  Close 1
  Text1 = Dateiinhalt
End Sub

Nun fragen Sie sich vielleicht, warum Sie den Text ganz normal anzeigen können, wenn VB6 doch Strings in Unicode speichert, Sie aber die Textdatei ganz normal in ANSI gespeichert haben.

Auch hier ist der Fall, dass VB6 den ausgelesenen Dateiinhalt automatisch nach Unicode konvertiert.

Vielleicht öffnen Sie auch eine Bild-Datei oder irgendwas anderes, was keinen Text enthält, und Sie aber den Byte-Wert an einer bestimmten Stelle brauchen. Dann machen Sie das vielleicht mit

MsgBox Asc(Mid(Dateiinhalt, 40, 1))

um den Wert des Bytes anzuzeigen, das an der 40. Stelle steht. Das funktioniert zwar auf westlichen Windows-Versionen, hat aber zuerst mal einen großen Nachteil: Da der Dateiinhalt ja nach Unicode konvertiert wird, braucht das Einlesen einer 1 MB-Datei dann 2 MB an Arbeitsspeicher, da Unicode ja 2 Bytes pro Zeichen verwendet. Dazu kommt, dass dies auf chinesischen und japanischen Windows-Versionen ein ziemlich unerwartetes Verhalten hervorrufen wird (dazu später mehr).

Sie müssen dem Get-Verb aber keinen String übergeben. Es geht auch mit einer Array-Variable.

Dim Dateiinhalt() As Byte
Open "C:\Datei.txt" For Binary As 1
ReDim Dateiinhalt(LOF(1) - 1) As Byte
Get 1, , Dateiinhalt
Close 1

Jetzt können Sie den Wert des Bytes an der 40. Stelle mit "MsgBox Dateiinhalt(40)" ausgeben, aber vielleicht brauchen Sie dann doch einen String? Sie wissen wahrscheinlich auch, dass man einem String ein Byte-Array zuweisen kann und umgekehrt. Wenn Sie jetzt mal versuchen:

Dim tmpArray() As Byte, Dateiinhalt as String
Open "C:\Datei.txt" For Binary As 1
ReDim tmpArray(LOF(1) - 1) As Byte
Get 1, , tmpArray
Close 1
Dateiinhalt = tmpArray

dann haben Sie wieder einen String, jedoch wurde der Dateiinhalt hier nicht nach Unicode konvertiert. Sie können jetzt also "MsgBox AscB(MidB(Dateiinhalt, 40, 1))" verwenden, um den Wert des 40. Bytes auszugeben. Dies hat vor allem mal den Vorteil, dass der Inhalt einer 1 MB großen Datei auch nur 1 MB (statt 2 MB) für den String-Inhalt braucht.

5. Weitere Funktionen im Zusammenhang mit Unicode-Strings
Wie Sie vielleicht gesehen haben, muss hier statt der Mid()-Funktion die MidB()-Funktion verwendet werden (es gibt auch noch eine LeftB-, RightB, LenB, InStrB-Funktion). Die MidB-Funktion arbeitet im Gegensatz zur "normalen" Mid-Funktion byteweise, und da der String ja auch byteweise vorliegt (nicht in Unicode), wird hier die Mid-Funktion nicht den Wert des 40., sondern des 79. + 80. Bytes ausgeben (dazu müssten Sie aber die AscW-Funktion verwenden).

So gibt auch die LenB-Funktion die genaue Anzahl der Bytes aus, die Len()-Funktion dagegen die Anzahl der Unicode-Zeichen. MsgBox Len("a") ist (natürlich) 1, MsgBox LenB("a") dagegen 2, da das "a"-Zeichen ja in Unicode aus 2 Bytes besteht. Wenn Sie also mit einem binären String arbeiten, muss immer die binäre Variante der String-Funktionen (mit einem B am Schluss) verwendet werden. Leider gibt es keine InStrRevB-, StringB- und SplitB-Funktion, sodass man diese selbst nachbauen muss.

6. Probleme auf japanischen / chinesischen Windows-Versionen
Oben erwähnte ich, dass das Einlesen einer Datei in einen String ein ungewöhnliches Verhalten auf japanischen / chinesischen Windows-Varianten hervorruft.

Nicht immer bedeutet der ANSI-Zeichensatz, dass 1 Zeichen immer durch 1 Byte dargestellt wird. Auf einem japanischen Windows enthält auch der ANSI-Zeichensatz 2-Byte-Zeichen. Dies sehen Sie, wenn sie wieder die Zeichentabelle öffnen, als Schrift "MS Gothic" auswählen (dies setzt aber voraus, dass sie die asiatischen Schriften installiert haben) und unten bei Zeichensatz "Windows: Japanisch" auswählen. Ganz oben finden Sie wieder die lateinischen Buchstaben, bei denen als Beschreibung sowas wie "U+0065 (0x65): Kleiner lateinischer Buchstabe E" steht. Also "0065" ist wieder der Hex-Unicodewert (2 Bytes) und "65" der Hex-ANSI-Wert (1 Byte). Wenn Sie aber einmal etwas runter scrollen, finden Sie haufenweise japanische Zeichen. Wenn Sie davon eins auswählen, steht dort sowas wie "U+8515 (0xE4F6): Einheitliches CJK-Ideogramm", also erst wieder der 2-Byte-Unicode-Wert, aber hier besteht auf einmal auch das ANSI-Zeichen aus 2 Bytes (E4 und F6). Das gilt natürlich auch für VB, und wenn Sie jetzt VB auf einem japanischen Windows ausführen und wie oben beschrieben eine Datei in einen String einlesen, wird dieses ja von VB nach Unicode konvertiert. Wenn jetzt zufällig in einer Stelle der Datei so eine Bytefole aus 2 Bytes für ein ANSI-Zeichen wie E4 und F6 vorkommt, wird das dann natürlich auch von VB als 1 Zeichen interpretiert. Wenn Sie jetzt wieder den Wert des 40. Bytes mit MsgBox Asc(Mid(Dateiinhalt, 40, 1)) auslesen wollen, haben Sie ein Problem, da entweder 0 herauskommt oder der Wert eines Zeichens, das aber weiter hinten liegt als in der Stelle 40.

Nehmen wir an, Sie haben eine Datei, die 2 Bytes mit den Werten E4 und F6 enthält. Wenn Sie diese Datei in einen String einlesen und mit der Chr- und Mid-Funktion die Werte der 2 Bytes ermitteln, kommt auf einem deutschen Windows 228 für das 1. und 246 für das 2. Byte heraus. Nachstellen können Sie dies mit

Dim Dateiinhalt as String
Dateiinhalt = StrConv(ChrB(228) & ChrB(246), vbUnicode)

Len(Dateiinhalt) ergibt hier auch 2. Wenn Sie das gleiche auf einem japanischen Windows machen, interpretiert VB aufgrund des japanischen Zeichensatzes diese 2 Bytes dagegen als 1 Zeichen. Versuchen Sie jetzt Len(Dateiinhalt), ergibt das 1! (aber nur wenn Sie nicht wirklich eine Datei einlesen (wie ganz oben), denn dann erstellen Sie ja mit Space(LOF(1)) einen String mit der Länge 2, dann ist das 2. Zeichen ein einfaches Leerzeichen). Wenn Sie dann eingeben,

MsgBox Asc(StrConv(ChrB(228) & ChrB(246), vbUnicode))

ergibt das -6922 (Die Funktion gibt einen Wert vom Typ Integer (16 Bit-Ganzzahl) zurück, wobei die negativen Werte durch den Komplementärwert dargestellt werden). Umgerechnet (2^16 + (-6922)) ergibt das 58614, in Hex E4F6, also wieder den 2-Byte-ANSI-Wert. Da das Byte 228 hier auch Bestandteil eines 2-Byte-Zeichens ist, können Sie mit der Chr-Funktion kein Zeichen mit dem ANSI-Wert 228 erstellen. Wenn Sie das folgende auf einem japanischen Windows versuchen:

MsgBox Asc(Chr(228))

werden Sie feststellen, dass 0 herauskommt, statt 228 (wie auf einem deutschen Windows). Wenn Sie dagegen

MsgBox AscB(ChrB(228))

verwenden, wird hier auch auf einem japanischen Windows 228 herauskommen.

Sie können das wieder selbst ausprobieren, indem Sie bei den Regions- und Sprachoptionen bei Erweitert für die nicht unicodefähigen Programme "Japanisch" auswählen und den PC neustarten.

Wenn Sie also vorhaben, ein Programm zu schreiben (auch wenn es nur eine englische Benutzeroberfläche haben soll und Sie eigentlich keinen unicodefähigen Label brauchen), das auf einmal auf japanischen oder chinesischen Systemen laufen soll, kann eine Nichtbeachtung des oben beschriebenen Verhaltens Fehlfunktionen verursachen. Dies gilt insbesondere auch für die Datenübertragung mit dem Winsock-Control.

Denn auch das Winsock-Control konvertiert einen der SendData-Methode übergebenen String zurück nach ANSI, und die GetData-Methode des empangenden Winsocks konvertiert den String dann wieder nach Unicode. Das führt einerseits dazu, dass Text, der versendet wird, auf dem anderen PC dann anders aussehen kann, und dass die Verwendung von Paketabgrenzungsmethoden, die die Länge der Daten vor den eigentlichen Daten senden, nicht mehr richtig funktionieren. Ich muss zugeben, dass ich das auch bei dem von mir erstellten Tipp  Daten vollständig + fehlerfrei über Winsock senden nicht beachtet habe, was dazu geführt hat, dass japanische Benutzer eines Programms von mir dieses nicht benutzen konnten.

Wie bei der Funktion zum Einlesen von Dateien macht es auch hier einen Unterschied, ob man den Winsock-Methoden einen String oder ein Byte-Array übergibt. Wenn man beispielsweise der SendData-Methode einen String übergibt, wird der String zurück nach ANSI konvertiert und dann versendet. Wenn man dagegen den String einem Byte-Array zuweist un dieses dann versendet, dann sendet das Winsock auch genau den Unicode-String (Wenn der String "Hallo" ist, dann sendet es 10 Bytes).

Vergleich:

Public Sub WSockSenden(Text As String)
  Winsock1.SendData Len(Text) & " " & Text
End Sub
 
Private Sub Winsock1_OnDataArrival(ByVal bytesTotal As Long)
  Dim strTemp As String
  Winsock1.GetData strTemp
  ' ... (Weiterverarbeitung)

Diese Vorgehensweise verwende ich in meinem Tipp, aber das führt dazu, dass auf japanischen Windows-Versionen die Längenangaben nicht mehr stimmen, wenn 2-Byte-Zeichen (wie oben beschrieben) vorkommen.

Um das zu verhindern, müsste man verwenden:

Public Sub WSockSenden(Text As String)
  Dim arrTemp() as Byte
  arrTemp = StrConv(LenB(Text) & " ", vbFromUnicode) & Text
  Winsock1.SendData arrTemp 
End Sub
 
Private Sub Winsock1_OnDataArrival(ByVal bytesTotal As Long)
  Dim strTemp As String, arrTemp() As Byte
  Winsock1.GetData arrTemp, vbArray + vbByte
  strTemp = arrTemp
  ' ... (Weiterverarbeitung)

Zur Weiterverarbeitung (z. B. Ermitteln der Länge) muss man dann aber auch die binären Funktionen wie LenB, MidB usw. verwenden. Das führt zum einen dazu, dass ein versendeter Unicode-String auf dem anderen PC (inkl. Sonder-/chinesischen Zeichen usw.) auch genau so ankommt, und die Fehlfunktionen bezüglich der Lägenangaben nicht mehr auftreten. Wenn man damit jetzt nur eine Datei versenden will, müsste man diese auch binär einlesen (also mit einem Byte-Array und dieses dann einem String zuweisen), und so der WSockSenden-Funktion übergeben. Somit braucht das empfangende Programm (unter Verwendung des Winsock-Tipps) nicht mehr 100 MB an Arbeitsspeicher, wenn es eine 50 MB-Datei empfängt, sondern eben auch nur 50 MB.

Zu erwähnen sei hier noch, dass auch größere VB-Projekte, wie beispielsweise CSocketMaster, eine API-/Subclassing-Implementation des Winsock-Steuerelements, den beschriebenen Sachverhalt nicht beachten. Wenn man bei diesem der SendData Methode ein Byte-Array zum binären Senden übergibt, wird dies mit der StrConv-Methode nach Unicode konvertiert und einem String zugewiesen und später die Länge dieses Strings für Pufferzwecke mit der Len-Funktion ausgelesen bzw. der String mit der Mid-Funktion geteilt. Das führt dazu, dass der Code dann auf z. B. japanischen Systemen nicht funktioniert. Stattdessen müsste das Byte-Array einfach direkt einem String zugewiesen und dann die Länge mit der LenB-Funktion ermittelt bzw. der String mit der MidB-Funktion geteilt werden.

7. Unicodefähige Print-Funktion
Sie kennen sich jetzt bestens mit der Verwendung von Unicode in VB6 aus und wollen jetzt auch mal auf einem deutschen Windows ein Sonderzeichen darstellen, das nicht im lokalen ANSI-Zeichensatz enthalten ist, z. B. mit

' Standardschrift MS Sans Serif eignet sich nicht für Sonderzeichen
Label1.Font.Name = "Tahoma"
Label1.Caption = ChrW(&H263A)

Leider machen Ihnen dann die VB6-Steuerelemente einen Strich durch die Rechnung, da sie, wie oben beschrieben, kein Unicode unterstützen und VB6 deswegen den String zurück nach ANSI konvertiert. Alle nichtdarstellbare Zeichen werden dann in Fragezeichen umgewandelt oder in Zeichen, die im ANSI-Zeichensatz vorhanden sind und den ursprünglichen ähneln (z. b. "a", wenn ein "ä" auf einem russischen Windows dargestellt werden soll).

Auch Form1.Print ChrW(&H263A) ergibt nur ein Fragezeichen. Da die Möglichkeiten der VB6-Bordmittel erschöpft sind, muss man sich also nach geeigneten API-Funktionen umsehen, die diese Funktionalität bieten. So gibt es die "TextOut"-Funktion in der gdi32.dll, die die Funktionalität der Print-Funktion bietet, man kann damit Text zeichen.

Der VB6 API-Viewer gibt folgende Deklaration an:

Public Declare Function TextOut Lib "gdi32" _
  Alias "TextOutA" ( _
  ByVal hdc As Long, _
  ByVal x As Long, _
  ByVal y As Long, _
  ByVal lpString As String, _
  ByVal nCount As Long) As Long

Ein Aufruf mit

Dim Result As Long, AnzeigeText As String
Me.AutoRedraw = True
Me.Font.Name = "Tahoma"
AnzeigeText = "Häuser. " & ChrW(&H263A)
Result = TextOut(Me.hdc, 0, 0, AnzeigeText, Len(AnzeigeText))

bringt allerdings auch nur ein Fragezeichen am Schluss. Das liegt daran, dass hier die ANSI-Variante verwendet wird, deshalb der Alias "TextOutA". Es gibt aber auch eine unicodefähige Variante mit dem Alias "TextOutW". Allerdings kann dieser dann kein normaler String mehr übergeben werden, sondern ein Unicode-String. Nun ist es so, dass VB6 intern ja Unicode-Strings hat, diese aber bei der Übergabe an API-Funktionen wieder nach ANSI zurückkonvertiert. Man könnte nun also den String bei der Übergabe mit StrConv(AnzeigeText, vbUnicode) "nochmal" nach Unicode konvertieren (also dass jedes Unicode-Zeichen zurückkonvertiert nach ANSI den Wert der einzelnen Bytes des ursprünglichen Unicode-Strings ergäbe), aber das kann auf japanischen Windows-Versionen wieder zu einem Fehlverhalten führen, wegen der 2-Byte-ANSI-Zeichen. Man muss stattdessen die Deklarierung "ByVal lpString As String" nach "ByRef lpString As Any" ändern, damit man auch ein Array übergeben kann. Allerdings muss man den ersten Array-Wert der Funktion übergeben, in dem Beispiel also:

Private Declare Function TextOut Lib "gdi32" _
  Alias "TextOutW" ( _
  ByVal hdc As Long, _
  ByVal x As Long, _
  ByVal y As Long, _
  ByRef lpString As Any, _
  ByVal nCount As Long) As Long
 
Private Sub Form_Load()
  Dim Result As Long, AnzeigeText As String, arrTemp() As Byte
  Me.AutoRedraw = True
  Me.Font.Name = "Tahoma"
  AnzeigeText = "Häuser. " & ChrW(&H263A)
  arrTemp = AnzeigeText
  Result = TextOut(Me.hdc, 0, 0, arrTemp(0), Len(AnzeigeText))
End Sub

Es gibt auch API-Funktionen, um eine unicodefähige Alternative zur TextHeight- und TextWidth-Funktion zu bauen. Im Folgenden finden Sie einen Code, der eine PrintW-, TextHeightW- und TextWidthW-Funktion enthält und den Sie in ein Modul einfügen können:

Private Type Size
  cx As Long
  cy As Long
End Type
 
Private Declare Function TextOut Lib "gdi32" _
  Alias "TextOutW" ( _
  ByVal hDC As Long, _
  ByVal X As Long, _
  ByVal Y As Long, _
  ByRef lpString As Any, _
  ByVal nCount As Long) As Long
 
Private Declare Function GetTextExtentPoint32 Lib "gdi32" _
  Alias "GetTextExtentPoint32W" ( _
  ByVal hDC As Long, _
  ByRef lpsz As Any, _
  ByVal cbString As Long, _
  lpSize As Size) As Long
 
Public Sub PrintW(hDC As Long, Text As String, X As Long, Y As Long)
  Dim arrbty() As Byte, retVal As Long
  If Text <> "" Then
    arrbty = Text
    retVal = TextOut(hDC, X / Screen.TwipsPerPixelX, _
      Y / Screen.TwipsPerPixelY, arrbty(0), Len(Text))
    If retVal = 0 Then Err.Raise 1, "Fehler in PrintW Funktion."
  End If
End Sub
 
Public Function TextWidthW(hDC As Long, Text As String) As Long
  Dim arrbty() As Byte, retVal As Long, ergebnis As Size
  If Text = "" Then
    TextWidthW = 0
  Else
    arrbty = Text
    retVal = GetTextExtentPoint32(hDC, arrbty(0), Len(Text), ergebnis)
    If retVal = 0 Then Err.Raise 1, "Fehler in TextWidthW Funktion."
    TextWidthW = ergebnis.cx * Screen.TwipsPerPixelX
  End If
End Function
 
Public Function TextHeightW(hDC As Long, Text As String) As Long
  Dim arrbty() As Byte, retVal As Long, ergebnis As Size
  If Text = "" Then Text = ChrW(32)
  arrbty = Text
  retVal = GetTextExtentPoint32(hDC, arrbty(0), Len(Text), ergebnis)
  If retVal = 0 Then Err.Raise 1, "Fehler in TextHeightW Funktion."
  TextHeightW = ergebnis.cy * Screen.TwipsPerPixelY
End Function

Diese Funktionen lassen sich wie die normalen Print, TextHeight und TextWidth-Funktionen benutzen, allerdings nicht als Methode des Zeichnungsobjekts. Stattdessen muss der Gerätekontext (hDC) übergeben werden, und bei der PrintW-Funktion muss noch die Position mit angegeben werden, z. B.

Private Sub Command1_Click()
  Form1.AutoRedraw = True
  Me.Font.Name = "Tahoma"
  PrintW Form1.hDC, "Häuser. " & ChrW(&H263A), 0, 0
  Form1.Refresh
End Sub

Dies funktioniert übrigens mit allen API-Funktionen, die neben der A-Variante (ANSI/ASCII) eine W-Variante (Wide) besitzen, um Unicode-Text zu übergeben.

8. Unicodefähiges Label
Man kann mit diesen Funktionen natürlich auch ein eigenenes Label-Steuerelement erstellen. Den folgenden Code können Sie in ein neues Benutzersteuerelement einfügen, um damit ein unicodefähiges Bezeichnercontrol (Label) zu erhalten. Leider lässt er sich nicht transparent schalten, aber ihm kann ein Picture-Object übergeben werden, sodass man bei einem Wechsel des Hintergrunds nur den Bildausschnitt, auf dem das Label sich befindet, seiner Picture-Eigenschaft übergeben muss. Das Label hat die am häufigsten verwendeten Funktionen eines normalen Labels, es unterstützt auch die Trennung eines Textes nach Leerzeichen, wenn sonst eine Zeile nicht mehr in das Label passen würde (das erledigt die TextZeichnen-Sub). Allerdings ist dies bei längerem Text ziemlich langsam; man kann den Umbruch nach Leerzeichen aber auch über die "Zeilenumbruch"-Eigenschaft deaktivieren. Über das Menü Extras - Prozedurattribute kann mann dann auch noch die Caption-Eigenschaft als Default-Eigenschaft (Voreinstellung) festlegen.

Option Explicit
 
Public Event Click()
Public Event DblClick()
Public Event MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Public Event MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Public Event MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
 
Private Type Size
  cx As Long
  cy As Long
End Type
 
Private Declare Function TextOut Lib "gdi32" _
  Alias "TextOutW" ( _
  ByVal hDC As Long, _
  ByVal X As Long, _
  ByVal Y As Long, _
  ByRef lpString As Any, _
  ByVal nCount As Long) As Long
 
Private Declare Function GetTextExtentPoint32 Lib "gdi32" _
  Alias "GetTextExtentPoint32W" ( _
  ByVal hDC As Long, _
  ByRef lpsz As Any, _
  ByVal cbString As Long, _
  lpSize As Size) As Long
 
Private CaptionInt As String
Private AutoSizeInt As Boolean
Private ZeilenumbruchInt As Boolean
Public Property Get Zeilenumbruch() As Boolean
  Zeilenumbruch = ZeilenumbruchInt
End Property
 
Public Property Let Zeilenumbruch(Wert As Boolean)
  ZeilenumbruchInt = Wert
End Property
Public Property Get Picture() As IPictureDisp
  Set Picture = UserControl.Picture
End Property
 
Public Property Set Picture(Bild As IPictureDisp)
  If Not UserControl.Picture Is Bild Then
    Set UserControl.Picture = Bild
    TextZeichnen
  End If
End Property
Public Property Get AutoSize() As Boolean
  AutoSize = AutoSizeInt
End Property
 
Public Property Let AutoSize(zeich As Boolean)
  AutoSizeInt = zeich
  If AutoSizeInt Then TextZeichnen
End Property
Private Sub UserControl_Click()
  RaiseEvent Click
End Sub
Private Sub UserControl_DblClick()
  RaiseEvent DblClick
End Sub
Private Sub UserControl_Initialize()
  UserControl.AutoRedraw = True
  UserControl.Font.Name = "Tahoma"
  CaptionInt = UserControl.Name
  ZeilenumbruchInt = True
End Sub
Private Sub UserControl_MouseDown(Button As Integer, Shift As Integer, _
  X As Single, Y As Single)
 
  RaiseEvent MouseDown(Button, Shift, X, Y)
End Sub
Private Sub UserControl_MouseMove(Button As Integer, Shift As Integer, _
  X As Single, Y As Single)
 
  RaiseEvent MouseMove(Button, Shift, X, Y)
End Sub
Private Sub UserControl_MouseUp(Button As Integer, Shift As Integer, _
  X As Single, Y As Single)
 
  RaiseEvent MouseUp(Button, Shift, X, Y)
End Sub
Private Sub UserControl_Resize()
  TextZeichnen
End Sub
Public Property Get Caption() As String
  Caption = CaptionInt
End Property
 
Public Property Let Caption(Wert As String)
  CaptionInt = Wert
  TextZeichnen
End Property
Public Property Get Font() As Font
  Set Font = UserControl.Font
End Property
 
Public Property Set Font(Wert As Font)
  Set UserControl.Font = Wert
  TextZeichnen
End Property
Public Property Get BackColor() As Long
  BackColor = UserControl.BackColor
End Property
 
Public Property Let BackColor(Wert As Long)
  UserControl.BackColor = Wert
  TextZeichnen
End Property
Public Property Get ForeColor() As Long
  ForeColor = UserControl.ForeColor
End Property
 
Public Property Let ForeColor(Wert As Long)
  UserControl.ForeColor = Wert
  TextZeichnen
End Property
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
  PropBag.WriteProperty "Font", UserControl.Font
  PropBag.WriteProperty "BackStyle", UserControl.BackStyle
  PropBag.WriteProperty "Caption", CaptionInt
  PropBag.WriteProperty "BackColor", Me.BackColor
  PropBag.WriteProperty "ForeColor", UserControl.ForeColor
  PropBag.WriteProperty "AutoSize", AutoSizeInt
  PropBag.WriteProperty "Picture", UserControl.Picture
  PropBag.WriteProperty "Zeilenumbruch", ZeilenumbruchInt
End Sub
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
  Set UserControl.Font = PropBag.ReadProperty("Font", UserControl.Font)
  UserControl.BackStyle = PropBag.ReadProperty("BackStyle", UserControl.BackStyle)
  AutoSizeInt = PropBag.ReadProperty("AutoSize", AutoSizeInt)
  UserControl.BackColor = PropBag.ReadProperty("BackColor", UserControl.BackColor)
  UserControl.ForeColor = PropBag.ReadProperty("ForeColor", UserControl.ForeColor)
  Set UserControl.Picture = PropBag.ReadProperty("Picture", UserControl.Picture)
  ZeilenumbruchInt = PropBag.ReadProperty("Zeilenumbruch", ZeilenumbruchInt)
  Caption = PropBag.ReadProperty("Caption", CaptionInt)
  ' Picture1.Cls
  ' PrintW Picture1.hDC, CaptionTemp, 0, 0
End Sub
Private Sub PrintW(hDC As Long, Text As String, X As Long, Y As Long)
  Dim arrbty() As Byte
  Dim retVal As Long
 
  If Text <> "" Then
    arrbty = Text
    retVal = TextOut(hDC, X / Screen.TwipsPerPixelX, _
      Y / Screen.TwipsPerPixelY, arrbty(0), Len(Text))
    If retVal = 0 Then Err.Raise 1, "Fehler in PrintW Funktion."
  End If
End Sub
Private Function TextWidthW(hDC As Long, Text As String) As Long
  Dim arrbty() As Byte
  Dim retVal As Long
  Dim ergebnis As Size
 
  If Text = "" Then
    TextWidthW = 0
  Else
    arrbty = Text
    retVal = GetTextExtentPoint32(hDC, arrbty(0), Len(Text), ergebnis)
    If retVal = 0 Then Err.Raise 1, "Fehler in TextWidthW Funktion."
    TextWidthW = ergebnis.cx * Screen.TwipsPerPixelX
  End If
End Function
Private Function TextHeightW(hDC As Long, Text As String) As Long
  Dim arrbty() As Byte
  Dim retVal As Long
  Dim ergebnis As Size
 
  If Text = "" Then Text = ChrW(32)
  arrbty = Text
  retVal = GetTextExtentPoint32(hDC, arrbty(0), Len(Text), ergebnis)
  If retVal = 0 Then Err.Raise 1, "Fehler in TextHeightW Funktion."
  TextHeightW = ergebnis.cy * Screen.TwipsPerPixelY
End Function
Private Sub TextZeichnen()
  Dim Zeilen() As String
  Dim ZeilenHoehe() As Long
  Dim temp1 As Long
  Dim Temp2 As Long
  Dim TempArbeitsCaption As String
  Dim ZlUmbrMethode As String
 
  TempArbeitsCaption = Replace(CaptionInt, vbCrLf, vbLf)
  ' Alle Zeilenumbruchvarianten in ein einheitliches Format verwandeln
  TempArbeitsCaption = Replace(TempArbeitsCaption, vbCr, vbLf)
  ZlUmbrMethode = vbLf
  If ZeilenumbruchInt And Not AutoSizeInt Then
    ' Zeilenumbrüche nach Leerzeichen erstellen
    Dim LetzteBrLfPos As Long
    Dim TempZeile As String
    LetzteBrLfPos = 1 - Len(ZlUmbrMethode)
    temp1 = -1
    ReDim Zeilen(20) As String
    Do
      temp1 = temp1 + 1
      ' Eine Zeile (durch die durch Zeilenumbrüche abgegrenzt ist) hernehmen
      If InStr(LetzteBrLfPos + Len(ZlUmbrMethode), _
        TempArbeitsCaption, ZlUmbrMethode) = 0 Then
 
        TempZeile = Mid(TempArbeitsCaption, LetzteBrLfPos + Len(ZlUmbrMethode))
      Else
        TempZeile = Mid(TempArbeitsCaption, LetzteBrLfPos + Len(ZlUmbrMethode), _
          InStr(LetzteBrLfPos + Len(ZlUmbrMethode), _
          TempArbeitsCaption, ZlUmbrMethode) - LetzteBrLfPos - Len(ZlUmbrMethode))
      End If
 
      If TextWidthW(UserControl.hDC, TempZeile) > UserControl.Width And _
        InStr(1, TempZeile, Chr(32)) > 0 Then
 
        ' Es sind Leerzeichen in der Zeile und sie ist länger als das UserControl,
        ' daher nach Leerzeichen Zeile umbrechen
        Dim LetzteLeerzeichenPos(1) As Long, TempNochVorhZeile As String
        TempNochVorhZeile = TempZeile
        temp1 = temp1 - 1
        Do
          temp1 = temp1 + 1
          LetzteLeerzeichenPos(1) = 0
          If InStr(1, TempNochVorhZeile, Chr(32)) > 0 Then
            Do
              LetzteLeerzeichenPos(0) = LetzteLeerzeichenPos(1)
              LetzteLeerzeichenPos(1) = InStr(LetzteLeerzeichenPos(1) + 1, _
                TempNochVorhZeile, Chr(32))
            Loop While LetzteLeerzeichenPos(1) > 0 And _
              TextWidthW(UserControl.hDC, Mid(TempNochVorhZeile, 1, _
              IIf(LetzteLeerzeichenPos(1) > 0, LetzteLeerzeichenPos(1), _
              Len(TempNochVorhZeile) + 1) - 1)) <= UserControl.Width
 
            If LetzteLeerzeichenPos(1) = 0 And TextWidthW(UserControl.hDC, _
              Mid(TempNochVorhZeile, 1, IIf(LetzteLeerzeichenPos(1) > 0, _
              LetzteLeerzeichenPos(1), Len(TempNochVorhZeile) + 1) - 1)) <= _
              UserControl.Width Then
                ' Kein Leerzeichen mehr, aber Text passt noch rein
                LetzteLeerzeichenPos(0) = Len(TempNochVorhZeile) + 1
            End If
 
            If LetzteLeerzeichenPos(0) = 0 Then
              ' Text enthält erst später ein Leerzeichen, sodass ein
              ' Überschreiten der Breite nicht verhindert werden kann
              LetzteLeerzeichenPos(0) = InStr(1, TempNochVorhZeile, Chr(32))
            End If
          ' Die längste, mögliche Textlänge, ohne dass der Text über das
          ' Usercontrol hinausgeht (außer es sind keine Leerzeichen mehr vorhanden)
          Else
            LetzteLeerzeichenPos(0) = Len(TempNochVorhZeile) + 1
          End If
 
          If temp1 > UBound(Zeilen) Then
            ReDim Preserve Zeilen(UBound(Zeilen) + 20) As String
          End If
          Zeilen(temp1) = Mid(TempNochVorhZeile, 1, LetzteLeerzeichenPos(0) - 1)
          TempNochVorhZeile = Mid(TempNochVorhZeile, LetzteLeerzeichenPos(0) + 1)
        Loop While Len(TempNochVorhZeile) > 0
      Else
        If temp1 > UBound(Zeilen) Then
          ReDim Preserve Zeilen(UBound(Zeilen) + 20) As String
        End If
        Zeilen(temp1) = TempZeile
      End If
      LetzteBrLfPos = InStr(LetzteBrLfPos + Len(ZlUmbrMethode), _
        TempArbeitsCaption, ZlUmbrMethode)
    Loop While LetzteBrLfPos > 0
    ReDim Preserve Zeilen(temp1) As String
  Else
    Dim TempHoehe As Long, TempBreite As Long
    Zeilen = Split(TempArbeitsCaption, ZlUmbrMethode)
  End If
 
  ReDim ZeilenHoehe(UBound(Zeilen)) As Long
  For temp1 = 0 To UBound(Zeilen)
    ZeilenHoehe(temp1) = TextHeightW(UserControl.hDC, Zeilen(temp1))
    TempHoehe = TempHoehe + ZeilenHoehe(temp1)
  Next
  If AutoSizeInt Then
    For temp1 = 0 To UBound(Zeilen)
      Temp2 = TextWidthW(UserControl.hDC, Zeilen(temp1))
      If Temp2 > TempBreite Then TempBreite = Temp2
    Next
    UserControl.Width = TempBreite
    UserControl.Height = TempHoehe
  End If
 
  UserControl.Cls
  Dim AktHoehe As Long
  For temp1 = 0 To UBound(Zeilen)
    If Not Zeilen(temp1) = "" Then
      PrintW UserControl.hDC, Zeilen(temp1), 0, AktHoehe
    End If
    AktHoehe = AktHoehe + ZeilenHoehe(temp1)
  Next
End Sub

9. Konvertierungsfunktionen für UTF-8 nach UTF-16 LE und umgekehrt
Abschließend finden Sie hier noch Funktionen, um UTF-8 (z. B. von einer Textdatei) nach UTF-16 LE (das interne Stringformat von VB) zu konvertieren, um z. B. eine UTF-8-Textdatei in dem unicodefähigen Label anzuzeigen. Fügen Sie dazu folgenden Code in ein Modul ein:

Option Explicit
 
Public Function UTF8nachUTF16B(Text As String) As String
  Dim temp1 As Long
  Dim Ausgabestr As String
  Dim TempBytes(2) As Byte
  Dim TempBytesUnicode(1) As Byte
  Dim TempArrayB() As Byte
  Dim VorhLaenge As Long
  Dim AktLaenge As Long
  Dim TempLngTextOrg As Long
 
  TempArrayB = Text
  TempLngTextOrg = LenB(Text) / 2
  Ausgabestr = String(TempLngTextOrg, Chr(0))
  VorhLaenge = TempLngTextOrg
  For temp1 = 0 To UBound(TempArrayB)
    If TempArrayB(temp1) < 128 Then
      If AktLaenge + 1 > VorhLaenge Then
        Ausgabestr = Ausgabestr & String(4 + Int(TempLngTextOrg / 4), Chr(0))
        VorhLaenge = VorhLaenge + 4 + Int(TempLngTextOrg / 4)
      End If
      Mid(Ausgabestr, AktLaenge + 1) = ChrW(TempArrayB(temp1))
      AktLaenge = AktLaenge + 1
 
    ' 2-Utf8-zeichen
    ElseIf TempArrayB(temp1) >= 192 And TempArrayB(temp1) < 224 Then
      TempBytes(0) = TempArrayB(temp1)
      TempBytes(1) = TempArrayB(temp1 + 1)
      TempBytesUnicode(1) = Int(TempBytes(0) / &H4) And &H7
      TempBytesUnicode(0) = (TempBytes(0) And &H3) * &H40 + (TempBytes(1) And &H3F)
      If AktLaenge + 1 > VorhLaenge Then
        Ausgabestr = Ausgabestr & String(4 + Int(TempLngTextOrg / 4), Chr(0))
        VorhLaenge = VorhLaenge + 4 + Int(TempLngTextOrg / 4)
      End If
      Mid(Ausgabestr, AktLaenge + 1) = ChrW(CLng(TempBytesUnicode(1)) * 256& + _
        CLng(TempBytesUnicode(0)))
      AktLaenge = AktLaenge + 1
      ' Ausgabestr = Ausgabestr & ChrW(CLng(TempBytesUnicode(1)) * 256 + _
      ' CLng(TempBytesUnicode(0)))
      temp1 = temp1 + 1
 
    ' 3 utf8-zeichen
    ElseIf TempArrayB(temp1) >= 224 And TempArrayB(temp1) < 240 Then
      TempBytes(0) = TempArrayB(temp1)
      TempBytes(1) = TempArrayB(temp1 + 1)
      TempBytes(2) = TempArrayB(temp1 + 2)
      TempBytesUnicode(1) = (TempBytes(0) And &HF) * &H10 + _
        (Int(TempBytes(1) / &H4) And &HF)
      TempBytesUnicode(0) = (TempBytes(1) And &H3) * &H40 + _
        (TempBytes(2) And &H3F)
      If AktLaenge + 1 > VorhLaenge Then
        Ausgabestr = Ausgabestr & String(4 + Int(TempLngTextOrg / 4), Chr(0))
        VorhLaenge = VorhLaenge + 4 + Int(TempLngTextOrg / 4)
      End If
      Mid(Ausgabestr, AktLaenge + 1) = ChrW(CLng(TempBytesUnicode(1)) * 256& + _
        CLng(TempBytesUnicode(0)))
      AktLaenge = AktLaenge + 1
      temp1 = temp1 + 2
    End If
  Next 
  UTF8nachUTF16B = Mid(Ausgabestr, 1, AktLaenge)
End Function
Public Function UTF16NachUTF8B(Text As String) As String
  Dim temp1 As Long
  Dim Ausgabestr As String
  Dim TempBytes(2) As Byte
  Dim TempBytesUnicode(1) As Byte
  Dim TempArrayB() As Byte
  Dim VorhLaenge As Long
  Dim AktLaenge As Long
  Dim TempLngTextOrg As Long
 
  TempArrayB = Text
  TempLngTextOrg = Len(Text)
  Ausgabestr = StringB(TempLngTextOrg, ChrB(0))
  VorhLaenge = TempLngTextOrg
  For temp1 = 0 To UBound(TempArrayB) Step 2
    TempBytesUnicode(0) = TempArrayB(temp1)
    TempBytesUnicode(1) = TempArrayB(temp1 + 1)
    ' 1-Byte-Zeichn
    If CLng(TempBytesUnicode(1)) * 256& + CLng(TempBytesUnicode(0)) <= &H7F& Then
      If AktLaenge + 1 > VorhLaenge Then
        Ausgabestr = Ausgabestr & StringB(4 + Int(TempLngTextOrg / 4), ChrB(0))
        VorhLaenge = VorhLaenge + 4 + Int(TempLngTextOrg / 4)
      End If
      MidB(Ausgabestr, AktLaenge + 1) = ChrB(TempBytesUnicode(0))
      AktLaenge = AktLaenge + 1
 
    ' 2-Byte-Zeichn
    ElseIf CLng(TempBytesUnicode(1)) * 256& + CLng(TempBytesUnicode(0)) > &H7F& And _
      CLng(TempBytesUnicode(1)) * 256& + CLng(TempBytesUnicode(0)) <= &H7FF& Then
 
      If AktLaenge + 2 > VorhLaenge Then
        Ausgabestr = Ausgabestr & StringB(4 + Int(TempLngTextOrg / 4), ChrB(0))
        VorhLaenge = VorhLaenge + 4 + Int(TempLngTextOrg / 4)
      End If
      TempBytes(0) = &HC0 + TempBytesUnicode(1) * &H4 + Int(TempBytesUnicode(0) / 2 ^ 6)
      TempBytes(1) = &H80 + (TempBytesUnicode(0) And &H3F)
      MidB(Ausgabestr, AktLaenge + 1) = ChrB(TempBytes(0))
      MidB(Ausgabestr, AktLaenge + 2) = ChrB(TempBytes(1))
      AktLaenge = AktLaenge + 2
 
    ' 3-Byte-Zeichn
    ElseIf CLng(TempBytesUnicode(1)) * 256& + CLng(TempBytesUnicode(0)) > &H7FF& And _
      CLng(TempBytesUnicode(1)) * 256& + CLng(TempBytesUnicode(0)) <= &HFFFF& Then
 
      If AktLaenge + 3 > VorhLaenge Then
        Ausgabestr = Ausgabestr & StringB(4 + Int(TempLngTextOrg / 4), ChrB(0))
        VorhLaenge = VorhLaenge + 4 + Int(TempLngTextOrg / 4)
      End If
      TempBytes(0) = &HE0 + Int(TempBytesUnicode(1) / 2 ^ 4)
      TempBytes(1) = &H80 + (TempBytesUnicode(1) And &HF) * 2 ^ 2 + _
        Int(TempBytesUnicode(0) / 2 ^ 6)
      TempBytes(2) = &H80 + (TempBytesUnicode(0) And &H3F)
      MidB(Ausgabestr, AktLaenge + 1) = ChrB(TempBytes(0))
      MidB(Ausgabestr, AktLaenge + 2) = ChrB(TempBytes(1))
      MidB(Ausgabestr, AktLaenge + 3) = ChrB(TempBytes(2))
      AktLaenge = AktLaenge + 3
    End If
  Next 
  UTF16NachUTF8B = MidB(Ausgabestr, 1, AktLaenge)
End Function
Private Function StringB(Number As Long, Character As String)
  Dim CharInt As String
 
  CharInt = MidB$(Character, 1, 1)
  StringB = String(Int(Number / 2), CharInt & CharInt)
  If Number Mod 2 = 1 Then StringB = StringB & CharInt
End Function

Zu beachten ist, dass die UTF8nachUTF16B-Funktion einen binären String als Argument erwartet und die UTF16NachUTF8B-Funktion einen binären String ausgibt. Wenn Sie damit beispielsweise eine UTF-8 Textdatei in dem unicodefähigen Label anzeigen wollen, können Sie folgende Funktion verwenden, die automatisch überprüft, ob die Datei ein UTF-8-, UTF-16 LE- oder kein BOM (ANSI) enthält und die Datei entsprechend konvertiert und den Dateiinhalt dann zurückgibt:

Public Function OeffneUnicodeDatei(Dateiname As String) As String
  Dim arrTemp() As Byte, DateiBinaerInhalt As String
  Open Dateiname For Binary As 1
  ReDim arrTemp(LOF(1) - 1) As Byte
  Get 1, , arrTemp
  Close 1
  DateiBinaerInhalt = arrTemp
  ' UTF-8-BOM, daher von UTF-8 nach UTF-16 LE konvertieren
  If MidB(DateiBinaerInhalt, 1, 3) = ChrB(239) & ChrB(187) & ChrB(191) Then
    OeffneUnicodeDatei = UTF8nachUTF16B(MidB(DateiBinaerInhalt, 4))
 
  ' UTF-16 LE-BOM, daher Datei nicht konvertieren, da sie ja schon in Unicode ist
  ElseIf MidB(DateiBinaerInhalt, 1, 2) = ChrB(255) & ChrB(254) Then
    OeffneUnicodeDatei = MidB(DateiBinaerInhalt, 3)
 
  ' Keine BOM, daher wird angenommen, dass es sich um eine normale Textdatei im ANSI-Format handelt
  Else
    OeffneUnicodeDatei = StrConv(DateiBinaerInhalt, vbUnicode)
  End If
End Function

Testen können Sie diesse Funktion, indem Sie mit dem Windows Editor einen Text mit ein paar Sonderzeichen (z. B. chinesische Zeichen) schreiben und diese Datei dann als "Unicode" oder "UTF-8" speichern.

Dieser Workshop wurde bereits 14.782 mal aufgerufen.

Über diesen Workshop im Forum diskutieren
Haben Sie Fragen oder Anregungen zu diesem Workshop, können Sie gerne mit anderen darüber in unserem Forum diskutieren.

Neue Diskussion eröffnen

nach obenzurück


Anzeige

Kauftipp Unser Dauerbrenner!Diesen und auch alle anderen Workshops finden Sie auch auf unserer aktuellen vb@rchiv  Vol.6
(einschl. Beispielprojekt!)

Ein absolutes Muss - Geballtes Wissen aus mehr als 8 Jahren vb@rchiv!
- nahezu alle Tipps & Tricks und Workshops mit Beispielprojekten
- Symbol-Galerie mit mehr als 3.200 Icons im modernen Look
Weitere Infos - 4 Entwickler-Vollversionen (u.a. sevFTP für .NET), Online-Update-Funktion u.v.m.
 
   

Druckansicht Druckansicht Copyright ©2000-2017 vb@rchiv Dieter Otter
Alle Rechte vorbehalten.
Microsoft, Windows und Visual Basic sind entweder eingetragene Marken oder Marken der Microsoft Corporation in den USA und/oder anderen Ländern. Weitere auf dieser Homepage aufgeführten Produkt- und Firmennamen können geschützte Marken ihrer jeweiligen Inhaber sein.

Diese Seiten wurden optimiert für eine Bildschirmauflösung von mind. 1280x1024 Pixel