dcsimg
Results 1 to 24 of 24

Thread: ReplaceAny and TrimAny-Function

  1. #1

    Thread Starter
    PowerPoster Zvoni's Avatar
    Join Date
    Sep 2012
    Location
    To the moon and then left
    Posts
    1,431

    ReplaceAny and TrimAny-Function

    Well, i was bored,
    and surfing the Net i found some curious, some weird, and some really atrocious constructions to achieve a ReplaceAny resp. TrimAny in comparison to the native Replace- and Trim-Functions in VB6/VBA

    So i sat down, and wrote my own.

    Feel free to use it, misuse it, abuse it, and reuse it as you will.

    If you have ideas to code it better, or to give me a review, be my guest.

    EDIT:
    Or, you could just say, "more work needed if you intend to use LARGEADDRESSAWARE", which I suspect few of us do.

    Take Care,
    Elroy
    "more work needed if you intend to use LARGEADDRESSAWARE"



    EDIT2: I've tweaked the code according to all suggestions. Thx to Krool and DEX for the Functions.
    And i've added Case-Sensitive/-Insensitive to it. Thx Dilettante for the Idea.
    As for (multiple) NUL's inside Source: I'm ignoring that on purpose.
    If you have 0-terminating characters within Source, then you have a problem way before calling any of these functions.
    Code:
    'API-Declares
    Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
    '#########################################################################################################################
    'StrSpn returns the length of the initial portion of Source which consists only of characters that are part of CharSet.
    'Therefore, if all of the characters in Source are in CharSet, the function returns the length of the entire Source-string,
    'and if the first (!!) character in Source is not in CharSet, the function returns zero.
    'Private Declare Function StrSpn Lib "SHLWAPI" Alias "StrSpnW" (ByVal lpSource As Long, ByVal lpCharSet As Long) As Long
    Private Declare Function StrSpn Lib "SHLWAPI" Alias "StrSpnW" (ByVal lpSource As Long, ByVal lpCharSet As Long) As Long
    Private Declare Function StrSpnI Lib "SHLWAPI" Alias "StrSpnIW" (ByVal lpSource As Long, ByVal lpCharSet As Long) As Long
    '#########################################################################################################################
    '#########################################################################################################################
    'StrCSpn scans Source for the first occurrence of any of the characters that are part of CharSet,
    'Returns the length of the initial part of Source not (!!) containing any of the characters that are part of CharSet.
    'This is the length of Source if none of the characters in CharSet are found in str1.
    'Private Declare Function StrCSpn Lib "SHLWAPI" Alias "StrCSpnW" (ByVal lpSource As Long, ByVal lpCharSet As Long) As Long
    Private Declare Function StrCSpn Lib "SHLWAPI" Alias "StrCSpnW" (ByVal lpSource As Long, ByVal lpCharSet As Long) As Long
    Private Declare Function StrCSpnI Lib "SHLWAPI" Alias "StrCSpnIW" (ByVal lpSource As Long, ByVal lpCharSet As Long) As Long
    '#########################################################################################################################
    Private Function PtrAdd(ByVal Ptr As Long, ByVal Offset As Long) As Long
    ' Unsigned Pointer addition
    ' avoids integer overflow when incrementing past 2GB Boundary
    ' needed for /LARGEADDRESSAWARE processes on 64bit Windows
        Const SIGN_BIT As Long = &H80000000
        PtrAdd = SIGN_BIT Xor (SIGN_BIT Xor Ptr) + Offset
    End Function
    
    Private Function CLngToULng(ByVal Value As Long) As Double
    Const OFFSET_4 As Double = 4294967296#
    If Value < 0 Then
        CLngToULng = Value + OFFSET_4
    Else
        CLngToULng = Value
    End If
    End Function
    '###############################################################################################
    'ReplaceAny: replaces any Character from "Delimiters" with "ReplaceWith"-String in "Source"
    '###############################################################################################
    Public Function ReplaceAny(ByVal Source As String, ByVal Delimiters As String, ByVal ReplaceWith As String, Optional ByVal CompareMethod As VbCompareMethod = vbBinaryCompare) As String
    Dim pRep As Long
    Dim pCur As Long
    Dim pDel As Long
    Dim pEnd As Long
    Dim cSave As Long
    Dim CharSize As Long
    Dim c As Long
    Dim lenRW As Long
    Dim sTemp As String
        If CompareMethod <> vbDatabaseCompare Then          'Ignoring vbDatabaseCompare --> Return original String
            ReplaceAny = vbNullString                       'Initialise Result
            lenRW = Len(ReplaceWith)                        'Length of "ReplaceWith"-String
            CharSize = LenB("a")                            'Size in Bytes of a single Character
            pCur = StrPtr(Source)                           'Pointer to Source
            pDel = StrPtr(Delimiters)                       'Pointer to Delimiters
            pRep = StrPtr(ReplaceWith)                      'Pointer to "ReplaceWith"-String
            cSave = LenB(Source)                            'Size in Bytes of Source
            pEnd = PtrAdd(pCur, cSave)                      'Get Pointer to End of Source
            Do While CLngToULng(pCur) < CLngToULng(pEnd)    'Check if we're past the End of Source - Also catches Empty Source-String
                If CompareMethod = vbBinaryCompare Then
                    c = StrCSpn(pCur, pDel)                 'Get next Position of Character to Replace
                Else
                    c = StrCSpnI(pCur, pDel)                'Get next Position of Character to Replace case-insensitive
                End If
                If c = 0 Then                               'It's a Delimiter
                    sTemp = String$(lenRW, " ")
                    CopyMemory ByVal StrPtr(sTemp), _
                               ByVal pRep, _
                               lenRW * CharSize             'Replace it!
                    pCur = PtrAdd(pCur, CharSize)           'Move Pointer forward to next Character after the replaced Character
                Else
                    sTemp = String$(c, " ")
                    CopyMemory ByVal StrPtr(sTemp), _
                               ByVal pCur, _
                               c * CharSize                 'Cut out Token between Delimiters
                    pCur = PtrAdd(pCur, c * CharSize)       'Move Pointer forward to next Character after the replaced Character
                End If
                ReplaceAny = ReplaceAny & sTemp             'Append everything
            Loop
        Else
            ReplaceAny = Source
        End If
    End Function
    
    '###############################################################################################
    'TrimAny, TrimAnyL, TrimAnyR trims any Character from "Delimiters" off "Source"
    '###############################################################################################
    Public Function TrimAny(ByVal Source As String, ByVal Delimiters As String, Optional ByVal CompareMethod As VbCompareMethod = vbBinaryCompare) As String
        TrimAny = TrimAnyL(Source, Delimiters, CompareMethod)
        TrimAny = TrimAnyR(TrimAny, Delimiters, CompareMethod)
    End Function
    
    Public Function TrimAnyR(ByVal Source As String, ByVal Delimiters As String, Optional ByVal CompareMethod As VbCompareMethod = vbBinaryCompare) As String
        Source = StrReverse(Source)                             'Reverse Source
        TrimAnyR = TrimAnyL(Source, Delimiters, CompareMethod)  'Call TrimAnyL
        TrimAnyR = StrReverse(TrimAnyR)                         'Reverse it back
    End Function
    
    Public Function TrimAnyL(ByVal Source As String, ByVal Delimiters As String, Optional ByVal CompareMethod As VbCompareMethod = vbBinaryCompare) As String
    Dim CharSize As Long
    Dim c As Long
        If CompareMethod <> vbDatabaseCompare Then                          'Ignoring vbDatabaseCompare --> Return original String
            CharSize = LenB("a")                                            'Size in Bytes of a single Character
            If CompareMethod = vbBinaryCompare Then
                c = StrSpn(StrPtr(Source), StrPtr(Delimiters))              'Get count of initial Delimiters to strip
            Else
                c = StrSpnI(StrPtr(Source), StrPtr(Delimiters))             'Get count of initial Delimiters to strip case-insensitive
            End If
            TrimAnyL = String$(Len(Source) - c, " ")                        'Allocate Memory to Destination
            CopyMemory ByVal StrPtr(TrimAnyL), _
                       ByVal PtrAdd(StrPtr(Source), c * CharSize), _
                       LenB(TrimAnyL)                                       'Copy remaining String to Result
        Else
            TrimAnyL = Source
        End If
    End Function
    Usage:
    Code:
    Dim sTest As String
    Dim sDel As String
    Dim Result As String
    
    sTest = ";-:!This,is;a:Test-,;with;a lot of-crap,between:words,;:"
    sDel = ";-:!,"
    Result=ReplaceAny(sTest, sDel, "/\")
    'Returns: --> /\/\/\/\This/\is/\a/\Test/\/\/\with/\a lot of/\crap/\between/\words/\/\/\
    Result=TrimAny(sTest, sDel)
    'Returns: --> This,is;a:Test-,;with;a lot of-crap,between:words
    Last edited by Zvoni; May 8th, 2018 at 03:41 AM.
    People call me crazy because i'm jumping out of perfectly fine airplanes.
    I say you're crazy not to!
    --------------------------------------------------------------------------------------------------
    For health reasons i try to avoid reading unformatted Code

  2. #2
    Fanatic Member wqweto's Avatar
    Join Date
    May 2011
    Posts
    716

    Re: ReplaceAny and TrimAny-Function

    pCur = pCur + c * CharSize -- you cannot increment *unsigned* pointers in VB6 like that. Not anymore as LARGEADDRESSAWARE compiled apps are the new normal.

    Do While pCur < pSave + cSave -- the same

    cheers,
    </wqw>

  3. #3

    Thread Starter
    PowerPoster Zvoni's Avatar
    Join Date
    Sep 2012
    Location
    To the moon and then left
    Posts
    1,431

    Re: ReplaceAny and TrimAny-Function

    You mean because i can run into an overflow, because the pointer targets an address, say "2347098213"?
    People call me crazy because i'm jumping out of perfectly fine airplanes.
    I say you're crazy not to!
    --------------------------------------------------------------------------------------------------
    For health reasons i try to avoid reading unformatted Code

  4. #4
    Frenzied Member
    Join Date
    Jun 2015
    Posts
    2,035

    Re: ReplaceAny and TrimAny-Function

    not only that, but you can't compare if one is less than the other, without some sort of conversion to something like Double.

    Here is what I use, although it's typically done in-line instead of a function.

    Code:
    Public Function PtrAdd(ByVal Ptr As Long, ByVal Offset As Long) As Long
    ' Unsigned Pointer addition
    ' avoids integer overflow when incrementing past 2GB Boundary
    ' needed for /LARGEADDRESSAWARE processes on 64bit Windows
        Const SIGN_BIT As Long = &H80000000
        PtrAdd = SIGN_BIT Xor (SIGN_BIT Xor Ptr) + Offset
    End Function
    And here is how Krool compares 32bit unsigned values

    Code:
    Public Function CLngToULng(ByVal Value As Long) As Double
    Const OFFSET_4 As Double = 4294967296#
    If Value < 0 Then
        CLngToULng = Value + OFFSET_4
    Else
        CLngToULng = Value
    End If
    End Function
    Code:
    Do While CLngToULng(pCur) < CLngToULng(PtrAdd(pSave, cSave))
    or
    Code:
    Do While CLngToULng(pCur) < (CLngToULng(pSave) + cSave)
    And here's Krool's conversion back to 32bit.
    Code:
    Public Function CULngToLng(ByVal Value As Double) As Long
    Const OFFSET_4 As Double = 4294967296#
    Const MAXINT_4 As Long = 2147483647
    If Value < 0 Or Value >= OFFSET_4 Then Err.Raise 6
    If Value <= MAXINT_4 Then
        CULngToLng = Value
    Else
        CULngToLng = Value - OFFSET_4
    End If
    End Function
    if speed matters, I'll typically calculate an end pointer and test for equality in the loop.
    Last edited by DEXWERX; May 4th, 2018 at 03:37 PM.

  5. #5
    PowerPoster Elroy's Avatar
    Join Date
    Jun 2014
    Location
    Near Nashville TN
    Posts
    4,579

    Re: ReplaceAny and TrimAny-Function

    With a bit of GetMem4, you could copy these Long pointers into a Currency, or a Decimal (in a Variant), or a LongLong (in a Variant), and then do the arithmetic and comparisons directly. And, when done, shove it back into your Long pointer.

    But then, you've still got the problem of making sure you get the pointers correct that are passed into GetMem4 (if a Variant is used, because an offset will be needed).

    Or, you could just say, "more work needed if you intend to use LARGEADDRESSAWARE", which I suspect few of us do.

    Take Care,
    Elroy
    Any software I post in these forums written by me is provided “AS IS” without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. Please understand that I’ve been programming since the mid-1970s and still have some of that code. My contemporary VB6 project is approaching 1,000 modules. In addition, I have a “VB6 random code folder” that is overflowing. I’ve been at this long enough to truly not know with absolute certainty from whence every single line of my code has come, with much of it coming from programmers under my employ who signed intellectual property transfers. I have not deliberately attempted to remove any licenses and/or attributions from any software. If someone finds that I have inadvertently done so, I sincerely apologize, and, upon notice and reasonable proof, will re-attach those licenses and/or attributions. To all, peace and happiness.

  6. #6

    Thread Starter
    PowerPoster Zvoni's Avatar
    Join Date
    Sep 2012
    Location
    To the moon and then left
    Posts
    1,431

    Re: ReplaceAny and TrimAny-Function

    Hmmm, ok. Understood.
    But this bears the Question: Does vb6/vba allow it for StrPtr to return a value which exceeds a Long?
    If i remember correctly StrPtr returns a Long, and that's the crucial point
    And, yes, i know: my Variable "c" (As Long) can also run into the overflow-problem
    People call me crazy because i'm jumping out of perfectly fine airplanes.
    I say you're crazy not to!
    --------------------------------------------------------------------------------------------------
    For health reasons i try to avoid reading unformatted Code

  7. #7
    Frenzied Member
    Join Date
    Jun 2015
    Posts
    2,035

    Re: ReplaceAny and TrimAny-Function

    Quote Originally Posted by Zvoni View Post
    Hmmm, ok. Understood.
    But this bears the Question: Does vb6/vba allow it for StrPtr to return a value which exceeds a Long?
    If i remember correctly StrPtr returns a Long, and that's the crucial point
    And, yes, i know: my Variable "c" (As Long) can also run into the overflow-problem
    Unless you're spelunking into 64bit processes, you will never get a pointer that exceeds 32bits.
    VB only handles 32bit values as Signed, so that's the root of the problem.
    The overflow happens when you try and increment a signed Long cross the 2GB boundary (MSB set).


    StrPtr() and other functions which return pointers, are not affected by where in memory it's pointing to. If it's above the 2GB boundary -VB will just interpret it as negative. That's why I posted the conversion routines. So you can view, and manipulate those values as if they were unsigned.

  8. #8
    Frenzied Member
    Join Date
    Jan 2010
    Posts
    1,103

    Re: ReplaceAny and TrimAny-Function

    Quote Originally Posted by DEXWERX View Post
    not only that, but you can't compare if one is less than the other, without some sort of conversion to something like Double.

    Here is what I use, although it's typically done in-line instead of a function.

    Code:
    Public Function PtrAdd(ByVal Ptr As Long, ByVal Offset As Long) As Long
    ' Unsigned Pointer addition
    ' avoids integer overflow when incrementing past 2GB Boundary
    ' needed for /LARGEADDRESSAWARE processes on 64bit Windows
        Const SIGN_BIT As Long = &H80000000
        PtrAdd = SIGN_BIT Xor (SIGN_BIT Xor Ptr) + Offset
    End Function
    And here is how Krool compares 32bit unsigned values

    Code:
    Public Function CLngToULng(ByVal Value As Long) As Double
    Const OFFSET_4 As Double = 4294967296#
    If Value < 0 Then
        CLngToULng = Value + OFFSET_4
    Else
        CLngToULng = Value
    End If
    End Function
    Code:
    Do While CLngToULng(pCur) < CLngToULng(PtrAdd(pSave, cSave))
    or
    Code:
    Do While CLngToULng(pCur) < (CLngToULng(pSave) + cSave)
    And here's Krool's conversion back to 32bit.
    Code:
    Public Function CULngToLng(ByVal Value As Double) As Long
    Const OFFSET_4 As Double = 4294967296#
    Const MAXINT_4 As Long = 2147483647
    If Value < 0 Or Value >= OFFSET_4 Then Err.Raise 6
    If Value <= MAXINT_4 Then
        CULngToLng = Value
    Else
        CULngToLng = Value - OFFSET_4
    End If
    End Function
    if speed matters, I'll typically calculate an end pointer and test for equality in the loop.
    Is the above Pointer Add the same with your old post?
    http://www.vbforums.com/showthread.p...FindResourceEx

  9. #9
    VB-aholic & Lovin' It LaVolpe's Avatar
    Join Date
    Oct 2007
    Location
    Beside Waldo
    Posts
    17,448

    Re: ReplaceAny and TrimAny-Function

    Quote Originally Posted by DEXWERX View Post
    Unless you're spelunking into 64bit processes, you will never get a pointer that exceeds 32bits.
    VB only handles 32bit values as Signed, so that's the root of the problem.
    The overflow happens when you try and increment a signed Long cross the 2GB boundary (MSB set)
    Has anyone seen if an array is subjected to the pointer math problem? Address of safe array LBound item is the memory address where the array starts. To move around the array, obviously some math is involved behind the scenes. Wondering if any "crashes" have occurred when VB references ArrayItem(50) for example, where 50 units were added to a negative (high bit set) starting memory address?

    If this is not a problem, one solution to handling the potential problem in this thread is to overlay a integer array on the string. Do what's needed, modifying the array contents (string characters), then removing the array overlay.
    Insomnia is just a byproduct of, "It can't be done"

    Classics Enthusiast? Here's my 1969 Mustang Mach I Fastback. Her sister '67 Coupe has been adopted

    Newbie? Novice? Bored? Spend a few minutes browsing the FAQ section of the forum.
    Read the HitchHiker's Guide to Getting Help on the Forums.
    Here is the list of TAGs you can use to format your posts
    Here are VB6 Help Files online


    {Alpha Image Control} {Memory Leak FAQ} {Unicode Open/Save Dialog} {Resource Image Viewer/Extractor}
    {VB and DPI Tutorial} {Manifest Creator} {UserControl Button Template} {stdPicture Render Usage}

  10. #10
    PowerPoster Elroy's Avatar
    Join Date
    Jun 2014
    Location
    Near Nashville TN
    Posts
    4,579

    Re: ReplaceAny and TrimAny-Function

    Quote Originally Posted by LaVolpe View Post
    Has anyone seen if an array is subjected to the pointer math problem? Address of safe array LBound item is the memory address where the array starts. To move around the array, obviously some math is involved behind the scenes. Wondering if any "crashes" have occurred when VB references ArrayItem(50) for example, where 50 units were added to a negative (high bit set) starting memory address?

    If this is not a problem, one solution to handling the potential problem in this thread is to overlay a integer array on the string. Do what's needed, modifying the array contents (string characters), then removing the array overlay.
    LaVolpe, that's a very interesting point. I'm not up for it, but I'd love to see a test of an array that crosses the 2Gig boundary. If it works correctly, that suggests that VB6 knows how to do arithmetic (at least adding and subtracting) with an unsigned-long, at least internally.

    Best Regards,
    Elroy
    Any software I post in these forums written by me is provided “AS IS” without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. Please understand that I’ve been programming since the mid-1970s and still have some of that code. My contemporary VB6 project is approaching 1,000 modules. In addition, I have a “VB6 random code folder” that is overflowing. I’ve been at this long enough to truly not know with absolute certainty from whence every single line of my code has come, with much of it coming from programmers under my employ who signed intellectual property transfers. I have not deliberately attempted to remove any licenses and/or attributions from any software. If someone finds that I have inadvertently done so, I sincerely apologize, and, upon notice and reasonable proof, will re-attach those licenses and/or attributions. To all, peace and happiness.

  11. #11
    Fanatic Member wqweto's Avatar
    Join Date
    May 2011
    Posts
    716

    Re: ReplaceAny and TrimAny-Function

    Quote Originally Posted by LaVolpe View Post
    Wondering if any "crashes" have occurred when VB references ArrayItem(50) for example, where 50 units were added to a negative (high bit set) starting memory address?
    No, there is no problem as integer arithmetics (signed/unsigned) in ASM/C/C++ does not throw on overflow -- it just overflows :-)) And because signed ints are using two's complement system overflowing produces valid unsigned results -- basicly falling into pit of success.

    cheers,
    </wqw>

  12. #12
    VB-aholic & Lovin' It LaVolpe's Avatar
    Join Date
    Oct 2007
    Location
    Beside Waldo
    Posts
    17,448

    Re: ReplaceAny and TrimAny-Function

    @wqweto. If I read your reply correctly, that's good news in any case where you can simply overlay a byte, integer, long array on a memory address when the situation lends itself to that scenario. I use the array overlay in different situations, but wasn't 100% sure it would be LARGEADDRESSAWARE safe.
    Insomnia is just a byproduct of, "It can't be done"

    Classics Enthusiast? Here's my 1969 Mustang Mach I Fastback. Her sister '67 Coupe has been adopted

    Newbie? Novice? Bored? Spend a few minutes browsing the FAQ section of the forum.
    Read the HitchHiker's Guide to Getting Help on the Forums.
    Here is the list of TAGs you can use to format your posts
    Here are VB6 Help Files online


    {Alpha Image Control} {Memory Leak FAQ} {Unicode Open/Save Dialog} {Resource Image Viewer/Extractor}
    {VB and DPI Tutorial} {Manifest Creator} {UserControl Button Template} {stdPicture Render Usage}

  13. #13
    Fanatic Member wqweto's Avatar
    Join Date
    May 2011
    Posts
    716

    Re: ReplaceAny and TrimAny-Function

    Yes, passing baBuffer(10) byref to an API function is safe, while ByVal VarPtr(baBuffer(0)) + 10 is not.

    Btw, here is an impl of UnsignedDiff that can be used to calc pointer offsets (e.g. ptr2 - ptr1)

    cheers,
    </wqw>

  14. #14
    PowerPoster Elroy's Avatar
    Join Date
    Jun 2014
    Location
    Near Nashville TN
    Posts
    4,579

    Re: ReplaceAny and TrimAny-Function

    That actually presents an interesting way you could "spoof" pointer arithmetic. We could build on the idea that VarPtr() always gets it correct, even if LARGEADDRESSAWARE is being used, and even if we're spanning the 2Gig boundary.

    We could just overlay our "memory of interest" with a 1D Byte SafeArray (with as many byte elements as we need). Then, we just stick the Byte array element we want into VarPtr(), and voila, we get the correct pointer, no need to do any explicit arithmetic on our pointers. So long as we have our starting address, it seems this would always work.

    We'd need to be sure and clean up our SafeArray though.

    Just Saying,
    Elroy
    Any software I post in these forums written by me is provided “AS IS” without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. Please understand that I’ve been programming since the mid-1970s and still have some of that code. My contemporary VB6 project is approaching 1,000 modules. In addition, I have a “VB6 random code folder” that is overflowing. I’ve been at this long enough to truly not know with absolute certainty from whence every single line of my code has come, with much of it coming from programmers under my employ who signed intellectual property transfers. I have not deliberately attempted to remove any licenses and/or attributions from any software. If someone finds that I have inadvertently done so, I sincerely apologize, and, upon notice and reasonable proof, will re-attach those licenses and/or attributions. To all, peace and happiness.

  15. #15
    PowerPoster
    Join Date
    Feb 2006
    Posts
    19,069

    Re: ReplaceAny and TrimAny-Function

    Here's another entry.

    It should be safe for LARGEADDRESSAWARE thought it doesn't do full unsigned arithmetic since the String data will never wrap around through location 0 anyway.

    Code:
    Option Explicit
    
    Private Declare Sub PutChar Lib "msvbvm60" Alias "PutMem2" (ByVal p As Long, ByVal Char As Integer)
    
    Private Declare Function StrCSpn Lib "shlwapi" Alias "StrCSpnW" ( _
        ByVal pszStr As Long, _
        ByVal pszSet As Long) As Long
    
    Private Declare Function StrCSpnI Lib "shlwapi" Alias "StrCSpnIW" ( _
        ByVal pszStr As Long, _
        ByVal pszSet As Long) As Long
    
    Private Function ReplaceCharset( _
        ByRef Expression As String, _
        ByRef Charset As String, _
        ByRef Replacement As String, _
        Optional ByVal CompareMethod As VbCompareMethod = vbBinaryCompare) As String
    
        Dim Length As Long
        Dim Repl As Integer
        Dim Ptr As Long
        Dim Start As Long
        Dim Pos As Long
    
        If (CompareMethod <> vbBinaryCompare And CompareMethod <> vbTextCompare) Or _
           Len(Charset) = 0 Or Len(Replacement) = 0 Then Err.Raise 380
    
        ReplaceCharset = Expression
        Length = Len(ReplaceCharset)
        If Length = 0 Then Exit Function
    
        Repl = CInt(AscW(Replacement) And &HFFFF&)
        Do
            Ptr = &H80000000 Xor ((StrPtr(ReplaceCharset) Xor &H80000000) + Start * 2)
            If CompareMethod = vbTextCompare Then
                Pos = StrCSpn(Ptr, StrPtr(Charset))
            Else
                Pos = StrCSpnI(Ptr, StrPtr(Charset))
            End If
            Pos = Start + Pos
            If Pos < Length Then
                Ptr = &H80000000 Xor ((StrPtr(ReplaceCharset) Xor &H80000000) + Pos * 2)
                PutChar Ptr, Repl
                Start = Pos + 1
            Else
                Exit Do
            End If
        Loop
    End Function
    Name:  sshot.png
Views: 144
Size:  4.0 KB


    Something similar could be done for a TrimCharset(), LTrimCharset(), and RTrimCharset() too.
    Attached Files Attached Files

  16. #16
    VB-aholic & Lovin' It LaVolpe's Avatar
    Join Date
    Oct 2007
    Location
    Beside Waldo
    Posts
    17,448

    Re: ReplaceAny and TrimAny-Function

    Quote Originally Posted by Elroy View Post
    ...Then, we just stick the Byte array element we want into VarPtr(), and voila, we get the correct pointer, no need to do any explicit arithmetic on our pointers.
    You won't even need a VarPtr, just pass the ArrayItem ByRef to whatever API you'd be using. Of course you should define the API parameter ByRef As Any
    Last edited by LaVolpe; May 6th, 2018 at 09:15 AM.
    Insomnia is just a byproduct of, "It can't be done"

    Classics Enthusiast? Here's my 1969 Mustang Mach I Fastback. Her sister '67 Coupe has been adopted

    Newbie? Novice? Bored? Spend a few minutes browsing the FAQ section of the forum.
    Read the HitchHiker's Guide to Getting Help on the Forums.
    Here is the list of TAGs you can use to format your posts
    Here are VB6 Help Files online


    {Alpha Image Control} {Memory Leak FAQ} {Unicode Open/Save Dialog} {Resource Image Viewer/Extractor}
    {VB and DPI Tutorial} {Manifest Creator} {UserControl Button Template} {stdPicture Render Usage}

  17. #17
    PowerPoster Elroy's Avatar
    Join Date
    Jun 2014
    Location
    Near Nashville TN
    Posts
    4,579

    Re: ReplaceAny and TrimAny-Function

    Quote Originally Posted by LaVolpe View Post
    You won't even need a VarPtr, just pass the ArrayItem ByRef to whatever API you'd be using.
    Good point. Just stay away from explicitly fetching the pointers all-together.
    Any software I post in these forums written by me is provided “AS IS” without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. Please understand that I’ve been programming since the mid-1970s and still have some of that code. My contemporary VB6 project is approaching 1,000 modules. In addition, I have a “VB6 random code folder” that is overflowing. I’ve been at this long enough to truly not know with absolute certainty from whence every single line of my code has come, with much of it coming from programmers under my employ who signed intellectual property transfers. I have not deliberately attempted to remove any licenses and/or attributions from any software. If someone finds that I have inadvertently done so, I sincerely apologize, and, upon notice and reasonable proof, will re-attach those licenses and/or attributions. To all, peace and happiness.

  18. #18

    Thread Starter
    PowerPoster Zvoni's Avatar
    Join Date
    Sep 2012
    Location
    To the moon and then left
    Posts
    1,431

    Re: ReplaceAny and TrimAny-Function

    @Dilletante

    There is a reason i've setup my algorithm the way it is.
    Besides the discussion about pointer-safety:
    My version accepts all "3" versions of replacing:
    Replace with nothing (aka delete it),
    replace with a single character (as your version),
    and replace it with a string (more than one character).
    It's one of the reasons i used CopyMemory instead of PutMem
    People call me crazy because i'm jumping out of perfectly fine airplanes.
    I say you're crazy not to!
    --------------------------------------------------------------------------------------------------
    For health reasons i try to avoid reading unformatted Code

  19. #19
    PowerPoster
    Join Date
    Feb 2006
    Posts
    19,069

    Re: ReplaceAny and TrimAny-Function

    Excellent point.

    I must be blind because I didn't see it, probably blinded by the case I need more often: zapping control characters to "?" for display. Your approach covers far more cases.

  20. #20
    Hyperactive Member
    Join Date
    Aug 2016
    Posts
    278

    Re: ReplaceAny and TrimAny-Function

    Quote Originally Posted by dilettante View Post
    Excellent point.

    I must be blind because I didn't see it, probably blinded by the case I need more often: zapping control characters to "?" for display. Your approach covers far more cases.
    can not replace xqr with '123'...

  21. #21
    Frenzied Member
    Join Date
    Jun 2015
    Posts
    2,035

    Re: ReplaceAny and TrimAny-Function

    Quote Originally Posted by LaVolpe View Post
    Has anyone seen if an array is subjected to the pointer math problem? Address of safe array LBound item is the memory address where the array starts. To move around the array, obviously some math is involved behind the scenes. Wondering if any "crashes" have occurred when VB references ArrayItem(50) for example, where 50 units were added to a negative (high bit set) starting memory address?

    If this is not a problem, one solution to handling the potential problem in this thread is to overlay a integer array on the string. Do what's needed, modifying the array contents (string characters), then removing the array overlay.
    That's what I do (so I hope it works fine crossing 2G!)

    Quote Originally Posted by Jonney View Post
    Is the above Pointer Add the same with your old post?
    http://www.vbforums.com/showthread.p...FindResourceEx
    Yes... yes it is.
    Last edited by DEXWERX; May 7th, 2018 at 08:54 AM.

  22. #22
    PowerPoster
    Join Date
    Feb 2006
    Posts
    19,069

    Re: ReplaceAny and TrimAny-Function

    Quote Originally Posted by xxdoc123 View Post
    can not replace xqr with '123'...
    If you mean my example above then no, you can't.

    Mine only uses the 1st character of the Replacement text to replace anything found matching any character from the Charset text. You can give it "123" but the result is the same as giving it "1" alone.

  23. #23
    PowerPoster
    Join Date
    Feb 2006
    Posts
    19,069

    Re: ReplaceAny and TrimAny-Function

    Here is another stab at it.

    This time I didn't get the sense of CompareMethod reversed (it worked in the demo above because I reverse it when calling too)! it also handles the replacement text being 0 to many characters in length.

    It also gets around the pitfall in using StrCSpn() and StrCSpnI() calls: it can cope with NULs in your strings.

    Code:
    Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
        ByRef Destination As Any, _
        ByRef Source As Any, _
        ByVal Size As Long)
    
    Private Declare Function ChrCmpI Lib "shlwapi" Alias "ChrCmpIW" ( _
        ByVal w1 As Integer, _
        ByVal w2 As Integer) As Long
    
    Private Function ReplaceCharset( _
        ByRef Expression As String, _
        ByRef Charset As String, _
        ByRef Replacement As String, _
        Optional ByVal CompareMethod As VbCompareMethod = vbBinaryCompare) As String
    
        Const CHUNK As Long = 512 'In chars, not bytes.
        Const REPL_FACTOR As Long = 5
        Dim ExpUB As Long
        Dim Exp() As Integer
        Dim ExpCur As Long
        Dim ChsUB As Long
        Dim Chs() As Integer
        Dim ReplUB As Long
        Dim Repl() As Integer
        Dim ResultUB As Long
        Dim Result() As Integer
        Dim ResultCur As Long
        Dim E As Long
        Dim Char As Integer
        Dim C As Long
        Dim Match As Boolean
    
        If (CompareMethod <> vbBinaryCompare And CompareMethod <> vbTextCompare) Or _
           Len(Charset) = 0 Then Err.Raise 380
    
        ExpUB = Len(Expression) - 1
        If ExpUB < 0 Then Exit Function
        ReDim Exp(ExpUB)
        CopyMemory Exp(0), ByVal StrPtr(Expression), (ExpUB + 1) * 2
    
        ChsUB = Len(Charset) - 1
        ReDim Chs(ChsUB)
        CopyMemory Chs(0), ByVal StrPtr(Charset), (ChsUB + 1) * 2
    
        ReplUB = Len(Replacement) - 1
        If ReplUB >= 0 Then
            ReDim Repl(ReplUB)
            CopyMemory Repl(0), ByVal StrPtr(Replacement), (ReplUB + 1) * 2
            
            If ReplUB + 1 > CHUNK * 2 Then
                ResultUB = ResultUB + (ReplUB + 1) * REPL_FACTOR
            Else
                ResultUB = ResultUB + CHUNK * 2
            End If
        Else
            ResultUB = ExpUB
        End If
    
        ReDim Result(ResultUB)
    
        For E = 0 To ExpUB
            Char = Exp(E)
            For C = 0 To ChsUB
                If CompareMethod = vbBinaryCompare Then
                    Match = Char = Chs(C)
                Else
                    Match = ChrCmpI(Char, Chs(C)) = 0
                End If
                If Match Then
                    If ReplUB >= 0 Then
                        'Replacement is not empty, copy it:
                        If ResultCur + ReplUB + 1 > ResultUB Then
                            'Grow the buffer:
                            If ReplUB + 1 > CHUNK * 2 Then
                                ResultUB = ResultUB + (ReplUB + 1) * REPL_FACTOR
                            Else
                                ResultUB = ResultUB + CHUNK * 2
                            End If
                            ReDim Preserve Result(ResultUB)
                        End If
                        If ReplUB = 0 Then
                            Result(ResultCur) = Repl(0)
                        Else
                            CopyMemory Result(ResultCur), Repl(0), (ReplUB + 1) * 2
                        End If
                        ResultCur = ResultCur + ReplUB + 1
                    End If
                    Exit For
                End If
            Next
            If C > ChsUB Then
                'Was no match, just copy Char:
                If ResultCur + 2 > ResultUB Then
                    'Grow the buffer by the remaining number of Expression chars:
                    ResultUB = ResultUB + ExpUB - E + 1
                    ReDim Preserve Result(ResultUB)
                End If
                Result(ResultCur) = Char
                ResultCur = ResultCur + 1
            End If
        Next
    
        ReplaceCharset = Space$(ResultCur)
        CopyMemory ByVal StrPtr(ReplaceCharset), Result(0), ResultCur * 2
    End Function
    Not thoroughly debugged. Needs more testing with long replacement text strings.

    You might need to tweak the Consts used to manage Redim Preserve operations for some applications.
    Attached Files Attached Files

  24. #24

    Thread Starter
    PowerPoster Zvoni's Avatar
    Join Date
    Sep 2012
    Location
    To the moon and then left
    Posts
    1,431

    Re: ReplaceAny and TrimAny-Function

    OK,

    i've changed the code in Post#1 (see EDIT2)
    People call me crazy because i'm jumping out of perfectly fine airplanes.
    I say you're crazy not to!
    --------------------------------------------------------------------------------------------------
    For health reasons i try to avoid reading unformatted Code

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Featured


Click Here to Expand Forum to Full Width