binary chunks

[D!SiLLUSiON]

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]

[Lior]

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.

[D!SiLLUSiON]

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

[Iain17]

Give this a go. This will get 1024 characters from a file at a time.

    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]

[D!SiLLUSiON]

thnx i hope it helps, cuz winsock just won't send it in chuncks whatever i do... hmmz we'll see

[Iain17]

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.

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

[Paul282]

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.

' 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]

[D!SiLLUSiON]

i'm sure it will do ) thnx very much!

[D!SiLLUSiON]

can anyone see what i'm doing wrong???

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.