Imports System
Imports System.IO
Imports System.Linq
Imports System.Net
Imports System.Text
Imports System.Threading.Tasks
Public Class SimpleProxy
Private ReadOnly _listenPort As Integer
Private ReadOnly _forwardPort As Integer
Private ReadOnly _forwardHost As String = "localhost"
Public Sub New(listenPort As Integer, forwardPort As Integer)
_listenPort = listenPort
_forwardPort = forwardPort
End Sub
'This is required or will receive access denied
'netsh http add urlacl url=http://{WANIP}:8080/ user=EVERYONE 'WanIP
'netsh http add urlacl url=http://192.168.0.XX:8080/ user=EVERYONE 'LANIP,
'netsh http add urlacl url=http://+:8080/ user=EVERYONE 'All IP's <-- requires admin during runtime
'netsh http add urlacl url=http://MyHostName.com:8080/ user=EVERYONE <-- DNS name
Public Async Function Start(HostnameOrIP As String) As Task
Dim listener As New HttpListener()
Dim AddressToListenOn As String = $"http://{HostnameOrIP}:{_listenPort}/"
listener.Prefixes.Add(AddressToListenOn)
listener.Start()
Debug.WriteLine($"Proxy listening on {AddressToListenOn}, forwarding to {_forwardHost}:{_forwardPort}")
Do While True
Try
Dim context As HttpListenerContext = Await listener.GetContextAsync()
ProcessRequest(context) ' Fire and forget Async Sub
Catch ex As HttpListenerException
If ex.ErrorCode = 995 Then Return ' Listener closed (occurs during shutdown)
Debug.WriteLine($"Listener Error: {ex.Message}")
Catch ex As Exception
Debug.WriteLine($"Error accepting request: {ex.Message}")
End Try
Loop
End Function
Private Async Sub ProcessRequest(context As HttpListenerContext)
Dim incomingRequest As HttpListenerRequest = context.Request
Dim proxyResponse As HttpListenerResponse = context.Response
Dim targetUrl As String = $"http://{_forwardHost}:{_forwardPort}{incomingRequest.RawUrl}"
Dim forwardRequest As HttpWebRequest = DirectCast(WebRequest.Create(targetUrl), HttpWebRequest)
Try
forwardRequest.Method = incomingRequest.HttpMethod
forwardRequest.ProtocolVersion = incomingRequest.ProtocolVersion
forwardRequest.UserAgent = incomingRequest.UserAgent
If incomingRequest.UrlReferrer IsNot Nothing Then
forwardRequest.Referer = incomingRequest.UrlReferrer.AbsoluteUri
End If
forwardRequest.KeepAlive = incomingRequest.KeepAlive
forwardRequest.ServicePoint.Expect100Continue = False
For Each headerKey As String In incomingRequest.Headers.AllKeys
Dim value As String = incomingRequest.Headers(headerKey)
Try
Select Case headerKey.ToLowerInvariant()
Case "host"
forwardRequest.Host = $"{_forwardHost}:{_forwardPort}"
Case "connection"
If value.ToLowerInvariant().Contains("keep-alive") Then
forwardRequest.KeepAlive = True
ElseIf value.ToLowerInvariant().Contains("close") Then
forwardRequest.KeepAlive = False
Else
forwardRequest.Connection = value
End If
Case "content-length"
forwardRequest.ContentLength = incomingRequest.ContentLength64
Case "content-type"
forwardRequest.ContentType = incomingRequest.ContentType
Case "accept"
forwardRequest.Accept = value
Case "expect"
If String.Equals(value, "100-continue", StringComparison.OrdinalIgnoreCase) Then
Continue For
End If
forwardRequest.Headers.Add(headerKey, value)
Case "if-modified-since"
Dim dt As DateTime
If DateTime.TryParse(value, dt) Then
forwardRequest.IfModifiedSince = dt
End If
Case "user-agent", "referer", "proxy-connection"
' User-Agent and Referer already set or handled by specific properties, Proxy-Connection is hop-by-hop
Case Else
forwardRequest.Headers.Add(headerKey, value) 'Range=bytes=0-
End Select
Catch ex As Exception
' Skip restricted headers (e.g., if trying to set a protected header) or invalid values
End Try
Next
If incomingRequest.HttpMethod <> "GET" AndAlso incomingRequest.HttpMethod <> "HEAD" AndAlso incomingRequest.ContentLength64 > 0 Then
Using requestStream As Stream = Await forwardRequest.GetRequestStreamAsync()
Await incomingRequest.InputStream.CopyToAsync(requestStream)
End Using
ElseIf forwardRequest.Method = "POST" OrElse forwardRequest.Method = "PUT" Then
If forwardRequest.ContentLength <= 0 AndAlso Not incomingRequest.Headers.AllKeys.Any(Function(k) k.Equals("Transfer-Encoding", StringComparison.OrdinalIgnoreCase)) Then
forwardRequest.ContentLength = 0
End If
End If
Using targetResponse As HttpWebResponse = DirectCast(Await forwardRequest.GetResponseAsync(), HttpWebResponse)
proxyResponse.StatusCode = CInt(targetResponse.StatusCode)
proxyResponse.StatusDescription = targetResponse.StatusDescription
proxyResponse.ProtocolVersion = targetResponse.ProtocolVersion
Dim connHeaderValueTarget As String = targetResponse.Headers.Get("Connection")
If connHeaderValueTarget IsNot Nothing Then
proxyResponse.KeepAlive = connHeaderValueTarget.ToLowerInvariant().Contains("keep-alive")
Else
proxyResponse.KeepAlive = (targetResponse.ProtocolVersion >= HttpVersion.Version11)
End If
For i As Integer = 0 To targetResponse.Headers.Count - 1
Dim headerName As String = targetResponse.Headers.GetKey(i)
Dim headerValue As String = targetResponse.Headers.Get(i)
Select Case headerName.ToLowerInvariant()
Case "content-length"
proxyResponse.ContentLength64 = targetResponse.ContentLength
Case "content-type"
proxyResponse.ContentType = headerValue
Case "transfer-encoding", "connection", "keep-alive"
' Transfer-Encoding is handled by CopyToAsync and HttpListener itself.
' Connection and Keep-Alive headers from target are used to set proxyResponse.KeepAlive property.
Case Else
Try
proxyResponse.Headers.Add(headerName, headerValue)
Catch ex As Exception
' Skip restricted headers
End Try
End Select
Next
Using responseStream As Stream = targetResponse.GetResponseStream()
If responseStream IsNot Nothing Then
Await responseStream.CopyToAsync(proxyResponse.OutputStream)
End If
End Using
End Using
Catch webEx As WebException
Try
If webEx.Response IsNot Nothing AndAlso TypeOf webEx.Response Is HttpWebResponse Then
Dim errorResponse As HttpWebResponse = DirectCast(webEx.Response, HttpWebResponse)
proxyResponse.StatusCode = CInt(errorResponse.StatusCode)
proxyResponse.StatusDescription = errorResponse.StatusDescription
proxyResponse.ProtocolVersion = errorResponse.ProtocolVersion
For i As Integer = 0 To errorResponse.Headers.Count - 1
Dim headerName As String = errorResponse.Headers.GetKey(i)
Dim headerValue As String = errorResponse.Headers.Get(i)
Select Case headerName.ToLowerInvariant()
Case "content-length" : proxyResponse.ContentLength64 = errorResponse.ContentLength
Case "content-type" : proxyResponse.ContentType = headerValue
Case Else
Try : proxyResponse.Headers.Add(headerName, headerValue)
Catch : End Try ' Skip restricted
End Select
Next
If errorResponse.ContentLength > 0 Then
Using errorStream As Stream = errorResponse.GetResponseStream()
If errorStream IsNot Nothing Then
' Using synchronous Write in Catch block
Dim buffer(4095) As Byte ' 4KB buffer
Dim bytesRead As Integer
Do
bytesRead = errorStream.Read(buffer, 0, buffer.Length)
If bytesRead > 0 Then
proxyResponse.OutputStream.Write(buffer, 0, bytesRead)
End If
Loop While bytesRead > 0
End If
End Using
End If
errorResponse.Close()
Else
proxyResponse.StatusCode = 502 ' Bad Gateway
proxyResponse.StatusDescription = "Bad Gateway"
Dim body As Byte() = Encoding.UTF8.GetBytes($"Proxy error (WebException without HTTP response): {webEx.Message}")
proxyResponse.ContentType = "text/plain"
proxyResponse.ContentLength64 = body.Length
proxyResponse.OutputStream.Write(body, 0, body.Length) ' Synchronous Write
End If
Catch exInner As Exception
' If setting the error response itself fails (e.g., headers already sent)
Debug.WriteLine($"Failed to send error response: {exInner.Message}")
End Try
Catch ex As Exception
Try
proxyResponse.StatusCode = 500 ' Internal Server Error
proxyResponse.StatusDescription = "Internal Server Error"
Dim body As Byte() = Encoding.UTF8.GetBytes($"Proxy error (General exception): {ex.Message}")
proxyResponse.ContentType = "text/plain"
proxyResponse.ContentLength64 = body.Length
proxyResponse.OutputStream.Write(body, 0, body.Length) ' Synchronous Write
Catch exInner As Exception
Debug.WriteLine($"Failed to send 500 error response: {exInner.Message}")
End Try
Finally
Try
proxyResponse.Close()
Catch finalEx As Exception
Debug.WriteLine($"Error closing proxyResponse: {finalEx.Message}")
End Try
End Try
End Sub
End Class