Delphi Developer's Kit 1996/Delphi Developer's Kit 1996.iso/power/vbsock11/chat/client/mainwin.frm

Visual Basic Form | 1995-12-22 | 10.2 KB | 324 lines

VERSION 2.00
Begin Form MainForm
   BackColor       =   &H00C0C0C0&
   Caption         =   "Client"
   ClientHeight    =   6060
   ClientLeft      =   2490
   ClientTop       =   1260
   ClientWidth     =   7080
   Height          =   6750
   Icon            =   MAINWIN.FRX:0000
   Left            =   2430
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   ScaleHeight     =   6060
   ScaleWidth      =   7080
   Top             =   630
   Width           =   7200
   Begin VBClient VBClient1
      Prop10          =   "Click on ""..."" for the About Box ---->"
      ErrorFlag       =   0
      GiveErrorFlag   =   0  'FALSE
      Height          =   420
      HostAddress     =   ""
      Left            =   6480
      OpenFlag        =   0
      Port            =   0
      Protocol        =   0  'TCP
      SelectAction    =   0
      SinFamily       =   2  ' AF_INET
      Top             =   120
      Width           =   420
   End
   Begin CommandButton SendData
      Caption         =   "&Send"
      Default         =   -1  'True
      Enabled         =   0   'False
      Height          =   495
      Left            =   4920
      TabIndex        =   0
      Top             =   240
      Width           =   1215
   End
   Begin TextBox RecvBox
      Height          =   2175
      Left            =   240
      MaxLength       =   2000
      MultiLine       =   -1  'True
      ScrollBars      =   2  'Vertical
      TabIndex        =   4
      Top             =   3240
      Width           =   6615
   End
   Begin ComboBox ServerBox
      Height          =   300
      Left            =   240
      TabIndex        =   3
      Top             =   240
      Width           =   3495
   End
   Begin TextBox MessageBox
      Enabled         =   0   'False
      Height          =   1695
      Left            =   240
      MultiLine       =   -1  'True
      ScrollBars      =   2  'Vertical
      TabIndex        =   2
      Top             =   960
      Width           =   6615
   End
   Begin CommonDialog CMDialog1
      Filter          =   "Host File (Hosts.)|Hosts|All Files (*.*)|*.*"
      Left            =   3840
      Top             =   240
   End
   Begin CommandButton Command1
      Caption         =   "&Connect"
      Height          =   495
      Left            =   2760
      TabIndex        =   1
      Top             =   5520
      Width           =   1215
   End
   Begin Label Label1
      BackColor       =   &H00C0C0C0&
      Caption         =   "In Coming..."
      Height          =   255
      Index           =   1
      Left            =   240
      TabIndex        =   7
      Top             =   3000
      Width           =   1335
   End
   Begin Line Line1
      BorderWidth     =   4
      X1              =   240
      X2              =   6840
      Y1              =   2760
      Y2              =   2760
   End
   Begin Label Label2
      BackColor       =   &H00C0C0C0&
      Caption         =   "Send Message"
      Height          =   255
      Left            =   240
      TabIndex        =   6
      Top             =   720
      Width           =   1455
   End
   Begin Label Label1
      BackColor       =   &H00C0C0C0&
      Caption         =   "Server"
      Height          =   255
      Index           =   0
      Left            =   240
      TabIndex        =   5
      Top             =   0
      Width           =   735
   End
   Begin Menu mnuFile
      Caption         =   "&File"
      Begin Menu mnuExit
         Caption         =   "E&xit"
      End
   End
   Begin Menu MnuOptions
      Caption         =   "&Options"
      Begin Menu MnuClear
         Caption         =   "&Clear Windows"
      End
   End
DefInt A-Z
Dim ServerSocket As Integer
Dim CurrentSocket As Integer
Dim TheSendsocket As Integer
Sub Command1_Click ()
    If StartStop = START_MODE Then
        Command1.Caption = "&Disconnect"
        StartStop = STOP_MODE
        SendData.Enabled = True
        MessageBox.Enabled = True
        RecvBox.Enabled = True

        StartSendListen
        RecvBox.Text = ""
    Else
        Command1.Caption = "&Connect"
        StartStop = START_MODE
        SendData.Enabled = False
        MessageBox.Enabled = False
        RecvBox.Enabled = False

        StopSendListen
    End If
End Sub
Function FindBlank (PStringToSearch As String, PTargetString As String) As Integer
Dim LclString As String
    FindBlank = 0
    StringLen = Len(PStringToSearch)
    For ii = StringLen To 1 Step -1
        LclString = Mid$(PStringToSearch, ii)
        If Asc(LclString) < 32 Then
            FindBlank = ii
            Exit For
        End If
    Next ii
End Function
Sub Form_Load ()
'   Load the combo-box with valid servers from the
'   hosts file.
    ServerBox.Text = ServerString
    LoadServerBox ServerBox
    TheSendsocket = INVALID_SOCKET

    StartStop = START_MODE
End Sub
Sub Form_Unload (Cancel As Integer)
    StopSendListen
    ii = CleanSocket()
End Sub
' This function will take a string from a host table
' and return the server name.
' The strings in the host table take the form:
' <address> <server name>
Sub LoadServerBox (PServerBox As ComboBox)
    Dim LclString As String
    TempFileHandle = FreeFile
    On Error Resume Next
    Open HostFileName For Input As TempFileHandle
    If Err Then
        MsgBox "Can't open file: " + HostFileName
    Else
        Do While Not EOF(TempFileHandle)
            Line Input #TempFileHandle, LclString  ' Read line of data.
            LclString = ParseHostString(LclString)
            If Len(LclString) > 0 Then
                PServerBox.AddItem LclString
            End If
        Loop
    End If
   Close #TempFileHandle
End Sub
Sub MnuClear_Click ()
    MessageBox.Text = ""
    RecvBox.Text = ""
End Sub
Sub mnuExit_Click ()
  End
End Sub
Function ParseHostString (PString As String) As String
    ParseHostString = ""
    ii = FindBlank(PString, " ")
    If ii > 0 Then
        ii = ii + 1
        ParseHostString = Mid$(PString, ii)
    End If
End Function
Sub ProcessMessage ()
        Dim LclServer As String
        Dim LclString As String
        LclServer = ServerBox.Text
        LclString = "Message Recieved dude"
        SendString LclServer, LclString
End Sub
Sub SendData_Click ()
    Dim LclString As String
    Dim LclServer As String
    LclString = ServerBox.Text
    If Len(LclString) = 0 Then
        MsgBox "You Must Name a Server"
        ServerBox.SetFocus
    Else
        ServerString = ServerBox.Text
        LclServer = ServerBox.Text
        LclString = MessageBox.Text
        SendString LclServer, LclString
        MessageBox.Text = ""
        MessageBox.SetFocus
    End If
End Sub
Sub SendString (Pserver As String, PMessage As String)
    LclLen = Len(PMessage)
    ii = Sendsocket(TheSendsocket, PMessage, LclLen, 0)
End Sub
Sub StartSendListen ()
    Dim LclServer As String
    Dim ii As Integer
    LclServer = ServerBox.Text
    ii = Len(LclServer)
    If (ii <> 0) Then
        thePort = MSG_TCP_PORT
        If TheSendsocket = INVALID_SOCKET Then
           vbclient1.SelectAction = FD_ACCEPT Or FD_CLOSE Or FD_READ
           vbclient1.HostAddress = LclServer
           vbclient1.Port = thePort
           vbclient1.OpenFlag = True
           TheSendsocket = vbclient1.SocketNumber
            Select Case TheSendsocket
                Case BAD_SOCKET
                    MsgBox "Error Opening Socket: Bad Socket " + Str$(TheSendsocket)
                    Exit Sub
                Case UNRESOLVED_HOST
                    MsgBox "Error Opening Socket: Unresolved host " + Str$(TheSendsocket)
                    Exit Sub
                Case UNABLE_TO_BIND
                    MsgBox "Error Opening Socket: Unable to bind socket " + Str$(TheSendsocket)
                    Exit Sub
                Case UNABLE_TO_CONNECT
                    MsgBox "Error Opening Socket: Unable to connect socket " + Str$(TheSendsocket)
                    Exit Sub
            End Select
        End If ' TheSendsocket

    Else ' else they don't have a server
        MsgBox "You must select a server"
    End If ' end if len of LclString
End Sub
Sub StopSendListen ()
    If ServerSocket <> INVALID_SOCKET Then
        ii = CloseTheSocket(ServerSocket)
        ServerSocket = INVALID_SOCKET
    End If
    If CurrentSocket <> INVALID_SOCKET Then
        ii = CloseTheSocket(CurrentSocket)
        CurrentSocket = INVALID_SOCKET
    End If
    If TheSendsocket <> INVALID_SOCKET Then
        ii = CloseTheSocket(TheSendsocket)
        TheSendsocket = INVALID_SOCKET
    End If
End Sub
Sub VBClient1_Message (MsgVal As Integer, wparam As Integer, lparam As Long)
Dim LclBuf As String
    LclBuf = Space$(2000)
    If (wparam = TheSendsocket) Then
        ' socket closed by client
        ii = GetSelectEventSocket(lparam)
        If (ii = FD_READ) Then
            ' this assumes that no message exceeds MAX_MSG_SIZE
                LclLen = RecvSocket(TheSendsocket, LclBuf, 300, 0)
                If (LclLen > 0) Then
                    LclBuf = Mid$(LclBuf, 1, LclLen)
                    If Len(MainForm!RecvBox.Text) > 1250 Then
                        RecvBox.Text = LTrim$(Right$(RecvBox.Text, 50)) + LclBuf + Chr$(13) + Chr$(10)
                    Else
                        RecvBox.Text = RecvBox.Text + LclBuf + Chr$(13) + Chr$(10)
                    End If
                    LclBuf = RecvBox.Text
                    ii = Len(LclBuf)
                    RecvBox.SelStart = ii
                    LclBuf = ""
                    If MainForm.WindowState = MINIMIZED Then
                        MainForm.WindowState = NORMAL
                        Beep
                    End If
                    If AutoFlag = True Then
                        RecvBox.Text = RecvBox.Text + "AutoFlag True" + Chr$(13) + Chr$(10)
                        ProcessMessage
                    End If

            End If
        End If
    End If 'end if wp = TheSendsocket */
End Sub