Помогите перевести функцию с PHP на VB

Программирование на Visual Basic, главный форум. Обсуждение тем программирования на VB 1—6.
Даже если вы плохо разбираетесь в VB и программировании вообще — тут вам помогут. В разумных пределах, конечно.
Правила форума
Темы, в которых будет сначала написано «что нужно сделать», а затем просьба «помогите», будут закрыты.
Читайте требования к создаваемым темам.
SeT
Постоялец
Постоялец
Аватара пользователя
 
Сообщения: 362
Зарегистрирован: 29.12.2004 (Ср) 13:11

Помогите перевести функцию с PHP на VB

Сообщение SeT » 23.07.2009 (Чт) 23:19

Сама функция вот:
Код: Выделить всё
function GetServerInfo($server,$port) {
     $fp = fsockopen("udp://".$server, $port);
     if (!$fp) die("Ошибка сокетов");
     @fwrite($fp,"\xFF\xFF\xFF\xFF\x54\x53\x6F\x75\x72\x63\x65\x20\x  45\x6E\x67\x69\x6E\x65\x20\x51\x75\x65\x72\x79\x00  ".chr(10));
     $start=time();
     socket_set_timeout($fp,1);
     $st=fread($fp,1);
     $r=socket_get_status($fp);
     $r=$r["unread_bytes"];
     if ($r == 0) { @fclose($fp); return false;}
     $st.=fread($fp,$r);
     @fclose($fp);
     $st=substr($st,5);
     $address=SubStr($st,0,StrPos($st,chr(0)));
     $address=str_replace(chr(0),"|",$address);
     $st=SubStr($st,StrPos($st,chr(0))+1);
     $name=SubStr($st,0,StrPos($st,chr(0)));
     $st=SubStr($st,StrPos($st,chr(0))+1);
     $map=SubStr($st,0,StrPos($st,chr(0)));
     $st=SubStr($st,StrPos($st,chr(0))+1);
     $st=SubStr($st,StrPos($st,chr(0))+1);
     $st=SubStr($st,StrPos($st,chr(0))+1);
     $current=ord(SubStr($st,0,1));
     $max=ord(SubStr($st,1,1));
     if ($map == "") return false;
     $result['map'] = $map;
     $result['name']= $name;
     $result['current'] = $current;
     $result['max'] = $max;
     return $result;
}


Смысл функции - коннект к КС-серверу с запросом. В зависимости от запроса выдаются разные параметры. В принципе коннект осуществляется через сокеты, да и строку распарсить смогу. А как обратиться к серверу по протоколу UDP?
01000100
Причиняет боль 0010
Виртуальная любовь 00100
Индустрия снов 0010

alibek
Большой Человек
Большой Человек
 
Сообщения: 14205
Зарегистрирован: 19.04.2002 (Пт) 11:40
Откуда: Russia

Re: Помогите перевести функцию с PHP на VB

Сообщение alibek » 23.07.2009 (Чт) 23:27

Выбери протокол UDP.
Lasciate ogni speranza, voi ch'entrate.

SeT
Постоялец
Постоялец
Аватара пользователя
 
Сообщения: 362
Зарегистрирован: 29.12.2004 (Ср) 13:11

Re: Помогите перевести функцию с PHP на VB

Сообщение SeT » 24.07.2009 (Пт) 9:31

Я использую контрол дашарма. В нем нет выбора протокола.
Напиши компонент с поддержкой такого протокола (ctl желательно)
01000100
Причиняет боль 0010
Виртуальная любовь 00100
Индустрия снов 0010

iGrok
Артефакт VBStreets
Артефакт VBStreets
 
Сообщения: 4272
Зарегистрирован: 10.05.2007 (Чт) 16:11
Откуда: Сетевое сознание

Re: Помогите перевести функцию с PHP на VB

Сообщение iGrok » 24.07.2009 (Пт) 11:31

Ну возьми обычный винсок - он поддерживает.
label:
cli
jmp label

SeT
Постоялец
Постоялец
Аватара пользователя
 
Сообщения: 362
Зарегистрирован: 29.12.2004 (Ср) 13:11

Re: Помогите перевести функцию с PHP на VB

Сообщение SeT » 24.07.2009 (Пт) 11:44

Обычный винсок молчит как partizanen, не реагируя ни на какое внутреннее событие
Код: Выделить всё
Private Sub Form_Load()

    T1.Connect "77.220.180.147", 27017
    T1.SendData "\xFF\xFF\xFF\xFF\x54\x53\x6F\x75\x72\x63\x65\x20\x  45\x6E\x67\x69\x6E\x65\x20\x51\x75\x65\x72\x79\x00  " + Chr(10)
   
End Sub

Private Sub Form_Unload(Cancel As Integer)
    T1.Close
End Sub

Private Sub T1_DataArrival(ByVal bytesTotal As Long)
MsgBox T1.GetData
End Sub

Private Sub T1_Error(ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)
    MsgBox Description
End Sub

Private Sub T1_SendComplete()
MsgBox "Отправили!"
End Sub

Private Sub T1_SendProgress(ByVal bytesSent As Long, ByVal bytesRemaining As Long)
MsgBox "отправляем"
End Sub
01000100
Причиняет боль 0010
Виртуальная любовь 00100
Индустрия снов 0010

JohnK
Постоялец
Постоялец
Аватара пользователя
 
Сообщения: 874
Зарегистрирован: 03.08.2002 (Сб) 0:35
Откуда: 48.02` 37.58`

Re: Помогите перевести функцию с PHP на VB

Сообщение JohnK » 24.07.2009 (Пт) 12:31

А так попробуй:
Код: Выделить всё
f=chr$(255)
....
ws.protocol=sckUDPProtocol
ws.remotehost="Твой сервак"
ws.remoteport=27015
...
ws.senddata f&f&f&f& "infostring" & chr$(0)
ws.senddata f&f&f&f& "Tsource Engine Query" &  chr$(0)


Дальше парсишь, думаю протокол ты нашел...
SELECT * FROM girls WHERE tits NOT NULL AND age BETWEEN 18 AND 25 ORDER BY Beauty

SeT
Постоялец
Постоялец
Аватара пользователя
 
Сообщения: 362
Зарегистрирован: 29.12.2004 (Ср) 13:11

Re: Помогите перевести функцию с PHP на VB

Сообщение SeT » 24.07.2009 (Пт) 12:56

всё равно молчит
01000100
Причиняет боль 0010
Виртуальная любовь 00100
Индустрия снов 0010

djalex777
Постоялец
Постоялец
 
Сообщения: 461
Зарегистрирован: 23.03.2006 (Чт) 16:02

Re: Помогите перевести функцию с PHP на VB

Сообщение djalex777 » 24.07.2009 (Пт) 13:21

SeT писал(а):Обычный винсок молчит как partizanen, не реагируя ни на какое внутреннее событие
Код: Выделить всё
Private Sub Form_Load()

    T1.Connect "77.220.180.147", 27017
    T1.SendData "\xFF\xFF\xFF\xFF\x54\x53\x6F\x75\x72\x63\x65\x20\x  45\x6E\x67\x69\x6E\x65\x20\x51\x75\x65\x72\x79\x00  " + Chr(10)
   
End Sub

Private Sub Form_Unload(Cancel As Integer)
    T1.Close
End Sub

Private Sub T1_DataArrival(ByVal bytesTotal As Long)
MsgBox T1.GetData
End Sub

Private Sub T1_Error(ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)
    MsgBox Description
End Sub

Private Sub T1_SendComplete()
MsgBox "Отправили!"
End Sub

Private Sub T1_SendProgress(ByVal bytesSent As Long, ByVal bytesRemaining As Long)
MsgBox "отправляем"
End Sub

Я так понимаю коннект происходит (т.е. T1.Connect выполнено успешно). А вот это что??
Код: Выделить всё
T1.SendData "\xFF\xFF\xFF\xFF\x54\x53\x6F\x75\x72\x63\x65\x20\x  45\x6E\x67\x69\x6E\x65\x20\x51\x75\x65\x72\x79\x00  " + Chr(10)

Это нисколько не тоже самое что
Код: Выделить всё
@fwrite($fp,"\xFF\xFF\xFF\xFF\x54\x53\x6F\x75\x72\x63\x65\x20\x  45\x6E\x67\x69\x6E\x65\x20\x51\x75\x65\x72\x79\x00  ".chr(10));

Тебе экранирование ни о чем не говорит?

JohnK
Постоялец
Постоялец
Аватара пользователя
 
Сообщения: 874
Зарегистрирован: 03.08.2002 (Сб) 0:35
Откуда: 48.02` 37.58`

Re: Помогите перевести функцию с PHP на VB

Сообщение JohnK » 24.07.2009 (Пт) 15:01

Странно, потому как у меня этот код (МОЙ) в локалке работает. Сервер CS 1.6
SELECT * FROM girls WHERE tits NOT NULL AND age BETWEEN 18 AND 25 ORDER BY Beauty

SeT
Постоялец
Постоялец
Аватара пользователя
 
Сообщения: 362
Зарегистрирован: 29.12.2004 (Ср) 13:11

Re: Помогите перевести функцию с PHP на VB

Сообщение SeT » 24.07.2009 (Пт) 15:48

ок, сделал
Код: Выделить всё
ws.SendData Chr$(255) & Chr$(255) & Chr$(255) & Chr$(255) & Chr$(84) & Chr$(83) & Chr$(111) & _
Chr$(117) & Chr$(114) & Chr$(99) & Chr$(101) & Chr$(32) & " " & Chr$(69) & Chr$(110) & Chr$(103) & _
Chr$(105) & Chr$(110) & Chr$(101) & Chr$(32) & Chr$(81) & Chr$(117) & Chr$(101) & Chr$(114) & _
Chr$(121) & "  " & Chr$(10)


приходят лишь вопросительные знаки

JohnK, покажи, как парсинг делаешь
Последний раз редактировалось SeT 24.07.2009 (Пт) 15:48, всего редактировалось 1 раз.
01000100
Причиняет боль 0010
Виртуальная любовь 00100
Индустрия снов 0010

JohnK
Постоялец
Постоялец
Аватара пользователя
 
Сообщения: 874
Зарегистрирован: 03.08.2002 (Сб) 0:35
Откуда: 48.02` 37.58`

Re: Помогите перевести функцию с PHP на VB

Сообщение JohnK » 24.07.2009 (Пт) 15:48

А почему ты явно строку не шлешь? Так как это UDP, попробуй по таймауту послать еще запрос. У меня тоже не всегда приходит ответ с сервера.
SELECT * FROM girls WHERE tits NOT NULL AND age BETWEEN 18 AND 25 ORDER BY Beauty

SeT
Постоялец
Постоялец
Аватара пользователя
 
Сообщения: 362
Зарегистрирован: 29.12.2004 (Ср) 13:11

Re: Помогите перевести функцию с PHP на VB

Сообщение SeT » 24.07.2009 (Пт) 16:06

ок, могу и напрямую:

'яяяяgetchallenge valve'; //Используеться для определения наличия серверана!!!
'яяяяinfostring'; //получаем информацию о сервере (кол. игроков, ботов, карта и.т.д)
'яяяяTSource Engine Query.';
'яяяяdetails'; //тожесамое что и SendData2 только для CS Steam
'яяяяping'; //используеться для определения времени отклика сервера
'яяяяplayers'; //Список ников играющих


Осталось распарсить получаемые данные. Вот тут у меня ступор
01000100
Причиняет боль 0010
Виртуальная любовь 00100
Индустрия снов 0010

SeT
Постоялец
Постоялец
Аватара пользователя
 
Сообщения: 362
Зарегистрирован: 29.12.2004 (Ср) 13:11

Re: Помогите перевести функцию с PHP на VB

Сообщение SeT » 24.07.2009 (Пт) 19:12

м. во: как перевести набор шестнадцатеричных данных в читабельный текст?
01000100
Причиняет боль 0010
Виртуальная любовь 00100
Индустрия снов 0010

JohnK
Постоялец
Постоялец
Аватара пользователя
 
Сообщения: 874
Зарегистрирован: 03.08.2002 (Сб) 0:35
Откуда: 48.02` 37.58`

Re: Помогите перевести функцию с PHP на VB

Сообщение JohnK » 24.07.2009 (Пт) 21:27

Писал давно, поэтому без оптимизации:

Код: Выделить всё
Private Sub WS_DataArrival(ByVal bytesTotal As Long)
Dim str As String * 255
Dim ret() As Byte
On Error Resume Next

ReDim ret(bytesTotal)
WS.GetData ret()
Call Parse_CS_Response(ret())
End Sub

Private Sub Parse_CS_Response(sd1() As Byte)
Dim str2 As String
Dim jjj() As String
str2 = TranslateIntoStr(sd1())
If Mid(str2, 1, 4) = Chr(255) & Chr(255) & Chr(255) & Chr(255) Then

  If InStr(1, str2, "infostringresponse") Then
   jjj = Split(str2, "\")
    If UBound(jjj()) > 1 Then
     Text2.Text = Text2.Text & "Address: " & jjj(4) & vbCrLf
     Text2.Text = Text2.Text & "players: " & jjj(6) & vbCrLf
     Text2.Text = Text2.Text & "max: " & jjj(12) & vbCrLf
     Text2.Text = Text2.Text & "name: " & jjj(20) & vbCrLf
     Text2.Text = Text2.Text & "map: " & jjj(22) & vbCrLf
     WS.RemoteHost = Mid(jjj(4), 1, InStr(1, jjj(4), ":"))
     WS.SendData Chr$(255) & Chr$(255) & Chr$(255) & Chr$(255) & "players" & Chr$(0)
    End If
   
    ElseIf InStr(1, str2, "j") Then
     Text2.Text = Text2.Text & "ping: " & vbCrLf
   
    ElseIf InStr(1, str2, "players") Then
     Text2.Text = Text2.Text & "players: " & vbCrLf
 
  End If

End If

Private Function TranslateIntoStr(sd() As Byte) As String
Dim i As Long
TranslateIntoStr = ""
For i = 0 To UBound(sd())
  If sd(i) = 0 Then
   TranslateIntoStr = TranslateIntoStr & vbCrLf
    Else
   TranslateIntoStr = TranslateIntoStr & Chr(sd(i))
  End If
Next i
End Function
End Sub


Последнюю можно заменить на:

Код: Выделить всё
Public Sub Copy_Bytes2Str(sB() As Byte, sS As String)
sS = StrConv(sB(), vbUnicode)
End Sub
SELECT * FROM girls WHERE tits NOT NULL AND age BETWEEN 18 AND 25 ORDER BY Beauty

Хакер
Телепат
Телепат
Аватара пользователя
 
Сообщения: 16478
Зарегистрирован: 13.11.2005 (Вс) 2:43
Откуда: Казахстан, Петропавловск

Re: Помогите перевести функцию с PHP на VB

Сообщение Хакер » 24.07.2009 (Пт) 23:29

SeT писал(а):шестнадцатеричных данных

Таких не бывает.
—We separate their smiling faces from the rest of their body, Captain.
—That's right! We decapitate them.

SeT
Постоялец
Постоялец
Аватара пользователя
 
Сообщения: 362
Зарегистрирован: 29.12.2004 (Ср) 13:11

Re: Помогите перевести функцию с PHP на VB

Сообщение SeT » 28.07.2009 (Вт) 11:20

посидел, пофтыкал протокол. Вот что вышло:

Код: Выделить всё
Private Sub Command2_Click()
    f = Chr$(255)
    ws.SendData f & f & f & f & "U" & Chr$(65) & Chr$(54) & Chr$(80) & Chr$(99) & Chr$(7) & Chr$(0)
End Sub

Private Sub Command3_Click()
    f = Chr$(255)
    ws.SendData f & f & f & f & Chr$(87) & Chr$(0)
End Sub

Private Sub Command4_Click()
    f = Chr$(255)
    ws.SendData f & f & f & f & "ping" & Chr$(0)
End Sub

Private Sub Command5_Click()
    MsgBox Chr$(Text3.text)
    Text3 = ""
End Sub

Private Sub WS_DataArrival(ByVal bytesTotal As Long)
Dim str As String * 255
Dim ret() As Byte
'On Error Resume Next

ReDim ret(bytesTotal)
ws.GetData ret()
Call Parse_CS_Response(ret())
End Sub

Private Sub Parse_CS_Response(sd1() As Byte)
Dim str2 As String
Dim jjj() As String
Dim i As Long


str2 = TranslateIntoStr(sd1)
Text2 = str2
jjj = Split(str2, vbNewLine)
Text1.text = ""

If jjj(0) = "m" Then
     Text1.text = Text1.text & "Адрес: " & jjj(1) & vbCrLf
     Text1.text = Text1.text & "Название: " & jjj(2) & vbCrLf
     Text1.text = Text1.text & "Карта: " & jjj(3) & vbCrLf
     Text1.text = Text1.text & "Игроков: " & jjj(6) & "/" & jjj(7) & vbCrLf
     
ElseIf jjj(0) = "j" Then
     Text1.text = Text1.text & "Сервер доступен " & vbCrLf
     
ElseIf jjj(0) = "D" Then
    For i = 1 To UBound(jjj) Step 2
        If jjj(i) <> "" Then Text1.text = Text1.text & jjj(i) & " [" & jjj(i + 1) & "]" & vbCrLf
    Next i
End If
   
End Sub

Private Function TranslateIntoStr(sd() As Byte) As String
    Dim i, s As Long
    Dim v, x As Integer
   
    TranslateIntoStr = ""
    'MsgBox Chr$(sd(4))
    If Chr$(sd(4)) = "m" Then
        TranslateIntoStr = "m" & vbCrLf
        For i = 5 To UBound(sd)
            If sd(i) = 0 Then
                TranslateIntoStr = TranslateIntoStr & vbCrLf
                s = s + 1
            Else
                If s = 5 Or s = 6 Then
                    TranslateIntoStr = TranslateIntoStr & sd(i) & vbCrLf
                    s = s + 1
                Else
                    TranslateIntoStr = TranslateIntoStr & Chr$(sd(i))
                End If
            End If
        Next i
   
    ElseIf Chr$(sd(4)) = "j" Then
        TranslateIntoStr = "j" & vbCrLf
   
    ElseIf Chr$(sd(4)) = "D" Then
        TranslateIntoStr = "D" & vbCrLf
        v = 7
        For i = 7 To UBound(sd)
       
            If sd(i) = 0 And sd(i - 1) = 0 And sd(i - 2) = 0 And sd(i - 4) = 0 Then
                                   
                For x = v To i - 5
                    TranslateIntoStr = TranslateIntoStr & Chr$(sd(x))
                Next x
                TranslateIntoStr = TranslateIntoStr & vbNewLine & sd(i - 3) & vbNewLine
                i = i + 6
                v = i
            End If
        Next i
   
    Else
        For i = 5 To UBound(sd)
            TranslateIntoStr = TranslateIntoStr & Chr$(sd(i))
        Next i
    End If
   
End Function


т.о. скрипт обрабатывает команды ping, players и Тquery
01000100
Причиняет боль 0010
Виртуальная любовь 00100
Индустрия снов 0010


Вернуться в Visual Basic 1–6

Кто сейчас на конференции

Сейчас этот форум просматривают: AhrefsBot и гости: 92

    TopList