A split function implementation code [like VB]

General FreeBASIC programming questions.
xywhsoft
Posts: 25
Joined: Aug 28, 2009 6:28
Contact:

A split function implementation code [like VB]

Postby xywhsoft » Sep 14, 2020 22:06

I have tried to write a similar function, but the moderate memory management part is not satisfactory to me. I hope to realize a Split function with less pressure on memory management, but the idea was put on hold because of busy work. Until today, I decided to It is realized.

The principle is to save all the data in a pointer, so that when I don't need the data, I only need one free to process all the occupied memory.

The code is very simple, and I will post some usage examples later.

I wrote two codes for single-character delimiter and multi-character delimiter. This is to maximize efficiency, otherwise the code size can be reduced by half. Now it can work very well, and its ease of use is comparable to Visual Basic.



Edited on 2020-09-15, the comment was changed from Chinese to English, and the reference of dependent libraries was added.

In addition, when posting, I forgot to provide a method to loop through the results using Do, and I will also provide these codes.



Code: Select all

#include "windows.bi"
#include "crt.bi"



' Global variable, used to save the number of returned split strings
Dim Shared SplitCount As Integer

Function SplitChar(sText As ZString Ptr, iChar As UByte) As ZString Ptr Ptr
   Dim iPos As Integer = 0
   Dim iCount As Integer = 0
   ' Count the number of occurrences of the separator
   Do
      If Cast(UByte Ptr, sText)[iPos] = 0 Then
         If iChar = 0 Then
            ' If \0 is the separator, \0\0 is the terminator
            If Cast(UByte Ptr, sText)[iPos+1] = 0 Then
               Exit Do
            EndIf
         Else
            Exit Do
         EndIf
      EndIf
      If Cast(UByte Ptr, sText)[iPos] = iChar Then
         iCount += 1
      EndIf
      iPos += 1
   Loop
   ' The data to be returned is arranged in the following order:
   ' Split pointer table + NULL (pointer length, generally 4 bytes) + string table + \0
   Dim sRet As ZString Ptr Ptr = Allocate((iCount + 2) * SizeOf(Any Ptr) + iPos + 1)
   Dim pData As UByte Ptr = @sRet[iCount + 2]
   Dim pAddr As UByte Ptr = pData
   sRet[iCount + 1] = NULL
   RtlMoveMemory(pData, sText, iPos)
   pData[iPos] = 0
   ' Start to split data
   iCount = 0
   For i As Integer = 0 To iPos - 1
      'Print Cast(UByte Ptr, sText)[i], sText[i]
      If pData[i] = iChar Then
         pData[i] = 0
         sRet[iCount] = pAddr
         pAddr = pData + i + 1
         iCount += 1
      EndIf
   Next
   sRet[iCount] = pAddr
   SplitCount = iCount + 1
   Return sRet
End Function

Function SplitText(sText As ZString Ptr, sSep As ZString Ptr) As ZString Ptr Ptr
   Dim iSepSize As Integer = strlen(sSep)
   Dim iPos As Integer = 0
   Dim iCount As Integer = 0
   ' Count the number of occurrences of the separator
   Do
      If Cast(UByte Ptr, sText)[iPos] = 0 Then
         Exit Do
      EndIf
      If strncmp(@Cast(UByte Ptr, sText)[iPos], sSep, iSepSize) = 0 Then
         iCount += 1
      EndIf
      iPos += 1
   Loop
   Print iCount
   ' The data to be returned is arranged in the following order:
   ' Split pointer table + NULL (pointer length, generally 4 bytes) + string table + \0
   Dim sRet As ZString Ptr Ptr = Allocate((iCount + 2) * SizeOf(Any Ptr) + iPos + 1)
   Dim pData As UByte Ptr = @sRet[iCount + 2]
   Dim pAddr As UByte Ptr = pData
   sRet[iCount + 1] = NULL
   RtlMoveMemory(pData, sText, iPos)
   pData[iPos] = 0
   ' Start to split data
   iCount = 0
   For i As Integer = 0 To iPos - 1
      'Print Cast(UByte Ptr, sText)[i], sText[i]
      If strncmp(@pData[i], sSep, iSepSize) = 0 Then
         pData[i] = 0
         sRet[iCount] = pAddr
         pAddr = pData + i + iSepSize
         i += iSepSize - 1
         iCount += 1
      EndIf
   Next
   sRet[iCount] = pAddr
   SplitCount = iCount + 1
   Return sRet
End Function

Function Split(sText As ZString Ptr, sSep As ZString Ptr) As ZString Ptr Ptr
   Dim iSize As Integer = strlen(sSep)
   If iSize = 0 Then
      ' When the separator is \0
      Return SplitChar(sText, 0)
   ElseIf iSize = 1 Then
      ' Single character
      Return SplitChar(sText, Cast(UByte Ptr, sSep)[0])
   Else
      ' Multiple characters
      Return SplitText(sText, sSep)
   EndIf
End Function
Last edited by xywhsoft on Sep 15, 2020 11:33, edited 1 time in total.
xywhsoft
Posts: 25
Joined: Aug 28, 2009 6:28
Contact:

Re: A split function implementation code [like VB]

Postby xywhsoft » Sep 14, 2020 22:07

Usage example:

Code: Select all

Dim s2 As ZString Ptr Ptr = Split("123 | 456 | 789 | 000", " | ")

For i As Integer = 0 To SplitCount - 1
   Print s2[i], *s2[i]
Next

Deallocate(s2)


Example of using Do syntax to get a list of strings:
(by observing the output pointer, it is helpful to understand the memory data structure of the return value)

Code: Select all

Dim s2 As ZString Ptr Ptr = Split("123 | 456 | 789 | 000", " | ")

Print "Count :", SplitCount
Print "Addr :", s2, Hex(s2)
Dim idx As Integer
Do While s2[idx]
   Print s2[idx], *s2[idx]
   idx += 1
Loop
Last edited by xywhsoft on Sep 15, 2020 11:36, edited 1 time in total.
xywhsoft
Posts: 25
Joined: Aug 28, 2009 6:28
Contact:

Re: A split function implementation code [like VB]

Postby xywhsoft » Sep 14, 2020 22:08

The code is authorized by default in the public domain, and the author is xLeaves (xywhsoft), which can be used wherever you need it.
Tourist Trap
Posts: 2929
Joined: Jun 02, 2015 16:24

Re: A split function implementation code [like VB]

Postby Tourist Trap » Sep 15, 2020 8:47

xywhsoft wrote:The code is authorized by default in the public domain, and the author is xLeaves (xywhsoft), which can be used wherever you need it.

Thanks.
I often come here to grab this kind of functions that I was never able to write myself efficiently. I don't know if you have the fastest implementation over here, but it should be close to it if I can judge by the way you made use of rather direct memory management stuff.

Just for reference, there was this topic a while ago:
viewtopic.php?f=3&t=24563&p=228436&hilit=fastest+split#p228436
dodicat
Posts: 6687
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: A split function implementation code [like VB]

Postby dodicat » Sep 15, 2020 8:52

The code doesn't run here even If I include crt.bi.
What is RtlMoveMemory for example?
Tourist Trap
Posts: 2929
Joined: Jun 02, 2015 16:24

Re: A split function implementation code [like VB]

Postby Tourist Trap » Sep 15, 2020 8:59

dodicat wrote:The code doesn't run here even If I include crt.bi.
What is RtlMoveMemory for example?

It is ok with "windows.bi", but it's strlenthat I can not make work here. I guessed it just a len? But I didn't try any further more for now.

strncmp is also undefined. Can't figure out what it is a replacement for.

edit: ah ok, it's all good now with CRT.BI + WINDOWS.BI.

So this works fine for me here:

Code: Select all

#include "windows.bi"
#include "crt.bi"


Dim Shared SplitCount As Integer

Function SplitChar(sText As ZString Ptr, iChar As UByte) As ZString Ptr Ptr
   Dim iPos As Integer = 0
   Dim iCount As Integer = 0
   ' ??????????
   Do
      If Cast(UByte Ptr, sText)[iPos] = 0 Then
         If iChar = 0 Then
            ' ?? \0 ????,? \0\0 ?????
            If Cast(UByte Ptr, sText)[iPos+1] = 0 Then
               Exit Do
            EndIf
         Else
            Exit Do
         EndIf
      EndIf
      If Cast(UByte Ptr, sText)[iPos] = iChar Then
         iCount += 1
      EndIf
      iPos += 1
   Loop
   ' ??????? [???? + NULL + ???? + \0]
   Dim sRet As ZString Ptr Ptr = Allocate((iCount + 2) * SizeOf(Any Ptr) + iPos + 1)
   Dim pData As UByte Ptr = @sRet[iCount + 2]
   Dim pAddr As UByte Ptr = pData
   sRet[iCount + 1] = NULL
   RtlMoveMemory(pData, sText, iPos)
   pData[iPos] = 0
   ' ??????
   iCount = 0
   For i As Integer = 0 To iPos - 1
      'Print Cast(UByte Ptr, sText)[i], sText[i]
      If pData[i] = iChar Then
         pData[i] = 0
         sRet[iCount] = pAddr
         pAddr = pData + i + 1
         iCount += 1
      EndIf
   Next
   sRet[iCount] = pAddr
   SplitCount = iCount + 1
   Return sRet
End Function

Function SplitText(sText As ZString Ptr, sSep As ZString Ptr) As ZString Ptr Ptr
   Dim iSepSize As Integer = strlen(sSep)
   Dim iPos As Integer = 0
   Dim iCount As Integer = 0
   ' ??????????
   Do
      If Cast(UByte Ptr, sText)[iPos] = 0 Then
         Exit Do
      EndIf
      If strncmp(@Cast(UByte Ptr, sText)[iPos], sSep, iSepSize) = 0 Then
         iCount += 1
      EndIf
      iPos += 1
   Loop
   Print iCount
   ' ??????? [???? + NULL + ???? + \0]
   Dim sRet As ZString Ptr Ptr = Allocate((iCount + 2) * SizeOf(Any Ptr) + iPos + 1)
   Dim pData As UByte Ptr = @sRet[iCount + 2]
   Dim pAddr As UByte Ptr = pData
   sRet[iCount + 1] = NULL
   RtlMoveMemory(pData, sText, iPos)
   pData[iPos] = 0
   ' ??????
   iCount = 0
   For i As Integer = 0 To iPos - 1
      'Print Cast(UByte Ptr, sText)[i], sText[i]
      If strncmp(@pData[i], sSep, iSepSize) = 0 Then
         pData[i] = 0
         sRet[iCount] = pAddr
         pAddr = pData + i + iSepSize
         i += iSepSize - 1
         iCount += 1
      EndIf
   Next
   sRet[iCount] = pAddr
   SplitCount = iCount + 1
   Return sRet
End Function

Function Split(sText As ZString Ptr, sSep As ZString Ptr) As ZString Ptr Ptr
   Dim iSize As Integer = strlen(sSep)
   If iSize = 0 Then
      ' ???? \0 ???
      Return SplitChar(sText, 0)
   ElseIf iSize = 1 Then
      ' ????
      Return SplitChar(sText, Cast(UByte Ptr, sSep)[0])
   Else
      ' ????
      Return SplitText(sText, sSep)
   EndIf
End Function


Dim s2 As ZString Ptr Ptr = Split("123 | 456 | 789 | 000", " | ")

For i As Integer = 0 To SplitCount - 1
   Print s2[i], *s2[i]
Next

Deallocate(s2)
dodicat
Posts: 6687
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: A split function implementation code [like VB]

Postby dodicat » Sep 15, 2020 9:47

Thanks TT, OK now.
xywhsoft.
Perhaps you should include windows.bi and crt.bi in your code.
Nevertheless, very fast.
xywhsoft
Posts: 25
Joined: Aug 28, 2009 6:28
Contact:

Re: A split function implementation code [like VB]

Postby xywhsoft » Sep 15, 2020 11:28

Yes, my fault, these codes are written in a certain module, and the references of the dependent libraries are in other files. I forgot this when I copied it. In addition, I noticed that my comments are written in Chinese. I will later Edit, use English as comments to make it easier for everyone to understand the workflow of the code.

The efficiency of this Split function should be very fast. In principle, it only traverses the string 2 times and executes CopyMemory once, so even if a 1GB string is cut, it should be completed in about 1 second. This is based on I have not actually tested the theoretical values inferred from other algorithms I wrote.
xywhsoft
Posts: 25
Joined: Aug 28, 2009 6:28
Contact:

Re: A split function implementation code [like VB]

Postby xywhsoft » Sep 15, 2020 11:41

dodicat wrote:The code doesn't run here even If I include crt.bi.
What is RtlMoveMemory for example?


RtlMoveMemory is equivalent to the memcpy function of the C language runtime library;

Strncmp is a fixed-length comparison version of strcmp. I don’t know if there is a similar alternative function in Linux system, because I mainly develop on Wimdows platform, but it is not difficult to implement such a function, or you can use memcmp instead In principle, replacing this function has no effect on function realization.
marcov
Posts: 3010
Joined: Jun 16, 2005 9:45
Location: Eindhoven, NL
Contact:

Re: A split function implementation code [like VB]

Postby marcov » Sep 15, 2020 11:50

strncmp is C99.
jj2007
Posts: 1692
Joined: Oct 23, 2016 15:28
Location: Roma, Italia
Contact:

Re: A split function implementation code [like VB]

Postby jj2007 » Sep 15, 2020 18:25

Nice code, xywhsoft! Here is some code for getting the time to load a textfile into a string array using s2=Split(pContent, chr(13, 10)):

Code: Select all

#include "recall.bi"
#include "windows.bi"
#include "crt.bi"

' Global variable, used to save the number of returned split strings
Dim Shared SplitCount As Integer

Function SplitChar(sText As ZString Ptr, iChar As UByte) As ZString Ptr Ptr
   Dim iPos As Integer = 0
   Dim iCount As Integer = 0
   ' Count the number of occurrences of the separator
   Do
      If Cast(UByte Ptr, sText)[iPos] = 0 Then
         If iChar = 0 Then
            ' If \0 is the separator, \0\0 is the terminator
            If Cast(UByte Ptr, sText)[iPos+1] = 0 Then
               Exit Do
            EndIf
         Else
            Exit Do
         EndIf
      EndIf
      If Cast(UByte Ptr, sText)[iPos] = iChar Then
         iCount += 1
      EndIf
      iPos += 1
   Loop
   ' The data to be returned is arranged in the following order:
   ' Split pointer table + NULL (pointer length, generally 4 bytes) + string table + \0
   Dim sRet As ZString Ptr Ptr = Allocate((iCount + 2) * SizeOf(Any Ptr) + iPos + 1)
   Dim pData As UByte Ptr = @sRet[iCount + 2]
   Dim pAddr As UByte Ptr = pData
   sRet[iCount + 1] = NULL
   RtlMoveMemory(pData, sText, iPos)
   pData[iPos] = 0
   ' Start to split data
   iCount = 0
   For i As Integer = 0 To iPos - 1
      'Print Cast(UByte Ptr, sText)[i], sText[i]
      If pData[i] = iChar Then
         pData[i] = 0
         sRet[iCount] = pAddr
         pAddr = pData + i + 1
         iCount += 1
      EndIf
   Next
   sRet[iCount] = pAddr
   SplitCount = iCount + 1
   Return sRet
End Function

Function SplitText(sText As ZString Ptr, sSep As ZString Ptr) As ZString Ptr Ptr
   Dim iSepSize As Integer = strlen(sSep)
   Dim iPos As Integer = 0
   Dim iCount As Integer = 0
   ' Count the number of occurrences of the separator
   Do
      If Cast(UByte Ptr, sText)[iPos] = 0 Then
         Exit Do
      EndIf
      If strncmp(@Cast(UByte Ptr, sText)[iPos], sSep, iSepSize) = 0 Then
         iCount += 1
      EndIf
      iPos += 1
   Loop
   ' Print iCount
   ' The data to be returned is arranged in the following order:
   ' Split pointer table + NULL (pointer length, generally 4 bytes) + string table + \0
   Dim sRet As ZString Ptr Ptr = Allocate((iCount + 2) * SizeOf(Any Ptr) + iPos + 1)
   Dim pData As UByte Ptr = @sRet[iCount + 2]
   Dim pAddr As UByte Ptr = pData
   sRet[iCount + 1] = NULL
   RtlMoveMemory(pData, sText, iPos)
   pData[iPos] = 0
   ' Start to split data
   iCount = 0
   For i As Integer = 0 To iPos - 1
      'Print Cast(UByte Ptr, sText)[i], sText[i]
      If strncmp(@pData[i], sSep, iSepSize) = 0 Then
         pData[i] = 0
         sRet[iCount] = pAddr
         pAddr = pData + i + iSepSize
         i += iSepSize - 1
         iCount += 1
      EndIf
   Next
   sRet[iCount] = pAddr
   SplitCount = iCount + 1
   Return sRet
End Function

Function Split(sText As ZString Ptr, sSep As ZString Ptr) As ZString Ptr Ptr
   Dim iSize As Integer = strlen(sSep)
   If iSize = 0 Then
      ' When the separator is \0
      Return SplitChar(sText, 0)
   ElseIf iSize = 1 Then
      ' Single character
      Return SplitChar(sText, Cast(UByte Ptr, sSep)[0])
   Else
      ' Multiple characters
      Return SplitText(sText, sSep)
   EndIf
End Function

Dim as double t=Timer
Dim as ubyte ptr pContent
Dim As Long f=Freefile, sBytes
Dim as long flen
  If Open("inc\glib.bi" For Binary Access Read As #f) = 0 Then
   pContent = Allocate(Lof(f))
   Dim as ubyte ptr CurPos=pContent, CrPos
   flen=Lof(f)
   Get #f, 1, *pContent, Lof(f)
   Close #f
  endif

Dim s2 As ZString Ptr Ptr
Dim As string s()
Dim as long elements

for ct As Integer = 1 to 5
   t=timer
   s2=Split(pContent, chr(13, 10))
   Print "Splitting took ";int((timer-t)*10000)/10;" milliseconds"
   if ct<>5 then Deallocate(s2)

   t=timer
   elements=Recall("inc\glib.bi", s())
   Print "Recalling took ";int((timer-t)*10000)/10;" milliseconds";Chr(13, 10)
Next
print
print "results for splitting:"
Print " 0", *s2[0]
print " ..."
For i As Integer = SplitCount-4 to SplitCount-2
   Print i, *s2[i]
Next
print
print "results for recalling:"
Print " 0", s(0)
print " ..."
For i As Integer = ubound(s)-4 to ubound(s)-2
   Print i, s(i)
Next
Sleep
This is Recall.bi:

Code: Select all

' Recall.bi, 15 September 2020, jj2007
#include once "crt.bi"   ' needed for memcpy
#ifndef maxCell
   #Define maxCell 100   ' whatever you consider enough for a single cell
#endif
Dim shared retstr As string * maxCell+1   

Function Recall(fname As String, locArray() As String) As Integer
  Dim As Integer ct=0, cursize=1000   ' locArray is a local representation of a dynamic array
  Dim As Long f=Freefile, sBytes
  If Open(fname For Binary Access Read As #f) = 0 Then
   Dim as ubyte ptr pContent = Allocate(Lof(f)), CurPos=pContent, CrPos
   Dim as long flen=Lof(f)
   Get #f, 1, *pContent, Lof(f)
   Close #f
   Do
      if ct=0 or ct>cursize then
         cursize+=cursize shr 1
         ReDim Preserve locArray(cursize)
      endif
      CrPos=strstr(CurPos, Chr(10))
      sBytes=CrPos-CurPos-1
      if CrPos=0 Then CrPos=pContent+flen:flen=0:sBytes=CrPos-CurPos
      if sBytes>0 then
         locArray(ct)=Space(sBytes)
         memcpy(StrPtr(locArray(ct)), CurPos, sBytes)
      endif
      CurPos=CrPos+1
      ct+=1
   Loop until flen=0
   While ct>1 and len(trim(locArray(ct-2)))=0   ' get rid of trailing empty strings
      ct-=1
   Wend
   ReDim Preserve locArray(ct)
   DeAllocate(pContent)
  Else
   Print "Error opening file"
  End If
  Return ct
End Function

Function Cell(row As integer, col As integer, locArray() As String) As string
  Dim As integer ct=0, ctTabs=0, posLeft=-1, posRight=0
  Dim As ubyte ptr pString
  Dim c As ubyte
  pString=StrPtr(locArray(row))
  if pString then
   Do
      c=pString[ct]
      if c=0 then
         if ctTabs>=col then posRight=ct+1
         Exit do
      endif
      if c=9 then
         ctTabs=ctTabs+1
         if col=0 then
            posLeft=0
            if ctTabs>col then
               posRight=ct+1
               Exit do
            endif
         else
            if posLeft=-1 and ctTabs>=col then
                posLeft=ct+1
            elseif ctTabs>col then
                posRight=ct+1
                Exit do
            endif
         endif
      endif
      ct=ct+1
   Loop
  endif
  if posRight=0 then
   retstr[0]=0
  else
   posRight-=posLeft
   if posRight>maxCell then posRight=maxCell
   memcpy(StrPtr(retstr), pString+posLeft, posRight)
   retstr[posRight-1]=0
  endif
  return retstr
end function
dodicat
Posts: 6687
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: A split function implementation code [like VB]

Postby dodicat » Sep 15, 2020 19:18

I made a simple mid() version, only fb, no external includes.
Mid() version versus ptr ptr version for a BIG string.

Code: Select all

#include "windows.bi"
#include "crt.bi"


Dim Shared SplitCount As Integer

Function SplitChar(sText As ZString Ptr, iChar As Ubyte) As ZString Ptr Ptr
   Dim iPos As Integer = 0
   Dim iCount As Integer = 0
   ' ??????????
   Do
      If Cast(Ubyte Ptr, sText)[iPos] = 0 Then
         If iChar = 0 Then
            ' ?? \0 ????,? \0\0 ?????
            If Cast(Ubyte Ptr, sText)[iPos+1] = 0 Then
               Exit Do
            EndIf
         Else
            Exit Do
         EndIf
      EndIf
      If Cast(Ubyte Ptr, sText)[iPos] = iChar Then
         iCount += 1
      EndIf
      iPos += 1
   Loop
   ' ??????? [???? + NULL + ???? + \0]
   Dim sRet As ZString Ptr Ptr = Allocate((iCount + 2) * Sizeof(Any Ptr) + iPos + 1)
   Dim pData As Ubyte Ptr = @sRet[iCount + 2]
   Dim pAddr As Ubyte Ptr = pData
   sRet[iCount + 1] = NULL
   RtlMoveMemory(pData, sText, iPos)
   pData[iPos] = 0
   ' ??????
   iCount = 0
   For i As Integer = 0 To iPos - 1
      'Print Cast(UByte Ptr, sText)[i], sText[i]
      If pData[i] = iChar Then
         pData[i] = 0
         sRet[iCount] = pAddr
         pAddr = pData + i + 1
         iCount += 1
      EndIf
   Next
   sRet[iCount] = pAddr
   SplitCount = iCount + 1
   Return sRet
End Function

Function SplitText(sText As ZString Ptr, sSep As ZString Ptr) As ZString Ptr Ptr
   Dim iSepSize As Integer = strlen(sSep)
   Dim iPos As Integer = 0
   Dim iCount As Integer = 0
   ' ??????????
   Do
      If Cast(Ubyte Ptr, sText)[iPos] = 0 Then
         Exit Do
      EndIf
      If strncmp(@Cast(Ubyte Ptr, sText)[iPos], sSep, iSepSize) = 0 Then
         iCount += 1
      EndIf
      iPos += 1
   Loop
   '''Print iCount
   ' ??????? [???? + NULL + ???? + \0]
   Dim sRet As ZString Ptr Ptr = Allocate((iCount + 2) * Sizeof(Any Ptr) + iPos + 1)
   Dim pData As Ubyte Ptr = @sRet[iCount + 2]
   Dim pAddr As Ubyte Ptr = pData
   sRet[iCount + 1] = NULL
   RtlMoveMemory(pData, sText, iPos)
   pData[iPos] = 0
   ' ??????
   iCount = 0
   For i As Integer = 0 To iPos - 1
      'Print Cast(UByte Ptr, sText)[i], sText[i]
      If strncmp(@pData[i], sSep, iSepSize) = 0 Then
         pData[i] = 0
         sRet[iCount] = pAddr
         pAddr = pData + i + iSepSize
         i += iSepSize - 1
         iCount += 1
      EndIf
   Next
   sRet[iCount] = pAddr
   SplitCount = iCount + 1
   Return sRet
End Function

Function Split(sText As ZString Ptr, sSep As ZString Ptr) As ZString Ptr Ptr
   Dim iSize As Integer = strlen(sSep)
   If iSize = 0 Then
      ' ???? \0 ???
      Return SplitChar(sText, 0)
   Elseif iSize = 1 Then
      ' ????
      Return SplitChar(sText, Cast(Ubyte Ptr, sSep)[0])
   Else
      ' ????
      Return SplitText(sText, sSep)
   EndIf
End Function

'=============================

Function tally (somestring As String,partstring As String,arr() As Long) As Long
    redim arr(1 to len(somestring)\2)
    Dim As long i,j,ln,lnp,count
    ln=Len(somestring)
    lnp=Len(partstring)
    count=0
    i=-1
    Do
        i+=1
        If somestring[i] <> partstring[0] Then Goto skip
        If somestring[i] = partstring[0] Then
            For j=0 To lnp-1
                If somestring[j+i]<>partstring[j] Then Goto skip
            Next j
        End If
        count+=1
        arr(count)=i+1
        i=i+lnp-1
        skip:
    Loop Until i>=ln-1
    redim preserve arr(1 to count)
    Return count
End Function
 

Function splitstring(somestring As String,partstring As String,a() As String) As Long
    Redim As Long x()
   Var t= tally(somestring,partstring,x()),lps=Len(partstring)
   If t=0 Or Len(somestring)=0 Or lps=0 Then Return 0
   Redim a(1 To t+1)
   a(1)=Mid(somestring,1,x(1)-1)
    For n As Long=1 To Ubound(x)-1
       a(n+1)= Mid(somestring,x(n)+lps,x(n+1)-x(n)-lps)
Next n
a(Ubound(a))=Mid(somestring,x(Ubound(x))+lps)
Return t+1
End Function

Dim As String g="123 456 789 345666abcd45600"
Dim As String delim="456 789 345"
Redim As String s()


For n As Long=1 To 24
g+=g
Next

Print "Length ";Len(g)
Print
Dim As Double t=Timer
Var n=splitstring(g,delim,s())
Print n
if n then
Print Timer-t;"   seconds  MID"
For n As Long=Lbound(s) To 10
    Print s(n)
Next


Print ". . ."

For n As Long=Ubound(s)-10 To Ubound(s)
    Print s(n)
    Next n
Print
end if

Dim s2 As ZString Ptr Ptr
t=Timer
s2=split(g,delim)
Print SplitCount
if splitcount>1 then
Print Timer-t;"   seconds  ptr ptr"
 

For i As Integer = 0 To 9
   Print  *s2[i]
Next
Print ". . ."

For n As Long=splitcount -10 To splitcount
    Print s(n)
    Next n
Print
Deallocate(s2)
end if
Print "Done"

Sleep
 
 

Return to “General”

Who is online

Users browsing this forum: No registered users and 5 guests