07-14-2005, 07:24 AM
(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
program.bas
winsock.inb
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
--
sorry for my english...
sorry for my english...