;this is norm's generic proxy server
;created 17Nov2003
;latest version 9dec2003
;-top
IncludeFile "pinc.pb"
IncludeFile "inifile.pb"

Global COMPORT.l
Global MAXCOMBUFFER
Global *COMBUFFER
Global ONLINE.l

Global MaxUsers.l
Global Password.s
Global BandWidth.l
Global ActualBW.l
Global MasterTimer.l
Global MyRoom.l
Global MaxBW.l

;-userstruct
Structure UserType
  LID.l
  SocketID.l
  RID.l
  Name.b[8]
EndStructure
NewList User.UserType()
Declare SendMessage(FID.l,LID.l,msg.s)

Procedure UpdateUsers(RID.l)
  ClearGadgetItemList(#UserList)
  ResetList(User())
  msg.s=Chr(147)+Right("000"+Str(RID),3)+"0N"
  LID=1
  While NextElement(User())
    If User()\RID=RID
      User()\LID=RID*10+LID
      LID=LID+1
      msg=msg+Right("0000"+Str(User()\LID),4)+Left(PeekS(@User()\Name)+"        ",8)
      AddGadgetItem(#UserList,-1,PeekS(@User()\Name))
    EndIf
  Wend
  If Len(msg)>MAXCOMBUFFER
    msg=Left(msg,MAXCOMBUFFER)
  EndIf
  SendMessage(RID*10+9,RID*10,msg)
  
EndProcedure
Procedure SendRaw(FID.l,LID.l,size.l)
  ResetList(User())
  RID.l=Int(LID/10)
  BCF=0
  If RID*10=LID
    BCF=1
    ;send data to all users... BCF=BroadCastFlag
  EndIf
  Debug FID
  Debug LID
  While NextElement(User())
    Debug PeekS(@User()\Name)
    Debug User()\RID
    Debug User()\LID
    If RID=User()\RID
      If LID=User()\LID And FID<>LID
        ;private message
        SendNetworkData(User()\SocketID,*COMBUFFER,size)
        BandWidth=BandWidth+size
        Delay(1)
      Else
        If BCF=1 And FID<>User()\LID
          SendNetworkData(User()\SocketID,*COMBUFFER,size)
          BandWidth=BandWidth+size
          Delay(1)
        EndIf

      EndIf
    EndIf
  Wend
  

EndProcedure
Procedure SendMessage(FID.l,LID.l,msg.s)
  Debug FID
  Debug LID
  ResetList(User())
  PokeS(*COMBUFFER,msg,Len(msg))
  RID.l=Int(LID/10)
  BCF=0
  If RID*10=LID
    BCF=1
    ;send data to all users... BCF=BroadCastFlag
  EndIf
  
  While NextElement(User())
    Debug PeekS(@User()\Name)
    Debug User()\LID
    Debug User()\RID
    Debug RID
    If BCF=0
      If LID=User()\LID
        SendNetworkData(User()\SocketID,*COMBUFFER,Len(msg))
        BandWidth=BandWidth+Len(msg)
        Delay(1)
      EndIf
    Else
      If User()\LID<>FID
        If User()\RID=RID Or FID=9999
          SendNetworkData(User()\SocketID,*COMBUFFER,Len(msg))
          BandWidth=BandWidth+Len(msg)
          Delay(1)
        EndIf
      EndIf

    EndIf
    If Mid(msg,6,1)="D"
      ;this is a disconnect notice
      CloseNetworkConnection(User()\SocketID)
      DeleteElement(User())
    EndIf
  Wend
  If Mid(msg,6,1)="D"
    If Left(msg,7)=Chr(147)+"9999D"
      ;shutdown server
      CloseNetworkServer()
      ONLINE=0
      setwindowtext_(WindowID(),"Server Status - Offline")
    Else
      UpdateUsers(RID)
    EndIf
  EndIf
EndProcedure
Procedure HandleServerData(Start.l,Finish.l)
  msg.s=PeekS(*COMBUFFER+Start,Finish-Start)
  If Left(msg,1)=Chr(147)
    ;valid message
    ResetList(User())
    While NextElement(User())
      If User()\SocketID=NetworkClientID()
        
        name.s=PeekS(@User()\Name)
        
        SID.l=User()\SocketID
        User()\RID=Val(Mid(msg,2,3))
        *ThisUser=@User()
        If Mid(msg,6,1)="N"
          ;name=PeekS(*COMBUFFER + 7)
          name=Trim(Mid(msg,7,8))
          If Len(name)>8
            name=Left(name,8)
          EndIf
          PokeS(@User()\Name,name)
          
          UpdateUsers(User()\RID)
          ChangeCurrentElement(User(),*ThisUser)
          AddGadgetItem(#ChatList,-1,"**** "+name+" is here ****")
          SendMessage(User()\LID,User()\RID*10,Chr(147)+Right("0000"+Str(User()\LID),4)+"C**** "+name+" is here ****")
          
        EndIf
        LastElement(User())
      EndIf
    Wend
    ChangeCurrentElement(User(),*ThisUser)
    MT.l=Asc(Mid(msg,6,1))
    Select MT
      Case 66
        ;B change buffer
        If Mid(msg,7,8)=Password
          bs.l=Val(Mid(msg,15,4))
          If bs
            WriteInt("Server","Size",bs)
            *COMMBUFFER=AllocateMemory(1,MAXCOMBUFFER,0)
          EndIf
        EndIf

      Case 67
        ;C
        If GetMenuItemState(#MENUBAR_7,#MENU_MC)
          AddGadgetItem(#ChatList,-1,msg)
        Else
          If MyRoom=User()\RID
            AddGadgetItem(#ChatList,-1,msg)
          EndIf  
        EndIf
        TID=Val(Mid(msg,2,4))
        ;CallDebugger
        SendMessage(User()\LID,TID,msg)
      Case 68
        ;D disconnect
        If Mid(msg,2,4)<>"9999"
          TID=Val(Mid(msg,2,4))
          SendMessage(User()\LID,TID,msg)
        Else
          If Mid(msg,7,8)=Password
            TID=Val(Mid(msg,2,4))
            SendMessage(User()\LID,TID,msg)

          EndIf
        EndIf

      Case 78
        ;N new player - handled already
        ;ignore message
      Case 80
        ;P change server port
        If Mid(msg,7,8)=Password
          port.l=Val(Mid(msg,15,4))
          If port
            WriteInt("Server","Port",port)
          EndIf
        EndIf
      Case 81
        ;Q binary data
        
        TID=Val(Mid(msg,2,4))
        If GetMenuItemState(#MENUBAR_7,#MENU_MD) And MyRoom=User()\RID
          AddGadgetItem(#ChatList,-1,msg)
          
        EndIf

        ;raw data
        ;need to move data to start of buffer
        stepper.l=0
        For n=Start To Finish
          B.b=PeekB(*COMBUFFER+n)
          PokeB(*COMBUFFER+stepper,B)
          stepper+1
          
        Next n
        CallDebugger
        SendRaw(User()\LID,TID,stepper)

      Case 82
        ;R raw data
        
        TID=Val(Mid(msg,2,4))
        If GetMenuItemState(#MENUBAR_7,#MENU_MD) And MyRoom=User()\RID
          AddGadgetItem(#ChatList,-1,msg)
          
        EndIf

        ;raw data
        ;need to move data to start of buffer
        stepper.l=0
        For n=Start To Finish
          B.b=PeekB(*COMBUFFER+n)
          PokeB(*COMBUFFER+stepper,B)
          stepper+1
          
        Next n
        CallDebugger
        SendRaw(User()\LID,TID,stepper)
      Case 83
        ;S reStart command
        If Mid(msg,7,8)=Password

          ;first send a disconnect to all users
          msg=Chr(147)+"9999D"
          SendMessage(9999,0000,msg)
          ;check for restart
          If ONLINE
            CloseNetworkServer()
          EndIf
          MAXCOMBUFFER=GetInt("Server","Size",MAXCOMBUFFER)
          *COMMBUFFER=AllocateMemory(1,MAXCOMBUFFER,0)
          COMPORT=GetInt("Server","Port",COMPORT)
          ONLINE=CreateNetworkServer(COMPORT)
          
          If ONLINE
            setwindowtext_(WindowID(),"Server Status - Online Port="+Str(COMPORT))
          Else
            setwindowtext_(WindowID(),"Server Status - Offline")
          EndIf
        EndIf

      Case 84
        ;T request total user count
        msg=Chr(147)+"9999T"+Right("0000"+Str(CountList(User())),4)+Str(ActualBW)
        SendMessage(9999,User()\LID,msg)
      Case 87
        ;W change passward
        If Mid(msg,7,8)=Password
          If Len(msg)=22
            Password=Mid(msg,15,8)
          Else
            msg=Chr(147)+"9999CInvalid password ="+Mid(msg,15,8)
            SendMessage(9999,User()\LID,msg)
          EndIf
        Else
          msg=Chr(147)+"9999CInvalid password ="+Mid(msg,7,8)
          SendMessage(9999,User()\LID,msg)
        EndIf
      Default
        TID=Val(Mid(msg,2,4))
        SendMessage(User()\LID,TID,msg)

    EndSelect
    
  EndIf
EndProcedure
Procedure HandleServer(Event.l)
  Select Event
    Case 1
      ;new client
      AddElement(User())
      
      User()\SocketID=NetworkClientID()
    Case 2
      ;receive data
      td.l=ReceiveNetworkData(NetworkClientID(),*COMBUFFER,MAXCOMBUFFER)
      BandWidth=BandWidth+td
      For start=0 To td
        If PeekB(*COMBUFFER+start)&$FF=147
          ;start of message
          If PeekB(*COMBUFFER+start+5)&$FF=81
            ;binary data
            Finish=Start+Val(PeekS(*COMBUFFER+start+6,4))+1
          Else
            For Finish=Start+1 To td
              If PeekB(*COMBUFFER+Finish)&$FF=147
                ;multiple messages detected
                HandleServerData(Start,Finish-1)
              EndIf
            Next Finish
          EndIf
          ;only one message in buffer
          HandleServerData(Start,Finish-1)
        EndIf
      Next Start
    Case 4
      ;client left
      CID.l=NetworkClientID()
      ;locate the client to delete
      MaxUsers=0
      deaduser.s=""
      ResetList(User())
      While NextElement(User())
      
        If CID=User()\SocketID
          deaduser=PeekS(@User()\Name)
          RID.l=User()\RID
          LID.l=User()\LID
          DeleteElement(User())
          AddGadgetItem(#ChatList,-1,"**** "+deaduser+" left ****")
          sendmessage(LID,RID*10,Chr(147)+"0000C**** "+deaduser+" left ****")
          UpdateUsers(RID)
        EndIf
        
      Wend
      
    Default
      ;0= no event
      ;3= receive file.... not supported by me
  EndSelect  
EndProcedure
Procedure HandleWindows(WEID.l)
  WFID.l=0
  quit.l=0
  Select WEID
    Case #PB_EVENT_CLOSEWINDOW
      quit=1
    Case #PB_EVENT_MENU
      WFID=EventMenuID()
    Case #PB_EVENT_GADGET
      WFID=EventGadgetID()
    
  EndSelect
  Select WFID
    Case #MENU_ROM
      np.s=InputRequester("Select Room","000 to 999",Str(MyRoom))
      If Len(np)
        MyRoom=Val(Left(np,3))
        WriteInt("Server","MyRoom",MyRoom)
      EndIf
    Case #MENU_PAS
      np.s=InputRequester("Change password","Current password=",password)
      If Len(np)=8
        password=np
        WriteIniString("Server","Password",Password)
      EndIf
    Case #MENU_MC
      If GetMenuItemState(#MENUBAR_7,#MENU_MC)
        SetMenuItemState(#MENUBAR_7,#MENU_MC,0)
      Else
        SetMenuItemState(#MENUBAR_7,#MENU_MC,1)
      EndIf
    Case #MENU_MD
      If GetMenuItemState(#MENUBAR_7,#MENU_MD)
        SetMenuItemState(#MENUBAR_7,#MENU_MD,0)
      Else
        SetMenuItemState(#MENUBAR_7,#MENU_MD,1)
      EndIf

    Case #MENU_VBW
      If GetMenuItemState(#MENUBAR_7,#MENU_VBW)
        SetMenuItemState(#MENUBAR_7,#MENU_VBW,0)
      Else
        SetMenuItemState(#MENUBAR_7,#MENU_VBW,1)
      EndIf
    Case #MENU_LBW
      If GetMenuItemState(#MENUBAR_7,#MENU_LBW)
        SetMenuItemState(#MENUBAR_7,#MENU_LBW,0)
      Else
        SetMenuItemState(#MENUBAR_7,#MENU_LBW,1)
      EndIf
     
    Case #MENU_Start
      If ONLINE=0
        ONLINE=CreateNetworkServer(COMPORT)
      EndIf
      If ONLINE
        setwindowtext_(WindowID(),"Server Status - Online Port="+Str(COMPORT))
      Else
        setwindowtext_(WindowID(),"Server Status - Offline")
      EndIf

    Case #MENU_ShutDown
      If ONLINE
        SendMessage(9999,0,Chr(147)+"0000D")
        CloseNetworkServer()
        ONLINE=0
        setwindowtext_(WindowID(),"Server Status - Offline")
      EndIf
    Case #MENU_Port
      If ONLINE
        MessageRequester("Error","Can't change ports while running",#MB_ICONINFORMATION)
      Else
        np.s=InputRequester("Change Server Port","currently using port",Str(COMPORT))
        If Val(np.s)
          COMPORT=Val(np)
          WriteInt("Server","Port",COMPORT)
        EndIf
      EndIf
    Case #MENU_About
      ;this is my about box
      
      AboutIni("Norm's About Box","Proxy Server App")
    Case #MENU_Exit
      Quit=1
      CloseWindow(#Window_0)
    Case #MENU_Buffer
      np.s=InputRequester("Change Buffer Size","Please leave 10 bytes per user.Buffer currently set to",Str(MAXCOMBUFFER))
      If Val(np)>4
        MAXCOMBUFFER=Val(np)
        WriteInt("Server","Size",MAXCOMBUFFER)
        *COMBUFFER=AllocateMemory(1,MAXCOMBUFFER,0)
      EndIf
    Case #SendChat
      msg.s=GetGadgetText(#OutChat)
      TLID.l=Val(Left(msg,4))
      TRID.l=Val(Left(msg,3)+"9")
      msg=Chr(147)+msg
      If Len(msg)>MAXCOMBUFFER
        msg=Left(msg,MAXCOMBUFFER)
      EndIf
      SetGadgetText(#OutChat,"0000C")
      AddGadgetItem(#ChatList,-1,"Server > "+msg)
      
      
      
      SendMessage(TRID,TLID,msg)
    Case #ClearChat
      ClearGadgetItemList(#ChatList)
  
  EndSelect
  ProcedureReturn quit
EndProcedure
;-start
If InitNetwork()=0
  MessageRequester("Error","Unable to initialize network, shutting down.",#MB_ICONSTOP)
  End
EndIf
Open_Window_0()
AddKeyboardShortcut(#Window_0,#PB_Shortcut_Return,#SendChat)
ActivateGadget(#OutChat)
;assume at launch that we connect using defaults
GetCurrentPath()
IniFile=MainPath+"proxy.ini"
COMPORT=GetInt("Server","Port",2003)
MAXCOMBUFFER=getint("Server","Size",1000)
*COMBUFFER=AllocateMemory(1,MAXCOMBUFFER,0)
ONLINE=CreateNetworkServer(COMPORT)
Password=PeekS(GetString("Server","Password","password"))
MyRoom=GetInt("Server","MyRoom",0)
MaxBW=getint("Server","BandWidth",300)
;-MainLoop
If ONLINE
  setwindowtext_(WindowID(),"Server Status - Online Port="+Str(COMPORT))
Else
  setwindowtext_(WindowID(),"Server Status - Offline")
EndIf
MasterTimer=GetTickCount_()
Repeat
  If GetTickCount_()-MasterTimer>60000
    ActualBW=BandWidth/1000
    BandWidth=0
    MasterTimer=GetTickCount_()
    If GetMenuItemState(#MENUBAR_7,#MENU_VBW)
      If ONLINE
        setwindowtext_(WindowID(),"Server Status - Bandwidth ="+Str(ActualBW)+" KBPM")
      EndIf
    EndIf  
  EndIf
  If ONLINE
    HandleServer(NetworkServerEvent())
  
  EndIf
  quit.l=HandleWindows(WindowEvent())
  Delay(1)
Until quit
CloseWindow(#Window_0)

End

; ExecutableFormat=Windows
; EnableAsm
; EnableNT4
; EnableXP
; UseIcon=C:\Program Files\PureBasic\Projects\Matching\NET13.ICO
; Executable=C:\Program Files\PureBasic\Projects\Matching\proxy.exe
; DisableDebugger
; EOF