Member Avatar for bushman_222

Hey all,

I have this problem that I can't work out why it is doing it.

I've got a client - server program. The client sends an request to the Server, which in returns it queries an access database and save the output as a file. Which it will then send to the client.

It looks as if it saves the file correctly with out any corruption.

My problem is sometimes when I run it, some information gets corrupted (I think that it leaves some of the data off the end of the sending string)

Any suggestions on how to improve my code and make it more robust is extremly welcome

I've stripped out the code that I beleive is causing the problem. The code has some comments in it so you know why and what it is doing.

Private Sub SortNewData(ByVal StrSortcode As String, ByVal strData As String)

Dim arrayNumber As Long
Dim filedata As String
Dim strTempData As String
Dim intFileNumber As Integer

Dim i As Integer

    Select Case UCase(StrSortcode)
    Case "\FS" ' File section - a new file part has arrive - saved it to an array for later
        arrayNumber = Left(strData, InStr(1, strData, "\") - 1)
        filedata = Right(strData, Len(strData) - Len(StrSortcode) + 1)
        If filedata <> "\" Then
            FileArray(arrayNumber) = filedata
        End If
        StatusBar.Panels(1).Text = "Receiving file - " & prjstrFileSize & " - " & Format((arrayNumber / UBound(FileArray) * 100), "#.#") & "%"
        'request next section
        Call senddata("\R")
        
    Case "\RC" ' Total file sections - all parts arrived, generate report
        prjintFileSections = strData
        ReDim FileArray(prjintFileSections)
                
                'reset all details
        prjstrFileSize = "0"
        FileArray(0) = ""
        
    Case "\RE" ' File send end
    Dim intFreeFile As Integer
    
    Call ClearForm
    
    On Error GoTo handler
    
        mnuFilter.Enabled = True
        
        StatusBar.Panels(1) = "Processing data - Please wait"
        
        'check all sections arrived
        For i = 0 To UBound(FileArray)
            If FileArray(i) = "" Then
                StatusBar.Panels(1).Text = "Missing section & i "
		exit sub
            End If
        Next i
        
         'Save to file
        intFreeFile = FreeFile
        
        ' if file exists delete it
        
        If Dir(App.Path & "\report.txt") <> "" Then
            Call Kill(App.Path & "\report.txt")
        End If
        
        ' Save to file
        Open App.Path & "\report.txt" For Binary As intFreeFile
            On Error GoTo 0
            For i = 1 To UBound(FileArray)
                Put #intFreeFile, , FileArray(i)
            Next i
        Close #intFreeFile
        
        
        'Add Report files to array for processing
        intFreeFile = FreeFile
        i = 1
        ReDim ReportDetailArray(1)
        On Error Resume Next
        Open App.Path & "\report.txt" For Input As intFreeFile
            Do
            Input #intFreeFile, strData
            
            'clean date
                'look for \
                If InStr(1, strData, "\") > 0 Then
                    Debug.Print "Fixed row at " & i
                    strData = Left(strData, InStr(1, strData, "\") - 1) & Mid(strData, InStr(1, strData, "\") + 1, Len(strData))
                End If
                
                
           'add to Array
               ' strTempData is used to help sort the
                
                ReportDetailArray(i).strName = Left(strData, InStr(1, strData, Chr(187)) - 1) ' name
                strTempData = Right(strData, Len(strData) - Len(ReportDetailArray(i).strName) - 1)
                
                ReportDetailArray(i).dteDate = Left(strTempData, InStr(1, strTempData, Chr(187)) - 1)
                ReportDetailArray(i).tmeTime = Right(strData, Len(strData) - Len(ReportDetailArray(i).strName) - Len(ReportDetailArray(i).dteDate) - 4)
                
           ' Clean username in case of legacy client
    
                If InStr(1, ReportDetailArray(i).strName, "\") > 0 Then
                    ReportDetailArray(i).strName = Left(ReportDetailArray(i).strName, InStr(1, ReportDetailArray(i).strName, "\") - 1) & Right(ReportDetailArray(i).strName, Len(ReportDetailArray(i).strName) - InStr(1, ReportDetailArray(i).strName, "\"))
                End If
           
            i = i + 1
            ReDim Preserve ReportDetailArray(i)
            
            Loop While EOF(intFreeFile) = False
            
            If Len(ReportDetailArray(UBound(ReportDetailArray)).strName) = 0 Then
                ReDim Preserve ReportDetailArray(UBound(ReportDetailArray) - 1)
            End If
            
        Close #intFreeFile
        On Error GoTo 0
        'process data

        Call ProcessDayReport
        
        If Winsock.State = sckConnected Then
            StatusBar.Panels(1) = "Connected"
        Else
            StatusBar.Panels(1) = "Ready to connect"
        End If
        
        'clean up
        prjblnSendingReport = False
    
    Case "\RS" ' File Size
        prjstrFileSize = strData
        StatusBar.Panels(1) = "Receiving file - " & prjstrFileSize
        
    Case "\RD"
        FileArray(0) = strData
      
    Case "\RR"
        prjblnSendingReport = True
        Call ClearForm
        
        If UBound(FileArray) > 0 And Len(prjstrFileSize) > 0 And Len(FileArray(0)) <> 0 Then
            Call senddata("\RF")
            Debug.Print "Requesting first file"
        Else
            Debug.Print "missing file headers"
            'send request for the details again
        End If
           

    Case "\RM"
        StatusBar.Panels(1) = "No data found"
    End Select
    
    Exit Sub

handler:
    StatusBar.Panels(1) = "Received an Microsoft unexpected error" & " " & Err.Number
    On Error GoTo 0

End Sub
Private Sub SendQuery(ByVal strReportCode As String, ByVal ReportDate As String)

Dim intReportFile As Integer
Dim intArrayCount As Long           ' Keeps track of the array number, for the numbering packets to send
Dim i As Long
Dim strReportDuration As String     ' Report duration, weekly, monthly etc
Dim strReportStartDate As String    ' used to convert from 03/02/2008 to 03/feb/2008
Dim dteEndDate As String
Dim strEndDate As String
Dim dtestartDate As Date
Dim SQL As String

Close #intReportFile


strReportStartDate = FormatDateforSQL(ReportDate)



    '------------------------------------------------------------------
    ' what report manager wants to run, daily weekly, monthly, custom
    Select Case UCase(strReportCode)
        Case "D" ' day
            SQL = "SELECT * FROM Data WHERE Received_Date = #" & strReportStartDate & "# ORDER BY Received_Date, Received_Time;"
            Call Debugoutput(SQL)
            Set grsData = gdbDatabase.OpenRecordset(SQL)
            strReportDuration = "Day"
            
        Case "W" ' Week
            dteEndDate = ReportDate + 7
            strEndDate = FormatDateforSQL(dteEndDate)
            SQL = "SELECT * FROM Data WHERE Received_Date BETWEEN #" & strReportStartDate & "# AND #" & strEndDate & "# ORDER BY Received_Date, Received_Time;"
            Call Debugoutput(SQL)
            Set grsData = gdbDatabase.OpenRecordset(SQL)
            strReportDuration = "Week" & "\" & ReportDate
            
        Case "M" ' Month  '
            dteEndDate = GetMonthsDays(Mid(ReportDate, InStr(1, ReportDate, "/") + 1, 2)) & "/" & Mid(ReportDate, InStr(1, ReportDate, "/") + 1, Len(ReportDate))
            strEndDate = FormatDateforSQL(dteEndDate)
            SQL = "SELECT * FROM Data WHERE Received_Date BETWEEN #" & strReportStartDate & "# AND #" & strEndDate & "# ORDER BY Received_Date, Received_Time;"
            Call Debugoutput(SQL)
            Set grsData = gdbDatabase.OpenRecordset(SQL)
            strReportDuration = "Monthly"
        
        Case "C" ' Custom
            dtestartDate = left(ReportDate, InStr(1, ReportDate, Chr(187)) - 1)
            dteEndDate = Mid(ReportDate, InStr(1, ReportDate, Chr(187)) + 1, Len(ReportDate))
            SQL = "SELECT * FROM Data WHERE Received_Date BETWEEN #" & dtestartDate & "# AND #" & dteEndDate & "# ORDER BY Received_Date, Received_Time;"
            Call Debugoutput(SQL)
            Set grsData = gdbDatabase.OpenRecordset(SQL)
            strReportDuration = "Custom Report " & dtestartDate & " " & dteEndDate
    End Select
    Call Debugoutput(strReportDuration & " report reqested")
    
    
    '------------------------------------------------------------------
    'Add to Results to called report.txt
    On Error GoTo handler
    grsData.MoveFirst
    intReportFile = 0
    intReportFile = FreeFile
    
    Open App.Path & "\report.txt" For Output As intReportFile
    
    Do Until grsData.EOF
        Print #intReportFile, grsData!User_Name & Chr(187) & grsData!Received_Date & Chr(187) & grsData!Received_Time
        grsData.MoveNext
    Loop
    
    Close intReportFile
    grsData.Close
    Call Debugoutput("Added to report.txt")

    '------------------------------------------------------------------
   'open file in Binary and add data to array - to be ready for sending
   
   intArrayCount = 1
   ReDim Preserve DataToSend(intArrayCount)
   
   Open App.Path & "\Report.txt" For Binary As #intReportFile
   
    
    Do Until EOF(intReportFile)
        DataToSend(intArrayCount) = Input(chunk, #intReportFile)
        ReDim Preserve DataToSend(UBound(DataToSend) + 1)
        intArrayCount = intArrayCount + 1
    Loop
    
    If Len(DataToSend(intArrayCount)) = 0 Then
        ReDim Preserve DataToSend(UBound(DataToSend) - 1)
    End If
      
    Close intReportFile
    Call Debugoutput("Added to array")


    intReportFile = 0
    '------------------------------------------------------------------
    'Send data from array to client
        'always pausing to give the statsgrabber a chance to catch up between requests
    
    'send amount of sections
    Call SendData(prjintManagementConnection, "\RC" & UBound(DataToSend))
    DoEvents
    ReDim FileArray(UBound(DataToSend))
    Call Pause(0.3)
    
    'send file size
    Call SendData(prjintManagementConnection, "\RS" & Format(FileLen(App.Path & "\report.txt"), "#,##0") & " Bytes")
    DoEvents
    Call Pause(0.2)
    
    'send duration of report, day week or month
    Call SendData(prjintManagementConnection, "\RD" & strReportDuration)
    DoEvents
    Call Pause(0.2)
    
    ' tell client sending is starting
    Call SendData(prjintManagementConnection, "\RR")
    DoEvents
    NextSectiontoSend = 1
    Call Debugoutput("Send file headers")
    Call Debugoutput("Ready to Send File")

    
    
    ' Tidy up
    Exit Sub
    
handler:
Debug.Print Err.Description

    Call Debugoutput("frmMain Send Query " & Err.Number & " " & Err.Description)
    Select Case Err.Number
    Case 3021
        Call SendData(prjintManagementConnection, "\RM")
    
    Case 55
        Kill (App.Path & "\report.txt")
        intReportFile = intReportFile + 1
        Close intReportFile
        Debug.Print "Error 55" & " " & Err.Description
        Resume
    
    Case Else ' unknown error
        
        Debug.Print ""
        Debug.Print " ---------------------------------------------------------"
        Debug.Print ""
        Debug.Print Err.Number & "   " & Err.Description
        Debug.Print ""
        Debug.Print " ---------------------------------------------------------"
        Debug.Print ""
        
        Exit Sub
        Resume
    End Select
    

End Sub




'----------------------------- next procedure --------------------------------------------------------------




Private Sub SendFileSection()
Dim strToSend As String

    If NextSectiontoSend > UBound(DataToSend) Then
        Call Debugoutput("All sent - Sending Closure notice")
            'Tell Client all sent
        Call SendData(prjintManagementConnection, "\RE")
        DoEvents
        Exit Sub
    End If

    
    Call Debugoutput("Sending section " & NextSectiontoSend & " of " & UBound(DataToSend))
    
    strToSend = "\FS" & NextSectiontoSend & "\" & DataToSend(NextSectiontoSend)
    Call SendData(prjintManagementConnection, "\FS" & NextSectiontoSend & "\" & DataToSend(NextSectiontoSend))
    DoEvents
    NextSectiontoSend = NextSectiontoSend + 1


End Sub
  • 2 Contributors
  • 4 Replies
  • 179 Views
  • 1 Week Discussion Span
  • Latest Post Latest Post by bushman_222

Recommended Answers

All 4 Replies

Member Avatar for hkdani

Any suggestions on how to improve my code and make it more robust is extremly welcome

arrayNumber = Left(strData, InStr(1, strData, "\") - 1)

You're pulling an array number based on the position of the "\?"
I don't understand that. Explain, if you would.

And you declared arrayNumber as long and assign a string value to it? Why are you doing this? If you're using the Left() function (which returns a variant string value), you should be assigning its return value to a string variable?

I don't see how you dependably come up with a meaningful value number to use for your string array using this code.

Member Avatar for bushman_222 
arrayNumber = Left(strData, InStr(1, strData, "\") - 1)

You're pulling an array number based on the position of the "\?"
I don't understand that. Explain, if you would.

Before I send the files I add it to the array so that I know how many sections I needs to send, and if i'm missing a section then it can be sent again accuractly

And you declared arrayNumber as long and assign a string value to it? Why are you doing this? If you're using the Left() function (which returns a variant string value), you should be assigning its return value to a string variable?

I don't see how you dependably come up with a meaningful value number to use for your string array using this code.

On the sending string it is prefixes with the number, This is so that if there is a backlog of messages waiting to be processed and they get mixed up. The client adds that data into the array at that number. not very clear?. I've tried to explain it better below

(This is only an example)

A simple way of looking at that is that the server has 4 words to send "I have four words" I add it to an array

myArray(1) = I
myArray(2) = have
myArray(3) = four
myArray(4) = words

I then send each element of the array to the client

When the client gets the array element it saves it to an array, I do it this way in case I get the words mixed up when received, ie in this order "I four have words"

and that line makes sure that it is in the correct part of the array by taking the prefixed number and then saves the rest in to that element

Hope that makes sense

Member Avatar for hkdani 
arrayNumber = Left(strData, InStr(1, strData, "\") - 1)

Hope that makes sense

Well, you know, if you have to tell another programmer, I hope that it makes sense, you've got problems. Of course, that may depend on the programmer. But there's a simple formula for programming that should be followed: KISS.

I still can't make sense of that code. I still remember my old programming teacher telling me when I provided a very complex solution to a simple problem, "Keep it Simple Stupid!"

But this is what I'm guessing. You send a string: e.g. "1\some file data" You pull the number one with your code. That happens to be an integer. And I assume because there are only numbers before the "\" that you always extract integers in string form. And because the string can be converted by the compiler to a long, it doesn't throw an error.

In keeping with the paradigm of KISS--you did ask for tips for more robust code--I would simplify that code.

Private Sub SortNewData(ByVal StrSortcode As String, ByVal strData As String)
' Change that to the following

Private Sub SortNewData(ByVal StrSortcode As String, ByVal strData As String, MyArrayNumber as Long)

If you already know what the ArrayNumber is, why not just send it?
Add another parameter to your function. And then you wouldn't have to write extra code to extract the file data either. Just send the data as a string without any extra identifying characters. You could eliminate about 2 or 3 lines of code in that one Select Case statement.

That would be simpler. And if you had to try to figure out 2 years from now what you were doing, it wouldn't be a problem.

A common problem with programmers is that they write complex solutions for simple problems. The code may seem impressive at the time, but all that complexity can lead to unintelligible and unmanageable code down the road. And that means spending extra unneeded hours to sort through solutions that should have been written simply to begin with. Extra hours translates into extra money. And that's not a good thing.

Sometimes our minds get trapped in 'complex' mode. We have to continually remind ourselves to keep it simple. The simpler the better.

I haven't had time to analyze the rest of the code. I was stuck there. But I assume your complex solution works, but why is the data corrupt? Put a breakpoint at that point and step through it with the F8 checking your variables as you go to see if you're program is processing the data correctly.

If you consistently come up with corrupt data in a certain situation, that provides a perfect condition to use a breakpoint and the F8 function key to step through that section of the code you believe to be at fault to check the data to see where the problem lies.

Member Avatar for bushman_222

Sorry for the long delay


Your right about getting stuck in 'complex' mode, that was where my mind was on writing that blurb,

I only asked that as to make sure that I explained my self clearly, I know sometimes i don't ;S. The code it self is actually simple design,

Thanks for the tips, I'll merge them in.

The weird thing is that it works fine on my computer (hosting both server and client) but when I put the server on a different computer, it corrupts,

Any ideas?

Be a part of the DaniWeb community

We're a friendly, industry-focused community of developers, IT pros, digital marketers, and technology enthusiasts meeting, networking, learning, and sharing knowledge.