All pastes #988068 Raw Edit

Something

public text v1 · immutable
#988068 ·published 2008-04-17 05:47 UTC
rendered paste body
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