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

Text File | 1993-12-20 | 7.8 KB | 310 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

    Rem The following sets up the remote name, the network, node and socket (&h5454)
    spx1.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 ()

    spx1.Status = 0
    userPicture.Visible = False
    receiveList.Visible = False
    connectButton.Enabled = True
    disConnectButton.Enabled = False

End Sub

Sub connectButton_Click ()

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

    receiveList.Clear
    spx1.Send = "DIR"

End Sub

Sub disconnectButton_Click ()

    spx1.Status = 0

    userPicture.Visible = False
    receiveList.Visible = False
    connectButton.Enabled = True
    disConnectButton.Enabled = False
    cancelButton.Enabled = True

End Sub

Sub exitButton_Click ()
    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

    spx1.LinkType = 1  'REM This is the default anyway

    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

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 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 = spx1.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 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 spx1_LinkEvent ()

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

End Sub

Sub spx1_ReceiveData ()

    receiveList.Visible = True
    disConnectButton.Enabled = True
    connectButton.Enabled = False
    receiveList.AddItem spx1.Received

End Sub

Sub spx1_SendData ()

    'Fired when the packet has been sent

End Sub

Sub userPictureDrop_DblClick ()
    aboutForm.Show 1
End Sub