home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 5_2007-2008.ISO / data / Zips / Voice_Lagg2118646272008.psc / VcProtectexample / Usercontrols / VcHook.ctl next >
Text File  |  2008-06-21  |  6KB  |  243 lines
  1. VERSION 5.00
  2. Begin VB.UserControl VcHook 
  3.    ClientHeight    =   510
  4.    ClientLeft      =   0
  5.    ClientTop       =   0
  6.    ClientWidth     =   495
  7.    InvisibleAtRuntime=   -1  'True
  8.    Picture         =   "VcHook.ctx":0000
  9.    ScaleHeight     =   510
  10.    ScaleWidth      =   495
  11.    ToolboxBitmap   =   "VcHook.ctx":04A8
  12. End
  13. Attribute VB_Name = "VcHook"
  14. Attribute VB_GlobalNameSpace = False
  15. Attribute VB_Creatable = True
  16. Attribute VB_PredeclaredId = False
  17. Attribute VB_Exposed = False
  18. Option Explicit
  19. Public Event CurrentIP(ByVal IpAddress As String)
  20. Private WithEvents Winsock1 As Winsock
  21. Attribute Winsock1.VB_VarHelpID = -1
  22. Private WithEvents Winsock2 As Winsock
  23. Attribute Winsock2.VB_VarHelpID = -1
  24. Private MyRoomServer As String, MySourceID As String
  25.  
  26. Public Sub StartService(ByVal VoiceServer As String, ByVal VoicePort As String)
  27. On Error Resume Next
  28. Winsock1.Close
  29. Winsock2.Close
  30. Winsock1.Protocol = sckTCPProtocol
  31. Winsock2.Protocol = sckTCPProtocol
  32. Winsock2.RemoteHost = VoiceServer
  33. Winsock1.LocalPort = VoicePort
  34. Winsock1.Listen
  35. End Sub
  36.  
  37. Public Sub StopService()
  38. On Error Resume Next
  39. Winsock1.Close
  40. Winsock2.Close
  41. End Sub
  42.  
  43. Private Sub UserControl_Initialize()
  44. On Error Resume Next
  45. Set Winsock1 = New Winsock
  46. Set Winsock2 = New Winsock
  47. End Sub
  48.  
  49. Private Sub UserControl_Resize()
  50. On Error Resume Next
  51. UserControl.Width = 420
  52. UserControl.Height = 420
  53. End Sub
  54.  
  55. Private Sub UserControl_Terminate()
  56. On Error Resume Next
  57. Set Winsock1 = Nothing
  58. Set Winsock2 = Nothing
  59. End Sub
  60.  
  61. Private Sub Winsock1_Close()
  62. On Error Resume Next
  63. Winsock1.Close
  64. Winsock2.Close
  65. Form1.YTCP1.StopService
  66. Winsock1.Listen
  67. End Sub
  68.  
  69. Private Sub Winsock2_Close()
  70. On Error Resume Next
  71. Winsock1.Close
  72. Winsock2.Close
  73. Form1.YTCP1.StopService
  74. Winsock1.Listen
  75. End Sub
  76.  
  77. Private Sub Winsock1_ConnectionRequest(ByVal requestID As Long)
  78. On Error Resume Next
  79. Winsock2.Close
  80. Winsock2.RemotePort = Winsock1.LocalPort
  81. Winsock2.Connect
  82. Do
  83. DoEvents
  84. Loop Until Winsock2.State = sckConnected
  85. Winsock1.Close
  86. Winsock1.Accept requestID
  87. End Sub
  88.  
  89. 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)
  90. On Error Resume Next
  91. Winsock1.Close
  92. Winsock2.Close
  93. End Sub
  94.  
  95. Private Sub Winsock2_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)
  96. On Error Resume Next
  97. Winsock1.Close
  98. Winsock2.Close
  99. End Sub
  100.  
  101. Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
  102. On Error Resume Next
  103. Dim Data As String, DataLength As Integer, TmpData As String, HeaderLength As Integer
  104. HeaderLength = 4
  105. With Winsock1
  106. While .BytesReceived >= HeaderLength
  107. Call .PeekData(Data, vbString, HeaderLength)
  108. DataLength = (256 * Asc(Mid(Data, 1, 1)) + Asc(Mid(Data, 2, 1)))
  109. If DataLength <= .BytesReceived Then
  110. Call .GetData(TmpData, vbString, DataLength)
  111. ParseVoiceClient TmpData
  112. Else
  113. Exit Sub
  114. End If
  115. DoEvents
  116. Wend
  117. End With
  118. End Sub
  119.  
  120. Private Sub Winsock2_DataArrival(ByVal bytesTotal As Long)
  121. On Error Resume Next
  122. Dim Data As String, DataLength As Integer, TmpData As String, HeaderLength As Integer
  123. HeaderLength = 4
  124. With Winsock2
  125. While .BytesReceived >= HeaderLength
  126. Call .PeekData(Data, vbString, HeaderLength)
  127. DataLength = (256 * Asc(Mid(Data, 1, 1)) + Asc(Mid(Data, 2, 1)))
  128. If DataLength <= .BytesReceived Then
  129. Call .GetData(TmpData, vbString, DataLength)
  130. ParseVoiceServer TmpData
  131. Else
  132. Exit Sub
  133. End If
  134. DoEvents
  135. Wend
  136. End With
  137. End Sub
  138.  
  139. Private Sub ParseVoiceClient(Data As String)
  140. On Error Resume Next
  141. Dim TcpLen As Integer, HdrLen As Integer, CommandType As Integer, PcktType As Integer
  142. TcpLen = (256 * Asc(Mid(Data, 1, 1)) + Asc(Mid(Data, 2, 1)))
  143. HdrLen = Asc(Mid(Data, 8, 1)) + 4
  144. CommandType = Asc(Mid(Data, HdrLen + 2, 1))
  145. Select Case CommandType
  146. Case Is = 204
  147. PcktType = Asc(Mid(Data, HdrLen + 14, 1))
  148. Select Case PcktType
  149. Case Is = 1
  150. Winsock2.SendData Data
  151. GoTo 1
  152. Case Is = 7
  153. Winsock2.SendData Data
  154. GoTo 1
  155. Case Is = 13
  156. Winsock2.SendData Data
  157. GoTo 1
  158. Case Is = 15
  159. Winsock2.SendData Data
  160. GoTo 1
  161. Case Is = 51
  162. Winsock2.SendData Data
  163. GoTo 1
  164. Case Is = 0
  165. Winsock2.SendData Data
  166. GoTo 1
  167. End Select
  168. Case Is = 203
  169. Winsock2.SendData Data
  170. GoTo 1
  171. Case Is = 202
  172. Winsock2.SendData Data
  173. GoTo 1
  174. End Select
  175. Winsock2.SendData Data
  176. 1
  177. End Sub
  178.  
  179. Private Sub ParseVoiceServer(Data As String)
  180. On Error Resume Next
  181. Dim TcpLen As Integer, HdrLen As Integer, CommandType As Integer, PcktType As Integer, TempIP As String
  182. TcpLen = (256 * Asc(Mid(Data, 1, 1)) + Asc(Mid(Data, 2, 1)))
  183. HdrLen = Asc(Mid(Data, 8, 1)) + 4
  184. CommandType = Asc(Mid(Data, HdrLen + 2, 1))
  185. Select Case CommandType
  186. Case Is = 204
  187. PcktType = Asc(Mid(Data, HdrLen + 14, 1))
  188. Select Case PcktType
  189. Case Is = 10
  190. TempIP = Mid(Data, HdrLen + 23, 4)
  191. MyRoomServer = Asc(Mid(TempIP, 1, 1)) & Chr(46) & Asc(Mid(TempIP, 2, 1)) & Chr(46) & Asc(Mid(TempIP, 3, 1)) & Chr(46) & Asc(Mid(TempIP, 4, 1))
  192. Winsock1.SendData Replace(Data, TempIP, Chr(127) & String(2, 0) & Chr(1))
  193. RaiseEvent CurrentIP(MyRoomServer)
  194. DoEvents
  195. Winsock2.Close
  196. Winsock1.Close
  197. Winsock2.RemoteHost = MyRoomServer
  198. Winsock1.LocalPort = 5001
  199. Winsock1.Listen
  200. GoTo 1
  201. Case Is = 8
  202. Winsock1.SendData Data
  203. GoTo 1
  204. Case Is = 7
  205. Winsock1.SendData Data
  206. GoTo 1
  207. Case Is = 2
  208. TempIP = Mid(Data, HdrLen + 23, 4)
  209. Winsock1.SendData Replace(Data, TempIP, Chr(127) & String(2, 0) & Chr(1))
  210. GoTo 1
  211. Case Is = 4
  212. MySourceID = Mid(Data, HdrLen + 5, 4)
  213. Form1.YTCP1.SrartService MyRoomServer, MySourceID
  214. TempIP = Mid(Data, HdrLen + 23, 4)
  215. Winsock1.SendData Replace(Data, TempIP, Chr(127) & String(2, 0) & Chr(1))
  216. GoTo 1
  217. Case Is = 50
  218. Winsock1.SendData Data
  219. GoTo 1
  220. Case Is = 14
  221. Winsock1.SendData Data
  222. GoTo 1
  223. Case Is = 13
  224. Winsock1.SendData Data
  225. GoTo 1
  226. Case Is = 15
  227. Winsock1.SendData Data
  228. GoTo 1
  229. Case Is = 0
  230. Winsock1.SendData Data
  231. GoTo 1
  232. End Select
  233. Case Is = 202
  234. Winsock1.SendData Data
  235. GoTo 1
  236. Case Is = 203
  237. Winsock1.SendData Data
  238. GoTo 1
  239. End Select
  240. Winsock1.SendData Data
  241. 1
  242. End Sub
  243.