Private Type ArrArr
fLen As Long
fType As Long
fTime As Date
fArr() As Byte
End Type
Public RecBytes() As ArrArr 'полученные байт-массивы HEAD запросов
VERSION 5.00
Begin VB.Form Form2
BorderStyle = 1 'Fixed Single
ClientHeight = 585
ClientLeft = 45
ClientTop = 375
ClientWidth = 1410
BeginProperty Font
Name = "Tahoma"
Size = 8.25
Charset = 204
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Icon = "Form2.frx":0000
MaxButton = 0 'False
MinButton = 0 'False
Moveable = 0 'False
ScaleHeight = 585
ScaleWidth = 1410
ShowInTaskbar = 0 'False
StartUpPosition = 3 'Windows Default
Begin VB.Timer Timer1
Enabled = 0 'False
Interval = 100
Left = 0
Top = 0
End
End
Attribute VB_Name = "Form2"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Const WSADESCRIPTION_LEN As Long = 257
Private Const WSASYS_STATUS_LEN As Long = 129
Private Type WSAData
wVersion As Integer
wHighVersion As Integer
szDescription As String * WSADESCRIPTION_LEN '257
szSystemStatus As String * WSASYS_STATUS_LEN '129
iMaxSockets As Integer
iMaxUdpDg As Integer
lpVendorInfo As Long
End Type
Private Type sockaddr_in
sin_family As Integer
sin_port As Integer
sin_addr As Long
sin_zero(1 To 8) As Byte
End Type
Private Declare Function WSAStartup _
Lib "ws2_32.dll" (ByVal wVR As Long, _
lpWSAD As WSAData) As Long
Private Declare Function gethostbyname Lib "wsock32" (ByVal hostname As String) As Long
Private Declare Sub CopyMemory _
Lib "kernel32" _
Alias "RtlMoveMemory" (xDest As Any, _
xSource As Any, _
ByVal nbytes As Long)
Private Declare Function inet_addr Lib "ws2_32.dll" (ByVal cp As String) As Long
Private Declare Function htons Lib "ws2_32.dll" (ByVal hostshort As Integer) As Integer
Private Declare Function Socket _
Lib "ws2_32.dll" _
Alias "socket" (ByVal afi As Long, _
ByVal s_type As Long, _
ByVal protocol As Long) As Long
Private Declare Function Con _
Lib "ws2_32.dll" _
Alias "connect" (ByVal S As Long, _
ByRef name As sockaddr_in, _
ByVal namelen As Long) As Long
Private Declare Function WSAAsyncSelect _
Lib "ws2_32.dll" (ByVal S As Long, _
ByVal hWnd As Long, _
ByVal wMsg As Long, _
ByVal lEvent As Long) As Long
Private Declare Function send _
Lib "ws2_32.dll" (ByVal S As Long, _
ByRef buf As Any, _
ByVal BufLen As Long, _
ByVal flags As Long) As Long
Private Declare Function recv _
Lib "ws2_32.dll" (ByVal S As Long, _
ByRef buf As Any, _
ByVal BufLen As Long, _
ByVal flags As Long) As Long
Private Declare Function closesocket Lib "ws2_32.dll" (ByVal S As Long) As Long
Private Declare Function WSACleanup Lib "ws2_32.dll" () As Long
Private APISoket As Long 'хэндл сокета
Private lIndex As Long 'индекс в массиве байт-массивов
Private Sub Form_Load()
Const WINSOCK_VERSION As Long = 1
Dim WSAD As WSAData
WSAStartup WINSOCK_VERSION, WSAD
End Sub
Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Const MAX_BUFFER_LENGTH As Long = 8192
Static Answer As String 'текущий индекс байт-массива
Dim reBytes As Long 'кол-во принятых байт
Dim arrBuffer(1 To MAX_BUFFER_LENGTH) As Byte 'буферный байт-массив
reBytes = recv(APISoket, arrBuffer(1), MAX_BUFFER_LENGTH, 0&)
If reBytes > 0& Then
'байт-массив начинается с нулевого байта, а кол-во принятых байт посчитано с первого, поэтому -1
ReDim RecBytes(lIndex).fArr(reBytes - 1&)
RecBytes(lIndex).fLen = reBytes
CopyMemory RecBytes(lIndex).fArr(0), arrBuffer(1), reBytes
End If
Unload Me
End Sub
Private Sub Form_Unload(Cancel As Integer)
closesocket (APISoket)
WSACleanup
End Sub
Private Function GetIPFromHostName(ByRef sHostName As String) As String
Const cDot As String = "."
Dim nbytes As Long
Dim ptrHosent As Long
Dim ptrName As Long
Dim ptrAddress As Long
Dim ptrIPAddress As Long
Dim sAddress As String
sAddress = Space$(4&)
ptrHosent = gethostbyname(sHostName & vbNullChar)
If ptrHosent <> 0 Then
ptrAddress = ptrHosent + 12&
CopyMemory ptrAddress, ByVal ptrAddress, 4&
CopyMemory ptrIPAddress, ByVal ptrAddress, 4&
CopyMemory ByVal sAddress, ByVal ptrIPAddress, 4&
GetIPFromHostName = CStr(Asc(sAddress)) & cDot & CStr(Asc(Mid$(sAddress, 2&, 1&))) & cDot & CStr(Asc(Mid$(sAddress, 3&, 1&))) & cDot & CStr(Asc(Mid$(sAddress, 4&, 1&)))
End If
End Function
Public Sub Connect(ByRef Index As Long, ByVal Host As String, Optional ByVal Port As Long = 80&)
Const SOCK_STREAM As Long = 1
Const AF_INET As Long = 2
Const FD_READ As Long = &H1
Const FD_CLOSE As Long = &H20
Const WM_LBUTTONUP As Long = &H202
Dim constr As sockaddr_in 'адрес хоста в спец. типе данных
If Not Host Like "?##.?##.?##.?##" Then Host = GetIPFromHostName(Host)
lIndex = Index
constr.sin_addr = inet_addr(Host)
constr.sin_family = 2
constr.sin_port = htons(Port)
APISoket = Socket(AF_INET, SOCK_STREAM, 6&)
RecBytes(lIndex).fLen = Con(APISoket, constr, Len(constr))
If RecBytes(lIndex).fLen = -1& Then
Unload Me
Else
WSAAsyncSelect APISoket, Me.hWnd, WM_LBUTTONUP, FD_READ Or FD_CLOSE
Timer1.Enabled = True
End If
End Sub
Private Sub Timer1_Timer()
Timer1.Enabled = False
RecBytes(lIndex).fLen = send(APISoket, RecBytes(lIndex).fArr(0), UBound(RecBytes(lIndex).fArr), 0&)
If RecBytes(lIndex).fLen = -1& Then Unload Me
End Sub
фееричная чушь)Хакер писал(а):Если у человека в головекокаинумхаос, то дотнет особо не спасёт особо.
Хакер писал(а):Qwertiy только и агитирует за дотнет.
Хакер писал(а):Если у человека в головекокаинумхаос, то дотнет особо не спасёт особо.
Adam Smith писал(а):Нашел, Хакер упоминал WinHTTP, там есть готовые функции.
Index of /update/v5/windows/img/rtelecom/icon/service/
../
pi_bank_alpha.png 18-Nov-2014 11:50 7007
pi_bank_alpha_ls.png 18-Nov-2014 11:35 9874
pi_bank_anelik.png 09-Jun-2015 14:13 4761
........................................................................................
Adam Smith писал(а):Зависают классы, как-то рандомно.
Adam Smith писал(а):Всё таки нужны потоки и нужно как-то возвращаться к байт-массивам, строки память едят нещадно.
Set objHTTP = CreateObject("WinHttp.WinHttpRequest.5.1")
objHTTP.Option(WinHttpRequestOption_EnableHttpsToHttpRedirects) = True
и т.д.
Adam Smith писал(а):
- Код: Выделить всё
Set objHTTP = CreateObject("WinHttp.WinHttpRequest.5.1")
objHTTP.Option(WinHttpRequestOption_EnableHttpsToHttpRedirects) = True
Тип объектной переменной, используемой для сохранения возвращаемого объекта, может влиять на производительность приложения. Объявление объектной переменной при помощи предложения As Object приводит к созданию переменной, которая может содержать ссылку на любой тип объекта. Тем не менее, обращение к объекту через эту переменную организуется с поздним связыванием — это значит, что связывание производится в ходе выполнения программы. Существует множество причин для того, чтобы избегать позднего связывания; в их число входит и снижение производительности приложения.
- Код: Выделить всё
Sub CreateADODB()
Dim adoApp As Object
adoApp = CreateObject("ADODB.Connection")
End Sub
Можно создать объектную переменную, которая приводит к раннему связыванию — т.е. связыванию при компиляции программы. Чтобы сделать это, добавьте ссылку на библиотеку типов для объекта при помощи вкладки COM диалогового окна Добавить ссылку в меню Проект. Затем объявите объектную переменную типа, соответствующую объекту. В большинстве случаев для создания объекта вместо функции CreateObject более эффективно будет использовать инструкцию Dim и основную сборку взаимодействия.
Adam Smith писал(а):Там же где и тут https://msdn.microsoft.com/ru-ru/library/7t9k08y5(v=vs.90).aspx
Dim adoApp As Object
Private objHTTP As Object
Adam Smith писал(а):Ну даже если бы я объявил переменную как вариант это ни разу не делает позднее связывание ранним.
Adam Smith писал(а):CreateObject я очевидно использую потому, что не подключил WinHTTP в референсах.
что не подключил WinHTTP в референсах.
Private lIndex As Long 'индекс текущей в массиве ссылок
Private objHTTP As Object
Private Sub Class_Initialize()
Const WinHttpRequestOption_EnableHttpsToHttpRedirects = 12
Set objHTTP = CreateObject("WinHttp.WinHttpRequest.5.1")
'Enable redirection from HTTPS to HTTP (is Off by default)
objHTTP.Option(WinHttpRequestOption_EnableHttpsToHttpRedirects) = True
End Sub
После каждого исправления я не возражаю, а благодарю. Да вообще-то я так НЕ говорил и НЕ думал, а точно знал, что использую позднее связывание. Повторюсь, я об этом так и написал. А ты решил из этого выдумать мою ошибку.Хакер писал(а):Помимо того, что это выглядит глупо, это ещё и совершенно непродуктивно. Твоё дело меньше возражать, больше слушать и впитывать информацию, а не после каждого исправления возражать «да вообще-то я так и думал, я это и имел в виду, вы не подумайте!».
окей, где в твоём вопросе ну хотя бы исправление ошибки которую ты себе придумал? И об этом ты говоришь, как об исправлении и негодуешь! Помимо того, что отвечать вопросом на вопрос выглядит глупо, это ещё и контрпродуктивно.Хакер писал(а):Adam Smith писал(а):
- Код: Выделить всё
Set objHTTP = CreateObject("WinHttp.WinHttpRequest.5.1")
objHTTP.Option(WinHttpRequestOption_EnableHttpsToHttpRedirects) = True
Где тут признаки позднего связывания?
Хакер писал(а):Где тут признаки позднего связывания?
Adam Smith писал(а):Ну даже если бы я объявил переменную как вариант это ни разу не делает позднее связывание ранним.
Adam Smith писал(а):CreateObject я очевидно использую потому, что не подключил WinHTTP в референсах.
HRESULT GetResponseHeader(
[in] BSTR Header,
[out, retval] BSTR *Value
);
objHTTP.GetResponseHeader("Content-Type") в Byte
objHTTP.GetResponseHeader("Content-Length") в Long 'или в Decimal
objHTTP.GetResponseHeader("Last-Modified") в Date
Сейчас этот форум просматривают: AhrefsBot и гости: 77