home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Monster Media 1994 #1
/
monster.zip
/
monster
/
PROG_C
/
IPXSPX.ZIP
/
NETCHAT.TXT
< prev
next >
Wrap
Text File
|
1993-12-20
|
14KB
|
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