FreeBasic编写的PowerBasic内置网络函数

最新推荐文章于 2024-05-18 10:00:12 发布

aidendany

最新推荐文章于 2024-05-18 10:00:12 发布

阅读量259

点赞数

分类专栏： FreeBasic PowerBasic编程文章标签：经验分享 windows 青少年编程开发语言 Powered by 金山文档

本文链接：https://blog.csdn.net/aidendany/article/details/128705031

版权

PowerBasic编程同时被 2 个专栏收录

22 篇文章 1 订阅

订阅专栏

FreeBasic

18 篇文章 1 订阅

订阅专栏

利用freebasic编写了一遍powerbasic中内置的网络函数，为的是保留pb编程风格。

首先创建一个pb_winsock.bi库文件。

1、文件头

#include once "win/winsock2.bi"

#define TCP_ACCEPT  WM_USER + 4093 
#define TCP_ECHO  WM_USER + 4094 

#define LRCF CHR(10,13)
#define DEFAULT_BUFLEN 512

const NewLine = !"\r\n"

declare function HOST_ADDR ( hostname as string ) as ulong
declare function HOST_NAME ( byval ip as ulong ) as string
declare function TCP_OPEN ( srvc as string, address as string ) as SOCKET
declare function TCP_OPEN_PORT ( byval server_prot as long, server_addr as string ) as SOCKET
declare function TCP_OPEN_SERVER ( byval server_ip as long, byval server_prot as long ) as socket
declare function TCP_ACCEPTS ( byval hSocket as SOCKET ) as SOCKET
declare function TCP_NOTIFY ( byval hSocket as SOCKET, byval hWnd as HWND, byval wMsg as u_int, byval lEvent as long ) as long
declare sub TCP_RECV ( byval hSocket as SOCKET, byval strlen as integer, sBuffer as string )
declare sub TCP_SEND ( byval hSocket as SOCKET, sBuffer as string )
declare sub TCP_PRINT ( byval hSocket as SOCKET, sBuffer as string )
declare sub TCP_CLOSE ( byval hSocket as SOCKET )
declare function TCP_GetIP ( byval hSocket as SOCKET ) AS string
declare function TCP_GetProt ( byval hSocket as SOCKET ) AS string

2、函数定义

'======================================================================
' #INCLUDE ONCE "WinSock2.bi"
' Translate a host name into a corresponding IP address
'======================================================================
function HOST_ADDR ( hostname as string ) as ulong
    function = inet_addr ( hostname )
end function

'======================================================================
' #INCLUDE ONCE "WinSock2.bi"
' Translate an IP address into a corresponding host name
'======================================================================
function HOST_NAME ( byval ip as ulong ) as string
    dim cin as IN_ADDR
    cin.S_un.S_addr_ = ip
    function = *inet_ntoa ( cin )
end function

'======================================================================
' #INCLUDE ONCE "WinSock2.bi"
' Enable an application to communicate with a TCP/IP client
' srvc$ A service name takes the form of "http", "smtp", or "ftp", etc. 
' address$ As a client, address$ identifies the address to connect with.
'======================================================================
function TCP_OPEN ( srvc as string, address as string ) as SOCKET
    dim hSocket as SOCKET
    dim wsaData as WSADATA
    dim iResult as LONG
    dim ia as in_addr
    dim client as sockaddr_in
    dim hostentry as hostent ptr
    dim bytes as integer
    dim ip as integer
    
    WSAStartup ( MAKEWORD ( 2, 2 ), @wsaData )
    hSocket = opensocket ( AF_INET, SOCK_STREAM, IPPROTO_TCP )
    
    IF hSocket = INVALID_SOCKET THEN
        closesocket ( hSocket ) 
        WSACleanup ( )
        function = INVALID_SOCKET
        exit function
    end if

    if srvc = "http" then
        client.sin_port = htons ( 80 )
    end if
    if srvc = "smtp" then
        client.sin_port = htons ( 25 )
    end if
    if srvc = "ftp" then
        client.sin_port = htons ( 21 )
    end if

    ia.S_addr = inet_addr( address )
    if ( ia.S_addr = INADDR_NONE ) then        
        hostentry = gethostbyname ( address )
        if ( hostentry = 0 ) then
            closesocket ( hSocket ) 
            WSACleanup ( )
            function = INVALID_SOCKET
            exit function
        end if
        ip = *cast ( integer ptr, *hostentry->h_addr_list )
        else
            ip = ia.S_addr
    end if
    
    client.sin_family      = AF_INET
    client.sin_addr.s_addr = ip
    iResult = connect ( hSocket , Cptr ( SOCKADDR ptr, @client ), SIZEOF ( client ) )

    if iResult = SOCKET_ERROR then
        closesocket ( hSocket ) 
        WSACleanup ( )
        function = INVALID_SOCKET
        exit function
    end if
    
    function = hSocket
end function

'======================================================================
' #INCLUDE ONCE "WinSock2.bi"
' Enable an application to communicate with a TCP/IP client
' using the TCP protocol over Winsock
'======================================================================
function TCP_OPEN_PORT ( byval server_prot as long, server_addr as string ) as SOCKET
    dim hSocket as SOCKET
    dim wsaData as WSADATA
    dim iResult as LONG
    dim service as sockaddr_in
    
    WSAStartup ( MAKEWORD ( 2, 2 ), @wsaData )
    hSocket = opensocket ( AF_INET, SOCK_STREAM, IPPROTO_TCP )
    
    IF hSocket = INVALID_SOCKET THEN
        closesocket ( hSocket ) 
        WSACleanup ( )
        function = hSocket
        exit function
    end if
    
    service.sin_family      = AF_INET
    service.sin_addr.s_addr = inet_addr ( server_addr )
    service.sin_port        = htons ( server_prot )
    iResult = connect ( hSocket , Cptr ( SOCKADDR ptr, @service ), SIZEOF ( service ) )
    
    if iResult = SOCKET_ERROR then
        closesocket ( hSocket ) 
        WSACleanup ( )
        function = INVALID_SOCKET
        exit function
    end if
    
    function = hSocket
end function   

'======================================================================
' #INCLUDE ONCE "WinSock2.bi"
' Enable an application to communicate with a TCP/IP server
' using the TCP protocol over Winsock
'======================================================================
function TCP_OPEN_SERVER ( byval server_ip as long, byval server_prot as long ) as socket
    dim hSocket as SOCKET
    dim wsaData as WSADATA
    dim service as sockaddr_in 
    dim iResult as long
    
    WSAStartup ( MAKEWORD ( 2, 2 ), @wsaData )
    hSocket = opensocket ( AF_INET, SOCK_STREAM, IPPROTO_TCP )
    if hSocket = INVALID_SOCKET then
        closesocket ( hSocket )
        WSACleanup ( )
        function = hSocket
        exit function
    end if 
    
    service.sin_family          = AF_INET
    'service.sin_addr.S_un.S_addr_ = htonl ( INADDR_ANY )'inet_addr ( server_addr )
    service.sin_addr.s_addr = server_ip
    service.sin_port             = htons ( server_prot )
    iResult = bind ( hSocket , Cptr ( SOCKADDR ptr, @service ), sizeof ( service ) )
    if iResult = 0 then
       iResult = listen ( hSocket, SOMAXCONN )
       else
            closesocket ( hSocket )
            WSACleanup ( )
    end if

    function = hSocket
end function

'======================================================================
' #INCLUDE ONCE "WinSock2.bi"
' Accept an incoming request for communication from a specified TCP/IP port
'======================================================================
function TCP_ACCEPTS ( byval hSocket as SOCKET ) as SOCKET
   dim nSocket as SOCKET
   dim clientsocket as SOCKADDR_IN
   dim lens as ulong = sizeof ( SOCKADDR )   
   nSocket = accept ( hSocket, Cptr ( SOCKADDR ptr, @clientsocket ), @lens )
   function = nSocket
end function

'======================================================================
' #INCLUDE ONCE "WinSock2.bi"
' Designate which TCP/IP events will generate a notification message
' WSACreateEvent ( )
' rc = WSAEventSelect(s, hEventObject, FD_READ or FD_WRITE)
' TCP_NOTIFY hSocket, hWnd, TCP_ACCEPT, FD_ACCEPT
'======================================================================
function TCP_NOTIFY ( byval hSocket as SOCKET, byval hWnd as HWND, byval wMsg as u_int, byval lEvent as long ) as long
    dim rc as long 
    rc = WSAAsyncSelect ( hSocket, hWnd, 0, 0 )
    rc = WSAAsyncSelect ( hSocket, hWnd, wMsg, lEvent )
    function = rc
end function

'======================================================================
' #INCLUDE ONCE "WinSock2.bi"
' Receive data from a specified TCP/IP port
'======================================================================
sub TCP_RECV ( byval hSocket as SOCKET, byval strlen as integer, sBuffer as string )
    dim bytes as integer
    dim s as string
    dim recvbuffer as zstring ptr
    recvbuffer = Allocate ( strlen+1 )
    's = space ( strlen )
    do
        bytes = recv ( hSocket, recvbuffer, strlen+1, 0 )
        s = *recvbuffer
        sBuffer = sBuffer + s
        ZeroMemory ( recvbuffer, strlen+1 )
    loop while ( bytes > 0 ) or ( len( s ) > 0 ) or not( SOCKET_ERROR )
    Deallocate recvbuffer
end sub 

'======================================================================
' #INCLUDE ONCE "WinSock2.bi"
' Receive a line of text from a specified TCP/IP port.
'======================================================================
sub TCP_LINE_INPUT ( byval hSocket as SOCKET, sBuffer as string )
    dim bytes as integer
    dim idx as integer
    dim s as string
    dim recvbuffer as zstring ptr
    recvbuffer = Allocate ( 512 )
    idx = -1
    do
        bytes = recv ( hSocket, recvbuffer, 512, 0 )
        s = *recvbuffer
        idx = InStr ( s, LRCF )
        if idx > 0 then
            sBuffer = sBuffer + Left ( s, idx )
            else
            sBuffer = sBuffer + s
        end if
        ZeroMemory ( recvbuffer, 512 )
    loop while idx<0 or ( bytes > 0 ) or ( len( s ) > 0 ) or not( SOCKET_ERROR )
    Deallocate recvbuffer
end sub

'======================================================================
' #INCLUDE ONCE "WinSock2.bi"
' Write a string to a nominated TCP/IP port
'======================================================================
sub TCP_SEND ( byval hSocket as SOCKET, sBuffer as string )
    send ( hSocket, sBuffer, len ( sBuffer ) + 1, 0 )
end sub

'======================================================================
' #INCLUDE ONCE "WinSock2.bi"
' Write a string to a nominated TCP/IP port
'======================================================================
sub TCP_PRINT ( byval hSocket as SOCKET, sBuffer as string )
    sBuffer = sBuffer + NewLine
    send ( hSocket, sBuffer, len ( sBuffer ) + 1, 0 )
end sub

'======================================================================
' #INCLUDE ONCE "WinSock2.bi"
' Close a previously opened TCP/IP port
'======================================================================
sub TCP_CLOSE ( byval hSocket as SOCKET )
    closesocket ( hSocket )
    WSACleanup ( )
end sub

'----------------------------------------------------------
' 返回客户端IP
'----------------------------------------------------------
function TCP_GetIP ( byval hSocket as SOCKET ) as string
   dim sock_sa as SOCKADDR_IN 
   dim lpszIP as zstring ptr
   dim namelen as long
   
   namelen = SIZEOF ( sock_sa )
   if getpeername ( hSocket, Cptr ( SOCKADDR ptr, @sock_sa ), @namelen ) <> SOCKET_ERROR then
      lpszIP = inet_ntoa ( sock_sa.sin_addr )
      function = *lpszIP
   end if
end function

'----------------------------------------------------------
' 返回客户端port
'----------------------------------------------------------
function TCP_GetProt ( byval hSocket as SOCKET ) as string
   dim sock_sa AS sockaddr_in
   dim namelen as long
   namelen = sizeof ( sock_sa )
   if getpeername ( hSocket, Cptr ( SOCKADDR ptr, @sock_sa ), @namelen ) <> SOCKET_ERROR then
      function = str ( ntohs ( sock_sa.sin_port ) + 1 )
   end if
end function

3、函数程序中应用实例。（服务端）

function WindowProc ( byval hWnd as HWND, byval wMsg as UINT, byval wParam as WPARAM, byval lParam as LPARAM ) as LRESULT
    dim wmId as integer
    dim wmEvent as integer
    dim ListenSocket as SOCKET = INVALID_SOCKET
    dim AcceptSocket as SOCKET = INVALID_SOCKET

    select case( wMsg )
       case TCP_ACCEPT
           wmEvent = LOWORD ( lParam )
           ListenSocket = cast ( socket, wParam )
           select case wmEvent
              case FD_ACCEPT
                  AcceptSocket = TCP_ACCEPTS ( ListenSocket )
                  TCP_NOTIFY AcceptSocket, hWnd, TCP_ECHO, FD_READ OR FD_WRITE OR FD_CLOSE
                  
           end select
           function = 1

       case TCP_ECHO
           dim sendBuf as string * 1024
           dim receiveBuf as string '* 1024
           dim sBuffer as string
           wmEvent = LOWORD ( lParam )
           AcceptSocket = cast ( socket, wParam )
           select case wmEvent
              case FD_READ
                  'do
                     TCP_RECV AcceptSocket, 1024, receiveBuf
                   '  sBuffer = sBuffer + receiveBuf
                  'loop while receiveBuf = " "                 
                 MessageBox ( hWnd, receiveBuf, "Server 提示窗口 ( %FD_READ )", MB_OK )
 
              case FD_WRITE
                  sendBuf = "welcome to bejing" + "  " + TCP_GetIP ( AcceptSocket )
                  TCP_SEND ( AcceptSocket, sendBuf )
                  'MessageBox ( hWnd, sendBuf, "Server 提示窗口 ( %FD_WRITE )", MB_OK ) 
                  
              case FD_CLOSE
                 TCP_CLOSE ( AcceptSocket ) 
                  
           end select
           function = 1
        
       case WM_COMMAND
           wmId       = loword ( wParam )
           wmEvent = hiword ( wParam ) 
           select case ( wmId )
               case IDC_BUTTON1
                   if wmEvent = BN_CLICKED or wMsg = 1 then                       
                       dim ip as ulong = HOST_ADDR ( ServerAddress )
                       ListenSocket = TCP_OPEN_SERVER ( ip, ServerPort )
                       'MessageBox ( hWnd, str ( ListenSocket ), "Server 提示窗口", MB_OK )

                       if ListenSocket = INVALID_SOCKET then
                           TCP_CLOSE ( ListenSocket )
                           function = 0
                           exit function
                       end if
                       
                       TCP_NOTIFY ListenSocket, hWnd, TCP_ACCEPT, FD_ACCEPT                     
                   end if
                
               case IDC_BUTTON2                  
                   
           end select
           
        case WM_CLOSE
            TCP_CLOSE ( ListenSocket )
            DIALOG_END hWnd 
            exit function
            
        case WM_DESTROY
            TCP_CLOSE ( ListenSocket )
            DIALOG_END hWnd
            exit function
            
    end select                                         
    function = DefWindowProc ( hWnd, wMsg, wParam, lParam )                                             
end function

4、函数程序中应用实例。（客户端）

function WindowProc ( byval hWnd as HWND, byval wMsg as UINT, byval wParam as WPARAM, byval lParam as LPARAM ) as LRESULT
    dim wmId as integer
    dim wmEvent as integer
    dim wmError as long
    dim clientSocket as SOCKET 
    
    select case( wMsg )          
       case TCP_ACCEPT 
           dim receiveBuf as string
           dim sBuffer as string
           wmEvent = LOWORD ( lParam )
           wmError = HIWORD ( lParam )          
           clientSocket = cast ( socket, wParam )

          select case wmEvent                  
              case FD_READ
                  TCP_RECV clientSocket, 256, receiveBuf  
                  MessageBox ( hWnd,  receiveBuf, "Client 提示窗口", MB_OK )
                   
              case FD_WRITE
                  receiveBuf = "hello, this is client"
                  TCP_SEND clientSocket, receiveBuf
                  
              case FD_CLOSE      
                  TCP_CLOSE ( clientSocket )

          end select
          
       case WM_COMMAND
           wmId       = loword ( wParam )
           wmEvent = hiword ( wParam ) 
           select case ( wmId )
               case IDC_BUTTON1
                   if wmEvent = BN_CLICKED or wMsg = 1 then                       
                       clientSocket = TCP_OPEN_PORT ( ServerPort, ServerAddress )
                       TCP_NOTIFY clientSocket, hWnd, TCP_ACCEPT, FD_READ OR FD_WRITE OR FD_CLOSE                     
                   end if
                
               case IDC_BUTTON2
                   
                   
           end select
           
        case WM_CLOSE
            TCP_CLOSE ( clientSocket )
            DIALOG_END hWnd 
            exit function
            
        case WM_DESTROY
            TCP_CLOSE ( clientSocket )
            DIALOG_END hWnd
            exit function
            
    end select                                         
    function = DefWindowProc ( hWnd, wMsg, wParam, lParam )                                             
end function

结语：由于编程水平有限，难免代码中所有瑕疵，大家可以在借鉴过程中加以修正完善，再次仅仅起到抛砖引玉的目的，与basic爱好者相互交流学习。