Option Explicit Private Sub mDBMan_Click() frmDBManager.Show End Sub Private Sub MDIForm_Load() bLoggedIn = False ' We arn't logged in yet. ReDim aSocketInfo(0) As SocketInfo ' Multi-Array Socket Header Set cnBO = New Connection sConnection = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\Backoffice.mdb;Jet OLEDB:Database Password=dcs;" cnBO.Open sConnection Me.objStatus.Panels(3).Text = "Database Connection Opened" ' Not needed anymore ' Set rsBO = New Recordset Set cmBO = New Command Set cmBO.ActiveConnection = cnBO sSQL = "SELECT boUser, boPassword FROM Backoffice" rsBO.Open sSQL, cnBO, 1, 3 sBOUsername = rsBO("boUser").Value sBOPassword = rsBO("boPassword").Value frmLogin.cboUsername.AddItem sBOUsername frmLogin.cboUsername.ListIndex = 0 frmLogin.txtPassword.SetFocus Select Case sckServer(0).State Case sckListening objStatus.Panels(1).Text = "Listening for Clients" mStatus.Caption = "Stop Server" Case sckClosed objStatus.Panels(1).Text = "Server Offline, Refusing Connections from Clients" mStatus.Caption = "Start Server" End Select End Sub Private Sub mLogOff_Click() If bLoggedIn = True Then mLogOff.Enabled = True bLoggedIn = False frmLogin.Show ElseIf bLoggedIn = False Then mLogOff.Enabled = False End If End Sub Private Sub MDIForm_Unload(Cancel As Integer) Set cnBO = Nothing Set rsBO = Nothing End Sub Private Sub mLogStatus_Click() If mLogStatus.Caption = "Log On" Then frmLogin.Show ElseIf mLogStatus.Caption = "Log Off" Then bLoggedIn = False frmLogin.Show End If End Sub Private Sub mNewTable_Click() Dim strField1 As String Dim strField2 As String Dim strTable As String CreateTBL "Test", "FName", "LName" End Sub Private Sub mReportUA_Click() rptRegUsers.Show End Sub Private Sub mStatus_Click() Dim intN As Integer If mStatus.Caption = "Start Server" Then Me.sckServer(0).LocalPort = 9001 ' Set Port # Me.sckServer(0).Listen ' Open Socket mStatus.Caption = "Stop Server" Else For intN = 1 To intSckCount sckServer(intN).Close Unload sckServer(intN) Next intN mStatus.Caption = "Start Server" End If End Sub Private Sub sckServer_ConnectionRequest(index As Integer, ByVal requestID As Long) intSckCount = intSckCount + 1 ' Increment Socket Thread Load sckServer(intSckCount) ' Load new Socket ReDim Preserve aSocketInfo(intSckCount) As SocketInfo sckServer(intSckCount).Close ' Close preConnect sckServer(intSckCount).Accept requestID ' Accept User End Sub Private Sub ProcessClientCommand(sData As String) sTemp = Split(sData, "::") Parse End Sub Private Sub sckServer_DataArrival(index As Integer, ByVal bytesTotal As Long) Dim lOffset As Long ' Store buffer offset sckServer(index).GetData sData, bytesTotal ' Receive entire chunk first mSocketInfo(index).sBuffer = mSocketInfo(index).sBuffer & sData lOffset = InStr(aSocketInfo(index).sBuffer, vbLf) Do While lOffset > 0& ProcessClientCommand Left$(aSocketInfo(index).sBuffer, lOffset - 1&), index aSocketInfo(index).sBuffer = Mid$(aSocketInfo(index).sBuffer, lOffset + 1&) lOffset = InStr(aSocketInfo(index).sBuffer, vbLf) Loop Call Parse End Sub Private Sub Randchar() Randomize intVar = Int((45 * Rnd) + 1) End Sub Private Sub tmrState_Timer() Select Case sckServer(0).State Case sckListening: sSockState = "Listening for Clients" Case sckClosed: sSockState = "Not listening for Clients" Case sckClosing: sSockState = "Shutting down Server" End Select objStatus.Panels(1).Text = sSockState End Sub