downloads via http (winsock http server), IE

[1134i]

(sorry for my KORYAVIY english)

My DowlnloadFile function doesn't work in Internet Explorer (it works in Opera, Mozilla, download managers etc).

For example., Winsock 'send' function in VB version of this program, returns 0, when can't send data. Maybe, my realisation of DOEVENTS function - its a problem?

VRAGU NE SDAYOTSYA NASH GORDIY VARYAG!

'need file C:\MYFILE.EXE vith size 1024000, modify this line
'start - http://127.0.0.1:9099/



sendfile.inb

Code:

declare Function DownloadFile(fn As String, siz As Double, shfn As String, s as long)

Function DownloadFile(fn As String, siz As Double, shfn As String, s as long)
Dim mh As String
Dim myff As Integer
myff = FreeFile()

Open fn For Input As myff
Close myff
Open fn For Binary Access Read Lock Write As myff

mh = "HTTP/1.1 200 OK"
mh += nl + "Server: MyCoolTool"
mh += nl + "Content-type: application/octet-stream"
mh += nl + "Content-Disposition: attachment; filename=" + shfn
mh += nl + "Accept-Ranges: bytes"
mh += nl + "Content-Length: " + str$(siz)
mh += nl + "Connection: close"
mh += nl + nl

Dim bytesSend As Long

bytessend = wsSendData (s, mh)

Dim strt As Long, block As Long, bbuf As String
strt = 1
Do
If strt + 16384 < siz Then block = 16384 Else block = siz - strt
bbuf = String(block, 0)
Get #1, (strt+1), bbuf
DoEvents
bytesSend = wsSendData(s, bbuf)
'
? "send " + str$(bytesSend)
'
if bytessend = -1 then
exit function
else
If strt + block = siz Then Exit Do
strt = strt + bytessend
end if
Loop

Close myff

exit function
endsub:
? "error in function"
Reset
End Function

program.bas

Code:

option explicit
#include "winsock.inb"
#include "sendfile.inb"
dim tserver as long, i as long, q as long
dim taccept as long
wsInit(tserver)
wsListen (tserver, 9099, "0.0.0.0")
taccept = wsAccept (tserver)
downloadfile ("c:\\myfile.exe",1024000,"myfile.exe", taccept)
wsKill(tserver)
END

winsock.inb

Code:

option explicit
option escape
'$include: "win/winsock.bi"
'$include: "win/user32.bi"
declare function wsSendData   ( s as long, sendbuffer as string)
declare function wsInit (s as long)
declare function wsKill (s as long)
declare function wsListen (s as long, port as integer, bindaddr as string)
declare function wsAccept (s as long) as long
declare sub doevents()

const RECVBUFFLEN = 8192
const nl = "\r\n"

function wsAccept(s as long) as long
   dim ms as string
   dim acceptsocket as long
   AcceptSocket = SOCKET_ERROR
   while ( AcceptSocket = SOCKET_ERROR )
      AcceptSocket = accept( s, 0, 0)
   wend
   wsAccept = AcceptSocket
end function

function wsListen (s as long, port as integer, bindaddr as string)
   dim sa as sockaddr_in
   sa.sin_port      = htons(port)
   sa.sin_family      = AF_INET
   sa.sin_addr.S_addr   = inet_addr( bindaddr )
   bind( s, @sa, sizeof(sa) )
   listen( s, 1 )
end function

function wsKill(s as long)
   closesocket(s)
   shutdown(s, 2)
   WSACleanup
end function

function wsInit(s as long)
   dim wsaData as WSAData
   WSAStartup( MAKEWORD( 1, 1 ), @wsaData )
   s = opensocket(AF_INET, SOCK_STREAM, IPPROTO_TCP)
end function

function wsSendData(s as long, sendbuffer as string) as long
wssenddata = send(s, strptr(sendBuffer), len(sendBuffer),0)
end function

sub DoEvents
dim wmsg as msg
TranslateMessage wmsg
DispatchMessage wmsg
End sub

[whitetiger0990]

Sorry cant really help without looking at it closer and its a bit late.


but really. wow. people seem to be coming across my winsock functions... =o