?? chat.ctl
字號:
VERSION 5.00
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
Begin VB.UserControl chat
Alignable = -1 'True
Appearance = 0 'Flat
BackColor = &H80000005&
BackStyle = 0 '透明
ClientHeight = 600
ClientLeft = 0
ClientTop = 0
ClientWidth = 1230
ScaleHeight = 600
ScaleWidth = 1230
Begin VB.Timer Timer1
Interval = 300
Left = 480
Top = 720
End
Begin VB.Timer Timer
Enabled = 0 'False
Interval = 30000
Left = 1560
Top = 720
End
Begin MSWinsockLib.Winsock tcpsocket
Index = 0
Left = 1320
Top = 120
_ExtentX = 741
_ExtentY = 741
_Version = 393216
End
Begin VB.Image talk
Enabled = 0 'False
Height = 600
Left = 0
Picture = "chat.ctx":0000
Top = 0
Width = 1230
End
End
Attribute VB_Name = "chat"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit
Public CLOSINGAPPLICATION As Boolean
Public wStream As Object
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
Dim local_ip As String
Dim local_port As String
Private Function MyHotKey(vKeyCode) As Boolean
MyHotKey = (GetAsyncKeyState(vKeyCode) < 0)
End Function
Private Sub talk_Click()
Select Case talk.BorderStyle
Case 0
Timer.Enabled = True
talk.BorderStyle = 1
Dim rc As Long
If (Not wStream.Playing And _
Not wStream.Recording And _
wStream.RecDeviceFree And _
wStream.PlayDeviceFree) Then
wStream.Recording = True
rc = wStream.RecordWave(UserControl.hWND, TCPSocket)
If Not wStream.Playing And _
wStream.PlayDeviceFree And _
wStream.RecDeviceFree Then
Call play
End If
End If
Case 1
Timer.Enabled = False
talk.BorderStyle = 0
wStream.Recording = False
End Select
End Sub
Private Sub tcpsocket_Close(Index As Integer)
talk.Enabled = False
Call Disconnect(TCPSocket(Index))
'Unload tcpsocket(Index)
Set conn = Nothing
End Sub
Private Sub tcpsocket_DataArrival(Index As Integer, ByVal bytesTotal As Long)
Dim rc As Long
Dim WaveData() As Byte
Static ExBytes(MAXTCP) As Long
Static ExData(MAXTCP) As Variant
'--------------------------------------------------------------
With wStream
If (TCPSocket(Index).BytesReceived > 0) Then
Do While (TCPSocket(Index).BytesReceived > 0)
If (ExBytes(Index) = 0) Then
If (.waveChunkSize <= TCPSocket(Index).BytesReceived) Then
Call TCPSocket(Index).GetData(WaveData, vbByte + vbArray, .waveChunkSize)
Call .SaveStreamBuffer(Index, WaveData)
Call .AddStreamToQueue(Index)
Else
ExBytes(Index) = TCPSocket(Index).BytesReceived
Call TCPSocket(Index).GetData(ExData(Index), vbByte + vbArray, ExBytes(Index))
End If
Else
Call TCPSocket(Index).GetData(WaveData, vbByte + vbArray, .waveChunkSize - ExBytes(Index))
ExData(Index) = MidB(ExData(Index), 1) & MidB(WaveData, 1)
Call .SaveStreamBuffer(Index, ExData(Index))
Call .AddStreamToQueue(Index)
ExBytes(Index) = 0
ExData(Index) = ""
End If
Loop
If (Not .Playing And .PlayDeviceFree And _
Not .Recording And .RecDeviceFree) Then
Call play
End If
End If
End With
talk.BorderStyle = 0
wStream.Recording = False
End Sub
Private Sub tcpsocket_Error(Index As Integer, 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)
TCPSocket(0).Close
Call tcp_connect
End Sub
Private Sub Timer_Timer()
Call talk_Click
Timer.Enabled = False
End Sub
Private Sub Timer1_Timer()
If MyHotKey(vbKeyF9) Then Call talk_Click
End Sub
Private Sub UserControl_Initialize()
Dim rc As Long
Dim Idx As Long
Dim TCPidx As Long
'--------------------------------------------------------------
CLOSINGAPPLICATION = False
Set wStream = New WaveStream
Call wStream.InitACMCodec(WAVE_FORMAT_GSM610, TIMESLICE)
talk.Enabled = False
Call tcp_connect
Set conn = CreateObject("adodb.connection")
conn.open "driver={sql server};server=" + db_host + ";database=" + db_name + ";uid=" + db_user + ";pwd=" + db_pass
End Sub
Private Sub UserControl_Terminate()
Dim Idx As Long
Dim Socket As Winsock
'--------------------------------------------------------------
CLOSINGAPPLICATION = True
For Each Socket In TCPSocket
Call Disconnect(Socket)
Next
Set wStream = Nothing
Set conn = Nothing
End Sub
Private Sub tcp_connect()
Dim rc As Long
Dim Idx As Long
Dim LocalPort As Long
Dim RemotePort As Long
'--------------------------------------------------------------
Idx = InstanceTCP(TCPSocket)
If (Idx > 0) Then
On Error Resume Next
If Not Connect(TCPSocket(Idx), VOICEIP, VOICEPORT) Then
Unload TCPSocket(Idx)
End If
talk.Enabled = True
End If
local_ip = TCPSocket(Idx).LocalIP
local_port = TCPSocket(Idx).LocalPort
End Sub
Private Sub play()
Dim rc As Long
Dim iPort As Integer
Dim itm As Integer
'--------------------------------------------------------------
If (Not wStream.Playing And wStream.PlayDeviceFree And _
Not wStream.Recording And wStream.RecDeviceFree) Then
wStream.Playing = True
iPort = wStream.StreamInQueue
Do While (iPort <> NULLPORTID)
rc = wStream.PlayWave(UserControl.hWND, iPort)
Call wStream.RemoveStreamFromQueue(iPort)
iPort = wStream.StreamInQueue
Loop
wStream.Playing = False
End If
End Sub
Public Property Get UpdateInterval() As Variant
UpdateInterval = ""
End Property
Public Property Let UpdateInterval(ByVal vNewValue As Variant)
Dim temp_data
temp_data = Split(vNewValue, "%")
Set rs = CreateObject("adodb.recordset")
rs.open "select * from active order by active_id", conn, 1, 2
rs.addnew
rs("user_name") = Trim(temp_data(0))
rs("login_time") = Now()
rs("room_id") = CInt(Trim(temp_data(1)))
rs("login_port") = local_port
rs("login_ip") = local_ip
rs.Update
Set rs = Nothing
PropertyChanged "UpdateInterval"
End Property
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -