home *** CD-ROM | disk | FTP | other *** search
Wrap
VERSION 5.00 Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX" Object = "{6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.3#0"; "COMCTL32.OCX" Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX" Begin VB.Form frmChat BackColor = &H00FF8080& BorderStyle = 1 'Fixed Single Caption = "Cool Chat" ClientHeight = 6765 ClientLeft = 45 ClientTop = 645 ClientWidth = 7230 FillColor = &H00008080& HelpContextID = 10 Icon = "Chat.frx":0000 LinkTopic = "Form1" MaxButton = 0 'False ScaleHeight = 6765 ScaleWidth = 7230 StartUpPosition = 2 'CenterScreen Begin VB.Frame FrameCheckEmail BackColor = &H00FF8080& Caption = "Check Email" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H0000FFFF& Height = 2415 Left = 120 TabIndex = 44 Top = 3840 Visible = 0 'False Width = 6975 Begin VB.CommandButton cmdCheckEmail Caption = "Check Mail" Height = 315 Left = 5640 TabIndex = 53 Top = 2040 Width = 1215 End Begin VB.TextBox txtPassword Height = 285 IMEMode = 3 'DISABLE Left = 3840 PasswordChar = "*" TabIndex = 2 Text = "Jasean94" ToolTipText = "Pop3 Password (Usually same as ISP password)" Top = 1920 Width = 1335 End Begin VB.CheckBox chkLogStatus Alignment = 1 'Right Justify BackColor = &H00FF8080& BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 495 Left = 6000 TabIndex = 3 ToolTipText = "Check this if you want to see the responses from the POP3 server" Top = 600 Width = 255 End Begin VB.TextBox txtServer Height = 285 Left = 240 TabIndex = 0 Text = "216.169.120.181" ToolTipText = "Usually: mail.yourisp.com , pop.yourisp.com , pop3.yourisp.com (Not for AOL users)" Top = 1920 Width = 1695 End Begin VB.TextBox txtUser Height = 285 Left = 2160 TabIndex = 1 Text = "ebonyhq" ToolTipText = "Pop3 Username (Usually same as ISP username)" Top = 1920 Width = 1455 End Begin VB.TextBox txtPOP3Port Height = 285 Left = 5880 TabIndex = 5 Text = "110" ToolTipText = "POP3 Port - Default is 110" Top = 1440 Width = 495 End Begin VB.Frame FrameCheckEmailStatus BackColor = &H00FF8080& Caption = "Port Connection Status:" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 1215 Left = 120 TabIndex = 45 Top = 360 Width = 5295 Begin ComctlLib.ProgressBar ProgressBar2 Height = 135 Left = 120 TabIndex = 47 ToolTipText = "Status Progress Bar" Top = 960 Width = 5055 _ExtentX = 8916 _ExtentY = 238 _Version = 327682 Appearance = 1 End Begin VB.ListBox lstStatus Height = 645 Left = 120 TabIndex = 46 TabStop = 0 'False ToolTipText = "Port Status Messages" Top = 240 Width = 5055 End End Begin VB.Label lblCaption Alignment = 2 'Center BackColor = &H00FF8080& Caption = "Show Port Status" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 375 Index = 4 Left = 5640 TabIndex = 52 Top = 240 Width = 975 End Begin VB.Label lblCaption Alignment = 2 'Center BackColor = &H00FF8080& Caption = "Port:" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 255 Index = 0 Left = 5760 TabIndex = 51 Top = 1200 Width = 615 End Begin VB.Label lblCaption BackColor = &H00FF8080& Caption = "POP3 Server:" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 255 Index = 1 Left = 240 TabIndex = 50 Top = 1680 Width = 1215 End Begin VB.Label lblCaption BackColor = &H00FF8080& Caption = "Username:" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 255 Index = 2 Left = 2160 TabIndex = 49 Top = 1680 Width = 975 End Begin VB.Label lblCaption BackColor = &H00FF8080& Caption = "Password:" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 255 Index = 3 Left = 4200 TabIndex = 48 Top = 1680 Width = 975 End End Begin VB.Frame FrameUtility BackColor = &H00FF8080& Caption = "Utilities" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H0000FFFF& Height = 735 Left = 120 TabIndex = 34 Top = 3000 Width = 6975 Begin MSComDlg.CommonDialog CommonDialog1 Left = 5040 Top = 240 _ExtentX = 847 _ExtentY = 847 _Version = 393216 End Begin VB.Timer tmrClock Enabled = 0 'False Interval = 1000 Left = 1560 Top = 120 End Begin VB.Timer tmrFlash Enabled = 0 'False Interval = 500 Left = 3000 Top = 120 End Begin VB.OptionButton optUtility BackColor = &H00FF8080& Caption = "Connect Options" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 255 Index = 0 Left = 120 TabIndex = 37 Top = 360 Value = -1 'True Width = 1815 End Begin VB.OptionButton optUtility BackColor = &H00FF8080& Caption = "Check Email" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 255 Index = 2 Left = 3600 TabIndex = 36 Top = 360 Width = 1455 End Begin VB.OptionButton optUtility BackColor = &H00FF8080& Caption = "Send Email" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 255 Index = 1 Left = 2040 TabIndex = 35 Top = 360 Width = 1335 End Begin MSWinsockLib.Winsock Winsock3 Left = 5400 Top = 240 _ExtentX = 741 _ExtentY = 741 _Version = 393216 End Begin MSWinsockLib.Winsock Winsock1 Left = 5880 Top = 240 _ExtentX = 741 _ExtentY = 741 _Version = 393216 End Begin MSWinsockLib.Winsock Winsock2 Left = 6480 Top = 240 _ExtentX = 741 _ExtentY = 741 _Version = 393216 End Begin ComctlLib.ImageList ImageList1 Left = 6240 Top = 0 _ExtentX = 1005 _ExtentY = 1005 BackColor = -2147483643 ImageWidth = 74 ImageHeight = 90 MaskColor = 12632256 _Version = 327682 BeginProperty Images {0713E8C2-850A-101B-AFC0-4210102A8DA7} NumListImages = 2 BeginProperty ListImage1 {0713E8C3-850A-101B-AFC0-4210102A8DA7} Picture = "Chat.frx":27A2 Key = "" EndProperty BeginProperty ListImage2 {0713E8C3-850A-101B-AFC0-4210102A8DA7} Picture = "Chat.frx":76B4 Key = "" EndProperty EndProperty End End Begin VB.Frame FrameSendText BackColor = &H00FF8080& Caption = "Send Text" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H0000FFFF& Height = 615 Left = 120 TabIndex = 31 Top = 2280 Width = 6975 Begin VB.Frame FrameCounter BackColor = &H00FF8080& BorderStyle = 0 'None Caption = "Online For:" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H0000FFFF& Height = 375 Left = 4320 TabIndex = 38 Top = 120 Width = 2535 Begin VB.Label lblMinutes Alignment = 2 'Center BackColor = &H00FFC0C0& BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H000000C0& Height = 255 Left = 0 TabIndex = 42 Top = 120 Width = 375 End Begin VB.Label Label2 BackColor = &H00FFC0C0& Caption = "Minute(s)" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 255 Left = 360 TabIndex = 41 Top = 120 Width = 855 End Begin VB.Label lblSeconds Alignment = 2 'Center BackColor = &H00FFC0C0& BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H000000C0& Height = 255 Left = 1200 TabIndex = 40 Top = 120 Width = 375 End Begin VB.Label Label3 BackColor = &H00FFC0C0& Caption = "Seconds" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 255 Left = 1560 TabIndex = 39 Top = 120 Width = 855 End End Begin VB.CommandButton cmdSendText Caption = "Send Text" Height = 255 Left = 3000 TabIndex = 33 ToolTipText = "This button send the text to the left to the other party" Top = 240 Width = 1095 End Begin VB.TextBox txtSendText Height = 285 Left = 120 TabIndex = 32 ToolTipText = "Text to send to your friend" Top = 240 Width = 2775 End End Begin VB.Frame FrameStatus BackColor = &H00FF8080& Caption = "Status:" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H0000FFFF& Height = 2175 Left = 5760 TabIndex = 28 Top = 0 Width = 1335 Begin VB.CommandButton cmdConnect Caption = "Connect" Height = 375 Left = 120 TabIndex = 30 ToolTipText = "This button controls Connecting, Disconnecting and Listening" Top = 1680 Width = 1095 End Begin VB.PictureBox imgConnecting Appearance = 0 'Flat AutoSize = -1 'True BackColor = &H00FF8080& BorderStyle = 0 'None ForeColor = &H80000008& Height = 1350 Left = 120 Picture = "Chat.frx":C5C6 ScaleHeight = 1350 ScaleWidth = 1110 TabIndex = 29 Top = 240 Visible = 0 'False Width = 1110 End Begin VB.Image imgOnline Height = 1350 Left = 120 Picture = "Chat.frx":D5BF Top = 240 Visible = 0 'False Width = 1110 End Begin VB.Image imgOffline Height = 1350 Left = 120 Picture = "Chat.frx":E5C9 Top = 240 Width = 1110 End End Begin ComctlLib.StatusBar StatusBar1 Align = 2 'Align Bottom Height = 375 Left = 0 TabIndex = 19 Top = 6390 Width = 7230 _ExtentX = 12753 _ExtentY = 661 SimpleText = "" _Version = 327682 BeginProperty Panels {0713E89E-850A-101B-AFC0-4210102A8DA7} NumPanels = 3 BeginProperty Panel1 {0713E89F-850A-101B-AFC0-4210102A8DA7} Alignment = 1 Object.Width = 2469 MinWidth = 2469 Object.Tag = "" EndProperty BeginProperty Panel2 {0713E89F-850A-101B-AFC0-4210102A8DA7} Alignment = 1 Object.Width = 7937 MinWidth = 7937 Object.Tag = "" EndProperty BeginProperty Panel3 {0713E89F-850A-101B-AFC0-4210102A8DA7} Style = 5 Alignment = 1 Object.Width = 2293 MinWidth = 2293 TextSave = "2:17 AM" Object.Tag = "" EndProperty EndProperty End Begin VB.TextBox txtIncomingData Height = 2175 Left = 120 MultiLine = -1 'True ScrollBars = 2 'Vertical TabIndex = 4 Top = 0 Width = 5655 End Begin VB.Frame FrameSendEmail BackColor = &H00FF8080& Caption = "Send Email" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H0000FFFF& Height = 2175 Left = 120 TabIndex = 20 Top = 3840 Visible = 0 'False Width = 6975 Begin VB.Frame FrameSendEmailStatus BackColor = &H00FF8080& Caption = "Status" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 1695 Left = 5400 TabIndex = 25 Top = 240 Width = 1455 Begin VB.CommandButton cmdSendMail Caption = "Send" Height = 255 Left = 120 TabIndex = 54 Top = 1200 Width = 1215 End Begin ComctlLib.ProgressBar ProgressBar1 Height = 135 Left = 120 TabIndex = 26 Top = 720 Width = 1215 _ExtentX = 2143 _ExtentY = 238 _Version = 327682 Appearance = 1 End Begin VB.Label StatusTxt BackColor = &H00FF8080& Height = 375 Left = 120 TabIndex = 27 ToolTipText = "Status Messages" Top = 240 Width = 1215 End End Begin VB.TextBox txtEmailBodyOfMessage Height = 1215 Left = 2040 MultiLine = -1 'True ScrollBars = 2 'Vertical TabIndex = 10 ToolTipText = "Put your text here" Top = 240 Width = 3255 End Begin VB.TextBox txtToEmailAddress Height = 285 Left = 120 TabIndex = 7 Top = 1080 Width = 1815 End Begin VB.TextBox txtFromEmailAddress Height = 285 Left = 120 TabIndex = 6 ToolTipText = "youremail@yourisp.com" Top = 480 Width = 1815 End Begin VB.TextBox txtEmailServer Height = 285 Left = 120 TabIndex = 8 Text = "12.9.25.36" ToolTipText = "mail.yourisp.com or smtp.yourisp.com" Top = 1680 Width = 1815 End Begin VB.TextBox txtEmailSubject Height = 285 Left = 2040 TabIndex = 9 ToolTipText = "Email Subject" Top = 1680 Width = 3255 End Begin VB.Label Label7 BackColor = &H00FF8080& Caption = "Send To:" BeginProperty Font Name = "MS Sans Serif" Size = 9.75 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 255 Left = 120 TabIndex = 24 Top = 840 Width = 975 End Begin VB.Label Label1 BackColor = &H00FF8080& Caption = "Your Email Address:" BeginProperty Font Name = "MS Sans Serif" Size = 9.75 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 255 Left = 120 TabIndex = 23 Top = 240 Width = 1935 End Begin VB.Label Label5 BackColor = &H00FF8080& Caption = "SMTP Address:" BeginProperty Font Name = "MS Sans Serif" Size = 9.75 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 255 Left = 120 TabIndex = 22 Top = 1440 Width = 1935 End Begin VB.Label Label6 BackColor = &H00FF8080& Caption = "Subject:" BeginProperty Font Name = "MS Sans Serif" Size = 9.75 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 255 Left = 2040 TabIndex = 21 Top = 1440 Width = 855 End End Begin VB.Frame FrameConnectOptions BackColor = &H00FF8080& Caption = "Connect Options" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H0000FFFF& Height = 975 Left = 120 TabIndex = 16 Top = 3840 Width = 6975 Begin VB.TextBox txtNick Height = 285 Left = 5040 TabIndex = 15 Text = "Nick Name" ToolTipText = "You can change the Nickname even during a chat session" Top = 480 Width = 1215 End Begin VB.TextBox txtPort Height = 285 Left = 4200 TabIndex = 14 Text = "1005" ToolTipText = "The Host AND Guest MUST use the same port number" Top = 480 Width = 615 End Begin VB.TextBox txtIP Height = 285 Left = 2520 TabIndex = 13 Text = "localhost" ToolTipText = "If you're connecting to yourself, then leave as Localhost... Otherwise enter the IP# of the Host" Top = 480 Width = 1415 End Begin VB.OptionButton optHostGuest BackColor = &H00FF8080& Caption = "GUEST" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H000000FF& Height = 195 Index = 1 Left = 1200 TabIndex = 12 ToolTipText = "You will connect to a host... Get the IP# of the Host and enter below" Top = 480 Value = -1 'True Width = 1095 End Begin VB.OptionButton optHostGuest BackColor = &H00FF8080& Caption = "HOST" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H000000FF& Height = 195 Index = 0 Left = 120 TabIndex = 11 ToolTipText = "You will receive the connection, tell your friend your IP#" Top = 480 Width = 975 End Begin VB.Label LabelNick Alignment = 2 'Center AutoSize = -1 'True BackColor = &H00FF8080& Caption = "Nick Name" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 195 Left = 5040 TabIndex = 43 Top = 240 Width = 975 End Begin VB.Label LabelAddress AutoSize = -1 'True BackColor = &H00FF8080& Caption = "Address" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 195 Left = 2520 TabIndex = 18 Top = 240 Width = 690 End Begin VB.Label labelPort Alignment = 2 'Center AutoSize = -1 'True BackColor = &H00FF8080& Caption = "Port" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 195 Left = 4200 TabIndex = 17 Top = 240 Width = 375 End End Begin VB.Menu mnuFile Caption = "&File" Begin VB.Menu mnuExit Caption = "E&xit" End End Begin VB.Menu mnuOptions Caption = "&Colors" Begin VB.Menu mnuColor Caption = "Background Color" End Begin VB.Menu mnuFrameColor Caption = "Frame Background Colors" End Begin VB.Menu mnuFrameCapColor Caption = "Frame Caption Color" End End Begin VB.Menu mnuHelp Caption = "&Help" Begin VB.Menu mnuHelpContents Caption = "Contents" HelpContextID = 10 End Begin VB.Menu mnuAbout Caption = "&About" End End Attribute VB_Name = "frmChat" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False 'Written by Michael Sharp (aka Mike D.) mdsharp@netzero.net 'Notes: 'In case you can't figure out how I got all the images 'to change, depending on the connection status, I have 4 'different images laid on top of each other (imgConnecting, 'imgOnline, imgOffline, imgConnecting (you can move 'them around on the form layout to see)) 'Chat variables Dim IP As String Dim s As Integer Dim m As Integer 'Utilities: Send Email variables Dim Response As String, Reply As Integer, DateNow As String Dim first As String, Second As String, Third As String Dim Fourth As String, Fifth As String, Sixth As String Dim Seventh As String, Eighth As String, Ninth As String Dim start As Single, Tmr As Single 'Utilities: Check Email variables Option Explicit 'Constant used to limit the number of list 'box items before removing the oldest Private Const MAX_LIST_ITEMS = 100 'Variables to store waiting message information Private mnMessageCount As Integer Private mlMessageChars As Long 'This variable hold the most recent command 'that was sent to the POP3 Server Private msCommand As String 'State of the Log Port Status Check Box Private mbLogStatus As Boolean 'Variable to track state of socket data reception Private mbGotData As Boolean 'Array for socket state descriptions Private mvntSocketState As Variant '################# BEGIN CHAT SUBS ###################### 'Below Subs (Offline, Online, Connecting & Listening 'are repetitious tasks that are called from other 'Subs. Instead of putting these 10 or so lines in each Sub 'that they belong to, I put them up here which makes it 'easier to figure out the heart of each sub instead of 'being bombarded by all of these .Visible's , etc 'Perhaps I could've made some modules? Public Sub Offline() imgOffline.Visible = True imgOnline.Visible = False imgConnecting.Visible = False txtPort.Enabled = True txtNick.Enabled = True txtIP.Enabled = True cmdSendText.Enabled = False txtSendText.Enabled = False optHostGuest(0).Enabled = True optHostGuest(1).Enabled = True StatusBar1.Panels(2).Text = "" Winsock1.Close 'Reset Online Timer tmrClock.Enabled = False s = 0 m = 0 FrameCounter.Visible = False lblSeconds.Caption = "" lblMinutes.Caption = "" tmrFlash.Enabled = False End Sub Public Sub Online() imgOnline.Visible = True imgOffline.Visible = False imgConnecting.Visible = False txtIP.Enabled = False txtPort.Enabled = False cmdSendText.Enabled = True txtSendText.Enabled = True txtIncomingData.Text = "" optHostGuest(0).Enabled = False optHostGuest(1).Enabled = False cmdConnect.Caption = "Disconnect" tmrFlash.Enabled = False End Sub Public Sub Connecting() tmrFlash.Enabled = True imgConnecting.Visible = True imgOffline.Visible = False imgOnline.Visible = False cmdSendText.Enabled = False txtSendText.Enabled = False StatusBar1.Panels(2).Text = "CONTACTING HOST..." Winsock1.Close IP = txtIP.Text If LCase$(IP) = "localhost" Then IP = Winsock1.LocalIP Winsock1.Connect txtIP.Text, txtPort.Text End Sub Public Sub Listening() imgConnecting.Visible = True imgOffline.Visible = False imgOnline.Visible = False cmdSendText.Enabled = False txtSendText.Enabled = False Winsock1.Close Winsock1.LocalPort = txtPort.Text 'set the port Winsock1.Listen 'tell it to listen StatusBar1.Panels(2).Text = "LISTENING ON PORT: " & txtPort.Text tmrFlash.Enabled = True End Sub Private Sub cmdConnect_Click() If cmdConnect.Caption = "Connect" Or cmdConnect.Caption = "Listen" Then 'If the button is showing Connect or Listen, then we are 'currently offline, so do this: 'Now do the Online sub Call Online Else 'If the button is NOT showing Connect or Listen, then we 'must be Offline, so call the Offline sub Call Offline If optHostGuest(0).Value = True Then cmdConnect.Caption = "Listen" 'If the Host button is checked, then we dont want 'to do the Online sub, which is for Guest Mode, we 'want to call the Listening Sub: Call Listening Else 'Else we are already Listening in Host mode, so Go Offline cmdConnect.Caption = "Connect" End If Call Offline Exit Sub End If Select Case optHostGuest(0).Value Case True: 'Host 'Listen for connections Call Listening Case False: 'Guest 'Try to connect Call Connecting End Select End Sub Private Sub cmdSendMail_Click() On Error GoTo ErrorHandling SendEmail txtEmailServer.Text, txtFromEmailAddress.Text, txtFromEmailAddress.Text, txtToEmailAddress.Text, txtToEmailAddress.Text, txtEmailSubject.Text, txtEmailBodyOfMessage.Text MsgBox ("Mail Sent") StatusTxt.Caption = "Mail Sent" StatusTxt.Refresh Beep Close ErrorHandling: Winsock2.Close End Sub Private Sub mnuAbout_Click() frmAbout.Show End Sub Private Sub mnuColor_Click() On Error GoTo Cancel CommonDialog1.ShowColor frmChat.BackColor = CommonDialog1.Color Cancel: End Sub Private Sub mnuExit_Click() Unload Me End Sub Private Sub mnuFrameCapColor_Click() On Error GoTo Cancel CommonDialog1.ShowColor FrameSendText.ForeColor = CommonDialog1.Color FrameUtility.ForeColor = CommonDialog1.Color FrameSendEmail.ForeColor = CommonDialog1.Color FrameCheckEmail.ForeColor = CommonDialog1.Color FrameCounter.ForeColor = CommonDialog1.Color FrameConnectOptions.ForeColor = CommonDialog1.Color FrameStatus.ForeColor = CommonDialog1.Color FrameSendEmailStatus.ForeColor = CommonDialog1.Color FrameCheckEmailStatus.ForeColor = CommonDialog1.Color Cancel: End Sub Private Sub mnuFrameColor_Click() On Error GoTo Cancel CommonDialog1.ShowColor FrameSendText.BackColor = CommonDialog1.Color FrameUtility.BackColor = CommonDialog1.Color FrameSendEmail.BackColor = CommonDialog1.Color FrameCheckEmail.BackColor = CommonDialog1.Color FrameCounter.BackColor = CommonDialog1.Color FrameConnectOptions.BackColor = CommonDialog1.Color FrameStatus.BackColor = CommonDialog1.Color FrameSendEmailStatus.BackColor = CommonDialog1.Color FrameCheckEmailStatus.BackColor = CommonDialog1.Color optUtility(0).BackColor = CommonDialog1.Color optUtility(1).BackColor = CommonDialog1.Color optUtility(2).BackColor = CommonDialog1.Color lblCaption(0).BackColor = CommonDialog1.Color lblCaption(1).BackColor = CommonDialog1.Color lblCaption(2).BackColor = CommonDialog1.Color lblCaption(3).BackColor = CommonDialog1.Color lblCaption(4).BackColor = CommonDialog1.Color chkLogStatus.BackColor = CommonDialog1.Color optHostGuest(0).BackColor = CommonDialog1.Color optHostGuest(1).BackColor = CommonDialog1.Color LabelAddress.BackColor = CommonDialog1.Color labelPort.BackColor = CommonDialog1.Color LabelNick.BackColor = CommonDialog1.Color Label1.BackColor = CommonDialog1.Color Label2.BackColor = CommonDialog1.Color Label3.BackColor = CommonDialog1.Color Label5.BackColor = CommonDialog1.Color Label6.BackColor = CommonDialog1.Color Label7.BackColor = CommonDialog1.Color StatusTxt.BackColor = CommonDialog1.Color Cancel: End Sub Private Sub mnuHelpContents_Click() Shell "winhelp.exe coolchat.hlp", vbNormalFocus End Sub Private Sub cmdCheckEmail_Click() Dim nMonitorPort As Integer Dim sServer As String 'Get the Value used for the server name sServer = txtServer.Text If Len(sServer) = 0 Then MsgBox "Plese enter the POP3 server name" Exit Sub End If 'Get the value used for the port connection nMonitorPort = CInt(txtPort.Text) If nMonitorPort = 0 Then MsgBox "Please enter the POP3 server and Port (Default = 110)" Exit Sub End If 'Error checking for username and password has been 'left out intentionally to show the error messages 'returned by the POP3 Server cmdCheckEmail.Enabled = False 'Connect and get the message count lstStatus.Clear Call POP3CheckMail cmdCheckEmail.Enabled = True End Sub Private Sub optHostGuest_Click(Index As Integer) 'Does something when either Guest or Host value is checked '(Not pushing the connect button, just clicking the options) Select Case Index Case 0: 'Host value is clicked on 'Automatically paste your IP# in the Address box IP = Winsock1.LocalIP txtIP.Text = IP 'Prevent the address from being changed txtIP.Locked = True txtIP.Enabled = False cmdConnect.Caption = "Listen" StatusBar1.Panels(1).Text = "HOST MODE" Case 1: 'Guest value is clicked on txtIP.Text = "localhost" cmdConnect.Caption = "Connect" txtIP.Locked = False txtIP.Enabled = True StatusBar1.Panels(1).Text = "GUEST MODE" End Select End Sub Private Sub cmdSendText_Click() 'Send Text to other party Winsock1.SendData txtNick.Text & ": " & txtSendText.Text 'Display YOUR text on your screen, too txtIncomingData.Text = txtIncomingData.Text + vbCrLf + txtNick.Text + ": " + txtSendText.Text 'Make the text box blank after we send the text. 'otherwise, we'd have to erase all the characters before 'sending a new message, EVERYTIME txtSendText.Text = "" End Sub Private Sub Form_Load() StatusBar1.Panels(1).Text = "GUEST MODE" cmdSendText.Enabled = False txtSendText.Enabled = False FrameCounter.Visible = False txtIncomingData.Text = "Welcome to Cool Chat!" & vbCrLf & _ "Click on this screen to clear the text at anytime." StatusBar1.Panels(2).Text = "Cool Chat v" & App.Major & "." & App.Minor & "." & App.Revision & " - MDSoftware" 'Check Email variables 'Load the variant arrary with socket states mvntSocketState = Array("Closed", "Opening", "Listening", "Connection Pending", "Resolving Host", "Host Resolved", "Connecting", "Connected", "Closing", "Error") 'Initialize the log status state to false mbLogStatus = False End Sub Private Sub optUtility_Click(Index As Integer) Select Case Index Case 0: 'Connection Options FrameConnectOptions.Visible = True FrameSendEmail.Visible = False FrameCheckEmail.Visible = False Case 1: 'Send Email FrameConnectOptions.Visible = False FrameSendEmail.Visible = True FrameCheckEmail.Visible = False IP = Winsock1.LocalIP txtEmailBodyOfMessage.Text = "My IP number is: " & IP Case 2: ' Check Email FrameConnectOptions.Visible = False FrameSendEmail.Visible = False FrameCheckEmail.Visible = True End Select End Sub Private Sub tmrClock_Timer() 'This does nothing but simply display an online timer 'when a connection is complete 'Note if you want to make a timer like this, make sure 'you set the Interval in Properties to 1000 'Simplest form to do a timer is: 's = s + 1 'Label1.Caption = s (for Label) or Text1.Text = s (for text) 'Just those 2 lines will make you a seconds counter. s = s + 1 'When seconds gets to 60, then restart to 0 and add 1 to minutes If s = 60 Then s = 0 m = m + 1 End If 'When the first minutes is reached display it If m > 0 Then lblMinutes.Caption = m End If lblSeconds.Caption = s End Sub Private Sub tmrFlash_Timer() Static blnImage1 As Boolean If blnImage1 Then imgConnecting.Picture = ImageList1.ListImages(1).Picture imgConnecting.Picture = ImageList1.ListImages(2).Picture End If blnImage1 = Not blnImage1 End Sub Private Sub txtIncomingData_Change() 'Makes the chat screen auto scroll 'BTW, Len is used to tell you the length (# of characters) 'in a text ("string") Variable txtIncomingData.SelStart = Len(txtIncomingData) End Sub Private Sub txtIncomingData_Click() txtIncomingData.Text = "" End Sub Private Sub txtSendText_KeyPress(KeyAscii As Integer) If KeyAscii = 13 Then 'If user pressed 'Enter' cmdSendText_Click 'click 'Send' button KeyAscii = 0 'Make sure it doesnt write enter to txtText End If End Sub Private Sub Winsock1_Close() 'What happens when a connection is closed/terminated Select Case optHostGuest(0).Value Case True: 'Host closed Winsock cmdConnect_Click 'Click the Disconnect button cmdConnect_Click 'Click Listen button again for Listen Mode MsgBox "Connection terminated by Guest. Server has been reset and awaiting a new client..." Case False: 'Guest closed Winsock MsgBox "Connection terminated by Host..." cmdConnect_Click 'Push the disconnect button to make offline End Select End Sub Private Sub Winsock1_Connect() Select Case optHostGuest(0).Value Case True: 'Host got a connection 'I left this blank because the "CLIENT CONNECTED" msg 'is displayed below in the Winsock1_ConnectionRequest Sub 'along with the Call Online command Case False: 'Guest got a connection Call Online StatusBar1.Panels(2).Text = "CONNECTED TO HOST" End Select 'Turn on and show Online Timer FrameCounter.Visible = True tmrClock.Enabled = True End Sub Private Sub Winsock1_ConnectionRequest(ByVal requestID As Long) 'When Host received a Connection Request... If Winsock1.State <> sckClosed Then Winsock1.Close Winsock1.LocalPort = txtPort.Text Winsock1.Accept requestID 'accept the connection Online StatusBar1.Panels(2).Text = "CLIENT CONNECTED" FrameCounter.Visible = True tmrClock.Enabled = True End If End Sub Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long) 'Get incoming chat data and put it in the Text Box Dim Data As String Winsock1.GetData Data 'gets the data txtIncomingData.Text = txtIncomingData.Text + vbCrLf & Data End Sub Private Sub Winsock1_Error(ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean) 'What to do if an error occurs, this usually happens 'the Host is not Listening or your ISP is down StatusBar1.Panels(2).Text = "WINSOCK ERROR: " & Err cmdConnect_Click 'Push the disconnect button to reset MsgBox "UNABLE TO CONNECT..." End Sub '#################### END CHAT SUBS ############### '#################### SEND EMAIL SUBS ####################### Sub SendEmail(MailServerName As String, FromName As String, FromEmailAddress As String, ToName As String, ToEmailAddress As String, EmailSubject As String, EmailBodyOfMessage As String) On Error GoTo ErrorHandler Winsock2.LocalPort = 0 ' Must set local port to 0 (Zero) or you can only send 1 e-mail pre program start If Winsock2.State = sckClosed Then ' Check to see if socet is closed DateNow = Format(Date, "Ddd") & ", " & Format(Date, "dd Mmm YYYY") & " " & Format(Time, "hh:mm:ss") & "" & " -0600" first = "mail from:" + Chr(32) + FromEmailAddress + vbCrLf ' Get who's sending E-Mail address Second = "rcpt to:" + Chr(32) + ToEmailAddress + vbCrLf ' Get who mail is going to Third = "Date:" + Chr(32) + DateNow + vbCrLf ' Date when being sent Fourth = "From:" + Chr(32) + FromName + vbCrLf ' Who's Sending Fifth = "To:" + Chr(32) + ToEmailAddress + vbCrLf ' Who it going to Sixth = "Subject:" + Chr(32) + EmailSubject + vbCrLf ' Subject of E-Mail Seventh = EmailBodyOfMessage + vbCrLf ' E-mail message body Ninth = "X-Mailer: EBT Reporter v 2.x""To:" + Chr(32Y2Frames Undeext = 2>''ng, EmaendText_CiTFalse txtSenquest Ss") f ' EpmmonDiacelpContFalse txtSenquest Ss") f ' Ewen is used to tell you N, thiT(32Y2F= 'o thep.Major & "." & App.Minor & "." &d "Contenalog1.Colin a textt0pd") & "/ CaltmdCheckEll you NLdgir3) + Frou ' E-mail mesrty Font e it dTg Frou ' ' ' ' 24 CTE(2), By=hat ho+ vbCd Framer() If io+ vbCdow + v1 lpFila2v = 110)" o.net de'request(ByVal statuy Foe i Format(Time,ate Subsae Winsock1nection u-a NLdgir3) + Fp.ust clicking NLdgir1o = TruykColoBS #################bCd Framer() Framor chkLogStatus.BackColor = As Long, ByVal S SeByVal S SeByVal S SeByVof E-Mail SeiS.Pane 13 port to 0 (=s txtLn theng, '###############m####cv being sent Fourth = "Fn leave as LocaliuA.=hatS S Sevent e-maabled = False se optHnDthe POPo t,g, '##Array("CIP.Texuursalog1.ryct" Or cmdConneS p desc"Subject: a ENr(3oes something wheer() Four T 8.25 Charset = Dalse: ' Ninth tusBar Winr:e Italic YYY")efy discofy dis)i FromEma End Sub '#################### END CHAT SUBS ############### '#################### SEND EMAIL SUBSa######## END CHAT SUBS ### Exs)txtIP.Enabled r ve enter the Pncomind = False End Sub 2(mmonDialog1.Com YYYY") & " "r = CommonDialog1.Color optUtility(1).BackColor = UnderliUd ponDiaEnd Sub vwe areosic Sub ConP" w+ vbCrLf CHAT S= CommonDNL SrOme End Sub wext at 'IxtIP'hConP" FrameuckColor =ocus !e v 2.x""Tr ho+ Case False: 'r1o = TrlerDNtlosed WinP" FrameuckColor =ocus !ei polor =o 's = s o i Format(TiPUcBar WWh Sub wexalog1.Co(-Private Sub WMS Sanso i Format(TiPUcBar m24 CTE(2), By=hat d W FroMajor & '#######.Visible = True is)i FromEma En.25 Dim Dt_Cittton is checkb WMSpmmonDiao1.Sen 'LaID 'accept the connectioAr.25 Dim uListbessagAddress bochaolorororororbocI5bi.Text, txtToEmail&d "Contenalog1.Colin a tlEin a tlEin a tlEin a tlEwexal' i arou ' ox txtTo i a5bi.Text, txtToEmail&d "ContenaloElor = CommonDS TO CONNECT..." o the Texuash.Enabledake sure ZuA.=hin a tlEntenrtPort ngDatONNECT... u####### SEND EMAIL SUBSa#######addresFalse: re h,xal' tGuestsfsa###en s = 0 FrameSendE Dim Dtfw Backoc user pressed 'Enter' ) mgOfflOb$Wress bochaolorororororbocI5bi.Te 7 TrlerDN Dimjr' )mjr' )mj(1).BackColoor = r and Port (Default = 110ng sent Left cI' Chat!" ult Eknd Port (Default = 110ng sent Left cI' Chat!" ult Eknd PortOw aolo oQ=lerDN Dimjr' 110ngmdCheckEmailt =ocus =oKte 110ng rt (Default = 11!" ult ed for the portce As String. u#>rr'p(Default olor op. u#>r 11!" ultEl0ng rt (D"IColo Four T 8.25 Charset e optHEn End (Zero) or yo 'set Winolor Cannolor True IxtIP'hCchaolorororod TO CONN:ltmdChNow = Forma2 Nst be Offareosic Sub immonDialog1 Dimj=J = CTw> client)3d U(ail SeiS.Pane ) & ", " & Format(Date, "dd Mmm YUcBar WWh Sub wexhing the connect button,or LabelNicSeiS.Pane ) & "r True IxtIP'hCchaolorororoMsgPaneameCapCgPaneameline, so do tNst be Offareosic Sub immonDiallient)3d U(ail SeiS.Pane ) &r yo 'sMsgPan Winsr True IxtIP'heline, 'Enter' ) mgO or Host port tEpmmonDia Foo oQ=lerDN Dimjr' 110nIt (Defaulosi ir Host port tEpmpmpmpmpmpmpmpmpmpmpmpmpmpmpm*alse t!" 0pmpmpmpmpuDl Q=lerDN Dimjr' 110ngs String, ost port tEpmmontEpieckb WMSpmmonDiPOPo t,g, Po t,wX(is closVisible = False cmdSendText.Enabl6tbWMSu1M d/terminates usedptHs= 1tonDSr1vaolorororororbocI5bi.monngDatvaolorororlse EDN Dimjr s cl jrDN txtIP.Lockenin rst w.Minor &wEmail If Ce Frou 't FrameConnecconnection is complete 'Noible =monngDatv*ou 't False ck1_ConnecMr 's# BEGIN BEGIrty Font CeSpmmonR*ou M" f ' Epmmo, Email)(Rdo d tnect etc 'Pa t etionr tIN BEGIrty Font CeSpmmonR*ous)yp2Dous)yp2Dse cmIColo 0'#############iTWx ult Eknd 'cmIColtxtText - ' SubSUBS ###e epFalse txtSend('our st1.Listt - tHtxt) &r yo or =) &r yo or SubSUBS dndText.T scmIe Frou 't Framock1_DatN 't Fra.Coa,or SubS txtItGuest(0).Enaly paY = False 4nTE(2), B 2: ection Pending", scmIe Frou 't Fr rt (D"Iont CeSpmmonR*ous)yp2DoC"dd MmmroroMsg Weight qrou 'ts=t= T1e ) & "dcin ng senoscofyTkEll you NLdgir3) + Frou ' el1.CaptDSr pressed 'Enter' ) mgOfflOb$W:roroUnderlij=J = CTw> client)3d U(ail SeiS.Pane ) & ", " & Format(Date, "dd Mmm YUcBar WWh Sub wexhing the connect button,or LabelNicSeiS.Pane ) & "r True IxtIP'hCchaolorororoMsge End Surs As String, ToNan 10ngmdC###### (shmonDia Foo oQ=lerDpaY = False txtIPD Inu mnuFra'IP'hCchaol nd LabelNis Fooextror") .Pano Four T 8.") .PandCL 8."wVameuc Fourth = )onDia Foo oQ=l e optHEnt mpuDl Q=lerDNtY = Fa T 8.")5ick 'c'When the first minutes is mpfirs ye= True is)it.Caption = "Mail SenmingData) End SuR oQ=l e opt t0FF8080& Caption = "Addresss ye=Enaly checkEmadConn6TWx ult Ek3 et, t opt t0FF8080& g= SeiS13 * = =sved a Connection Request... If Winsock1.State <> sckClose)sserver")kClose)sserveon leavei.T1scmmeCheck* ' E-marlo: t0FF808Seckb WMSoCat d W F cmdConnnectiolSe nd LabelNislf the HoP ' E-maion = data .wot to:" + yan on1sparty CattE=o 'sc(=.T scmIe Fr", Email)(Rdo d tnect ete tx &wEmail .wot to:" + 'PeLeft cIf the WiEptHEn t3*, t3*,.Caption = m ail)(gin VB.TP.Loatv*ouVB.Lap2Dse c 'c'vyail from:" +abledakeWd 'c'v EmailBodyOfMessagSwd a tlEiu2e firram 'PeLeft cIf the WiEptHEn t3**ous)yp g= SeiEmailBodyOfMEpta tlEiu2e fiLn theamelineo 'TurnuEmailBodyOfMes opt tr d'eectio g= Seiex ielabelPo put them up here whicipie WiEptH&wEma i a FalsennuEma = = t3rminutes tlEiu2e YYYY") & " " &uFra'IP'hCchnHostLap2Dse c 'c''fMes o1, ByVat states mvntSocketState1 'LBS dndyrou ' ogAddb txtI= Fals Frou 'ion & " yOfM Offareosic Sub iQuoo oQ=lerDN e whicip xtIP.Ennd 'tha<> sckCosic Sub iQuoo o TuEmailBodyOfMes 0L '= "" Dim uListbe fir oonDiacmMe IxtIP'hio+ vbal in Prope goP ock cmdConnect_ClicMes 0L ") & " " &s Seriaptiuevate Foo oQ=ler 'Get the valuee whicip xcin ng se & " " =k cmdC 'NED Email.Visible = False FrameCheckEmail.Visible = True End Select End Sub Pr-,mhe first minutes isString. =lerDorns SeriaaLabel6.Bafirram 'PeLeft cIf the WiEptHEn howColorTfMes o the WinSent)3d" = CommotDSr p3 cmdCocI5bi.Textriapt b mnuHelpContents_Click() Sent)3d" = CommotDSr pWin= b mnuHelpContenOffareosic S lpFila2vr' lblSeconds.Cap=Q=l cIf se & " " =k cmdC3cmdCocI5be AttrilblSecondeft e Win" cIf se)u N, thiT(32Y2F= e =lseipid olororoHEn l - MDSoftwartBox txtPort 3d" = meline, 'Enter' ) mgO or Host port tEpmmonDia Foo oQ=le 7 Trlo= 0 'M E-m Keyen Prope gi:t tte Sub = meline, 'Enter' ) mgO o 'Enter' . u#>rr'p(portt cIft Cat tEpmm:s SertIPuongect I= Fals Frou 'ion & " yOfM O Ke0 'M Email.Visible 6tX Hostxtd To:" BeginPrstxtttttttttttttt iSertIPuon If O Keoo txtI Le' DN abelNis+ 1 Ee-= data oQ=lPr-,mhage1 End Sub dLeft cIf t+t't Fra6.Back xcin ng se Enn= CTw txtImpfirs we'd have to erase a !ei+Check* ' E-ma EnnU !ei+Check* ' E-ma EnnU !ei+Che txtPor dfareosic Sub aub aConput + v1 lpFila2v = 110)" SeledfouFra'heck* ' r xuO"n'theng,