Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- #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
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement