Exampel source code how to create simple HTTP proxy for sharing Web access between computers in Visual Basic, minimum requirements: VB5 Pro.



Project: Standard EXE
ActiveX Controls/Objects: MSWINSCK.OCX
Controls: cmdStart (CommandButton), txtPort (TextBox), wsTCP (Winsock), _
wsProxy (Winsock), lblStatus (Label), Label1 (Label)

Code:
Option Explicit

Dim s(255) As String
Dim h(255) As String
Dim p(255) As String
Dim i As Integer

Private Sub cmdStart_Click()
If cmdStart.Caption = "Start" Then
wsTCP(0).LocalPort = txtPort
wsTCP(0).Listen
lblStatus = "Running..."
cmdStart.Caption = "Stop"
Else
cmdStart.Caption = "Start"
wsTCP(0).Close
lblStatus = "Stopped"
End If
End Sub
Private Sub wsProxy_Close(Index As Integer)
On Error Resume Next
Unload wsProxy(Index)
wsTCP(Index).SendData p(Index)
End Sub

Private Sub wsProxy_Connect(Index As Integer)
wsProxy(Index).SendData s(Index)
End Sub

Private Sub wsProxy_DataArrival(Index As Integer, ByVal bytesTotal As Long)
wsProxy(Index).GetData h(Index)
Debug.Print "(" & Index & ") " & h(Index)
p(Index) = p(Index) & h(Index)
End Sub

Private Sub wsProxy_Error(Index As Integer, 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)
Debug.Print "(" & Index & ") Error " & Number & ": " & Description
Unload wsProxy(Index)
End Sub

Private Sub wsTCP_Close(Index As Integer)
Unload wsTCP(Index)
End Sub

Private Sub wsTCP_ConnectionRequest(Index As Integer, ByVal requestID As Long)
i = i + 1
Load wsTCP(i)
Load wsProxy(i)
wsTCP(i).Accept requestID
End Sub

Private Sub wsTCP_DataArrival(Index As Integer, ByVal bytesTotal As Long)
wsTCP(Index).GetData s(Index)
Debug.Print "(" & Index & ") " & s(Index)
Dim strHost As String, iPort As Integer
iPort = 80
If InStr(UCase(s(Index)), "GET ") > 0 Then
strHost = Mid(s(Index), InStr(UCase(s(Index)), "GET ") + 4)
ElseIf InStr(UCase(s(Index)), "PUT ") > 0 Then
strHost = Mid(s(Index), InStr(UCase(s(Index)), "PUT ") + 4)
Else
wsTCP(Index).SendData "Mailformed HTTP request"
Exit Sub
End If
strHost = Left(strHost, InStr(strHost, " ") - 1)
If InStr(strHost, "://") <> 0 Then strHost = Mid(strHost, InStr(strHost, "://") + 3)
If InStr(strHost, ":") <> 0 Then
iPort = Val(Mid(strHost, InStr(strHost, ":") + 1))
strHost = Left(strHost, InStr(strHost, ":") - 1)
End If
If InStr(strHost, "/") > 0 Then strHost = Left(strHost, InStr(strHost, "/") - 1)
With wsProxy(Index)
.RemoteHost = strHost
.RemotePort = iPort
.Connect
End With
End Sub

Private Sub wsTCP_Error(Index As Integer, 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)
Debug.Print "(" & Index & ") Error " & Number & ": " & Description
Unload wsTCP(Index)
End Sub

Private Sub wsTCP_SendComplete(Index As Integer)
wsTCP(Index).Close
End Sub

'end code
'source: ostrosoft.com

0 komentar:

 
Top