netgiftran.ctl

远端荧幕传输程序,远端荧幕传输程序.rar

            fFree = (sckClosed = WskItem(I).State) '空闲
            
            If fErr Then '控件不存在，创建
                Idx = I
                Load WskItem(Idx)
                Exit For
            Else
                If fFree Then '空闲的
                    Idx = I
                    Exit For
                Else '已连结
                End If
            End If
            
        Next I
        
        '仍没有找到，则创建
        If Idx = -1 Then
            Idx = WskItem.UBound + 1
            Load WskItem(Idx)
            ReDim Preserve mServers(0 To Idx)
        End If
        
        '接收连结请求
        WskItem(Idx).Accept requestID
        mCurClients = mCurClients + 1
        Debug.Print "mCurClients:"; mCurClients
        
        '创建流对象
        If mServers(Idx).CmdS Is Nothing Then Set mServers(Idx).CmdS = New CByteStream
        If mServers(Idx).LZWS Is Nothing Then Set mServers(Idx).LZWS = New CByteStream
        
    Else
    End If
    
End Sub

Private Sub wskMain_DataArrival(ByVal bytesTotal As Long)
    'Debug.Print "wskMain_DataArrival: bytesTotal="; bytesTotal
    
    Dim tCmdR As MyCommandHeader, tCmdS As MyCommandHeader
    Dim TempBytes() As Byte
    
    '得到数据
    Call wskMain.GetData(TempBytes, vbByte Or vbArray, bytesTotal)
    
    '联接位流
    Call mCmdS.AddData(TempBytes)
    
    Do While mCmdS.Count >= SizeofMyCommandHeader
        '查探数据流是否足够长度
        Call mCmdS.PeekData4Ptr(VarPtr(tCmdR), , SizeofMyCommandHeader)
        'Debug.Print "wskMain: " & "Command=" & tCmdR.Code & "," & vbTab & "Size=" & tCmdR.SIZE & "(&H" & Hex(tCmdR.SIZE) & ")"
        'If tCmdR.Code = f Then Debug.Assert False
        If mCmdS.Count < (SizeofMyCommandHeader + tCmdR.SIZE) Then Exit Do
        Call mCmdS.DeleteData(, SizeofMyCommandHeader)
        
        '处理数据
        '因服务器端的wskMain只负责监听，所以这里都是客户机处理
        'Debug.Print "wskMain: " & "Command=" & tCmdR.Code & "," & vbTab & "Size=" & tCmdR.SIZE & "(&H" & Hex(tCmdR.SIZE) & ")"
        Select Case tCmdR.Code
        Case MyCID_Stop
            Me.CloseConnect
            
        Case MyCID_QVer
            '（无）
            
        Case MyCID_Ver
            '取得数据
            Call mCmdS.PeekData4Ptr(VarPtr(mCurVer), , 2)
            Debug.Print "Ver:"; Hex(mCurVer)
            
            '版本号判断
            If mCurVer <> SoftVer Then
                '不符合
                mCmdS.Clear
                Me.CloseConnect
                Debug.Print "ErrVer"
                Exit Do
            End If
            
            '发送MyCID_Next
            With tCmdS
                .Sign = MyCommandSign
                .Code = MyCID_Next
                .SIZE = 0
                ReDim TempBytes(0 To SizeofMyCommandHeader + .SIZE - 1)
            End With
            CopyMemory TempBytes(0), tCmdS, SizeofMyCommandHeader
            Call wskMain.SendData(TempBytes)
            
        Case MyCID_Next
            '（无）
            
        Case MyCID_Info
            'Dim tInfo As MyImageInfo
            
            '取得数据
            Call mCmdS.PeekData4Ptr(VarPtr(mImgInfo), , Len(mImgInfo))
            'mLZWSSize = mImgInfo.SizeImage
            
            If mImgInfo.SizeImage <= 0 Or mImgInfo.Width <= 0 Or mImgInfo.Height <= 0 Then
                mImgInfo.SizeImage = 0
                Debug.Print "Error Image!"
            Else
                '清空LZW数据流，等待数据
                mLZWS.Clear
            End If
            
            '发送MyCID_QData（若图像数据错误，则发送MyCID_Next）
            With tCmdS
                .Sign = MyCommandSign
                .Code = IIf(mImgInfo.SizeImage > 0, MyCID_QData, MyCID_Next)
                .SIZE = 0
                ReDim TempBytes(0 To SizeofMyCommandHeader + .SIZE - 1)
            End With
            CopyMemory TempBytes(0), tCmdS, SizeofMyCommandHeader
            Call wskMain.SendData(TempBytes)
            
        Case MyCID_QData
            '（无）
            
        Case MyCID_Send
            '合并数据流
            Call mCmdS.PeekData(TempBytes, , tCmdR.SIZE)
            'Debug.Print TempBytes(0)
            Call mLZWS.AddData(TempBytes)
            
            '发送标记
            With tCmdS
                .Sign = MyCommandSign
                bDecode = (mLZWS.Count >= mImgInfo.SizeImage)
                .Code = IIf(bDecode, MyCID_Next, MyCID_QData)
                .SIZE = 0
                ReDim TempBytes(0 To SizeofMyCommandHeader + .SIZE - 1)
            End With
            CopyMemory TempBytes(0), tCmdS, SizeofMyCommandHeader
            Call wskMain.SendData(TempBytes)
            
        End Select
        
        '删除多余数据
        Call mCmdS.DeleteData(, tCmdR.SIZE)
        
    Loop
    
End Sub

Private Sub wskMain_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)
    'Debug.Print "wskMain_Error: Number=" & Number
    'Debug.Print wskMain.State
    
    Select Case Number
    Case sckConnectionRefused
        Me.CloseConnect
        
    Case Else
        Me.CloseConnect
        MsgBox Number & vbCrLf & Description, vbCritical, "wskMain"
        
    End Select
    
    
End Sub

Private Sub wskMain_SendComplete()
    'Debug.Print "wskMain_SendComplete:"
    
    If bClosing Then
        'If sckClosed <> wskMain.State Then wskMain.Close
        bClosing = False
    End If
    
    '解码图片
    If bDecode Then
        If mImgInfo.SizeImage > 0 Then
            Call pDecode
            
            mLZWS.Clear
            
            RaiseEvent OnPictureArrival
            
        End If
        
        mImgInfo.SizeImage = 0
        bDecode = False
        
    End If
    
End Sub

Private Sub wskMain_SendProgress(ByVal bytesSent As Long, ByVal bytesRemaining As Long)
    'Debug.Print "wskMain_SendProgress:"
    
End Sub

'## 外部函数 ##############################################

'注意！不要删除或修改下列被注释的行！
'MappingInfo=wskMain,wskMain,-1,LocalHostName
Public Property Get LocalHostName() As String
Attribute LocalHostName.VB_Description = "返回本地机器名称"
    LocalHostName = wskMain.LocalHostName
End Property

'注意！不要删除或修改下列被注释的行！
'MappingInfo=wskMain,wskMain,-1,LocalIP
Public Property Get LocalIP() As String
Attribute LocalIP.VB_Description = "返回本地机器 IP 地址"
    LocalIP = wskMain.LocalIP
End Property

'注意！不要删除或修改下列被注释的行！
'MappingInfo=wskMain,wskMain,-1,LocalPort
Public Property Get LocalPort() As Long
Attribute LocalPort.VB_Description = "返回/设置本地计算机上要使用的端口"
    LocalPort = wskMain.LocalPort
End Property

Public Property Let LocalPort(ByVal New_LocalPort As Long)
    wskMain.LocalPort() = New_LocalPort
    PropertyChanged "LocalPort"
End Property

'注意！不要删除或修改下列被注释的行！
'MappingInfo=wskMain,wskMain,-1,RemoteHost
Public Property Get RemoteHost() As String
Attribute RemoteHost.VB_Description = "返回/设置用于标识远程计算机的名称"
    RemoteHost = wskMain.RemoteHost
End Property

Public Property Let RemoteHost(ByVal New_RemoteHost As String)
    wskMain.RemoteHost() = New_RemoteHost
    PropertyChanged "RemoteHost"
End Property

'注意！不要删除或修改下列被注释的行！
'MappingInfo=wskMain,wskMain,-1,RemoteHostIP
Public Property Get RemoteHostIP() As String
Attribute RemoteHostIP.VB_Description = "返回远程主机 IP 地址"
    RemoteHostIP = wskMain.RemoteHostIP
End Property

'注意！不要删除或修改下列被注释的行！
'MappingInfo=wskMain,wskMain,-1,RemotePort
Public Property Get RemotePort() As Long
Attribute RemotePort.VB_Description = "返回/设置要连接的远程计算机端口"
    RemotePort = wskMain.RemotePort
End Property

Public Property Let RemotePort(ByVal New_RemotePort As Long)
    wskMain.RemotePort() = New_RemotePort
    PropertyChanged "RemotePort"
End Property

'注意！不要删除或修改下列被注释的行！
'MappingInfo=wskMain,wskMain,-1,SocketHandle
Public Property Get SocketHandle() As Long
Attribute SocketHandle.VB_Description = "返回套接字句柄"
    SocketHandle = wskMain.SocketHandle
End Property

'注意！不要删除或修改下列被注释的行！
'MappingInfo=wskMain,wskMain,-1,State
Public Property Get State() As Integer
Attribute State.VB_Description = "返回套接字连接的状态"
    State = wskMain.State
End Property
'注意！不要删除或修改下列被注释的行！
'MemberInfo=0,0,0,false
Public Property Get IsServer() As Boolean
Attribute IsServer.VB_Description = "是不是服务器"
    IsServer = m_IsServer
End Property

Public Property Let IsServer(ByVal New_IsServer As Boolean)
    If wskMain.State <> sckClosed Then Exit Property
    m_IsServer = New_IsServer
    PropertyChanged "IsServer"
End Property

'注意！不要删除或修改下列被注释的行！
'MemberInfo=5
Public Function Connect() As Boolean
Attribute Connect.VB_Description = "连接到远程计算机"
    Dim Rc As Boolean
    
    If Me.IsServer Then
        On Error Resume Next
        Call wskMain.Listen
        Rc = (0 = Err.Number)
        On Error GoTo 0
    Else
        On Error Resume Next
        Call wskMain.Connect
        Rc = (0 = Err.Number)
        On Error GoTo 0
    End If
    
    Connect = Rc
    
End Function

'注意！不要删除或修改下列被注释的行！
'MappingInfo=wskMain,wskMain,-1,Close
Public Sub CloseConnect()
    If Me.IsServer Then
        Dim I As Long
        
        '关闭所有服务连结
        On Error Resume Next
        For I = WskItem.LBound To WskItem.UBound
            If sckClosed <> WskItem(I).State Then WskItem(I).Close
        Next I
        On Error GoTo 0
        
        If sckClosed <> wskMain.State Then wskMain.Close
        
        RaiseEvent CloseConnect
        
    ElseIf sckConnected <> wskMain.State Then
        If sckClosed <> wskMain.State Then wskMain.Close
        
    Else
        Dim tCmdS As MyCommandHeader
        Dim TempBytes() As Byte
        
        With tCmdS
            .Sign = MyCommandSign
            .Code = MyCID_Stop
            .SIZE = 0
            ReDim TempBytes(0 To SizeofMyCommandHeader + .SIZE - 1)
        End With
        CopyMemory TempBytes(0), tCmdS, SizeofMyCommandHeader
        Call wskMain.SendData(TempBytes)
        
        'If sckClosed <> wskMain.State Then wskMain.Close
        bClosing = True
        
    End If
    
End Sub

'注意！不要删除或修改下列被注释的行！
'MemberInfo=8,0,0,30
Public Property Get MaxClient() As Long
Attribute MaxClient.VB_Description = "最大用户连结数"
    MaxClient = m_MaxClient
End Property

Public Property Let MaxClient(ByVal New_MaxClient As Long)
    If New_MaxClient <= 0 Then
        Exit Property
    End If
    If wskMain.State <> sckClosed Then
        Exit Property
    End If
    m_MaxClient = New_MaxClient
    PropertyChanged "MaxClient"
End Property

Public Property Get CurClients() As Long
    CurClients = mCurClients
End Property

'设置位图
Public Function SetBitmap(ByVal hDC As Long, _
        ByVal X As Long, ByVal Y As Long, _
        ByVal Width As Long, ByVal Height As Long) As Boolean
    SetBitmap = pSetBitmap(hDC, X, Y, Width, Height)
End Function

Public Function Draw(ByVal hDC As Long, _
        Optional ByVal X As Long = 0, Optional ByVal Y As Long = 0, _
        Optional ByVal Width As Long = DefNum, Optional ByVal Height As Long = DefNum, _
        Optional ByVal SrcX As Long = 0, Optional ByVal SrcY As Long = 0, _
        Optional ByVal SrcWidth As Long = DefNum, Optional ByVal SrcHeight As Long = DefNum, _
        Optional ByVal dwRop As RasterOpConstants = vbSrcCopy) As Long
    If mScanBytes <= 0 Then Exit Function
    
    If Width = DefNum Then Width = mBI.bmiHeader.biWidth
    If Height = DefNum Then Height = mBI.bmiHeader.biHeight
    If SrcWidth = DefNum Then SrcWidth = mBI.bmiHeader.biWidth
    If SrcHeight = DefNum Then SrcHeight = mBI.bmiHeader.biHeight
    
    Draw = StretchDIBits(hDC, X, Y, Width, Height, SrcX, SrcY, SrcWidth, SrcHeight, mMapData(0), mBI, DIB_RGB_COLORS, dwRop)
    
End Function