Tutorial Simple HTTP proxy in VB |
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 |
