Picture über Wisock zum Server/Client

D

dennislassiter

Erfahrenes Mitglied
hi!
Mein Problem:
Ich möchte beim Client ein Bild auf der Festplatte (*.jpg|*.gif|*.bmp) aussuchen können (nicht mein Problem). Dann soll das Bild in der Picturebox vom Server zu sehen sein...

Wie mach ich das?

2.) Ich habe eine *.exe oder *.zip Datei und möchte diese über Winsock verschicken.
Mein Problem: Es werden nur etwa 7-10 kb übertragen, anstatt ca. 2 MB.

MfG,

Dennis Lassiter
 
wie verschiggst du das?

schau mal hier:
da wird das in häppchen rübergeschickt

Code: 
'Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum.
'Ansonsten viel Spaß und Erfolg mit diesem Source!

'------------- Anfang Projektdatei Project1.vbp -------------
' Die Komponente 'Microsoft Winsock Control 6.0 (SP5) (MSWINSCK.OCX)'  
' wird benötigt.
'--------- Anfang Formular "Form1" alias Form1.frm  ---------

'Control Frame: Frame1
'Control CommandButton: Command1
'Control Timer: Timer1
'Control PictureBox: Picture1
'Control FileListBox: File1
'Control DirListBox: Dir1
'Control DriveListBox: Drive1
'Control TextBox: Text1
'Control Winsock: Winsock1
'Control Label: Label2
'Control Label: Label1
'Control Label: Label3
'Control Label: Label4
'Control Label: Label5
'Control Label: Label6



Option Explicit

Const ResponseTimeOut = 20 '20 Sekunden
Const PaketSize = 2048

Dim Start&
Dim OkFlag As Boolean
Dim TimeOut As Boolean
Dim Connected As Boolean

Private Sub Form_Load()
  Timer1.Enabled = False
  Timer1.Interval = 400
  Winsock1.LocalPort = CInt(Text1.Text)
  Winsock1.Listen
  
  Label2.Caption = "Nicht verbunden"
  Label3.Caption = App.Path & "\Testdatei.bmp"
  
  If Dir$(Label3.Caption) <> "" Then
    Label4.Caption = Int((FileLen(Label3.Caption) / 1024) * 10) _
                     / 10 & " kB"
  End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
  Unload Form2
End Sub

Private Sub Command1_Click()
  Call SendFile(Label3.Caption)
End Sub

Private Sub Drive1_Change()
  Dir1.Path = Drive1.Drive
End Sub

Private Sub Dir1_Change()
  File1.Path = Dir1.Path
End Sub

Private Sub File1_Click()
  Dim AA$, BB$
  
    AA = File1.Path
    If Right$(AA, 1) <> "\" And Right$(AA, 1) <> "/" Then
      AA = AA & "\"
    End If
    
    Label3.Caption = AA & File1.FileName
    Label4.Caption = Int((FileLen(Label3.Caption) / 1024) * 10) _
                     / 10 & " kB"
End Sub

Private Sub Timer1_Timer()
  If Timer - Start > ResponseTimeOut Then
    TimeOut = True
    OkFlag = False
  End If
End Sub

Private Sub Winsock1_ConnectionRequest(ByVal requestID As Long)
  If Winsock1.State <> sckClosed Then Winsock1.Close
  Winsock1.Accept requestID
  Winsock1.SendData 77
  Label2.Caption = "Verbunden, bereit"
  Connected = True
End Sub

Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
  Dim Data() As Byte
    
    Winsock1.GetData Data, vbString
    If Data(0) = 77 Then
      OkFlag = False
    End If
End Sub

Private Sub SendFile(FileName$)
  Dim Data() As Byte
  Dim l&, AA$, BB$, x&, FN%, TM As Single
  
  On Error Resume Next
    
    If Not Connected Then
      MsgBox ("Es besteht keine Verbindung zum Client!")
      Exit Sub
    End If
    
    Call Disable
    l = FileLen(FileName)
    AA = Hex(l)
    Do While Len(AA) < 8
      AA = "0" & AA
    Loop
    
    BB = LastPath(FileName)
    BB = BB & Space$(257 - Len(BB))
    AA = "New Data|" & AA & BB
    ReDim Data(0 To Len(AA) - 1)
    For x = 1 To Len(AA)
      Data(x - 1) = Asc(Mid$(AA, x, 1))
    Next x
    
    Winsock1.SendData Data
    
    If WaitForResponse Then
      FN = FreeFile
      Open FileName For Binary As #FN
      ReDim Data(1 To PaketSize) As Byte
      
      Label2.Caption = "Sende Daten"
      Label2.Refresh
      
      l = LOF(FN)
      TM = Timer
      For x = 1 To l \ PaketSize
        Get #FN, , Data
        Winsock1.SendData Data
        Call ProgressBar(x * PaketSize, 0, l)
        Label5.Caption = Int(x * PaketSize / 1024 / (Timer - TM) * _
                         10) / 10 & " kB/Sec"
                         
        Label5.Refresh
        If Not WaitForResponse Then
          MsgBox ("Übertragunsfehler")
          Call ProgressBar(0, 0, l)
          Label2.Caption = "Verbunden, bereit"
          Call Enable
          Exit Sub
        End If
      Next x
    
      If l Mod PaketSize <> 0 Then
        ReDim Data(1 To l Mod PaketSize) As Byte
        Get #FN, , Data
        Winsock1.SendData Data
        Call ProgressBar(l, 0, l)
        Label5.Caption = Int(x * PaketSize / 1024 / (Timer - TM) * _
                         10) / 10 & " kB/Sec"
                         
        Label5.Refresh
        If Not WaitForResponse Then
          MsgBox ("Übertragunsfehler")
          Call ProgressBar(0, 0, l)
          Label2.Caption = "Verbunden, bereit"
          Call Enable
          Exit Sub
        End If
      End If
    
      Close FN
      Label2.Caption = "Verbunden, bereit"
      Call ProgressBar(0, 0, l)
    Else
      Label2.Caption = "Timeout"
      MsgBox ("Konnte Verbindung nicht herstellen!")
    End If
    Call Enable
End Sub

Private Function WaitForResponse() As Boolean
  OkFlag = True
  TimeOut = False
  Start = Timer
  Timer1.Enabled = True
  Do While OkFlag
    DoEvents
  Loop
  If Not TimeOut Then WaitForResponse = True
  Timer1.Enabled = False
End Function

Private Sub ProgressBar(ByVal Prg&, ByVal Min&, ByVal Max&)
  Dim Fx&
  Static LastX
    If Prg < Min Or Prg > Max Or Max <= Min Then Exit Sub
    Prg = Int(100 / (Max - Min) * (Prg - Min))
    With Picture1
      
      If Prg > 0 Then
        If Prg <> LastX Then
          Picture1.Cls
          Fx = (Picture1.ScaleWidth - 2) / 100 * Prg
          Picture1.Line (0, 0)-(Fx + 1, Picture1.ScaleHeight _
                        - 1), &H8000000D, BF
          .CurrentX = Fx + 3
          .CurrentY = 0
          Picture1.Print Trim$(CStr(Prg) & " %")
          LastX = Prg
        End If
      Else
        Picture1.Cls
      End If
    End With
End Sub

Private Function LastPath(ByVal Path$) As String
   Dim AA$, BB$, x&
     For x = Len(Path) To 1 Step -1
       AA = Mid$(Path, x, 1)
       If AA = "/" Or AA = "\" Then
         Exit For
       Else
         BB = AA & BB
       End If
     Next x
     LastPath = BB
End Function

Private Sub Disable()
  Text1.Enabled = False
  Command1.Enabled = False
  File1.Enabled = False
  Dir1.Enabled = False
  Drive1.Enabled = False
  MousePointer = vbHourglass
End Sub

Private Sub Enable()
  Text1.Enabled = True
  Command1.Enabled = True
  File1.Enabled = True
  Dir1.Enabled = True
  Drive1.Enabled = True
  MousePointer = vbDefault
End Sub
'---------- Ende Formular "Form1" alias Form1.frm  ----------
'--------- Anfang Formular "Form2" alias Form2.frm  ---------

'Control Frame: Frame1
'Control CommandButton: Command1
'Control PictureBox: Picture1
'Control Timer: Timer1
'Control DriveListBox: Drive1
'Control DirListBox: Dir1
'Control FileListBox: File1
'Control TextBox: Text1
'Control TextBox: Text2
'Control Winsock: Winsock1
'Control Label: Label8
'Control Label: Label1
'Control Label: Label2
'Control Label: Label4
'Control Label: Label3
'Control Label: Label7
'Control Label: Label9
'Control Label: Label5



Option Explicit

Const ResponseTimeOut = 20 '20 Sekunden

Dim Start&
Dim OkFlag As Boolean
Dim TimeOut As Boolean
Dim Connected As Boolean
Dim Awaiting As Boolean

Private Sub Form_Load()
  Timer1.Enabled = False
  Timer1.Interval = 400
  
  Drive1.Drive = "c:"
  Dir1.Path = "c:"
  
  With Form1
    .Show
    .Top = Screen.Height / 2
    .Left = (Screen.Width - .Width) / 2
  End With
  
  With Me
   .Left = Form1.Left
   .Top = Form1.Top - .Height
  End With
End Sub

Private Sub Form_Unload(Cancel As Integer)
  Unload Form1
End Sub

Private Sub Command1_Click()
  On Error Resume Next
  Winsock1.Connect Text2.Text, CInt(Text1.Text)
  
  Awaiting = True
  If WaitForResponse Then
    Label1.Caption = "Verbunden, bereit"
    Command1.Enabled = False
  Else
    MsgBox ("Konnte keine Verbindung zum Server hestellen")
    Winsock1.Close
  End If
  Awaiting = False
End Sub

Private Sub Drive1_Change()
  Dir1.Path = Drive1.Drive
End Sub

Private Sub Dir1_Change()
  Dim AA$
  
    AA = Dir1.Path
    If Right$(AA, 1) <> "\" And Right$(AA, 1) <> "/" Then
      AA = AA & "\"
    End If
    Label8.Caption = AA
    File1.Path = Dir1.Path
End Sub

Private Sub Timer1_Timer()
  If Timer - Start > ResponseTimeOut Then
    TimeOut = True
    OkFlag = False
  End If
End Sub

Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
  Dim Data() As Byte
  Dim AA$, BB$, x&, d As Single
  Static Rec As Boolean
  Static TotalLen&
  Static IsLen&
  Static FN%
  Static TM As Single
 
    Winsock1.GetData Data, vbString
    If Awaiting Then
      If Data(0) = 77 Then OkFlag = False
    Else
      If UBound(Data) = 273 And Not Rec Then
        For x = 0 To UBound(Data)
          AA = AA & Chr$(Data(x))
        Next x
        
        If Left$(AA, 9) = "New Data|" Then
          TotalLen = CLng("&H" & Mid$(AA, 10, 8))
          If TotalLen <> 0 Then
            BB = Trim$(Mid$(AA, 18))
            Label1.Caption = "Empfange die Datei " & Chr$(34) & _
                             BB & Chr$(34)
                             
            Label4.Caption = Int((TotalLen / 1024) * 10) / 10 & _
                             " kB"
                             
            Call Dir1_Change
            Label8.Caption = Label8.Caption & BB
            TM = Timer
            Call Disable
          Else
            TotalLen = 0
          End If
        End If
        
        If TotalLen <> 0 Then
          Winsock1.SendData 77
          Rec = True
          FN = FreeFile
          IsLen = 0
          If Dir$(Label8.Caption) <> "" Then
            Kill Label8.Caption
          End If
          Open Label8.Caption For Binary As #FN
        End If
      ElseIf Rec Then
        Put #FN, , Data
        IsLen = IsLen + UBound(Data) + 1
        
        d = (Timer - TM)
        If d <> 0 Then Label3.Caption = Int(IsLen / 1024 / _
                                        d * 10) / 10 & " kB/Sec"
           
        Call ProgressBar(IsLen, 0, TotalLen)
        If IsLen = TotalLen Then
          Close FN
          MsgBox ("Übertragung erfolgreich beendet!")
          Call ProgressBar(0, 0, TotalLen)
          Rec = False
          Call Enable
          TotalLen = 0
          File1.Refresh
          BB = LastPath(Label8.Caption)
          If File1.ListCount > 0 Then
            For x = 0 To File1.ListCount - 1
              If File1.List(x) = BB Then
                File1.ListIndex = x
                Exit For
              End If
            Next x
            Label1.Caption = "Verbunden, bereit"
          End If
        End If
        Winsock1.SendData 77
      End If
    End If
End Sub

Private Sub ProgressBar(ByVal Prg&, ByVal Min&, ByVal Max&)
  Dim Fx&
  Static LastX
    If Prg < Min Or Prg > Max Or Max <= Min Then Exit Sub
    Prg = Int(100 / (Max - Min) * (Prg - Min))
    With Picture1
      
      If Prg > 0 Then
        If Prg <> LastX Then
          Picture1.Cls
          Fx = (Picture1.ScaleWidth - 2) / 100 * Prg
          Picture1.Line (0, 0)-(Fx + 1, Picture1.ScaleHeight _
                        - 1), &H8000000D, BF
                        
          .CurrentX = Fx + 3
          .CurrentY = 0
          Picture1.Print Trim$(CStr(Prg) & " %")
          LastX = Prg
        End If
      Else
        Picture1.Cls
      End If
    End With
End Sub

Private Function WaitForResponse() As Boolean
  OkFlag = True
  TimeOut = False
  Start = Timer
  Timer1.Enabled = True
  Do While OkFlag
    DoEvents
  Loop
  If Not TimeOut Then WaitForResponse = True
  Timer1.Enabled = False
End Function

Private Function LastPath(ByVal Path$) As String
   Dim AA$, BB$, x&
     For x = Len(Path) To 1 Step -1
       AA = Mid$(Path, x, 1)
       If AA = "/" Or AA = "\" Then
         Exit For
       Else
         BB = AA & BB
       End If
     Next x
     LastPath = BB
End Function

Private Sub Disable()
  Text1.Enabled = False
  Text2.Enabled = False
  Dir1.Enabled = False
  Drive1.Enabled = False
  MousePointer = vbHourglass
End Sub

Private Sub Enable()
  Text1.Enabled = True
  Text2.Enabled = True
  Dir1.Enabled = True
  Drive1.Enabled = True
  MousePointer = vbDefault
End Sub
'---------- Ende Formular "Form2" alias Form2.frm  ----------
'-------------- Ende Projektdatei Project1.vbp --------------
 
Bei einem Bild wäre es noch möglich es als String über die Sock zu schicken und dann an der anderen Stelle den String wieder in das Bild zu verwandeln.
 
Um antworten zu können musst du eingeloggt sein.

Neue Beiträge

Zurück