Toon posts:

[VB+Winsock+HTTP] Bestand goed versturen

Pagina: 1
Acties:

Verwijderd

Topicstarter
Ik ben een webserver(tje) aan het schrijven, en na twee middagjes programmeerwerk werkt ie een beetje redelijk. D.w.z. geen errors meer... alleen de snelheid laat wat te wensen over :-/ Ik haal maar 329 KB/s, op welk systeem ik het ook draai... sja ik weet dat Winsock niet zo snel werkt, maar ik moet er toch iets meer dan 329 KB/s uit kunnen halen lijkt mij...

Ik verstuur bestanden met de volgende code (voor de gelegenheid maar eens voorzien van commentaar :P)

code:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
Sub SendFile(Socket As frmConn, Req As Request, Code%, CodeDesc$, FileName$)
    Dim i As Long, imax As Long
    
    DoEvents              ' dit om eventuele nieuwe requests die tegelijkertijd worden gedaan ook te vangen
    
    On Error GoTo 500       ' zie commentaar bij label 500
    
    Socket.fnum = FreeFile
    Open FileName For Binary Access Read As #Socket.fnum
    Socket.imax = RoundUp(LOF(Socket.fnum) / FilePacketSize)      ' RoundUp is zelf geschreven en werkt, no doubt about that :)
    Socket.i = 1
    
    If Socket.imax = 1 Then
        Socket.Buf = String(LOF(1), vbNullChar)
    Else
        Socket.Buf = String(FilePacketSize, vbNullChar)              ; FilePacketSize is een constante (die op 1048576 oftewel 1 M staat, maar makkelijk gewijzigd kan worden)
    End If
    
    Socket.ReadData    ' lees in van bestand
    
    Socket.Send CreateHeader(Req, LOF(Socket.fnum), DCT(FileName), Code, CodeDesc) + Socket.Buf              ' CreateHeader en DCT werken goed, dat is zeker
    
    If Socket.imax = 1 Then        ' als dit het hele bestand was,
        Close #Socket.fnum         ' sluit het bestand dan
        Socket.fnum = 0                ' en meldt aan Socket dat er geen bestand meer verstuurd wordt
    End If
    
    Exit Sub
500:                                           ' stuur ipv het bestand een Internal Server Error
    Close #Socket.fnum               ' sluit bestand
    Socket.fnum = 0                     ' meldt dat niet meer stuurt
    SendPage Socket, Req, 500, "Internal Server Error", CreatePage_500(Req, "Could not open the local file " + FileName, Err.Description + " (" + CStr(Err.Number) + ")")
                                                   ' en CreatePage_500(blabla) werkt ook goed :)
End Sub


Uit het object "Socket" (wat verwijst naar een formulier) zal ik ook een stukje code planten:

code:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
Public fnum As Integer     ' if 0, then not sending or sending from memory
Public i As Long
Public imax As Long

Public Buf$

Public Sub ReadData()
    Get #fnum, , Buf              ' lijkt misschien een beetje stom dat dat niet in SendFile
                                           ' staat, maar als ik het daar neerzet geeftie een of
                                             ' gekke error --> naja doek het hier maar :P
End Sub

Private Sub sckConn_SendComplete()   ' wordt aangeroepen zodra het verzenden afgerond is
    If fnum > 0 Then                        ' als je een bestand aan het versturen was vanaf hdd
        ' Read and send new piece
        i = i + 1
        If i = imax Then                        ' als dit het laatste deel van de file is
            Buf = String(LOF(1) - ((i - 1) * SendFileInPieces), vbNullChar)  ' zo groot als resterende deel
        Else
            Buf = String(SendFileInPieces, vbNullChar)     ' anders maar net hoe groot de constante is
        End If
        
        Get #fnum, , Buf              ' lees zooi uit file
        
        If i = imax Then               ' als alles gelezen dan sluit en meldt niet meer sturen
            Close #fnum
            fnum = 0
            Send Buf + Enter
        Else
            Send Buf
        End If
        
        Buf = ""                          ' deze inhoud niet meer nodig
    End If
End Sub


De code werkt opzich goed! Alleen te traag :? Iemand enig idee?

Owja aan het CPU-gebruik zal het ook niet liggen, want dat blijft onder de 5% tijdens het sturen...

Sorry voor m'n slordige commentaar... ik heb het commentaar pas hier op het forum toegevoegd, behalve de twee regeltjes die in het Engels zijn ;)

/edit: owja als ik het bestand in 1x inlees en dan verstuur haal ik wel een "normale" snelheid... alleen dat kost teveel geheugen in het geval van een film ;)

[ Voor 6% gewijzigd door Verwijderd op 16-05-2004 21:47 ]


  • Sponge
  • Registratie: Januari 2002
  • Laatst online: 15:19

Sponge

Serious Game Developer

Strings zijn traag. Kan je geen bytearray sturen? ;)

Verwijderd

Topicstarter
Sponge schreef op 16 mei 2004 @ 21:51:
Strings zijn traag. Kan je geen bytearray sturen? ;)
Nee, dat gaat niet voor zover ik weet... (in theorie wel geloof ik, in de praktijk niet :P)

Maar als ik het hele bestand in 1x inlees heb ik dus een string met (in het geval van mijn testbestandje) zo'n 160 miljoen tekens en het versturen van die string gaat nog met een "normale" snelheid dus dan moet een string van 1 miljoen tekens *helemaal* geen probleem zijn ;)

[ Voor 5% gewijzigd door Verwijderd op 16-05-2004 22:02 ]