SocketProxy

#ifndef unicode
    #define unicode
#endif
#include "windows.bi"
#include once "win\winsock2.bi"
#include once "win\ws2tcpip.bi"

' Инкапсуляция клиентского и серверного сокетов как параметр для процедуры потока
Type ClientServerSocket
    Dim InSock As SOCKET
    Dim OutSock As SOCKET
End Type

Declare Function CommandLineToArgv Alias "CommandLineToArgvW"(ByVal CommandLineString As WString Ptr, ByVal ArgsCount As Integer Ptr)As WString Ptr Ptr
Declare Function ThreadProc(ByVal lpParam As LPVOID)As DWORD
' Соединиться с сервером и вернуть сокет
Declare Function ConnectToServer(ByRef sServer As WString, ByVal mPort As Integer, ByRef localServer As WString, ByVal LocalPort As Integer)As SOCKET
' Создать сокет и привязать к адресу
Declare Function CreateSocketAndBind(ByRef localServer As WString, ByVal LocalPort As Integer)As SOCKET
' Создать прослушивающий сокет
Declare Function CreateSocketAndListen(ByRef localServer As WString, ByVal LocalPort As Integer)As SOCKET
' Получение данных от входящего соединения и отправка исходящему
Declare Function SendReceiveData(ByVal Flag As Integer, ByVal InSock As SOCKET, ByVal OutSock As SOCKET) As Integer

' Закрывает сокет
Declare Sub CloseSocketConnection(ByVal mSock As SOCKET)
' Разрешение доменного имени
Declare Function ResolveHost(ByRef sServer As WString)As Integer
Extern "C"
    ' Возвращает указатель на подстроку в строке
    Declare Function wcsstrW Alias "wcsstr"(ByVal Instring As WString Ptr, ByVal Pattern As WString Ptr)As WString Ptr
    ' Строку в Integer
    Declare Function wtoi Alias "_wtoi"(ByVal s As WString Ptr)As Integer
End Extern

' Размер буфера
Const MaxBytesCount As Integer = 2048

' Разрешает доменное имя
Function ResolveHost(ByRef sServer As WString)As Integer
    Dim intDataLength As Integer = lstrlen(sServer)
    ' Перекодируем в байты utf8
    Dim intBytesCount As Integer = WideCharToMultiByte(CP_UTF8, 0, sServer, intDataLength, 0, 0, 0, 0)
    Dim bytes As ZString*MaxBytesCount = Any
    WideCharToMultiByte(CP_UTF8, 0, sServer, intDataLength, bytes, intBytesCount, 0, 0)
    bytes[intBytesCount] = 0

    Dim ia As in_addr
    Dim hostentry As hostent Ptr

    ia.S_addr = inet_addr(bytes)
    If ia.S_addr = INADDR_NONE Then
        hostentry = gethostbyname(bytes)
        If hostentry <> 0 Then
            Return *CPtr(Integer Ptr, *hostentry->h_addr_list)
        End If
    Else
        Return ia.S_addr
    End if
End Function

' Закрывает сокет
Sub CloseSocketConnection(ByVal mSock As SOCKET)
    Shutdown(mSock, 2)
    closesocket(mSock)
End Sub

Function CreateSocketAndBind(ByRef localServer As WString, ByVal LocalPort As Integer)As SOCKET
    ' Открыть сокет
    Dim iSocket As SOCKET = WSASocket(AF_INET, SOCK_STREAM, IPPROTO_TCP, 0, 0, WSA_FLAG_OVERLAPPED)
    If iSocket <> INVALID_SOCKET Then
        ' Привязать адрес к сокету
        Dim localIp As Integer = ResolveHost(LocalServer)
        Dim localSa As sockaddr_in
        With localSa
            .sin_port = htons(LocalPort)
            .sin_family = AF_INET
            .sin_addr.S_addr = localIp
        End With
        If bind(iSocket, Cast(PSOCKADDR, @localSa), SizeOf(localSa)) <> SOCKET_ERROR Then
            Return iSocket
        End If
    End If
    CloseSocketConnection(iSocket)
    Return INVALID_SOCKET
End Function

' Открывает соединение с сервером
Function ConnectToServer(ByRef sServer As WString, ByVal mPort As Integer, ByRef localServer As WString, ByVal LocalPort As Integer)As SOCKET
    ' Открыть сокет
    Dim iSocket As SOCKET = CreateSocketAndBind(localServer, LocalPort)
    If iSocket <> INVALID_SOCKET Then
        Dim ip As Integer = ResolveHost(sServer)
        If ip <> 0 Then
            Dim sa As sockaddr_in
            With sa
                .sin_port = htons(mPort)
                .sin_family = AF_INET
                .sin_addr.S_addr = ip
            End With
            If WSAConnect(iSocket, Cast(PSOCKADDR, @sa), SizeOf(sa), 0, 0, 0, 0) = 0 Then
                Return iSocket
            End If
        End If
    End If
    CloseSocketConnection(iSocket)
    Return INVALID_SOCKET
End Function

Function CreateSocketAndListen(ByRef localServer As WString, ByVal LocalPort As Integer)As SOCKET
    ' Открыть сокет
    Dim iSocket As SOCKET = CreateSocketAndBind(localServer, LocalPort)
    If iSocket <> INVALID_SOCKET Then
        ' Начать прослушивание
        If listen(iSocket, 1) <> SOCKET_ERROR Then
            Return iSocket
        End If
    End If
    CloseSocketConnection(iSocket)
    Return INVALID_SOCKET
End Function

' Приём данных от сервера и отправка клиенту в отдельном потоке
Function ThreadProc(ByVal lpParam As LPVOID)As DWORD
    Dim objClientServerSocket As ClientServerSocket Ptr = lpParam
    Return SendReceiveData(1, objClientServerSocket->InSock, objClientServerSocket->OutSock)
End Function

Function SendReceiveData(ByVal Flag As Integer, ByVal InSock As SOCKET, ByVal OutSock As SOCKET) As Integer
    Dim ReceiveBuffer As ZString*MaxBytesCount = Any
    Do
        ' Читать данные из входящего сокета, отправляю на исходящий
        Dim intReceivedBytesCount As Integer = recv(InSock, ReceiveBuffer, MaxBytesCount, 0)
        If intReceivedBytesCount > 0 Then
            ' Отправить данные
            If send(OutSock, ReceiveBuffer, intReceivedBytesCount, 0) = SOCKET_ERROR Then
                Return SOCKET_ERROR
            End If
        Else
            Return SOCKET_ERROR
        End If
    Loop
    Return 0
End Function

/'
    Параметры
    1 — локальный адрес адаптера, через который будет идти соединение с сервером
    2 — локальный порт
    3 — адрес сервера
    4 — порт сервер
    5 — адрес, с которым будет соединяться клиент
    6 — порт, с которым будет соединяться клиент
'/
Function ConsoleEntryPoint Alias "ConsoleEntryPoint"()As Integer
    ' Параметры командной строки
    Dim ArgsCount As Integer = Any
    Dim Args As WString Ptr Ptr = CommandLineToArgv(GetCommandLine(), @ArgsCount)
    ' Инициализация сокетов
    Dim objWsaData As WSAData
    If WSAStartup(MAKEWORD(2, 2), @objWsaData) = NO_ERROR Then
        ' Открыть слушатель на локалхосте
        Dim ListenSocket As SOCKET = CreateSocketAndListen(*Args[5], wtoi(Args[6]))
        If ListenSocket = INVALID_SOCKET Then
            ConsoleEntryPoint = 2
        Else
            ' Принять соединение
            Dim AcceptSocket As SOCKET = accept(ListenSocket, 0, 0)
            If AcceptSocket = INVALID_SOCKET Then
                ConsoleEntryPoint = 3
            Else
                ' Соединиться с сервером
                Dim ClientSocket As SOCKET = ConnectToServer(*Args[3], wtoi(Args[4]), *Args[1], wtoi(Args[2]))
                If ClientSocket = INVALID_SOCKET Then
                    ConsoleEntryPoint = 4
                Else
                    Dim objClientServerSocket As ClientServerSocket = Any
                    With objClientServerSocket
                        .InSock = ClientSocket
                        .OutSock = AcceptSocket
                    End With
                    ' Запустить поток чтения данных от сервера   , передать клиентский сокет в качестве параметра
                    Dim hThread As HANDLE = CreateThread(NULL, 0, @ThreadProc, @objClientServerSocket, 0, NULL)

                    ' Получить данные от клиента и отправить на сервер
                    SendReceiveData(0, AcceptSocket, ClientSocket)
                End If
                CloseSocketConnection(ClientSocket)
                CloseSocketConnection(AcceptSocket)
            End If
        End If
        CloseSocketConnection(ListenSocket)
        ' При ошибках чтения‐записи закрывать соединение и выходить
        WSACleanup()
        ConsoleEntryPoint = 0
    Else
        ConsoleEntryPoint = 1
    End If
    ' Очистка памяти от параметров программы
    LocalFree(Args)
End Function