Home All Groups Group Topic Archive Search About
Author
1 Jun 2009 11:41 AM
Jimekus
I have built up an elaborate system around an old text reader. At one
time I used to save any text that hadn't been read using the
RichTextBox.Savefile method. This was very quick even when I had many
megabytes of text to save.

My program then allowed for many open text boxes each on a different
interrupted priority in my reading stream, but I had to manually
consolidate them if they weren't finished. Recently I automated the
program termination to now gather up all the unread texts and print
them interspersed with heading identification into a single text file
for subsequent reloading.

It worked fine for my daily news reading, but unfortunately, I have
just started reading an 8Mb text and the Print speed on termination is
unbearable. Is there a quicker way to get what I want. I thought about
structuring a whole bunch of .SaveFile calls and somthing like a final
consolidating Dos copy batch method, but that seems horrible. Here is
my current routine.

Sub SaveCopyReload(Optional ByVal GatherUp As Long = Zero)
With Me
    On Error Resume Next
    Dim workz6 As String, lStart As Long, lLength As Long
    workz6 = "temp\" & "Copy of SpeakNext.txt"
    If .MeTextLength > Thousand Then
        '\\  saves current cursor
        lStart = .DocText_SelStart
        lLength = .DocText.SelLength

        Open FilenameEx(workz6) For Output As One '\\  only opens once
else resume next
        .DocText.SelLength = .MeTextLength - .DocText_SelStart
        '\\  only one vbCrLf to differentiate a real Append which goes
into ZipfDoc
        If .DocText_ToolTipText <> NotString Then
            Print #One, vbCrLf & ". . . . " & vbCrLf & vbCrLf & "<!--"
& .DocText_ToolTipText & "-->"; vbCrLf & ". . . . " & vbCrLf &
vbCrLf; .DocText.SelText
        Else
            Print #One, vbCrLf & ". . . . " & vbCrLf & vbCrLf & "<!--"
& Me.Caption & "-->"; vbCrLf & ". . . . " & vbCrLf &
vbCrLf; .DocText.SelText
        End If
        If GatherUp = One Then
            Dim lWork As Long
            For lWork = UBound(fDoc) To One Step -One
                If Val(fDoc(lWork).Caption) <> Val(Me.Caption) And Val
(fDoc(lWork).Caption) > Zero And LCase(Right(fDoc(lWork).Caption,
Four)) <> ".ing" Then
                    fDoc(lWork).SaveCopyReload Two
                    fDoc(lWork).Caption = NotString
                End If
            Next
            Close #One
            AddRecent Five, workz6
            inGrid.mnuFileMRU(One).Caption = inGrid.mnuFileMRU
(Two).Caption
            inGrid.mnuFileMRU(Two).Caption = workz6
            .DocText_Filename = NotString
            Unload Me
            Exit Sub
        ElseIf GatherUp = Two Then
            Unload Me
            Exit Sub
        End If
        Close #One
        '\\  restores cursor
        .DocText_SelStart = lStart
        .DocText.SelLength = lLength
    ElseIf GatherUp = Zero Then
        .DocText.LoadFile FilenameEx(workz6), rtfText


    End If
    .Caption = Val(.Caption) & ": " & workz6
    .DocText_Filename = Filename_Ini(workz6)
    AddRecent Five, workz6
    inGrid.mnuFileMRU(One).Caption = inGrid.mnuFileMRU(Two).Caption
    inGrid.mnuFileMRU(Two).Caption = workz6
End With
End Sub

Author
1 Jun 2009 2:25 PM
Dave O.
Have a look at how long it's taking to build the string you are saving, if
you are appending blocks of text and one of them is about 8meg then I
suspect this is going to be a significant bottleneck. Look at the various
String Builders (either class based or a stand alone routine) to be found
out on the net.

If the file writing is taking too long then try writing it all in a single
pass as binary, like this:

Lets assume you've built your string and it's in a String variable called
TextOut and the full path to save to is in SavePath

dim ff   as integer

ff = freefile
open SavePath as ff
Put ff,,TextOut
Close ff

Without invoking sneakyAPI file writing routines, this is generally the
fastest writing method.

Regards
Dave O.


Show quoteHide quote
"Jimekus" <Jime***@gmail.com> wrote in message
news:f3ad3c49-8444-43e4-ba9f-34134224af46@e21g2000yqb.googlegroups.com...
>I have built up an elaborate system around an old text reader. At one
> time I used to save any text that hadn't been read using the
> RichTextBox.Savefile method. This was very quick even when I had many
> megabytes of text to save.
>
> My program then allowed for many open text boxes each on a different
> interrupted priority in my reading stream, but I had to manually
> consolidate them if they weren't finished. Recently I automated the
> program termination to now gather up all the unread texts and print
> them interspersed with heading identification into a single text file
> for subsequent reloading.
>
> It worked fine for my daily news reading, but unfortunately, I have
> just started reading an 8Mb text and the Print speed on termination is
> unbearable. Is there a quicker way to get what I want. I thought about
> structuring a whole bunch of .SaveFile calls and somthing like a final
> consolidating Dos copy batch method, but that seems horrible. Here is
> my current routine.
>
> Sub SaveCopyReload(Optional ByVal GatherUp As Long = Zero)
> With Me
>    On Error Resume Next
>    Dim workz6 As String, lStart As Long, lLength As Long
>    workz6 = "temp\" & "Copy of SpeakNext.txt"
>    If .MeTextLength > Thousand Then
>        '\\  saves current cursor
>        lStart = .DocText_SelStart
>        lLength = .DocText.SelLength
>
>        Open FilenameEx(workz6) For Output As One '\\  only opens once
> else resume next
>        .DocText.SelLength = .MeTextLength - .DocText_SelStart
>        '\\  only one vbCrLf to differentiate a real Append which goes
> into ZipfDoc
>        If .DocText_ToolTipText <> NotString Then
>            Print #One, vbCrLf & ". . . . " & vbCrLf & vbCrLf & "<!--"
> & .DocText_ToolTipText & "-->"; vbCrLf & ". . . . " & vbCrLf &
> vbCrLf; .DocText.SelText
>        Else
>            Print #One, vbCrLf & ". . . . " & vbCrLf & vbCrLf & "<!--"
> & Me.Caption & "-->"; vbCrLf & ". . . . " & vbCrLf &
> vbCrLf; .DocText.SelText
>        End If
>        If GatherUp = One Then
>            Dim lWork As Long
>            For lWork = UBound(fDoc) To One Step -One
>                If Val(fDoc(lWork).Caption) <> Val(Me.Caption) And Val
> (fDoc(lWork).Caption) > Zero And LCase(Right(fDoc(lWork).Caption,
> Four)) <> ".ing" Then
>                    fDoc(lWork).SaveCopyReload Two
>                    fDoc(lWork).Caption = NotString
>                End If
>            Next
>            Close #One
>            AddRecent Five, workz6
>            inGrid.mnuFileMRU(One).Caption = inGrid.mnuFileMRU
> (Two).Caption
>            inGrid.mnuFileMRU(Two).Caption = workz6
>            .DocText_Filename = NotString
>            Unload Me
>            Exit Sub
>        ElseIf GatherUp = Two Then
>            Unload Me
>            Exit Sub
>        End If
>        Close #One
>        '\\  restores cursor
>        .DocText_SelStart = lStart
>        .DocText.SelLength = lLength
>    ElseIf GatherUp = Zero Then
>        .DocText.LoadFile FilenameEx(workz6), rtfText
>
>
>    End If
>    .Caption = Val(.Caption) & ": " & workz6
>    .DocText_Filename = Filename_Ini(workz6)
>    AddRecent Five, workz6
>    inGrid.mnuFileMRU(One).Caption = inGrid.mnuFileMRU(Two).Caption
>    inGrid.mnuFileMRU(Two).Caption = workz6
> End With
> End Sub
Author
2 Jun 2009 3:35 AM
Jimekus
thanks for the tip. It was not the Print statement but passing the
large string to the Print statement that bogged down the system. My
corrected code first replaces all text before .SelStart with heading
identification and then uses .SaveFile calls, and ExecCmd for
concatenating subsequent files on the fly.

Sub SaveCopyReload(Optional ByVal GatherUp As Long = Zero)
With Me

    Dim workz6 As String, lStart As Long


    workz6 = "temp\" & "Copy of SpeakNext.txt"
    If .MeTextLength > Thousand Then
        '\\  saves current cursor
        lStart = .DocText_SelStart

        .DocText_SelStart = Zero
        .DocText.SelLength = lStart

        '\\  only start with one vbCrLf to differentiate from a real
Append which goes into ZipfDoc
        If .DocText_ToolTipText <> NotString Then
            .DocText.SelText = vbCrLf & ". . . . " & vbCrLf & vbCrLf &
"<!--" & .DocText_ToolTipText & "-->" & vbCrLf & ". . . . " & vbCrLf &
vbCrLf
        Else
            .DocText.SelText = vbCrLf & ". . . . " & vbCrLf & vbCrLf &
"<!--" & Me.Caption & "-->" & vbCrLf & ". . . . " & vbCrLf & vbCrLf
        End If
        Static workz7 As String
        If workz7 = vbNullString Then
            workz7 = FilenameEx("temp\" & "SpeakNext.txt")
            .DocText.SaveFile FilenameEx(workz6), rtfText
        Else
            .DocText.SaveFile FilenameEx(workz7), rtfText
            workbuffer = "copy " & FilenameEx(workz6) & " + " & workz7
            ExecCmd workbuffer
            Kill workz7
        End If
        If GatherUp = One Then
            Dim lWork As Long

            For lWork = UBound(fDoc) To One Step -One
                With fDoc(lWork)
                    If Val(.Caption) <> Val(Me.Caption) And Val
(.Caption) > Zero And LCase(Right(.Caption, Four)) <> ".ing" Then
                        .SaveCopyReload Two
                        .Caption = vbNullString
                    End If
                End With

            Next

            AddRecent Five, workz6
            inGrid.mnuFileMRU(One).Caption = inGrid.mnuFileMRU
(Two).Caption
            inGrid.mnuFileMRU(Two).Caption = workz6
            .DocText_Filename = vbNullString
            Unload Me
            Exit Sub
        ElseIf GatherUp = Two Then
            Unload Me
            Exit Sub
        End If

    ElseIf GatherUp = Zero Then
        .DocText.LoadFile FilenameEx(workz6), rtfText


    End If
    .Caption = Val(.Caption) & ": " & workz6
    .DocText_Filename = Filename_Ini(workz6)
    AddRecent Five, workz6
    inGrid.mnuFileMRU(One).Caption = inGrid.mnuFileMRU(Two).Caption
    inGrid.mnuFileMRU(Two).Caption = workz6
End With
End Sub