home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic 6 Unleashed…sional Reference Edition) / Visual_Basic_6_Unleashed_Professional_Reference_Edition_Sams_1999.iso / Source / CHAP23 / Server2.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1998-03-16  |  6.5 KB  |  192 lines
  1. VERSION 5.00
  2. Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "mswinsck.ocx"
  3. Begin VB.Form frmServer 
  4.    AutoRedraw      =   -1  'True
  5.    Caption         =   "Information Server"
  6.    ClientHeight    =   4770
  7.    ClientLeft      =   165
  8.    ClientTop       =   450
  9.    ClientWidth     =   6810
  10.    LinkTopic       =   "Form1"
  11.    ScaleHeight     =   4770
  12.    ScaleWidth      =   6810
  13.    StartUpPosition =   3  'Windows Default
  14.    Begin VB.Data Data1 
  15.       Caption         =   "Data1"
  16.       Connect         =   "Access"
  17.       DatabaseName    =   "C:\winsock\server\Inven.mdb"
  18.       DefaultCursorType=   0  'DefaultCursor
  19.       DefaultType     =   2  'UseODBC
  20.       Exclusive       =   0   'False
  21.       Height          =   345
  22.       Left            =   600
  23.       Options         =   0
  24.       ReadOnly        =   0   'False
  25.       RecordsetType   =   1  'Dynaset
  26.       RecordSource    =   "Products"
  27.       Top             =   4080
  28.       Visible         =   0   'False
  29.       Width           =   2655
  30.    End
  31.    Begin VB.ListBox List1 
  32.       Height          =   1815
  33.       Left            =   120
  34.       TabIndex        =   5
  35.       Top             =   360
  36.       Width           =   6615
  37.    End
  38.    Begin VB.Frame Frame1 
  39.       Height          =   1455
  40.       Left            =   120
  41.       TabIndex        =   0
  42.       Top             =   2400
  43.       Width           =   4095
  44.       Begin VB.Label lblUsers 
  45.          Caption         =   "Connections"
  46.          BeginProperty Font 
  47.             Name            =   "MS Sans Serif"
  48.             Size            =   9.75
  49.             Charset         =   0
  50.             Weight          =   700
  51.             Underline       =   0   'False
  52.             Italic          =   0   'False
  53.             Strikethrough   =   0   'False
  54.          EndProperty
  55.          Height          =   375
  56.          Left            =   240
  57.          TabIndex        =   7
  58.          Top             =   960
  59.          Width           =   1455
  60.       End
  61.       Begin VB.Label lblConnections 
  62.          Height          =   375
  63.          Left            =   1680
  64.          TabIndex        =   6
  65.          Top             =   960
  66.          Width           =   2175
  67.       End
  68.       Begin VB.Label lblAddress 
  69.          Height          =   255
  70.          Left            =   1680
  71.          TabIndex        =   4
  72.          Top             =   600
  73.          Width           =   2055
  74.       End
  75.       Begin VB.Label lblHostID 
  76.          Height          =   255
  77.          Left            =   1680
  78.          TabIndex        =   3
  79.          Top             =   240
  80.          Width           =   1935
  81.       End
  82.       Begin VB.Label lblIP 
  83.          Caption         =   "IP Address"
  84.          BeginProperty Font 
  85.             Name            =   "MS Sans Serif"
  86.             Size            =   9.75
  87.             Charset         =   0
  88.             Weight          =   700
  89.             Underline       =   0   'False
  90.             Italic          =   0   'False
  91.             Strikethrough   =   0   'False
  92.          EndProperty
  93.          Height          =   375
  94.          Left            =   240
  95.          TabIndex        =   2
  96.          Top             =   600
  97.          Width           =   1335
  98.       End
  99.       Begin VB.Label lblHostName 
  100.          Caption         =   "Host"
  101.          BeginProperty Font 
  102.             Name            =   "MS Sans Serif"
  103.             Size            =   9.75
  104.             Charset         =   0
  105.             Weight          =   700
  106.             Underline       =   0   'False
  107.             Italic          =   0   'False
  108.             Strikethrough   =   0   'False
  109.          EndProperty
  110.          Height          =   255
  111.          Left            =   240
  112.          TabIndex        =   1
  113.          Top             =   240
  114.          Width           =   1215
  115.       End
  116.    End
  117.    Begin MSWinsockLib.Winsock Socket 
  118.       Index           =   0
  119.       Left            =   4440
  120.       Top             =   3120
  121.       _ExtentX        =   741
  122.       _ExtentY        =   741
  123.       _Version        =   327681
  124.    End
  125. Attribute VB_Name = "frmServer"
  126. Attribute VB_GlobalNameSpace = False
  127. Attribute VB_Creatable = False
  128. Attribute VB_PredeclaredId = True
  129. Attribute VB_Exposed = False
  130. Option Explicit
  131. Dim iSockets As Integer
  132. Dim sServerMsg As String
  133. Dim sRequestID As String
  134. Private Sub cmdStop_Click()
  135. End Sub
  136. Private Sub Form_Load()
  137.   '-------------------------------------------------------------------------------------
  138.   ' Program :   Server2.exe
  139.   ' Author:     Loren D.Eidahl
  140.   ' Date  :     2/31/98
  141.   ' Notice:     Copyright(c) 1998 CTS, Inc. and Loren D. Eidahl
  142.   ' This product is supplied without support of any kind.
  143.   ' Notes:
  144.   '-----------------------------------------------------------------------------------
  145.     frmServer.Show
  146.     lblHostID.Caption = Socket(0).LocalHostName
  147.     lblAddress.Caption = Socket(0).LocalIP
  148.     Socket(0).LocalPort = 1007
  149.     sServerMsg = "Listening to port: " & Socket(0).LocalPort
  150.     List1.AddItem (sServerMsg)
  151.     Socket(0).Listen
  152. End Sub
  153. Private Sub socket_Close(Index As Integer)
  154.     sServerMsg = "Connection closed: " & Socket(Index).RemoteHostIP
  155.     List1.AddItem (sServerMsg)
  156.     Socket(Index).Close
  157.     Unload Socket(Index)
  158.     iSockets = iSockets - 1
  159.     lblConnections.Caption = iSockets
  160. End Sub
  161. Private Sub socket_ConnectionRequest(Index As Integer, ByVal requestID As Long)
  162.     sServerMsg = "Connection request id " & requestID & " from " & Socket(Index).RemoteHostIP
  163.   If Index = 0 Then
  164.     List1.AddItem (sServerMsg)
  165.     sRequestID = requestID
  166.     iSockets = iSockets + 1
  167.     lblConnections.Caption = iSockets
  168.     Load Socket(iSockets)
  169.     Socket(iSockets).LocalPort = 1007
  170.     Socket(iSockets).Accept requestID
  171.   End If
  172. End Sub
  173. Private Sub socket_DataArrival(Index As Integer, ByVal bytesTotal As Long)
  174.     Dim sItemData As String
  175.     Dim strData As String
  176.     Dim strOutData As String
  177.         
  178.     ' get data from client
  179.     Socket(Index).GetData vtData, vbString
  180.     sServerMsg = "Received: " & vtData & " from " & Socket(Index).RemoteHostIP & "(" & sRequestID & ")"
  181.     List1.AddItem (sServerMsg)
  182.     ' Get clients request from database
  183.     strData = "ItemNumber = '" & sItemData & "'"
  184.     Data1.Recordset.MoveLast
  185.     Data1.Recordset.FindFirst strData
  186.     strOutData = Data1.Recordset.Fields("Price")
  187.     'send data to client
  188.     sServerMsg = "Sending: " & strOutData & " to " & Socket(Index).RemoteHostIP
  189.     List1.AddItem (sServerMsg)
  190.     Socket(Index).SendData strOutData
  191. End Sub
  192.