Oppure

Loading
14/06/11 13:36
albumsilente
Ciao a tutti sto realizzando un applicazione client server. Il client e server si connettono alla perfezione. In lan mi va tutto veloce invece quando faccio prove fuori lan, il trasferimento immagine è lentissimo. Vi scrivo il codice.
SERVER.

Private Sub Winsock7_DataArrival(ByVal bytesTotal As Long)
Dim data As String
Winsock7.GetData data
Select Case data
Case "1"
Dim hwnd As Long
Dim hDC As Long
hwnd = GetDesktopWindow()
hDC = GetWindowDC(hwnd)
Picture1.Appearance = 0 ' Flat
Picture2.Appearance = 0 ' Flat
Picture1.AutoRedraw = True
Picture2.AutoRedraw = True
Picture2.Width = Screen.Width
Picture2.Height = Screen.Height
Picture1.Visible = True
Picture2.Visible = True
' copio l'immagine catturata su Picture2
BitBlt Picture2.hDC, 0, 0, Screen.Width, Screen.Height, hDC, 0, 0, vbSrcCopy
Picture2.Picture = Picture2.Image ' rendo l'immagine persistente
' rimpicciolisco (stretch) l'immagine in base alle dimensioni di Picture1
Picture1.PaintPicture Picture2, 0, 0, Picture1.Width, Picture1.Height, , , , , vbSrcCopy
Picture1.Picture = Picture1.Image ' rendo l'immagine persistente
ReleaseDC hwnd, hDC
SavePicture Picture1.Picture, "C:\system.bmp"
Case "2"
Winsock8.SendData "apri"
Dim immagine() As Byte
Open "C:\system.bmp" For Binary As #1
ReDim immagine(0 To LOF(1) - 1)
DoEvents
Get #1, , immagine
Winsock7.SendData immagine()
Close #1
End Select
Ens Sub


CLIENT

Option Explicit
Private Sub Command1_Click()
On Error Resume Next
Winsock7.Close
Winsock7.LocalPort = 4001
Winsock7.Listen
Shape1.BackColor = vbYellow
Shape1.BorderColor = vbYellow
End Sub
Private Sub Command2_Click()
On Error Resume Next
Winsock8.Close
Winsock8.LocalPort = 4002
Winsock8.Listen
Shape2.BackColor = vbYellow
Shape2.BorderColor = vbYellow
End Sub

Private Sub Command3_Click()
On Error Resume Next
Winsock7.SendData "1"
End Sub

Private Sub Command4_Click()
On Error Resume Next
Winsock7.SendData "2"
End Sub
Private Sub Command5_Click()
On Error Resume Next
SavePicture Picture1.Image, "C:\screenremoto.bmp"
End Sub
Private Sub Command6_Click()
On Error Resume Next
Winsock7.Close
Shape1.BackColor = vbRed
Shape1.BorderColor = vbRed
Picture1.BackColor = vbBlack
End Sub
Private Sub Command7_Click()
On Error Resume Next
Winsock8.Close
Shape2.BackColor = vbRed
Shape2.BorderColor = vbRed
Picture1.BackColor = vbBlack
End Sub

Private Sub Command8_Click()
On Error Resume Next
Winsock7.SendData "3"
End Sub

Private Sub Winsock7_ConnectionRequest(ByVal requestID As Long)
On Error Resume Next
Winsock7.Close
Winsock7.Accept requestID
Shape1.BackColor = vbGreen
Shape1.BorderColor = vbGreen
End Sub
Private Sub Winsock7_DataArrival(ByVal bytesTotal As Long)
On Error Resume Next
Dim immagine() As Byte
Winsock7.GetData immagine
Put #1, , immagine()
DoEvents
End Sub
Private Sub Winsock8_ConnectionRequest(ByVal requestID As Long)
On Error Resume Next
Winsock8.Close
Winsock8.Accept requestID
Shape2.BackColor = vbGreen
Shape2.BorderColor = vbGreen
End Sub
Private Sub Winsock8_DataArrival(ByVal bytesTotal As Long)
On Error Resume Next
Dim dati As String
Winsock8.GetData dati, vbString
If Left(dati, 4) = "apri" Then
Open App.Path & "\imm.bmp" For Binary Access Write As #1
DoEvents
Text1.Text = dati
Else
If Left(dati, 4) = "fine" Then
Text1.Text = dati
DoEvents
Close #1
DoEvents
Picture1.Picture = LoadPicture(App.Path & "\imm.bmp";)
DoEvents
Kill (App.Path & "\imm.bmp";)
End If
End If
End Sub


aaa