home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / checkt1g / chatnets.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1999-08-26  |  7.9 KB  |  243 lines
  1. VERSION 5.00
  2. Object = "{FFACF7F3-B868-11CE-84A8-08005A9B23BD}#1.7#0"; "DSSOCK32.OCX"
  3. Begin VB.Form chatnetServer 
  4.    BorderStyle     =   1  'Fixed Single
  5.    Caption         =   " Server"
  6.    ClientHeight    =   2250
  7.    ClientLeft      =   45
  8.    ClientTop       =   330
  9.    ClientWidth     =   5985
  10.    Icon            =   "chatnetServer.frx":0000
  11.    LinkTopic       =   "Form1"
  12.    MaxButton       =   0   'False
  13.    MinButton       =   0   'False
  14.    ScaleHeight     =   2250
  15.    ScaleWidth      =   5985
  16.    StartUpPosition =   3  'Windows Default
  17.    Begin VB.Timer Timer2 
  18.       Left            =   2880
  19.       Top             =   480
  20.    End
  21.    Begin VB.Timer Timer1 
  22.       Enabled         =   0   'False
  23.       Interval        =   60000
  24.       Left            =   3000
  25.       Top             =   48000
  26.    End
  27.    Begin VB.ListBox List1 
  28.       Height          =   2040
  29.       Left            =   4200
  30.       TabIndex        =   6
  31.       Top             =   120
  32.       Width           =   1695
  33.    End
  34.    Begin dsSocketLib.dsSocket dsSocket1 
  35.       Height          =   420
  36.       Index           =   0
  37.       Left            =   2280
  38.       TabIndex        =   5
  39.       Top             =   480
  40.       Width           =   420
  41.       _Version        =   65543
  42.       _ExtentX        =   741
  43.       _ExtentY        =   741
  44.       _StockProps     =   64
  45.       LocalPort       =   2000
  46.       RemoteHost      =   ""
  47.       RemotePort      =   0
  48.       ServiceName     =   ""
  49.       RemoteDotAddr   =   ""
  50.       Linger          =   -1  'True
  51.       Timeout         =   10
  52.       LineMode        =   0   'False
  53.       EOLChar         =   10
  54.       BindConnect     =   0   'False
  55.       SocketType      =   0
  56.    End
  57.    Begin VB.CommandButton Command1 
  58.       Caption         =   "Serve"
  59.       Height          =   315
  60.       Left            =   3120
  61.       TabIndex        =   4
  62.       Top             =   120
  63.       Width           =   975
  64.    End
  65.    Begin VB.TextBox Text1 
  66.       Height          =   1335
  67.       Left            =   120
  68.       MultiLine       =   -1  'True
  69.       ScrollBars      =   2  'Vertical
  70.       TabIndex        =   3
  71.       Top             =   840
  72.       Width           =   3975
  73.    End
  74.    Begin VB.TextBox Text2 
  75.       Height          =   285
  76.       Left            =   1440
  77.       TabIndex        =   1
  78.       Text            =   "127.0.0.1"
  79.       Top             =   120
  80.       Width           =   1575
  81.    End
  82.    Begin VB.Label Label3 
  83.       Caption         =   "0"
  84.       Height          =   15
  85.       Left            =   3600
  86.       TabIndex        =   7
  87.       Top             =   6000
  88.       Width           =   135
  89.    End
  90.    Begin VB.Label Label2 
  91.       BackStyle       =   0  'Transparent
  92.       Caption         =   "Status:"
  93.       BeginProperty Font 
  94.          Name            =   "MS Sans Serif"
  95.          Size            =   12
  96.          Charset         =   0
  97.          Weight          =   700
  98.          Underline       =   0   'False
  99.          Italic          =   0   'False
  100.          Strikethrough   =   0   'False
  101.       EndProperty
  102.       Height          =   255
  103.       Left            =   120
  104.       TabIndex        =   2
  105.       Top             =   480
  106.       Width           =   975
  107.    End
  108.    Begin VB.Label Label1 
  109.       BackStyle       =   0  'Transparent
  110.       Caption         =   "Your IP Address:"
  111.       Height          =   255
  112.       Left            =   120
  113.       TabIndex        =   0
  114.       Top             =   120
  115.       Width           =   1335
  116.    End
  117. Attribute VB_Name = "chatnetServer"
  118. Attribute VB_GlobalNameSpace = False
  119. Attribute VB_Creatable = False
  120. Attribute VB_PredeclaredId = True
  121. Attribute VB_Exposed = False
  122. Private Sub Command1_Click()
  123. On Error Resume Next
  124. If Command1.Caption = "Serve" Then
  125. dsSocket1(0).LocalPort = 2000
  126. dsSocket1(0).Listen
  127. Text1 = "Now Serving Chat...."
  128. Command1.Caption = "Close"
  129. Timer1.Enabled = True
  130. Exit Sub
  131. End If
  132. If Command1.Caption = "Close" Then
  133. Timer1.Enabled = False
  134. For i = 0 To intMax
  135. dsSocket1(i).Close
  136. Next i
  137. Text1 = Text1 & vbCrLf & "Serving Stopped."
  138. Command1.Caption = "Serve"
  139. Exit Sub
  140. End If
  141. End Sub
  142. Private Sub dsSocket1_Accept(Index As Integer, SocketID As Integer)
  143. On Error Resume Next
  144. If Index = 0 Then
  145.  intMax = intMax + 1
  146.  Load dsSocket1(intMax)  'load a new dssocket control
  147.  dsSocket1(intMax).TabStop = False
  148.  dsSocket1(intMax).Socket = SocketID
  149.  'accept the connection on the newly made control.
  150. Text1 = Text1 & vbCrLf & "New User Joined" 'display status
  151. 'now we gotta send the user list to the new user
  152. For i = 0 To List1.ListCount - 1
  153.  TimeOut 0.5
  154.  dsSocket1(intMax).Send = "_$u:" & List1.List(i)
  155.  TimeOut 0.1
  156.  Next i
  157. End If
  158. End Sub
  159. Private Sub dsSocket1_Close(Index As Integer, ErrorCode As Integer, ErrorDesc As String)
  160. If intMax = 1 Then
  161. dsSocket1(1).Send = "ChatHOST:  well, no one is in the room except you.  you will not be able to send anymore text until we get someone else in here to see it.  you see, talking to yourself is the first sign of madness.  hehe"
  162. 'this just makes it so that if there is only one user
  163. 'left then they wont be able to chat.
  164. End If
  165. End Sub
  166. Private Sub dsSocket1_Exception(Index As Integer, ErrorCode As Integer, ErrorDesc As String)
  167. On Error Resume Next
  168. Text1 = Text1 & vbCrLf & "[" & Index & "]  " & ErrorCode & "   " & ErrorDesc
  169. 'display the error
  170. End Sub
  171. Private Sub dsSocket1_Receive(Index As Integer, ReceiveData As String)
  172. On Error Resume Next
  173. 'new user
  174. If InStr(ReceiveData, "_$u:") Then
  175. thelen$ = Len(ReceiveData) - 4
  176. user$ = Right$(ReceiveData, thelen$)
  177. List1.AddItem user$
  178. Call List_NoDupes(List1)
  179. End If
  180. 'user left
  181. If InStr(ReceiveData, "_$l:") Then
  182. thelen$ = Len(ReceiveData) - 4
  183. user$ = Right$(ReceiveData, thelen$)
  184. Call List_RemoveName(List1, user$)
  185. End If
  186. 'send the received data to each user in the chat.
  187. a = 0
  188. For i = 0 To intMax
  189. If a = intMax Then Exit For
  190. a = a + 1
  191. TimeOut 0.5
  192. dsSocket1(a).Send = ReceiveData
  193. Next i
  194. 'i put in a timeout of .5 because packets will get
  195. 'mixed up if you send them too fast.  you can change it
  196. 'but be warned that it could cause screwy data in your
  197. 'program.
  198. Text1 = Text1 & vbCrLf & "data:>  [" & Index & "]   " & ReceiveData
  199. End Sub
  200. Private Sub Form_Load()
  201. On Error Resume Next
  202. 'this is for displaying your IP
  203. Text2 = dsSocket1(0).LocalDotAddr
  204. End Sub
  205. Private Sub Form_Unload(Cancel As Integer)
  206. On Error Resume Next
  207. If Command1.Caption = "Close" Then
  208. For i = 0 To intMax
  209. dsSocket1(i).Send = "ChatHOST:  the server is now ending this chat session."
  210. dsSocket1(i).Close
  211. Next i
  212. End If
  213. End Sub
  214. Private Sub List1_DblClick()
  215. 'this is pretty much useless.  heh.  i dont know why
  216. 'i even added it.  anywho, all it does is display the
  217. 'selected users name and their IP address in a message
  218. 'box.
  219. T$ = "User:  " & List1.text
  220. T$ = T$ & vbCrLf
  221. T$ = T$ & "IP Address:  " & dsSocket1(List1.ListIndex).RemoteDotAddr
  222. MsgBox T$, vbInformation, "Info on " & List1.text
  223. End Sub
  224. Private Sub Timer1_Timer()
  225. On Error Resume Next
  226. If Label3 = "3" Then
  227.  X = Str(Int(Rnd * 6)) + 1
  228.  If X = 7 Then X = 1
  229.  If X = 1 Then T$ = "did you know i say something exactly every 3 minutes?  weird huh?  hehe"
  230.  If X = 2 Then T$ = "this is a pretty cool multi-user chat example made by Jon Cromer"
  231.  If X = 3 Then T$ = "this example was written in under 30 minutes.  that's pretty good for the server and client and all the rem statements in here."
  232.  If X = 4 Then T$ = "if you're seeing this.... and this isn't called chat net  by Jon Cromer, then a lamer copied my form and said it was his.  make fun of the person who sent you this cause they cant code.  damn script kiddies."
  233.  If X = 5 Then T$ = "check out my website if ya got time.  http://www.pure-elite.com/senate/main.htm"
  234.  If X = 6 Then T$ = "im a bot created to spice up this chat  by Jon Cromer"
  235.  For i = 0 To intMax
  236.  dsSocket1(i).Send = "ChatHOST:  " & T$
  237.  Next i
  238.  labe3 = "0"
  239.  Exit Sub
  240. End If
  241. Label3 = Val(Label3) + 1
  242. End Sub
  243.