Форум программистов, компьютерный форум, киберфорум
Наши страницы
Basic
Войти
Регистрация
Восстановить пароль
 
Рейтинг 4.75/4: Рейтинг темы: голосов - 4, средняя оценка - 4.75
Замабувараев
349 / 355 / 93
Регистрация: 18.12.2014
Сообщений: 722
Записей в блоге: 1
1

FreeBASIC и сети

17.07.2017, 15:45. Просмотров 773. Ответов 3

Здравствуй, форум. Всё дело в том, что есть одни сетевые функции, и для этих функций Я решил написать обёртку. Чтобы не возиться созданием сокетов.

Заголовочный файл "Network.bi"
QBasic/QuickBASIC
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
#ifndef unicode
    #define unicode
#endif
#include once "windows.bi"
#include once "win\winsock2.bi"
#include once "win\ws2tcpip.bi"
 
' Соединиться с сервером и вернуть сокет
DECLARE FUNCTION ConnectToServer(BYVAL sServer AS WString Ptr, BYVAL Port AS WString Ptr, BYVAL LocalAddress AS WString Ptr, BYVAL LocalPort AS WString Ptr)AS SOCKET
 
' Создать прослушивающий сокет, привязанный к адресу
DECLARE FUNCTION CreateSocketAndListen(BYVAL LocalAddress AS WString Ptr, BYVAL LocalPort AS WString Ptr)AS SOCKET
 
' Закрывает сокет
DECLARE SUB CloseSocketConnection(BYVAL mSock AS SOCKET)
 
' Создать сокет, привязанный к адресу
DECLARE FUNCTION CreateSocketAndBind(BYVAL sServer AS WString Ptr, BYVAL Port AS WString Ptr)AS SOCKET
 
' Разрешение доменного имени
DECLARE FUNCTION ResolveHost(BYVAL sServer AS WString Ptr, BYVAL Port AS WString Ptr)AS addrinfoW Ptr
Файл "Network.bas"
QBasic/QuickBASIC
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
#include once "Network.bi"
 
SUB CloseSocketConnection(BYVAL mSock AS SOCKET)
    Shutdown(mSock, 2)
    closesocket(mSock)
END SUB
 
FUNCTION ResolveHost(BYVAL sServer AS WString Ptr, BYVAL Port AS WString Ptr)AS addrinfoW Ptr
    DIM hints AS addrinfoW
    ' Если стоит AF_UNSPEC, то неважно, IPv4 или IPv6
    hints.ai_family = AF_UNSPEC ' AF_INET или AF_INET6
    hints.ai_socktype = SOCK_STREAM
    hints.ai_protocol = IPPROTO_TCP
    
    DIM pResult AS addrinfoW Ptr = 0
    IF GetAddrInfoW(sServer, Port, @hints, @pResult) = 0 THEN
        RETURN pResult
    END IF
    RETURN 0
END FUNCTION
 
FUNCTION CreateSocketAndBind(BYVAL sServer AS WString Ptr, BYVAL Port AS WString Ptr)AS SOCKET
    ' Открыть сокет
    DIM iSocket AS SOCKET = socket_(AF_UNSPEC, SOCK_STREAM, IPPROTO_TCP)
    IF iSocket <> INVALID_SOCKET THEN
        ' Привязать адрес к сокету
        DIM localIpList AS addrinfoW Ptr = ResolveHost(sServer, Port)
        IF localIpList <> 0 THEN
            ' Обойти список адресов и сделать привязку
            DIM pPtr AS addrinfoW Ptr = localIpList
            DIM BindResult AS INTEGER = ANY
            DO
                BindResult = bind(iSocket, Cast(LPSOCKADDR, pPtr->ai_addr), pPtr->ai_addrlen)
                IF BindResult = 0 THEN
                    ' Привязано
                    EXIT DO
                END IF
                pPtr = pPtr->ai_next
            LOOP UNTIL pPtr = 0
            ' Очистка
            FreeAddrInfoW(localIpList)
            ' Привязались к адресу
            IF BindResult = 0 THEN
                RETURN iSocket
            END IF
        END IF
        CloseSocketConnection(iSocket)
    END IF
    RETURN INVALID_SOCKET
END FUNCTION
 
FUNCTION CreateSocketAndListen(BYVAL LocalAddress AS WString Ptr, BYVAL LocalPort AS WString Ptr)AS SOCKET
    ' Открыть сокет
    DIM iSocket AS SOCKET = CreateSocketAndBind(LocalAddress, LocalPort)
    IF iSocket <> INVALID_SOCKET THEN
        ' Начать прослушивание
        IF listen(iSocket, 1) <> SOCKET_ERROR THEN
            RETURN iSocket
        END IF
        CloseSocketConnection(iSocket)
    END IF
    RETURN INVALID_SOCKET
END FUNCTION
 
FUNCTION ConnectToServer(BYVAL sServer AS WString Ptr, BYVAL Port AS WString Ptr, BYVAL LocalAddress AS WString Ptr, BYVAL LocalPort AS WString Ptr)AS SOCKET
    ' Открыть сокет
    DIM iSocket AS SOCKET = CreateSocketAndBind(LocalAddress, LocalPort)
    IF iSocket <> INVALID_SOCKET THEN
        ' Привязать адрес к сокету
        DIM localIpList AS addrinfoW Ptr = ResolveHost(sServer, Port)
        IF localIpList <> 0 THEN
            ' Обойти список адресов и сделать привязку
            DIM pPtr AS addrinfoW Ptr = localIpList
            DIM ConnectResult AS INTEGER = ANY
            DO
                ConnectResult = connect(iSocket, Cast(LPSOCKADDR, pPtr->ai_addr), pPtr->ai_addrlen)
                IF ConnectResult = 0 THEN
                    ' Соединено
                    EXIT DO
                END IF
                pPtr = pPtr->ai_next
            LOOP UNTIL pPtr = 0
            ' Очистка
            FreeAddrInfoW(localIpList)
            ' Соединение установлено
            IF ConnectResult = 0 THEN
                RETURN iSocket
            END IF
        END IF
        CloseSocketConnection(iSocket)
    END IF
    RETURN INVALID_SOCKET
END FUNCTION
Добавлено через 1 час 5 минут
Вот пример создания сервера, который принимает данные от клиента и отправляет их обратно.

QBasic/QuickBASIC
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
#include once "Network.bi"
 
' IP‐адрес, с которого сервер будет принимать соединения
CONST LocalAddress = "0.0.0.0"
CONST LocalPort = "8080"
CONST BufferSize AS INTEGER = 4096
 
DIM objWsaData AS WSAData = ANY
IF WSAStartup(MAKEWORD(2, 2), @objWsaData) <> NO_ERROR THEN
    ' Ошибка инициализации
    END(1)
END IF
 
' Создать прослушивающий сокет
DIM ListenSocket AS SOCKET = CreateSocketAndListen(LocalAddress, LocalPort)
IF ListenSocket = INVALID_SOCKET THEN
    ' Ошибка создания прослушивающего сокета
    WSACleanup()
    END(2)
END IF
 
' Принять соединение
DIM RemoteAddress AS SOCKADDR_IN = ANY
DIM RemoteAddressLength AS LONG = SizeOf(RemoteAddress)
DIM ClientSocket AS SOCKET = accept(ListenSocket, CPtr(SOCKADDR Ptr, @RemoteAddress), @RemoteAddressLength)
 
DO UNTIL ClientSocket = INVALID_SOCKET
    DIM buffer AS ZString * BufferSize = ANY
    ' Принять данные от клиента
    DIM intReceivedBytesCount AS INTEGER = recv(ClientSocket, @buffer, BufferSize, 0)
    IF intReceivedBytesCount > 0 OrElse intReceivedBytesCount <> SOCKET_ERROR THEN
        ' Отправить обратно их же
        DIM intSendBytesCount AS INTEGER = send(ClientSocket, @buffer, intReceivedBytesCount, 0)
    END IF
    ' Закрыть
    CloseSocketConnection(ClientSocket)
    ' Принять вновь
    ClientSocket = accept(ListenSocket, CPtr(SOCKADDR Ptr, @RemoteAddress), @RemoteAddressLength)
LOOP
 
' Закрыть
CloseSocketConnection(ListenSocket)
WSACleanup()
Добавлено через 1 минуту
А вот пример создания клиента, который соединяется с сервером, отправляет данные, принимает данные, выводит их на консоль и завершается.

QBasic/QuickBASIC
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
#include once "Network.bi"
 
' Адрес сервера
CONST ServerAddress = "127.0.0.1"
' Порт сервера
CONST ServerPort = "8080"
' Адрес сетевой карты, с которого будет идти соединение к серверу
CONST LocalBindAddress = "0.0.0.0"
CONST LocalBindPort = "0"
 
CONST BufferSize AS INTEGER = 4096
 
DIM objWsaData AS WSAData = ANY
IF WSAStartup(MAKEWORD(2, 2), @objWsaData) <> NO_ERROR THEN
    ' Ошибка инициализации
    END(1)
END IF
 
' Соединиться с сервером
DIM ClientSocket AS SOCKET = ConnectToServer(@ServerAddress, @ServerPort, @LocalBindAddress, @LocalBindPort)
IF ClientSocket = INVALID_SOCKET THEN
    PRINT "Ошибка"
ELSE
    ' Отправить строку "Привет, мир!" на сервер
    CONST HelloWorld = "Привет, мир!"
    send(ClientSocket, CPtr(ZString Ptr, @HelloWorld), (LEN(HelloWorld) + 1) * SizeOf(WString), 0)
    
    ' Принять данные с сервера
    DIM buffer AS WString * BufferSize = ANY
    DIM intBytesCount AS INTEGER = recv(ClientSocket, CPtr(ZString Ptr, @buffer), BufferSize, 0)
    ' Напечатать
    PRINT buffer
END IF
 
' Закрыть
CloseSocketConnection(ClientSocket)
WSACleanup()
2
Similar
Эксперт
41792 / 34177 / 6122
Регистрация: 12.04.2006
Сообщений: 57,940
17.07.2017, 15:45
Ответы с готовыми решениями:

FreeBASIC
Заметил, что уже имеющиеся на форуме темы в разделах: - QBasic - Visual Basic - VBA - Pure...

Немного о FreeBasic
Чаще всего при начальном использовании какого-то языка , люди стараются выбрать простую,...

Графика FreeBasic
Приветствую всех cyber-форумчан!:) Несмотря на наличие графического треда в младшем разделе,...

Осваиваю (ем) FreeBasic
Решил больше не тянуть, а приступить сегодня. Если тема будет актуальна - возможно модераторы...

FreeBasic. MyFbFramework + VisualFBEditor
Начал новый фреймворк для FreeBasic: MyFbFramework И редактор для него: VisualFBEditor Файлы...

3
Quiet Snow
4416 / 1313 / 378
Регистрация: 25.04.2010
Сообщений: 3,411
24.07.2017, 14:15 2
Код не проверял, но плюсану. Стас уже выкладывал что-то подобное, но там без обёрток.
0
mypostconstrain
0 / 0 / 0
Регистрация: 28.08.2017
Сообщений: 1
17.12.2017, 03:20 3
Помощи не жди называется)
0
Замабувараев
349 / 355 / 93
Регистрация: 18.12.2014
Сообщений: 722
Записей в блоге: 1
25.12.2017, 20:34  [ТС] 4
Цитата Сообщение от mypostconstrain Посмотреть сообщение
Помощи не жди называется)
Что именно не работает?
0
25.12.2017, 20:34
MoreAnswers
Эксперт
37091 / 29110 / 5898
Регистрация: 17.06.2006
Сообщений: 43,301
25.12.2017, 20:34

FreeBasic круги на воде
Очень интересный код имитирующий распространение кругов на воде. Описание алгоритма тут Что меня...

Синтаксические особенности FreeBasic
По совету Stabud создаю тему, в которой будем обсуждать семантику и синтаксис диалекта FreeBasic....

Задача на графику в FreeBASIC
Помогите с задача по графике в FreeBASIC Построить совокупность n равных отрезков, центры которых...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
4
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2019, vBulletin Solutions, Inc.
Рейтинг@Mail.ru