chat.ctl

一个VB做的语音系统控件

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