VB实现远程共享显示及声音

'frmServer.frm 

Option Explicit 

Const FileName = "C:\sys1.tmp", BlockSize = 3072 ' 传送包大小 

Private Declare Sub keybd_event Lib "user32" _ 

(ByVal bVk As Byte, ByVal bScan As Byte, _ 

ByVal dwFlags As Long, ByVal dwExtraInfo As Long) 

 

Private Sub Form_Load() 

tcpServer.LocalPort = 1001 ' 设置监听端口号 

tcpServer.Listen ' 开始监听 

End Sub 

 

Private Sub tcpServer_ConnectionRequest(ByVal requestID As Long) 

If tcpServer.State <> sckClosed Then tcpServer.Close 

tcpServer.Accept requestID 

tcpServer.SendData "SH" ' 成功连接后，发送“握手”信息 

End Sub 

 

Private Sub tcpServer_DataArrival(ByVal bytesTotal As Long) 

Static FileID As Integer, Cur_Pos As Long, FileLen As Long 

Dim strData As String, j 

Dim Buf() As Byte ' 定义一个可变大小的数组，用于传送二进制图像包 

tcpServer.GetData strData 

Select Case strData 

Case "Close" ' 接到“Disconnect”命令后，关闭当前连接，并继续监听 

tcpServer.Close 

ImgEdit1.ClearDisplay 

tcpServer.LocalPort = 1001 

tcpServer.Listen 

Case "Save Picture" 

Call keybd_event(vbKeySnapshot, 1, 0, 0) ' 模拟按键操作 

j = DoEvents() 

If Dir$(FileName) <> "" Then Kill FileName 

If ImgEdit1.IsClipboardDataAvailable Then
' 当剪贴板上有数据时 

ImgEdit1.ClearDisplay 

ImgEdit1.DisplayBlankImage Screen.Width / _ 

Screen.TwipsPerPixelX, Screen.Height / _ 

Screen.TwipsPerPixelY, , , 6 

ImgEdit1.ClipboardPaste ' 从剪贴板粘贴图像 

ImgEdit1.BurnInAnnotations 0, 2 

ImgEdit1.SaveAs FileName, 1, 6, 6, 256 ' 另存图像。参数说明如下： 

' “FileName”：文件名 

' 参数“1”：TIFF 型文件； 

' 第一个“6”：RGB24类型； 

' 第二个“6”：JPEG压缩类型 

' 参数“256”：最大压缩比 

Clipboard.Clear 

tcpServer.SendData "PS" ' 发送“图像文件就绪”信息 

End If 

Case "Get Picture" 

If Dir$(FileName) <> "" Then 

FileID = FreeFile 

Open FileName For Binary As #FileID ' 打开文件并发送第一块数据 

FileLen = LOF(FileID) 

ReDim Buf(1 To BlockSize) As Byte 

Get #FileID, , Buf 

tcpServer.SendData Buf 

Cur_Pos = BlockSize 

End If 

Case "Next Block" 

If Cur_Pos = FileLen Then 

tcpServer.SendData "EF" ' 文件传送完毕后，发送“完成”信息 

Close FileID 

Exit Sub 

End If 

j = Cur_Pos + BlockSize 

If j > FileLen Then 

j = FileLen - Cur_Pos 

Else 

j = BlockSize 

End If 

ReDim Buf(1 To j) As Byte ' 动态确定数组大小 

Get #FileID, , Buf 

tcpServer.SendData Buf ' 发送后续包 

Cur_Pos = Cur_Pos + j 

End Select 

End Sub