Гость
Войти | Профиль | Очистить
Целевая тема:
Создать новую тему:
Автор:
Действия ...
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / WinSock хочу доконать / 6 сообщений из 6, страница 1 из 1
24.06.2011, 23:15
    #37324427
Андрей159
Андрей159
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
WinSock хочу доконать
Написал функцию
 
сама функция работает
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
Public Function WinSocket_In_URL(ByVal Url As String) As String
 Const BrowserAgent = "Opera/9.80 (Windows NT 5.1; U; ru) Presto/2.8.131 Version/11.11"
 Const BrowserAcept = "text/html, application/xml;q=0.9, application/xhtml+xml, image/png, image/webp, image/jpeg, image/gif, image/x-xbitmap, */*;q=0.1"
 Const BrowserAceptLng = "ru-RU,ru;q=0.9,en;q=0.8"
 Const BrowserAceptEnc = "deflate"
 Const BrowserAceptReferer = "http://ro.ru"
 Const BrowserAceptConnetction = "Keep -Alive"
 Const VbCrlfe = Chr( 13 ) ' запасной вариант
 Const VbCrlfN = "r/n/"    ' запасной вариант
 
 Dim tmGet As String
 Dim tmBezHTTP As String
 Dim tmOsnovaUrl As String
 Dim tmDodatokUrl As String
 Dim Zagal As String
 Dim Tilo As String
 Dim i As Long
 
 If LCase(Left(Url,  7 )) = "http://" Then tmBezHTTP = Mid(Url,  8 ) Else Beep: MsgBox "Не знайдено в URL рядку HTTP://": Exit Function
 i = InStr(tmBezHTTP, "/")
 If i =  0  Then
   tmOsnovaUrl = tmBezHTTP
   tmDodatokUrl = ""
 Else
   tmOsnovaUrl = Left(tmBezHTTP, i -  1 )
   tmDodatokUrl = Mid(tmBezHTTP, i)
 End If
 
 Tilo = "GET " & tmDodatokUrl & " HTTP/1.1"
 
 Zagal = Tilo & vbCrLf
 Zagal = Zagal & "User-Agent: " & BrowserAgent & vbCrLf
 Zagal = Zagal & "Host: " & tmOsnovaUrl & vbCrLf
 Zagal = Zagal & "Accept: " & BrowserAcept & vbCrLf
 Zagal = Zagal & "Accept-Language: " & BrowserAceptLng & vbCrLf
 Zagal = Zagal & "Accept -encoding: " & BrowserAceptEnc & vbCrLf
 Zagal = Zagal & "Referer: " & BrowserAceptReferer & vbCrLf
 Zagal = Zagal & "Connection: " & BrowserAceptConnetction & vbCrLf
 WinSocket_In_URL = Zagal
End Function

котораю хотелось б использовать и проверить на WinSock
 
Запуск
Код: plaintext
1.
2.
3.
4.
5.
Public Function FormuvannaZaprosa(ByVal Url As String, ElSocket As Winsock)
 Dim s As String
 s = WinSocket_In_URL(Url)
 ElSocket.SendData s
End Function

но немогу проверить поскольку на простом соединении происходит ошибка №10048

К примеру вот сдесь выдает уже ошибку
Код: plaintext
1.
2.
'Событие Click
Winsock1.Close
 Winsock1.Connect "www.google.com", "80"
№10048
"Address in use"

Что делаю не правильно ? Что-то видимо не так настроил WinSock. Уже забыл как раньше делал...(
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
29.06.2011, 18:46
    #37329513
Андрей159
Андрей159
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
WinSock хочу доконать
После чего заработало
Оказывается Winsock нуждается в дополнительном времени соединения, и после команды .Connect нужно дождаться конекта, а после чего давать запрос SendData
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
    winsock.RemotePort =  80 
    winsock.Protocol = sckTCPProtocol
    winsock.RemoteHost = "google.com"
    winsock.Connect
    
    While Not blnConnected
        DoEvents
    Wend

    winsock.SendData s1
 
где S1 может любой запрос, который не оставляет на локалке следовGET / HTTP/1.1
User-Agent: Opera/9.80 (Windows NT 5.1; U; ru) Presto/2.8.131 Version/11.11
Host: www.google.com.ua
Accept: text/html, application/xml;q=0.9, application/xhtml+xml, image/png, image/webp, image/jpeg, image/gif, image/x-xbitmap, */*;q=0.1
Accept-Language: ru-RU,ru;q=0.9,en;q=0.8
Accept-Encoding: gzip, deflate
Cookie: GZ=Z=1; PREF=ID=eb:U=37:FF=0:TM=1239:LM=6947:S=a1ezCd; SID=4AQ; HSID=AC; NID=48=Tg1
Cache-Control: no-cache
Connection: Keep-Alive
(дополнительный перевод строки vbcrlf)
(дополнительный перевод строки vbcrlf)

 
Даем разрешение пользоваться Winsock
Код: plaintext
1.
2.
Private Sub winsock_Connect()
    blnConnected = True
End Sub


Еще вот деталь одну не знаю: нужно ли закрывать конект если адрес остается тот же а запрос только другой передаю.

И еще будет вопрос о приеме данных. У меня иногда не все данные принимаются.
Код: plaintext
1.
2.
3.
4.
5.
Private Sub winsock_DataArrival(ByVal bytesTotal As Long)
    Dim strResp As String
    winsock.GetData strResp, vbString, bytesTotal
    txtResp.Text = strResp
End Sub
Бывает до половины, бывает все сразу отдаст. Я вот подумывал чтоб принимать очередями и задать winsock.GetData strResp, vbString, bytesTotal вместо bytesTotal например число, и также в цыкле через DoEvents суммировать значение. Не знаю поможет или нет. Когда передавал значения по UDP соединению, то был провал и я запросил старый проэкт. Сейчас же хочу доконать. Может кто уже сталкивался с таким ?
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
29.06.2011, 20:00
    #37329575
VSVLAD
VSVLAD
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
WinSock хочу доконать
Андрей159нужно ли закрывать конект если адрес остается тот же а запрос только другой передаю.
Если использовать HTTP/1.1 - с заголовком Keep-Alive:Connection - то сервер не закрывает соединения после ответа, и можно отправлять данные. Но лучше перед отправкой проверить состояние сокета, так как сервер может игнорировать этот заголовок (мало ли)... или что ещё может случиться со связью.

Андрей159У меня иногда не все данные принимаются.
Так как размер пакета ограничен... (У меня около 8 кб, хотя вроде где-то читал что размер буфера 64К для передачи.. ну да ладно) вообщем нужно дождаться пока сервер не начнёт закрывать соединение - значит файл пришёл (в случае если нет заголовка Content-Length), так как раз в нём содержится длина ответа от сервера.

А с UDP другие вещи, что конкретно с ним не получится, задавайте
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
29.06.2011, 21:30
    #37329642
Valeriu
Valeriu
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
WinSock хочу доконать
Где-то я этот вопрос поднял на форуме.
Выложу отрывок проги работающей
Обрати внимания на Private m_blnHeaderArrived As Boolean
Используется для проверки (True), что все данные поступили


Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
Option Explicit
'=============================
'EVENTS
'==============================
Public Event DataArrival(ByVal bytesTotal As Long)
Private m_blnHeaderArrived As Boolean
Private m_var( 0  To  13 ) As String
Private m_strHeader As String
Private WithEvents GTMCmd As CSocketMaster

Private Sub Class_Terminate()
Set GTMCmd = Nothing
End Sub

Private Sub Class_Initialize()
  Set GTMCmd = New CSocketMaster
End Sub

Public Sub Refresh()
Reset
End Sub

Private Sub GTMCmd_DataArrival(ByVal bytesTotal As Long)
Dim m_strChunk As String
Dim cnt As Integer, rec As Integer
Dim varFull() As String

On Error GoTo Error_Handler
m_blnHeaderArrived = False
GTMCmd.GetData m_strChunk
    'if header hasn't arrived pentru functii ... tot aici
    m_strHeader = m_strHeader & m_strChunk
    '---------------------------------------------------------------
    'if header hasn't arrived. QUIT - "Q"  No QUIT - "R"
    '---------------------------------------------------------------
    If InStr(m_strHeader, Chr( 0 ) & Chr( 0 ) & Chr( 0 ) & Chr( 0 ) & Chr( 0 )) Then
    'Selectam cati parameteri. Eroare - END
    'ZERO e rezervat pentru a intoarce "Q"
    varFull = Split(m_strHeader, Chr( 0 ) & Chr( 0 ) & Chr( 0 ) & Chr( 0 ))
        If InStr(varFull( 1 ), "%GTM-E") Then
            MsgBox varFull( 1 )
        Exit Sub
    End If
    For cnt =  0  To UBound(varFull) -  1 
        m_var(cnt) = varFull(cnt)
    Next cnt
     m_strHeader = ""
     m_strChunk = ""
     m_blnHeaderArrived = True
    End If

Exit Sub
Error_Handler:
    m_strHeader = ""
    MsgBox ("Error: " & Err.Number & Err.Description)
End Sub
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
29.06.2011, 21:45
    #37329657
Valeriu
Valeriu
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
WinSock хочу доконать
Еще. Можно скачать полностью код по следующему адресу

http://www.planet-source-code.com/vb/scripts/ShowCode.asp?txtCodeId=52072&lngWId=1
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
29.06.2011, 21:50
    #37329662
Valeriu
Valeriu
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
WinSock хочу доконать
По моему там освещено именно то, что хочешь "доканать" ;)
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / WinSock хочу доконать / 6 сообщений из 6, страница 1 из 1
Найденые пользователи ...
Разблокировать пользователей ...
Читали тему (0):
Читали форум (0):
Пользователи онлайн (0):
Польз. соглашение
созд. / загр.: 657ms
Закрыть
start [/forum/topic.php?fid=60&mobile=1&tid=2158583]:
 0ms
get settings:
 9ms
get forum list:
 16ms
check forum access:
 5ms
check topic access:
 5ms
track hit:
 192ms
get topic data:
 11ms
get forum data:
 2ms
get page messages:
 47ms
get tp. blocked users:
 1ms
others: 369ms
total:  657ms
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]