'In 1st form
Private Sub Form_Load()
Dim sSave As String
hwnd1 = Me.hwnd
HookForm hwnd1, Me
StartWinsock sSave
lSocket1 = ConnectSock("finance.yahoo.com", 80, 0, Me.hwnd, False)
End Sub
Private Sub Form_Unload()
closesocket lSocket1
EndWinsock
UnHookForm Me.hwnd
End Sub
'In 2nd form
Private Sub Form_Load()
Dim sSave As String
hwnd2 = Me.hwnd
HookForm hwnd2, Me
StartWinsock sSave
lSocket2 = ConnectSock("finance.yahoo.com", 80, 0, Me.hwnd, False)
End Sub
Private Sub Form_Unload()
closesocket lSocket2
EndWinsock
UnHookForm Me.hwnd
End Sub
'In a standard module. Public variables Form1, Form2, lSocket1, lSocket2, hwnd1, hwnd2
Public Sub HookForm(ByVal hwnd As Long, f As Object)
Select Case hwnd
Case hwnd1: Set Form1 = f
Case hwnd2: Set Form2 = f
End Select
PrevProc = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf WindowProc)
End Sub
Public Sub UnHookForm(ByVal hwnd As Long)
If PrevProc <> 0 Then
SetWindowLong hwnd, GWL_WNDPROC, PrevProc
PrevProc = 0
End If
End Sub
Public Function WindowProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
If uMsg = WINSOCKMSG Then
ProcessMessage wParam, lParam
Else
WindowProc = CallWindowProc(PrevProc, hwnd, uMsg, wParam, lParam)
End If
End Function
Public Sub ProcessMessage(ByVal lFromSocket As Long, ByVal lParam As Long)
Dim X As Long, ReadBuffer(1 To 1024) As Byte, strCommand As String
Select Case lParam
Case FD_CONNECT
Case FD_WRITE
Select Case lFromSocket
Case lSocket1
strCommand = "GET /q?s=INTC HTTP/1.0" + vbCrLf
strCommand = strCommand + "Pragma: no-cache" + vbCrLf
strCommand = strCommand + "Accept: */*" + vbCrLf
strCommand = strCommand + "Accept: text/html" + vbCrLf + vbCrLf
SendData lFromSocket, strCommand
Case lSocket2
strCommand = "GET /q?s=GE HTTP/1.0" + vbCrLf
strCommand = strCommand + "Pragma: no-cache" + vbCrLf
strCommand = strCommand + "Accept: */*" + vbCrLf
strCommand = strCommand + "Accept: text/html" + vbCrLf + vbCrLf
SendData lFromSocket, strCommand
End Select
Case FD_READ
Select Case lFromSocket
Case lSocket1
Do
X = recv(lFromSocket, ReadBuffer(1), 1024, 0)
If X > 0 Then
strData1 = strData1 + Left$(StrConv(ReadBuffer, vbUnicode), X)
Debug.Print X; " bytes read....." & lFromSocket
End If
If X <> 1024 Then Exit Do
Loop
Case lSocket2
Do
X = recv(lFromSocket, ReadBuffer(1), 1024, 0)
If X > 0 Then
strData2 = strData2 + Left$(StrConv(ReadBuffer, vbUnicode), X)
Debug.Print X; " bytes read..............." & lFromSocket
End If
If X <> 1024 Then Exit Do
Loop
End Select
Case FD_CLOSE
Select Case lFromSocket
Case lSocket1
Unload Form1
Set Form1 = Nothing
Debug.Print strData1
strData1 = vbNullString
Case lSocket2
Unload Form2
Set Form2 = Nothing
Debug.Print strData2
strData2 = vbNullString
End Select
End Select
End Sub