Проксирующая утилита

Задача. Имеется два сетевых адаптера, однако в Миранде никак нельзя настроить, чтобы она соединялась с сервером через конкретный адаптер, она соединяется только через адрес 0.0.0.0. Нужно написать небольшую утилиту, с которой будет соединяться Миранда, а утилита будет соединяться с сервером через конкретный адаптер. Пример: есть проводная сетевая карта с айпишником 192.168.1.10 и беспроводная вайфайная сетевая карта с адресом 192.168.43.68, необходимо, чтобы трафик до сервера шёл только через 192.168.43.68, а не через 0.0.0.0.
Вот код утилиты SocketProxy.bas

Код:



#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 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 = 8192

' Разрешает доменное имя
Private 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 = Any
   Dim hostentry As hostent Ptr = Any
   
   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 = Any
      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 = Any
         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
   Return SendReceiveData(CPtr(ClientServerSocket Ptr, lpParam)->InSock, CPtr(ClientServerSocket Ptr, lpParam)->OutSock)
End Function

Function SendReceiveData(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(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



Я буду компилировать без встроенной библиотеки времени выполнения. Вот командный файл для компиляции:

Код:



"%programfiles%\freebasic\fbc.exe" -r -lib SocketProxy.bas
cscript //Nologo RemoveLines.vbs "SocketProxy.asm"
"%ProgramFiles%\FreeBASIC\bin\win32\as.exe" --32 --strip-local-absolute "SocketProxy.asm" -o "SocketProxy.o"
"%ProgramFiles%\FreeBASIC\bin\win32\ld.exe" -m i386pe -e _ConsoleEntryPoint@0 -subsystem console -s --stack 1048576,1048576 -L "%programfiles%\freebasic\lib\win32" -L "./" "SocketProxy.o" -o "SocketProxy.exe" -( -lkernel32 -luser32 -lshell32 -lWs2_32 -lmsvcrt -ladvapi32 -)


Скрипт RemoveLines.vbs можно взять из https://freebasic.forum2x2.ru/t514-topic он используется для удаления лишнего кода из ассемблерного листинга.
В итоге утилита получается в три килобайта.

Для запуска утилиты можно создать командный файл с параметрами.
1. Айпишник, через который нужно пропускать трафик.
2. Номер порта, здесь использую 0, чтобы система сама определила номер порта.
3. Сервер, с которым необходимо связаться, здесь используется jabber.ru.
4. Порт сервера, тут 5222.
5. Локальный адрес, на котором утилита будет слушать подключения к самой себе.
6. Локальный порт.
Локальный адрес и порт нужно прописать в Миранде, чтобы с ними соединялась.

Код:


:startlabel
SocketProxy.exe 192.168.43.68 0 jabber.ru 5222 localhost 52123
echo %errorlevel%
goto startlabel


Очень полезный пример, благодарю!

Вот исходник, только использующий новый юникодный метод разрешения доменных имён. Также здесь можно использовать протокол IPv6 при установке соответствующего флага.

Код:



#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 Main(ByVal ArgsCount As Integer, ByVal Args As WString Ptr Ptr)As Integer
Declare Function ThreadProc(ByVal lpParam As LPVOID)As DWORD
' Соединиться с сервером и вернуть сокет
Declare Function ConnectToServer(ByRef sServer As WString, ByRef ServiceName As WString, ByRef localServer As WString, ByRef LocalServiceName As WString)As SOCKET
' Создать сокет и привязать к адресу
Declare Function CreateSocketAndBind(ByRef sServer As WString, ByRef ServiceName As WString)As SOCKET
' Создать прослушивающий сокет
Declare Function CreateSocketAndListen(ByRef localServer As WString, ByRef ServiceName As WString)As SOCKET
' Получение данных от входящего соединения и отправка исходящему
Declare Function SendReceiveData(ByVal InSock As SOCKET, ByVal OutSock As SOCKET) As Integer

' Закрывает сокет
Declare Sub CloseSocketConnection(ByVal mSock As SOCKET)
' Разрешение доменного имени
Declare Function ResolveHost(ByRef sServer As WString, ByRef ServiceName As WString)As addrinfoW Ptr

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

' Разрешает доменное имя
Private Function ResolveHost(ByRef sServer As WString, ByRef ServiceName As WString)As addrinfoW Ptr
   ' Параметр функции
   Dim hints As addrinfoW
   With hints
      ' Использовать IP протокол версии 4
      .ai_family = AF_INET ' Если стоит AF_UNSPEC, то неважно, IPv4 или IPv6
      .ai_socktype = SOCK_STREAM
      .ai_protocol = IPPROTO_TCP
   End With
   ' Связанный список результата
   Dim pResult As addrinfoW Ptr
   
   If GetAddrInfoW(sServer, ServiceName, @hints, @pResult) = 0 Then
      Return pResult
   Else
      Return 0
   End If
End Function

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

Function CreateSocketAndBind(ByRef sServer As WString, ByRef ServiceName As WString)As SOCKET
   ' Открыть сокет
   Dim iSocket As SOCKET = WSASocket(AF_INET, SOCK_STREAM, IPPROTO_TCP, 0, 0, WSA_FLAG_OVERLAPPED)
   If iSocket <> INVALID_SOCKET Then
      REM Print "Создал сокет"
      ' Привязать адрес к сокету
      Dim localIp As addrinfoW Ptr = ResolveHost(sServer, ServiceName)
      If localIp <> 0 Then
         ' Обойти список адресов и сделать привязку
         Dim pPtr As addrinfoW Ptr = localIp
         Do Until pPtr = 0
            If bind(iSocket, Cast(LPSOCKADDR, pPtr->ai_addr), pPtr->ai_addrlen) <> SOCKET_ERROR Then
               Exit Do
            End If
            pPtr = pPtr->ai_next
         Loop
         ' Очистка
         FreeAddrInfoW(localIp)
         Return iSocket
      End If
   End If
   CloseSocketConnection(iSocket)
   Return INVALID_SOCKET
End Function

' Открывает соединение с сервером
Function ConnectToServer(ByRef sServer As WString, ByRef ServiceName As WString, ByRef localServer As WString, ByRef LocalServiceName As WString)As SOCKET
   ' Открыть сокет
   Dim iSocket As SOCKET = CreateSocketAndBind(localServer, LocalServiceName)
   If iSocket <> INVALID_SOCKET Then
      ' Привязать адрес к сокету
      Dim localIp As addrinfoW Ptr = ResolveHost(sServer, ServiceName)
      If localIp <> 0 Then
         ' Обойти список адресов и сделать привязку
         Dim pPtr As addrinfoW Ptr = localIp
         Do Until pPtr = 0
            If WSAConnect(iSocket, Cast(LPSOCKADDR, pPtr->ai_addr), pPtr->ai_addrlen, 0, 0, 0, 0) <> SOCKET_ERROR Then
               Exit Do
            End If
            pPtr = pPtr->ai_next
         Loop
         ' Очистка
         FreeAddrInfoW(localIp)
         Return iSocket
      End If
   End If
   CloseSocketConnection(iSocket)
   Return INVALID_SOCKET
End Function

Function CreateSocketAndListen(ByRef localServer As WString, ByRef ServiceName As WString)As SOCKET
   ' Открыть сокет
   Dim iSocket As SOCKET = CreateSocketAndBind(localServer, ServiceName)
   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
   Return SendReceiveData(CPtr(ClientServerSocket Ptr, lpParam)->InSock, CPtr(ClientServerSocket Ptr, lpParam)->OutSock)
End Function

Function SendReceiveData(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 = Any
   If WSAStartup(MAKEWORD(2, 2), @objWsaData) = NO_ERROR Then
      ' Открыть слушатель на локалхосте
      Dim ListenSocket As SOCKET = CreateSocketAndListen(*Args[5], *Args[6])
      If ListenSocket = INVALID_SOCKET Then
         ConsoleEntryPoint = 2
      Else
         ' Принять соединение
         Dim AcceptSocket As SOCKET = WSAAccept(ListenSocket, 0, 0, 0, 0)
         If AcceptSocket = INVALID_SOCKET Then
            ConsoleEntryPoint = 3
         Else
            ' Соединиться с сервером
            Dim ClientSocket As SOCKET = ConnectToServer(*Args[3], *Args[4], *Args[1], *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(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