4

I'm trying to read data from my online mySQL server using WinHttpRequest in VBA. 

Dim objHTTP As New WinHttp.WinHttpRequest
With objHTTP
    .Open "POST", "http://www.dname.com/ruski/php/getNewestPID.php", True
    .SetRequestHeader "Content-Type", "application/x-www-form-urlencoded; charset=""UTF-8"""
    .Send "PID=" & lngPID
    .WaitForResponse
    Debug.Print .ResponseText
End With

<?php
$PID = $_POST['PID'];

require_once ('config.php'); 

if(!$PID>0){
    die("##### Error: getNewestPID failed - PID='" . $PID . "'  #####");
}

$phrases = mysql_query("SELECT * FROM phrases WHERE (PID > '$PID')");

if(!$phrases){
    die("##### Error: getNewestPID SELECT failed - PID=" . $PID . " - " . mysql_error() . "  #####");
}

mysql_close($db);

echo "data=";
while($row = mysql_fetch_array($phrases)) {
    echo $row[0] . "|" . $row[1] . "|" . $row[2] . "|" . $row[3];
}
?>

All works well, but cyrillic text is returned like:

data=21361|105||Ð?алÑ?Ñ?ик игÑ?аеÑ? на ÑкÑ?ипке в Ñвоей комнаÑ?Ð

My db uses UTF-8 Unicode. I know cyrillic works in tables and forms, but views junk in the VB editor.

I tried this:

Set FileStream = CreateObject("ADODB.Stream")
FileStream.Open
FileStream.Type = 1 'Binary
FileStream.Write objHTTP.ResponseBody
FileStream.Position = 0
FileStream.Type = 2 'adTypeText
FileStream.Charset = "Windows-1251"  ' https://msdn.microsoft.com/en-us/library/ms526296(v=exchg.10).aspx
strText = FileStream.ReadText
FileStream.Close

ending up with junk in the record:

Мальчик играет на скрипке в своей комнате.

The best result is with:

mb_convert_encoding($row[3], "Windows-1251", "UTF-8")

Ìàëü÷èê èãðàåò íà ñêðèïêå â ñâîåé êîìíàòå.

user3305711
  • 441
  • 5
  • 16

1 Answers1

0

This is not very elegant but it worked for me when I had similar issues. It is simply a function that will manually go from 1251 into Unicode. This one works for Russian and Ukrainian but according to which language you are working with there may be different characters and you would need to add them to the if statement. Also consider adding an else if that throws a question mark in case the character you are looking for is not found. 

Public Function AsciitoUni(base_cell As String) As String

AsciitoUni = ""

For i = 1 To Len(base_cell)

Dim s As String
Dim u As Integer
Dim a As Integer


s = Mid(base_cell, i, 1)
a = Asc(s)

If (a <= 127) Then
u = a
ElseIf (a >= 192) And (a <= 255) Then
u = a + 848
ElseIf (a = 184) Then
u = 1105
ElseIf (a = 186) Then
u = 1108
ElseIf (a = 179) Then
u = 1110
ElseIf (a = 191) Then
u = 1111
ElseIf (a = 168) Then
u = 1025
ElseIf (a = 170) Then
u = 1028
ElseIf (a = 178) Then
u = 1030
ElseIf (a = 175) Then
u = 1031
ElseIf (a = 185) Then
u = 8470
End If

AsciitoUni = AsciitoUni & ChrW(u)

Next

End Function
alexolb
  • 21
  • 1
  • 6