QBasic & Borland Pascal & C/Delphi5.iso/Basic/Samples/IPXSPX/IPXSPX.ZIP/SOURCE/NETCHAT/NETCHAT.TXT

Text File | 1993-12-20 | 13.9 KB | 525 lines

Option Explicit
Option Base 1

Sub About_Click ()
    aboutForm.Show 1
End Sub

Sub BinderyObjList_DblCLick ()
    Dim Address As String
    Dim formatString As String
    Dim nwTime As String
    Dim YY, MM, DD, HR, MI, SC, DA As Integer
    Dim nwLoginTime  As Variant
    Dim nwUser As USER_INFO
    Dim ccode, index As Integer

    nwUser = netWareUsers(BinderyObjList.ListIndex + 1)
    userName = Mid$(BinderyObjList.Text, 1, 20)
    userConn = nwUser.connNumber
    nwTime = nwUser.loginTime
    YY = Asc(Mid(nwTime, 1, 1)) + 1900
    MM = Asc(Mid(nwTime, 2, 1))
    DD = Asc(Mid(nwTime, 3, 1))
    HR = Asc(Mid(nwTime, 4, 1))
    MI = Asc(Mid(nwTime, 5, 1))
    SC = Asc(Mid(nwTime, 6, 1))

    'pretty print the login time
    nwLoginTime = DateSerial(YY, MM, DD)
    formatString = Format$(nwLoginTime, "mm-dd-yyyy")
    userLoginTime = formatString

    'pretty print the login date
    formatString = TimeSerial(HR, MI, SC)
    userLoginDay = formatString

    'pretty print the internet address
    ccode = NWGetInternetAddress(nwConn, userConn, yourInetAddress)
    If ccode Then
    MsgBox "Error getting internet addresss"
    End If

    formatString = yourInetAddress.network & yourInetAddress.node
    FormatInternetAddress formatString

    userAddress = formatString
    userPicture.Visible = True

    ipx1.RemoteName = yourInetAddress.network & yourInetAddress.node & Chr$(&H54) & Chr$(&H54)
    connectButton.SetFocus

End Sub

Sub BinderyObjList_KeyPress (KeyAscii As Integer)
    If KeyAscii = 13 Then
    BinderyObjList_DblCLick
    End If
End Sub

Sub cancelButton_Click ()

    userPicture.Visible = False
    sendBox.Visible = False
    receiveBox.Visible = False

    connectButton.Enabled = True
    disconnectButton.Enabled = False

End Sub

Sub connectButton_Click ()
    Dim formatString As String
    Dim NetData As String

    If Mid$(ipx1.LocalName, 1, 10) = Mid$(ipx1.RemoteName, 1, 10) Then
    MsgBox "Unable to chat to yourself"
    Exit Sub
    End If

    'Send the connect request and my connection number
    NetData = Chr$(IPXSPX_CONNECT) & Chr$(nwConnNumber / 256) & Chr$(nwConnNumber And &HFF)

    netChatState = IPXSPX_SENDCONN
    ipx1.Send = NetData

    formatString = yourInetAddress.network & yourInetAddress.node
    FormatInternetAddress formatString
    netChatConnection!connectionLabel = "Attempting to chat with " & formatString
    netChatConnection!connectionOK.Caption = "&Cancel"

    netChatConnection.Show 1
    Select Case netChatState
    Case IPXSPX_CONNECT
        sendBox.Visible = True
        receiveBox.Visible = True
        connectButton.Enabled = False
        disconnectButton.Enabled = True
        cancelButton.Enabled = False
        receiveBox.Text = ""
        sendBox.Text = ""
    Case IPXSPX_SENDCONN
        NetData = Chr$(IPXSPX_DISCONNECT)
        ipx1.Send = NetData
        netChatState = IPXSPX_DISCONNECT
    End Select

End Sub

Sub ConnectionRequest (inetAddress)
    Dim formatString As String

    formatString = inetAddress
    FormatInternetAddress formatString
    netChatConnection!connectionLabel = formatString & " calling, will you accept the charges?"

End Sub

Sub ConnectState (netChatPtr As NetChatInput)
    Dim connNumber As Integer
    Dim Address As String
    Dim formatString As String
    Dim nwTime As String
    Dim YY, MM, DD, HR, MI, SC, DA As Integer
    Dim nwLoginTime  As Variant
    Dim nwUser As USER_INFO
    Dim ccode, index As Integer

    Select Case netChatState
    Case IPXSPX_SENDCONN
        If ipx1.ReceivedFrom = ipx1.RemoteName Then
        netChatState = IPXSPX_CONNECT
        Unload netChatConnection
        End If

    Case IPXSPX_DISCONNECT
        netChatState = IPXSPX_RECEIVECONN
        ConnectionRequest Mid$(ipx1.ReceivedFrom, 1, 10)
        netChatConnection.Show 1
        If netChatState = IPXSPX_RECEIVECONN Then
        ipx1.RemoteName = ipx1.ReceivedFrom
        connNumber = Asc(Mid$(netChatPtr.data, 2, 1)) * 256 + Asc(Mid$(netChatPtr.data, 3, 1))

        ipx1.Send = Chr$(IPXSPX_CONNECT) & Chr$(54) & Chr$(54) & Chr$(nwConnNumber / 256) & Chr$(nwConnNumber And &HFF)

        ccode = NWGetConnectionInformation(nwConn, connNumber, ByVal nwUser.objectName, nwUser.objectType, nwUser.objectID, ByVal nwUser.loginTime)
        If ccode Then
            MsgBox "Unable to get connection information"
            Exit Sub
        End If

        nwTime = nwUser.loginTime
        YY = Asc(Mid(nwTime, 1, 1)) + 1900
        MM = Asc(Mid(nwTime, 2, 1))
        DD = Asc(Mid(nwTime, 3, 1))
        HR = Asc(Mid(nwTime, 4, 1))
        MI = Asc(Mid(nwTime, 5, 1))
        SC = Asc(Mid(nwTime, 6, 1))

        'pretty print the login time
        nwLoginTime = DateSerial(YY, MM, DD)
        formatString = Format$(nwLoginTime, "mm-dd-yyyy")
        userLoginTime = formatString

        'pretty print the login date
        formatString = TimeSerial(HR, MI, SC)
        userLoginDay = formatString

        'pretty print the internet address
        formatString = ipx1.RemoteName
        FormatInternetAddress formatString

        userAddress = formatString
        userPicture.Visible = True

        sendBox.Visible = True
        receiveBox.Visible = True
        connectButton.Enabled = False
        disconnectButton.Enabled = True
        cancelButton.Enabled = False
        netChatState = IPXSPX_CONNECT
        receiveBox.Text = ""
        sendBox.Text = ""
        netChatForm.WindowState = 0
        sendBox.SetFocus
        End If
    End Select

End Sub

Sub ConvertInputToData (NetData, netChatPtr As NetChatInput)

    netChatPtr.header.destination.network = Mid$(ipx1.LocalName, 1, 4)
    netChatPtr.header.destination.node = Mid$(ipx1.LocalName, 5, 6)
    netChatPtr.header.destination.socket = Mid$(ipx1.LocalName, 11, 2)
    netChatPtr.header.source.network = Mid$(NetData, 1, 4)
    netChatPtr.header.source.node = Mid$(NetData, 5, 6)
    netChatPtr.header.source.socket = Mid$(NetData, 11, 2)
    netChatPtr.data = Mid$(NetData, 13)

End Sub

Sub DataState (netChatPtr As NetChatInput)
    Dim netVal As String

    Select Case netChatState
    Case IPXSPX_CONNECT
        netVal = Mid$(netChatPtr.data, 2)
        Select Case Asc(netVal)
        Case 13 'return
            receiveBox = receiveBox & Chr$(13) & Chr$(10)
        Case 8 'Backspace
        If Len(receiveBox) > 0 Then
            If Asc(Right$(receiveBox, 1)) = 10 Then
            receiveBox = Left$(receiveBox, Len(receiveBox) - 2)
            Else
            receiveBox = Left$(receiveBox, Len(receiveBox) - 1)
            End If
        End If
        Case Else   ' Must be something else.
            receiveBox = receiveBox & netVal

    End Select

    End Select
End Sub

Sub disconnectButton_Click ()

    Dim NetData As String

    NetData = Chr$(IPXSPX_DISCONNECT)
    ipx1.Send = NetData

    userPicture.Visible = False
    sendBox.Visible = False
    receiveBox.Visible = False

    connectButton.Enabled = True
    disconnectButton.Enabled = False
    cancelButton.Enabled = True
    netChatState = IPXSPX_DISCONNECT
End Sub

Sub DisconnectionRequest (inetAddress)
    Dim formatString As String

    formatString = inetAddress
    FormatInternetAddress formatString
    netChatDisConnection!disconnectionLabel = formatString & " has disconnected"

End Sub

Sub DisConnectState (netChatPtr As NetChatInput)

    Select Case netChatState
    Case IPXSPX_RECEIVECONN
        netChatState = IPXSPX_DISCONNECT
        Unload netChatConnection

    Case IPXSPX_SENDCONN
        netChatState = IPXSPX_DISCONNECT

    Case IPXSPX_DISCONNECT
        Unload netChatConnection

    Case IPXSPX_CONNECT
        If ipx1.ReceivedFrom = ipx1.RemoteName Then
        DisconnectionRequest Mid$(ipx1.ReceivedFrom, 1, 10)
        netChatState = IPXSPX_RECEIVECONNMODAL
        netChatDisConnection.Show 1
        userPicture.Visible = False
        sendBox.Visible = False
        receiveBox.Visible = False
        connectButton.Enabled = True
        disconnectButton.Enabled = False
        cancelButton.Enabled = True
        netChatState = IPXSPX_DISCONNECT
        End If
    End Select

End Sub

Sub exitButton_Click ()
    Dim NetData As String

    'if still connected, send a disconnect
    If netChatState = IPXSPX_CONNECT Then
    NetData = Chr$(IPXSPX_DISCONNECT)
    ipx1.Send = NetData
    End If

    End
End Sub

Sub Form_Load ()
    Dim title, server, fileServerName As String
    Dim ccode, connID As Integer
    Dim s As String

    ccode = NWCallsInit(ByVal 0&, ByVal 0&)
    If ccode Then
    MsgBox "Unable to initialize NWCALLS.DLL"
    End
    End If

    Screen.MousePointer = 11        'change mouse cursor to hourglass

    server = String$(48, 0)
    server = GetConnections()

    ScanUsers server    'scan the bindery of the default server

    ServerNameBox.Selected(0) = True
    BinderyObjList.Selected(0) = True

    netChatState = IPXSPX_DISCONNECT

End Sub

Sub FormatInternetAddress (inString)
    Dim nwString, outString As String
    Dim index As Integer

    'Pretty printing for the hexidecimal network and node addresses
    outString = "["
    nwString = Mid$(inString, 1, 4)
    For index = 1 To Len(nwString)
       outString = outString & Format$(Hex$(Asc(Mid$(nwString, index, 1))), "00")
    Next index

    outString = outString & "]["
    nwString = Mid$(inString, 5, 6)
    For index = 1 To Len(nwString)
    outString = outString & Format$(Hex$(Asc(Mid$(nwString, index, 1))), "00")
    Next index

    outString = outString & "]"

    inString = outString
End Sub

Function GetConnections () As String
 Dim connID As Integer
 Dim fileServerName As String
 Dim ccode, mode, connListSize As Integer
 Dim numConnections As Integer
 ReDim connListBuffer(50) As Integer

 ServerNameBox.Clear

 mode = 0
 connListSize = 50
 ccode = NWGetConnectionList(mode, connListBuffer(1), connListSize, numConnections)


 For connID = 1 To numConnections
    'for each connection in workstation's file server name table
    'get the table entry, then see if it's null

    fileServerName = String$(48, 0)
    NWGetFileServerName connID, fileServerName
    If Left$(fileServerName, 1) <> Chr$(0) Then
        'you have to explicitly look for a null in the first character,
        'because Visual Basic doesn't know about null-terminated strings
        '(a null prints as a space)
        If connID = 1 Then GetConnections = fileServerName
        ServerNameBox.AddItem fileServerName
    End If
    Next connID

End Function

Sub ipx1_LinkEvent ()

    If ipx1.Event Then
    MsgBox "Error Link: " & ipx1.Event
    Exit Sub
    End If

End Sub

Sub ipx1_ReceiveData ()
    Dim NetString, NetData As String
    Dim nwConn As Integer
    Dim netChatPtr As NetChatInput

    ConvertInputToData ipx1.ReceivedFrom & ipx1.Received, netChatPtr

    Select Case Asc(Mid$(netChatPtr.data, 1, 1))
    'select from the first byte of the packet
    'which contains the action type

    Case IPXSPX_CONNECT
        ConnectState netChatPtr

    Case IPXSPX_DISCONNECT
        DisConnectState netChatPtr

    Case IPXSPX_DATA
        DataState netChatPtr

    End Select

End Sub

Sub ipx1_SendData ()

    'Fired when packet is sent

End Sub

Sub Rescan_Click ()

    ServerNameBox_DblClick  'same effect as if the user had
                'double-clicked on a file server name

End Sub

Sub RescanButton_Click ()
    Dim server As String

    server = GetConnections()
    ServerNameBox_DblClick  'same effect as if the user had
                'double-clicked on a file server name
End Sub

Sub ScanUsers (server)

    Dim objectType As String * 6
    Dim maxConns As Long
    Dim ccode As Integer
    Dim index As Integer
    Dim nIndex As Integer
    Dim nwUser As USER_INFO
    Dim objectName As String * 48

    Screen.MousePointer = 11        'change mouse cursor to hourglass

    BinderyObjList.Clear

    ccode = NWGetConnectionHandle(server, ByVal 0, nwConn, ByVal 0&)
    'get the connection handle to our default server
    If (ccode) Then
    MsgBox "Unable to get connection"
    Exit Sub
    End
    End If

    ccode = NWGetConnectionNumber(nwConn, nwConnNumber)
    'and get the connection number
    If (ccode) Then
    MsgBox "Unable to get connection number"
    Exit Sub
    End
    End If

    ccode = NWGetInternetAddress(nwConn, nwConnNumber, myInetAddress)
    Rem myInetAddress = ipx1.LocalName
    ' get our internet address and put it in a global for use later
    If (ccode) Then
    MsgBox "Unable to get internet address"
    Exit Sub
    End
    End If

    ccode = NWGetFileServerInformation(nwConn, ByVal 0&, ByVal 0&, ByVal 0&, ByVal 0&, maxConns, ByVal 0&, ByVal 0&, ByVal 0&, ByVal 0&, ByVal 0&)
    ' get the maximum number of connections the file server has used
    If (ccode) Then
    Exit Sub
    End If

    ReDim netWareUsers(maxConns)
    nIndex = 1
    'loop through all the possible connection numbers to get
     'all the logged in users

    For index = 1 To maxConns
    ccode = NWGetConnectionInformation(nwConn, index, ByVal nwUser.objectName, nwUser.objectType, nwUser.objectID, ByVal nwUser.loginTime)
    If ccode = 0 And Left$(nwUser.objectName, 1) <> Chr$(0) Then
        BinderyObjList.AddItem nwUser.objectName
        nwUser.connNumber = index
        netWareUsers(nIndex) = nwUser
        nIndex = nIndex + 1
    End If
    DoEvents
    Next index

EndConns:
    Screen.MousePointer = 0     'change mouse cursor back to how it was

End Sub

Sub sendBox_KeyPress (KeyAscii As Integer)
    ipx1.Send = Chr$(IPXSPX_DATA) & Chr$(KeyAscii)
End Sub

Sub ServerNameBox_DblClick ()
    Dim server, prefServer As String
    Dim index, ccode, connID As Integer

    prefServer = ServerNameBox.Text

    If Len(prefServer) = 0 Then
    Rem no server selected
    prefServer = ServerNameBox.List(0)
    End If

    server = GetConnections()

    ScanUsers prefServer 'then go scan its bindery
    index = SendMessage(ServerNameBox.hWnd, LB_FINDSTRING, ByVal -1, ByVal prefServer)
    If (index <> LB_ERR) Then
    ServerNameBox.Selected(index) = True
    Else
    ServerNameBox.Selected(0) = True
    End If

    BinderyObjList.Selected(0) = True
End Sub

Sub userPictureDrop_DblClick ()
    aboutForm.Show 1
End Sub