home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / CODE_UPLOAD78987182000.psc / modServer.bas < prev    next >
Encoding:
BASIC Source File  |  2000-07-18  |  2.2 KB  |  95 lines
  1. Attribute VB_Name = "modServer"
  2. Option Explicit
  3. Public Type User
  4.     Connection As String
  5.     RequestID As Long
  6.     Name As String
  7. End Type
  8.  
  9. Public iPort As Integer
  10. Public uUser(50) As User
  11. Public iClients As Integer
  12. Public strOriginalUser As String
  13. Public dBase As Database
  14.  
  15. Private Sub Main()
  16.  
  17. Dim i As Integer
  18. Dim strTemp As String
  19.  
  20. strTemp = modIni.GetINIValue("Server", "Port", App.Path & "\chat.ini")
  21. If strTemp <> "" Then
  22.     iPort = Int(strTemp)
  23. Else
  24.     iPort = 0
  25. End If
  26.  
  27. If iPort = 0 Then
  28.     iPort = 80
  29.     i = modIni.SetINIValue("Server", "Port", "80", App.Path & "\chat.ini")
  30. End If
  31.  
  32. Set dBase = OpenDatabase(App.Path & "\auth.mdb")
  33.  
  34. frmServer.Show
  35. frmServer.Caption = "Chat Server"
  36.  
  37. End Sub
  38.  
  39.  
  40. Function FindOpenSocket(frmMe As Form)
  41. 'this function finds and returns the first open socket
  42. 'available for the incoming request
  43. 'this fixes the problem of sockets staying open after a user has
  44. 'disconnected.  With this code in place, the next user will pick
  45. 'up the previous users spot, rather than get a brand new one
  46.  
  47. Dim i As Integer
  48.  
  49. For i = 1 To frmMe.wsServer.ubound
  50.     If uUser(i).Connection = "" Or uUser(i).Connection = "Disconnected" Then
  51.         FindOpenSocket = i
  52.         i = frmMe.wsServer.ubound + 1
  53.     End If
  54. Next i
  55.  
  56. If FindOpenSocket = 0 Then
  57.     FindOpenSocket = i
  58. End If
  59. End Function
  60.  
  61. Function DupeName(frmMe As Form, strName As String) As Boolean
  62. 'look for a duplicate name
  63. Dim i As Integer
  64.  
  65. For i = 1 To frmMe.wsServer.ubound
  66.     If uUser(i).Connection = "Connected" Then
  67.         If UCase(uUser(i).Name) = strName Then
  68.             DupeName = True
  69.             i = frmMe.wsServer.ubound + 1
  70.         End If
  71.     End If
  72. Next i
  73.  
  74. End Function
  75.  
  76. Function Authorize(strUser As String, strPassword As String) As Boolean
  77.  
  78. Dim RsTemp As Recordset
  79. Dim strSelect As String
  80.  
  81. strSelect = "SELECT * FROM Users"
  82. Set RsTemp = dBase.OpenRecordset(strSelect)
  83.  
  84. Do Until RsTemp.EOF
  85.     If UCase(strUser) = UCase(RsTemp!UserName) Then
  86.         If strPassword = RsTemp!Password Then
  87.             Authorize = True
  88.             RsTemp.MoveLast
  89.         End If
  90.     End If
  91.     RsTemp.MoveNext
  92. Loop
  93. RsTemp.Close
  94. End Function
  95.