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