-
i'm creating a webserver... now i have to read the files in chunks, cause otherwise the program will read the whole file first and then send it...
i first had this code:
Public Function Read_File(filename)
Dim file
Dim textdata
On Error Resume Next
Dim i As Integer
i = 1
f = FreeFile
textda = ""
If FileExists(filename) Then
If Len(filename) Then
Open filename For Binary As #file
textdata = Input(LOF(file), #file)
DoEvents
Close #file
End If
text_read = textdata
Else
text_read = ""
End If
End Function
this is what i've come up with after a day programming but it also doesn't work:
Public Function Load_File(filename)
Const ChunkSize = 1024
Dim file
Dim textdata
On Error Resume Next
Dim i As Integer
i = 1
file = FreeFile
textda = ""
If FileExists(filename) Then
If Len(filename) Then
Open filename For Binary As #file
Do Until LOF(1) = Loc(1) Or EOF(1)
textdata = ""
If LOF(1) - Loc(1) < ChunkSize Then
textdata = String(LOF(1) - Loc(1), 0)
Else
textdata = String(ChunkSize, 0)
End If
Get #file, , textdata
text_read = textdata
Loop
'DoEvents
Close #file
End If
text_read = textdata
Else
text_read = ""
End If
End Function
but how can i use chunks? i just can't get it working correct ;(
thanks for your help
[Edited by D!SiLLUSiON on 04-12-2000 at 05:23 PM]
-
misunderstanding....
Look man...
I really wanna help ya, but I didnt get your problem.
Please explain the exact problem clearly.
Is it a Bin to Dec translation problem or what?
Lior, An Israeli Programmer.
-
well, it's that i have to open an file in chunks of, lets say 1024 k, and then send them chunk by chunk to the client that connects to my program... well the thing is with the code i have now come up with that vb first will load whole the file, and then when it's whole loaded, then send it... but then if it opens a file of 10 mb, my program needs about 30mb internal memory, and the client has to wait about three minutes... that's not really what i want ;)
-
Chnuks
Give this a go. This will get 1024 characters from a file at a time.
Code:
Dim iLen As Long
Dim iMod As Long
Dim iRem As Long
Dim i As Long
Dim myString
'open the file
Open "me.doc" For Binary As #1
'get the length
iLen = FileLen("me.doc")
'find out how many time 1024 goes into iLen
iMod = iLen Mod 1024
'fins the remainder
iRem = iLen Mod 1024
'loop for however many times 1024 goes into the filelength
For i = 1 To iMod
myString = Input(1024, #1)
MsgBox myString
'send data
Next i
'get the remaining charcters
myString = Input(iRem, #1)
'send data
Close #1
hope this helps in some way.
[Edited by Iain17 on 04-14-2000 at 09:55 AM]
-
thnx i hope it helps, cuz winsock just won't send it in chuncks whatever i do... hmmz we'll see ;)
-
I suggest everyone completly ignores my last post, as i have just realised what a load of crap it was. When i tried writing the results to another file, the file was complete crap. Well not complete crap, but it wasn't the same.
Here is the revised code to split up a file properly.
Code:
Const CHUNK_SIZE = 1024
Private Sub Command1_Click()
Dim iLen As Long
Dim iMod As Long
Dim iRem As Long
Dim i As Long
Dim myFile As String
Dim myString As String * CHUNK_SIZE
myFile = "me.doc"
'open the file
Open myFile For Binary As #1
'get the length
iLen = FileLen(myFile)
'find out how many time 1024 goes into iLen
iMod = iLen / CHUNK_SIZE
'fins the remainder
iRem = iLen Mod CHUNK_SIZE
'loop for however many times 1024 goes into the filelength
For i = 1 To iMod
Get #1, , myString
'send data
Next i
'get the remaining charcters
Get #1, , myString
'send data
Close #1
End Sub
-
This is some code I wrote some time ago for copying those annoying xrated files from cd's that missreport the file size to over 700mb so you can't copy them, and I wanted a bar graph (it runs as fast as windows will copy),
hope it still makes sence 'cause I'm sort of in a hurry but know your prob.
:D :D :D :D :D :D :D :D :D :D :D :D :D :D :D :D
Code:
' Module Code
Public FileByte() As Byte
Public FileLength As Long
Public ToPath As String
Public FromPath As String
Public BufferSize As Long
' end module ----------------
Private Sub cmdCopy_Click()
BufferSize = 32768
Dim UpdateCount As Integer
Dim CopyLoop As Long
UpdateCount = 0
ReDim FileByte(BufferSize)
If Len(ToPath) > 1 And Len(FromPath) > 1 Then
Open FromPath For Binary As #1
FileLength = FileLen(FromPath) 'LOF(1)
If FileLength < 1 Then
MsgBox ("File Contains no Bytes")
Close #1
Exit Sub
End If
ProgressBar1.Max = FileLength \ 1000
StatusBar1.Panels(1).Text = "Bytes Copied: 0 of " & Format(FileLength, "#,###,###,###") & " " & 0 & "%"
Open ToPath For Binary As #2 'Len = (FileLength)
On Error GoTo ABORT
For CopyLoop = 1 To FileLength Step BufferSize
UpdateCount = UpdateCount + 1
If FileLength - CopyLoop > BufferSize Then
Get #1, CopyLoop, FileByte
Put #2, CopyLoop, FileByte
If UpdateCount = 37 Then
ProgressBar1.Value = CopyLoop \ 1000
'lblBytes.Caption = CopyLoop & " of " & FileLength
StatusBar1.Panels(1).Text = "Bytes Copied: " & Format(CopyLoop, "#,###,###,###") & " of " & Format(FileLength, "#,###,###,###") & " " & Format(CopyLoop / FileLength * 100, "00.#") & "%"
StatusBar1.Refresh
UpdateCount = 0
DoEvents
End If
Else
ReDim FileByte(FileLength - CopyLoop)
Get #1, CopyLoop, FileByte
Put #2, CopyLoop, FileByte
ProgressBar1.Value = ProgressBar1.Max
StatusBar1.Panels(1).Text = "Bytes Copied: " & Format(FileLength, "#,###,###,###") & " of " & Format(FileLength, "#,###,###,###") & " " & 100 & "%"
DoEvents
CopyLoop = FileLength + 1
End If
Next
Close #1
Close #2
MsgBox ("Done!, " & FileLength & " Bytes Copied")
Debug.Print FileLength
' Debug.Print FileBytes()
End If
Exit Sub
ABORT: 'Close on error
'lblBytes.Caption = CopyLoop & " of " & FileLength
StatusBar1.Panels(1).Text = "Bytes Copied: " & Format(CopyLoop, "#,###,###,###") & " of " & Format(FileLength, "#,###,###,###") & " " & Format(CopyLoop / FileLength * 100, "00.#") & "%"
ProgressBar1.Value = CopyLoop \ 1000
MsgBox ("Only " & CopyLoop & " of " & FileLength & " could be retrieved")
Close #1
Close #2
End Sub
[Edited by Paul282 on 04-14-2000 at 10:49 AM]
-
Thnx
i'm sure it will do ;)) thnx very much! ;)
-
It itsn't working
can anyone see what i'm doing wrong???
Code:
Private Sub sckWS_DataArrival(Index As Integer, ByVal bytesTotal As Long)
On Error Resume Next
Dim f As String
Dim filename As String
Dim iLen As Long
Dim iMod As Long
Dim iRem As Long
Dim i As Long
Dim spc2 As Integer
Dim strData As String
Dim htmlData As String
Dim FileByte() As Byte
Dim FileLength As Long
Dim BufferSize As Long
On Error Resume Next
i = 1
f = FreeFile
htmlData$ = ""
sckWS(Index).GetData strData$
If frmOptions.txtBanIP.Text <> "" Then
If sckWS(Index).RemoteHostIP = frmOptions.txtBanIP.Text Then
requestedPage = ""
sckWS(Index).SendData ReplaceStr(HTML_BannedIP, "$ip", sckWS(0).LocalIP) & vbCrLf
Exit Sub
End If
End If
If mnuTrayPause.Checked = True Then
requestedPage = ""
sckWS(Index).SendData ReplaceStr(HTML_ServerPaused, "$ip", sckWS(0).LocalIP) & vbCrLf
Exit Sub
End If
If Mid(strData$, 1, 3) = "GET" Then
Dim findget As String, pagetoget As String
findget = InStr(strData, "GET ")
spc2 = InStr(findget + 5, strData, " ")
pagetoget = Mid(strData, findget + 4, spc2 - (findget + 4))
requestedPage = pagetoget
ElseIf Mid$(strData, 1, 4) = "POST" Then
Dim findpost As String, pagetopost As String
findpost = InStr(strData$, "POST ")
spc2 = InStr(findpost + 5, strData, " ")
pagetopost = Mid(strData, findpost + 5, spc2 - (findpost + 5))
requestedPage = pagetopost
End If
If Left(requestedPage, Len(iconpath) + 1) = "/" & ReplaceStr(iconpath, "\", "/") Then 'this will check if it is a icon
sckWS(Index).SendData text_read(AddASlash(App.Path) & requestedPage)
Exit Sub
End If
If frmOptions.chkLogFile.Value = 1 Then
Dim Logging As Integer
Logging = FreeFile
Open AddASlash(App.Path) & "Log.log" For Append As #Logging
Print #Logging, Format(Date, "Long Date") & " " & Format(Time, "Long Time") & " ; " & sckWS(Index).RemoteHostIP & "; " & Mid(strData$, InStr(1, UCase(strData$), "USER-AGENT:") + 12, InStr(InStr(1, UCase(strData$), "USER-AGENT:") + 12, UCase(strData$), vbCrLf) - InStr(1, UCase(strData$), "USER-AGENT:") - 12) & "; requested Language: " & Mid(strData$, InStr(1, UCase(strData$), "ACCEPT-LANGUAGE:") + 17, InStr(InStr(1, UCase(strData$), "ACCEPT-LANGUAGE:") + 17, UCase(strData$), vbCrLf) - InStr(1, UCase(strData$), "ACCEPT-LANGUAGE:") - 17) & "; requested page: " & requestedPage$
Close #Logging
End If
If frmOptions.chkLogScreen.Value = 1 Then
txtLog.Text = txtLog.Text & Format(Date, "Long Date") & " " & Format(Time, "Long Time") & " ; " & sckWS(Index).RemoteHostIP & "; " & Mid(strData$, InStr(1, UCase(strData$), "USER-AGENT:") + 12, InStr(InStr(1, UCase(strData$), "USER-AGENT:") + 12, UCase(strData$), vbCrLf) - InStr(1, UCase(strData$), "USER-AGENT:") - 12) & "; requested Language: " & Mid(strData$, InStr(1, UCase(strData$), "ACCEPT-LANGUAGE:") + 17, InStr(InStr(1, UCase(strData$), "ACCEPT-LANGUAGE:") + 17, UCase(strData$), vbCrLf) - InStr(1, UCase(strData$), "ACCEPT-LANGUAGE:") - 17) & "; requested page: " & requestedPage$ & vbCrLf
End If
If requestedPage$ = "/" Then
requestedPage$ = htmlIndexPage$
Else
requestedPage$ = Mid(requestedPage$, 2, Len(requestedPage$) - 1)
End If
If FileExists(AddASlash(htmlPageDir) & requestedPage$) Then
filename = (AddASlash(htmlPageDir) & requestedPage$)
GoTo text_read
If frmOptions.chkCounter.Value = 1 Then
Dim CountValue As String, Counter As Integer
If InStr(1, htmlData$, "$counter") <> 0 Then
If FileExists(AddASlash(App.Path) & "counter.ini") Then
CountValue = text_read(AddASlash(App.Path) & "counter.ini")
Else
CountValue = "0"
End If
CountValue = CountValue + 1
Counter = FreeFile
Open AddASlash(App.Path) & "counter.ini" For Output As #Counter
Print #Counter, CountValue
Close #Counter
htmlData$ = ReplaceStr(htmlData$, "$counter", Str(CountValue))
End If
End If
htmlData$ = ReplaceStr(htmlData$, "$ip", sckWS(0).LocalIP)
sckWS(Index).SendData htmlData$ & vbCrLf
ElseIf FileExists(AddASlash(htmlPageDir) & AddASlash(requestedPage$) & htmlIndexPage$) Then
filename = (AddASlash(htmlPageDir) & AddASlash(requestedPage$) & htmlIndexPage$)
GoTo text_read
Else
If requestedPage = htmlIndexPage Then requestedPage = ""
sckWS(Index).SendData ReplaceStr(HTML_FileNotFound, "$ip", sckWS(0).LocalIP) & vbCrLf
End If
Exit Sub
text_read:
If FileExists(filename) Then
If Len(filename) Then
Dim UpdateCount As Integer
Dim CopyLoop As Long
BufferSize = 32768
UpdateCount = 0
ReDim FileByte(BufferSize)
Open filename For Binary As #f
'ProgressBar1.Max = FileLength \ 1000
'StatusBar1.Panels(1).Text = "Bytes Copied: 0 of " & Format(FileLength, "#,###,###,###") & " " & 0 & "%"
On Error GoTo AbortTransfer
For CopyLoop = 1 To FileLength Step BufferSize
UpdateCount = UpdateCount + 1
If FileLength - CopyLoop > BufferSize Then
Get #1, CopyLoop, FileByte
sckWS(Index).SendData FileByte
If UpdateCount = 37 Then
'ProgressBar1.Value = CopyLoop \ 1000
'lblBytes.Caption = CopyLoop & " of " & FileLength
'StatusBar1.Panels(1).Text = "Bytes Copied: " & Format(CopyLoop, "#,###,###,###") & " of " & Format(FileLength, "#,###,###,###") & " " & Format(CopyLoop / FileLength * 100, "00.#") & "%"
'StatusBar1.Refresh
UpdateCount = 0
DoEvents
End If
Else
ReDim FileByte(FileLength - CopyLoop)
Get #1, CopyLoop, FileByte
sckWS(Index).SendData FileByte
'ProgressBar1.Value = ProgressBar1.Max
'StatusBar1.Panels(1).Text = "Bytes Copied: " & Format(FileLength, "#,###,###,###") & " of " & Format(FileLength, "#,###,###,###") & " " & 100 & "%"
DoEvents
CopyLoop = FileLength + 1
End If
Next
Close #f
'Debug.Print "FileLength: " & FileLength
'Debug.Print "FileBytes: " & FileBytes()
End If
Else
htmlData$ = ""
End If
Exit Sub
AbortTransfer: 'Close on error
'lblBytes.Caption = CopyLoop & " of " & FileLength
'StatusBar1.Panels(1).Text = "Bytes Copied: " & Format(CopyLoop, "#,###,###,###") & " of " & Format(FileLength, "#,###,###,###") & " " & Format(CopyLoop / FileLength * 100, "00.#") & "%"
'ProgressBar1.Value = CopyLoop \ 1000
MsgBox ("Only " & CopyLoop & " of " & FileLength & " could be retrieved")
Close #1
DoneTransfer:
numConnections = numConnections - 1
End Sub
please respond.
