PowerBasic的HTTP服务器源代码

最近最的项目用到了socket，开始使用VB的winscok控件，但是这个控件的效率太低了而且没法设置超时，要建立一个Timer来完成，很不方便。于是决定用功能强大的PowerBasic来做。PB本身自带了好多有关TCP的函数使用起来非常方便，Google小搜索了下找到了这个很不错的代码，是一个Http服务器，使用多线程来完成socket，代码比较长，但是分析下就能看到socket部分的代码。希望对PBer有用。

点击下载：PowerBasci的HTTP服务器源代码

我分离出来了SOCKET部分的代码直接编译可通过监听localhost的888端口提供最大4000个连接有数据发来时将接收到的数据再发送回去超时为10秒

#COMPILE EXE
#DIM ALL

#IF NOT %DEF(%WINAPI)
#INCLUDE "WIN32API.INC"
#ENDIF

%WM_CONNECT = %WM_USER + 500   ' TCP Connect Msgs
%FD_ACCEPT                  = &H008
%FD_CLOSE                   = &H020

TYPE ConnectionStruct
     hSocket AS LONG   ' Connection's Socket handle (PB)
     hThread AS LONG   ' Thread Handle
     InUse    AS DWORD ' Flag to determine connections status.
END TYPE

GLOBAL Connections()   AS ConnectionStruct ' Holds Connection handles
GLOBAL ghDlg           AS DWORD   '窗体句柄
GLOBAL ListenSocket    AS LONG

FUNCTION PBMAIN () AS LONG

ShowDIALOG1 %HWND_DESKTOP

END FUNCTION

CALLBACK FUNCTION ShowDIALOG1Proc()
    DIM i AS LONG
    DIM ret AS LONG
    SELECT CASE AS LONG CB.MSG
        CASE %WM_CONNECT
           SELECT CASE LOWRD(CBLPARAM)
               CASE %FD_ACCEPT
                   FOR i = 1 TO 4000
                       IF Connections(i).InUse = 0 THEN
                          ' Get a new handle
                          Connections(i).hSocket = FREEFILE
                          ' Accept the connection and create a new socket
                          TCP ACCEPT ListenSocket AS Connections(i).hSocket
                          ' Capture Close Notifications
                          TCP NOTIFY Connections(i).hSocket, CLOSE TO ghDlg AS %WM_CONNECT
                          ' Flag the Thread as "INUSE"
                          Connections(i).InUse = 1
                          ' Start the thread to handle the socket
                          THREAD CREATE SocketThread(i) TO Connections(i).hThread
                          EXIT FOR
                       END IF
                   NEXT i
               CASE %FD_CLOSE
                   FOR i = 1 TO 4000
                       IF FILEATTR(Connections(i).hSocket, 2) = CBWPARAM THEN
                           THREAD CLOSE Connections(i).hThread TO ret
                           TCP CLOSE Connections(i).hSocket
                           Connections(i).hSocket = 0
                           Connections(i).hThread = 0
                           Connections(i).InUse = 0
                           EXIT FOR
                       END IF
                   NEXT i
           END SELECT
        CASE %WM_INITDIALOG
            CALL StartServer
            ' Initialization handler
        CASE %WM_NCACTIVATE
            STATIC hWndSaveFocus AS DWORD
            IF ISFALSE CB.WPARAM THEN
                ' Save control focus
                hWndSaveFocus = GetFocus()
            ELSEIF hWndSaveFocus THEN
                ' Restore control focus
                SetFocus(hWndSaveFocus)
                hWndSaveFocus = 0
            END IF

        CASE %WM_COMMAND
            ' Process control notifications
            SELECT CASE AS LONG CB.CTL
            END SELECT
    END SELECT
END FUNCTION

FUNCTION ShowDIALOG1(BYVAL hParent AS DWORD) AS LONG
    LOCAL lRslt AS LONG
    LOCAL hDlg AS DWORD
    DIALOG NEW hParent, "测试", , , 200, 200, %WS_VISIBLE OR %WS_MINIMIZEBOX OR _
        %WS_CLIPSIBLINGS OR %WS_CLIPCHILDREN OR %WS_CAPTION OR %WS_SYSMENU _
        OR %DS_3DLOOK OR %DS_NOFAILCREATE OR %DS_SETFONT, %WS_EX_WINDOWEDGE, _
        TO hDlg : ghDlg = hDlg
    DIALOG SHOW MODAL hDlg, CALL ShowDIALOG1Proc TO lRslt
    FUNCTION = lRslt
END FUNCTION

FUNCTION StartServer() AS LONG
    DIM i AS LONG
    REDIM Connections(1:4000) AS GLOBAL ConnectionStruct
    ListenSocket = FREEFILE
    TCP OPEN SERVER ADDR 16777343 PORT 888 AS ListenSocket TIMEOUT 10000 '16777343 就是127.0.0.1
    TCP NOTIFY ListenSocket, ACCEPT TO ghDlg AS %WM_CONNECT
END FUNCTION

FUNCTION SocketThread(BYVAL ID AS LONG) AS LONG

LOCAL ClientRequest AS STRING

IF Connections(ID).InUse <> 1 THEN EXIT LOOP

TCP RECV Connections(ID).hSocket,1024, ClientRequest

      IF ERR=%ERR_DEVICETIMEOUT THEN
        MSGBOX "timeout"
        ERRCLEAR
      END IF

      IF LEN(ClientRequest) > 0 THEN
          TCP SEND Connections(ID).hSocket,ClientRequest
      END IF

LOOP

END FUNCTION