Originally posted by NicTheQuick. I tried my best (Google) to translate the comments and such.
Thank you Nic and Google!
Code: Select all
;;;;;;;;;;;;
;
; This was originally written by NicTheQuick sometime in the summer of 2003.
;
; I modified it a little and translated the comments to English (via google!)
;
; It seems to be an effective library for using memory buffers instead of string variables
; to get around the 63999 char limit and thread safety issues of PB's string variables.
;
; If you modify this or find any bugs I'd love to know about them!
;
; Thanks!
; -Mitch (AKA Karbon)
; mitch@purebasic.org
;;;;;;;;;;;;
#Heap_Zero_Memory = $8
Procedure.l PbHeap()
!MOV EAX, dword [_PB_MemoryBase]
ProcedureReturn
EndProcedure
Procedure.l mP(hString.l)
ProcedureReturn *hString
EndProcedure
;Stores a new String
;String.s [in] : [more again?] String
;RETURN : Handle to String
Procedure.l mNewString(String.s)
Protected hString.l, sString.l, pString.l
sString = Len(String) + 1
hString = HeapAlloc_(PbHeap(), #Heap_Zero_Memory, sString)
CopyMemory(@String, hString, sString)
ProcedureReturn hString
EndProcedure
;Reserves a String with a certain length
;Length.l [in] : Length the one which can be reservedStrings
;RETURN : Handle of reserved String
Procedure.l mReserveString(Length.l)
Protected hString.l
hString = HeapAlloc_(PbHeap(), #Heap_Zero_Memory, Length + 1)
ProcedureReturn hString
EndProcedure
; Changes a String
;hString.l [in] : Handle to the original String
;String.s [in] : String
;RETURN : Handle of String ([can change])
Procedure.l mChangeString(hString.l, String.s)
Protected sString.l
sString = Len(String) + 1
shString = HeapSize_(PbHeap(), 0, hString)
If sString < shString
hString = HeapReAlloc_(PbHeap(), hString, sString, 0)
ElseIf sString > shString
GlobalFree_(hString)
hString = HeapAlloc_(PbHeap(), #Heap_Zero_Memory, sString)
EndIf
CopyMemory(@String, hString, sString)
ProcedureReturn hString
EndProcedure
;Copies one string into another
;hString1.l [in] : Handle of source string
;hString2.l [in] : Handle of destination string
;RETURN : Handle of destination string
Procedure.l mCopyString(hString1.l, hString2.l)
Protected sString1.l, sString2.l
sString1 = HeapSize_(PbHeap(), 0, hString1)
sString2 = HeapSize_(PbHeap(), 0, hString2)
If sString1 < sString2
hString2 = HeapReAlloc_(PbHeap(), 0, hString2, sString1)
ElseIf sString1 > sString2
HeapFree_(PbHeap(), 0, hString2)
hString2 = HeapAlloc_(PbHeap(), #Heap_Zero_Memory, sString1)
EndIf
CopyMemory(hString1, hString2, sString1)
ProcedureReturn hString2
EndProcedure
;Copies a string into a new one
;hString1.l [in] : Handle of source string
;RETURN : Handle of the copied string
Procedure mCopyStringEx(hString1.l)
Protected sString1.l, hString2.l
sString1 = HeapSize_(PbHeap(), 0, hString1)
hString2 = HeapAlloc_(PbHeap(), #Heap_Zero_Memory, sString1)
CopyMemory(hString1, hString2, sString1 - 1)
ProcedureReturn hString2
EndProcedure
;Releases the string and the memort
;hString.l [in] : Handle of String
;RETURN : #NULL, if the stringwas successfully deleted
Procedure.l mFreeString(hString.l)
ProcedureReturn HeapFree_(PbHeap(), 0, hString)
EndProcedure
;Returns the string in memory (at specified address I assume)
;hString.l [in] : Handle of String
;RETURN : String
Procedure.s mStrVal(hString.l)
Protected String.s
If hString
String = PeekS(hString)
ProcedureReturn String
Else
ProcedureReturn ""
EndIf
EndProcedure
;Joins two strings to make a new one
;hString1.l [in] : Handle of first String
;hString2.l [in] : Handle of second String
;RETURN : Handle of new String
Procedure.l mAddString(hString1.l, hString2.l)
Protected sString1.l, sString2.l, hString.l
sString1 = HeapSize_(PbHeap(), 0, hString1)
sString2 = HeapSize_(PbHeap(), 0, hString2)
hString = HeapAlloc_(PbHeap(), #Heap_Zero_Memory, sString1 + sString2 - 1)
CopyMemory(hString1, hString, sString1 - 1)
CopyMemory(hString2, hString + sString1 - 1, sString2)
ProcedureReturn hString
EndProcedure
;Add the second string to the first string
; I guess you use this to change the string in place.
; Use the procedure above, mAddString to make a new string wilst
; keeping the two old ones.
;hString1.l [in] : Handle of first String
;hString2.l [in] : Handle of second String
;RETURN : Handle of first String (changed)
Procedure.l mAddStringEx(hString1.l, hString2.l)
Protected sString1.l, sString2.l, hString.l
sString1 = HeapSize_(PbHeap(), 0, hString1)
sString2 = HeapSize_(PbHeap(), 0, hString2)
hString = HeapAlloc_(PbHeap(), #Heap_Zero_Memory, sString1 + sString2 - 1)
CopyMemory(hString1, hString, sString1 - 1)
CopyMemory(hString2, hString + sString1 - 1, sString2)
HeapFree_(PbHeap(), 0, hString1)
ProcedureReturn hString
EndProcedure
;Compare two strings
;hString1.l [in] : Handle of first String
;hString2.l [in] : Handle of second String
;RETURN : 0 = NOT equal, 1 = Equal
Procedure.l mCompareString(hString1.l, hString2.l)
Protected sString1.l, sString2.l
sString1 = HeapSize_(PbHeap(), 0, hString1)
sString2 = HeapSize_(PbHeap(), 0, hString2)
If sString1 = sString2
ProcedureReturn CompareMemory(hString1, hString2, sString1)
Else
ProcedureReturn 0
EndIf
EndProcedure
;Looks for one string in another
;hString1.l [in] : Handle of String to search
;hString2.l [in] : Handle of String to search for
;Begin.l [in] : Position in string to start search
;RETURN : Position of string in target
Procedure.l mFindString(hString1.l, hString2.l, Begin.l)
Protected sString1.l, sString2.l, eString1.l, eString2.l
Protected *z1.Byte, *z2.Byte
sString1 = HeapSize_(PbHeap(), 0, hString1)
sString2 = HeapSize_(PbHeap(), 0, hString2)
If sString2 > sString1 Or sString2 = 0
ProcedureReturn 0
Else
eString1 = hString1 + sString1 - 1
eString2 = hString2 + sString2 - 1
For *z1 = hString1 + Begin - 1 To hString2 - sString2
*z2 = hString2
While *z1\b = *z2\b
*z1 + 1
*z2 + 1
If *z2 = eString2
ProcedureReturn *z1 - sString2 - hString1 + 2
EndIf
Wend
Next
EndIf
EndProcedure
;Get a certain number of characters from the left side of a string
;hString1.l [in] : Handle of String
;Length.l [in] : Number of characters
;RETURN : Handle to new String (with specified characters in it)
Procedure.l mLeft(hString1.l, Length.l)
Protected sString1.l, hString2.l
sString1 = HeapSize_(PbHeap(), 0, hString1)
If sString1 - 1 < Length
Length = sString1 - 1
EndIf
hString2 = HeapAlloc_(PbHeap(), #Heap_Zero_Memory, Length + 1)
CopyMemory(hString1, hString2, Length)
ProcedureReturn hString2
EndProcedure
;
; Google says[Compares the at the beginning of the first String with a second]
; But it looks like it's only comparing the size of the strings.
; I guess the name is just misleading?
;hString1.l [in] : Handle of first String
;hString2.l [in] : Handle of second String
;RETURN : 0 = ungleich, 1 = gleich
Procedure.l mLeftCompare(hString1.l, hString2.l)
Protected sString1.l, sString2.l
sString1 = HeapSize_(PbHeap(), 0, hString1)
sString2 = HeapSize_(PbHeap(), 0, hString2)
If sString2 > sString1
ProcedureReturn #False
EndIf
ProcedureReturn CompareMemory(hString1, hString2, sString2 - 1)
EndProcedure
;Get a certain number of characters from the right side of
;a String And Return them as a new String
;hString1.l [in] : Handle of String
;Length.l [in] : Number of characters to get
;RETURN : Handle of new String
Procedure.l mRight(hString1.l, Length.l)
Protected sString1.l, hString2.l
sString1 = HeapSize_(PbHeap(), 0, hString1)
If sString1 - 1 < Length
Length = sString1 - 1
EndIf
hString2 = HeapAlloc_(PbHeap(), #Heap_Zero_Memory, Length + 1)
CopyMemory(hString1 + sString1 - Length - 1, hString2, Length)
ProcedureReturn hString2
EndProcedure
; Again Google says [The end of the first string compares with a second string]
; but all I see it doung is comparing the size of the string. I guess this name is just misleading too
;hString1.l [in] : Handle zum ersten String
;hString2.l [in] : Handle zum zweiten String
;RETURN : 0 = NOT equal, 1 = Equal
Procedure.l mRightCompare(hString1.l, hString2.l)
Protected sString1.l, sString2.l
sString1 = HeapSize_(PbHeap(), 0, hString1)
sString2 = HeapSize_(PbHeap(), 0, hString2)
If sString2 > sString1
ProcedureReturn #False
EndIf
ProcedureReturn CompareMemory(hString1 + sString1 - sString2, hString2, sString2)
EndProcedure
;Returns a certain number of characters from a given position in the string
;hString1.l [in] : Handle of String
;Position.l [in] : Start position in String
;Length.l [in] : Number of characters to grab
;RETURN : Handle of new String containing requested characters
Procedure.l mMid(hString1.l, Position.l, Length.l)
Protected sString1.l, hString2.l
sString1 = HeapSize_(PbHeap(), 0, hString1)
If sString1 < Length + Position
If sString1 - 1 < Position
hString2 = HeapAlloc_(PbHeap(), #Heap_Zero_Memory, 1)
ProcedureReturn hString2
EndIf
Length = sString1 - Position
EndIf
hString2 = HeapAlloc_(PbHeap(), #Heap_Zero_Memory, Length + 1)
CopyMemory(hString1 + Position - 1, hString2, Length)
ProcedureReturn hString2
EndProcedure
;Compares a character at a given position in two strings
;hString1.l [in] : Handle of first String
;Position.l [in] : Position in first String
;hString2.l [in] : Handle handle of second String
;RETURN : 0 = NOT equal, 1 = Equal
Procedure.l mMidCompare(hString1.l, Position.l, hString2.l)
Protected sString1.l, sString2.l
sString1 = HeapSize_(PbHeap(), 0, hString1)
sString2 = HeapSize_(PbHeap(), 0, hString2)
If sString2 + Position - 1 > sString1
ProcedureReturn #False
EndIf
ProcedureReturn CompareMemory(hString1 + Position - 1, hString2, sString2 - 1)
EndProcedure
;Get all characters from a given position in a string to the end of said string
;hString1.l [in] : Handle of String
;Position.l [in] : Position in String
;RETURN : Handle of new String
Procedure.l mMidEnd(hString1.l, Position.l)
Protected sString1.l, hString2.l
sString1.l = HeapSize_(PbHeap(), 0, hString1)
If sString1 - 1 < Position
hString2 = HeapAlloc_(PbHeap(), #Heap_Zero_Memory, 1)
ProcedureReturn hString2
EndIf
hString2 = HeapAlloc_(PbHeap(), #Heap_Zero_Memory, sString1 - Position + 1)
CopyMemory(hString1 + Position - 1, hString2, sString1 - Position)
ProcedureReturn hString2
EndProcedure
;Gives the length of the given string
;hString.l [in] : Handle of String
;RETURN : Length of string
Procedure.l mLen(hString.l)
Protected sString.l
sString = HeapSize_(PbHeap(), 0, hString)
ProcedureReturn sString - 1
;ProcedureReturn sString
EndProcedure
;Gives the length of the string not counting the zero byte (the ending NULL)
;hString.l [in] : Handle of String
;RETURN : Length up to the NULL byte
Procedure.l mLenZero(hString.l)
Protected *z.Byte
*z = hString
While *z\b : *z + 1 : Wend
ProcedureReturn *z - hString
EndProcedure
;Returns the ASCII code of the first character in a string
;hString.l [in] : Handle of String
;RETURN : ASCII Code of first character in the string
Procedure.l mAsc(hString.l)
Protected sString.l
sString = HeapSize_(PbHeap(), 0, hString)
If sString - 1
ProcedureReturn PeekB(hString) & $FF
EndIf
ProcedureReturn 256
EndProcedure
;Gives the ASCII code of a certain character in a string
;hString.l [in] : Handle of String
;Position.l [in] : Position of character in String
;RETURN : ASCII code of character at given position
Procedure.l mAscPosition(hString.l, Position.l)
Protected sString.l
sString = HeapSize_(PbHeap(), 0, hString)
If Position > sString - 1
ProcedureReturn 256
EndIf
ProcedureReturn PeekB(hString + Position - 1) & $FF
EndProcedure
;Make a string with given ASCII
;ASCII.l [in] : ASCII Code
;RETURN : Handle of new String
Procedure.l mChr(ASCII.l)
Protected hString.l
hString = HeapAlloc_(PbHeap(), #Heap_Zero_Memory, 2)
PokeB(hString, ASCII)
ProcedureReturn hString
EndProcedure
; Google says : Procedure around a storage area to fill of Stefan Moebius (dt. forum)
; Which means: Fill memory at the Adr address with AnzBytes worth of dword.
; dword is a hex value so keep that in mind.
;
; MemLFill(hString, Length, $20202020) is called below.
; That fills the memory address at hString with Length bytes of spaces
;
; $20202020 is 4 bytes of 0x20 (decimal 32 or the space ASCII code)
Procedure MemLFill(Adr, AnzBytes, dword.l)
!CLD
!MOV Edi,[Esp+0]
!MOV EAX,[Esp+8]
!MOV Ecx,[Esp+4]
!SHR Ecx,2
!REP STOSD
EndProcedure
;Creates a new string and fills it withgiven number of spaces (like space())
;Length.l [in] : Number of spaces
;RETURN : Handle of new String
Procedure.l mSpace(Length.l)
Protected hString.l
hString = HeapAlloc_(PbHeap(), #Heap_Zero_Memory, Length + 1)
MemLFill(hString, Length, $20202020)
ProcedureReturn hString
EndProcedure
;Compares the character at the given position with given ASCII code
;hString.l [in] : Handle of String
;Position.l [in] : Position in String
;ASCII.l [in] : ASCII Code to compare
;RETURN : 0 = NOT Equal, 1 = Equal
Procedure.l mCompareChar(hString.l, Position.l, ASCII.l)
Protected sString.l, *z.Byte
sString = HeapSize_(PbHeap(), 0, hString)
If sString - 1 < Position
ProcedureReturn #False
EndIf
*z = hString + Position - 1
If *z\b & $FF = ASCII
ProcedureReturn #True
Else
ProcedureReturn #False
EndIf
EndProcedure
Procedure mStringField(s_string1.l,requested_index.l, ascii_delimiter.l)
Protected *my_byte.Byte
;
; We start counting indexes at 1, not zero.
; Just maintaining some compatibility with PB's StringField()
;
internal_index.l = 1
;
; Point to the first character in our buffer
;
*my_byte = s_string1
;
; Variable set to let us know if we continue our loop or not.
;
loop_continue.b = 1
;
; The location of the beginning of our requested field.
;
; Default, the start of the whole string.
;
start_location.l = s_string1 - 1
;
; We want to look through the buffer byte by byte to find our ascii delimiter
;
While loop_continue = 1
If *my_byte\b = ascii_delimiter
;
; Increment our internal index so we can catch the field we want
;
internal_index + 1
;
; Set start location of our new string
; (note this is actually the location of the delimiter)
;
start_location = *my_byte
EndIf
;
; We process each byte and don't want our delimiters in the final string, so move on.
;
*my_byte + 1
;
; We've found the correct index and our delimiter then we just stop the loop.
; If a NULL is encountered we return a NULL buffer.
;
If internal_index = requested_index
If *my_byte\b = ascii_delimiter Or *my_byte\b = 0
loop_continue = 0
EndIf
ElseIf *my_byte\b = 0
s_new_string.l = HeapAlloc_(PbHeap(), #Heap_Zero_Memory, 1 )
ProcedureReturn(s_new_string)
EndIf
Wend
;
; I think this is self explanitory!
;
str_length.l = (*my_byte - start_location - 1)
s_new_string.l = HeapAlloc_(PbHeap(), #Heap_Zero_Memory, str_length + 1)
CopyMemory(start_location + 1, s_new_string, str_length)
ProcedureReturn s_new_string
EndProcedure
; Google really messed this one up!
; This trims spaces off the beginning and end of a string.
;hString1.l [in] : String to be trimmed
;RETURN : Handle of new trimmed string
Procedure.l mTrim(hString1.l)
Protected sString1.l, *z.Byte, Begin.l, Ends.l
Protected hString2
sString1 = HeapSize_(PbHeap(), 0, hString1)
*z = hString1
While *z\b = 32 And *z\b
*z + 1
Wend
Begin = *z - hString1
*z = hString1 + sString1 - 2
While *z\b = 32 And *z >= hString1
*z - 1
Wend
Ends = hString1 + sString1 - 2 - *z
If Begin = Ends
If Begin = sString1 - 1
Ends = 0
EndIf
EndIf
hString2 = HeapAlloc_(PbHeap(), #Heap_Zero_Memory, sString1 - (Begin + Ends))
HeapFree_(PbHeap(), 0, hString1)
CopyMemory(hString1 + Begin, hString2, sString1 - (Begin + Ends))
ProcedureReturn hString2
EndProcedure
; Seems the longer the sentence the worse google does!
; This pads a string to the left until it's Length long
; with a character specified by ASCII. Again like the PB
; procedure LSet().
; If the string is already longer than the specified length
; the original string is truncated.
;
;hString1.l [in] : Handle of String
;Length.l [in] : Length you want the string to be (which will determin how many padding chars get added)
;ASCII.l [in] : ASCII code of padding character
;RETURN : Handle of newly formatted String
;
Procedure mLSet(hString1.l, Length.l, ASCII.l)
Protected sString1.l, *z.Byte
sString1 = HeapSize_(PbHeap(), 0, hString1)
If sString1 - 1 > Length
hString2 = HeapAlloc_(PbHeap(), #Heap_Zero_Memory, Length + 1)
CopyMemory(hString1, hString2, Length)
HeapFree_(PbHeap(), 0, hString1)
ProcedureReturn hString2
Else
hString2 = HeapAlloc_(PbHeap(), #Heap_Zero_Memory, Length + 1)
CopyMemory(hString1, hString2, sString1 - 1)
HeapFree_(PbHeap(), 0, hString1)
For *z = hString2 + sString1 - 1 To hString2 + Length - 1
*z\b = ASCII
Next
ProcedureReturn hString2
EndIf
EndProcedure
; This pads a string to the right until it's Length long
; with a character specified by ASCII. Again like the PB
; procedure LSet().
; If the string is already longer than the specified length
; the original string is truncated.
;
;hString1.l [in] : Handle of String
;Length.l [in] : Length you want the string to be (which will determin how many padding chars get added)
;ASCII.l [in] : ASCII code of padding character
;RETURN : Handle of newly formatted String
;
Procedure mRSet(hString1.l, Length.l, ASCII.l)
Protected sString1.l, *z.Byte
sString1 = HeapSize_(PbHeap(), 0, hString1)
If sString1 - 1 > Length
hString2 = HeapAlloc_(PbHeap(), #Heap_Zero_Memory, Length + 1)
CopyMemory(hString1, hString2, Length)
HeapFree_(PbHeap(), 0, hString1)
ProcedureReturn hString2
Else
hString2 = HeapAlloc_(PbHeap(), #Heap_Zero_Memory, Length + 1)
CopyMemory(hString1, hString2 + Length - sString1 + 1, sString1 - 1)
HeapFree_(PbHeap(), 0, hString1)
For *z = hString2 To hString2 + Length - sString1
*z\b = ASCII
Next
ProcedureReturn hString2
EndIf
EndProcedure
;Sets a character at a given position to a given character (using an ASCII code)
;hString.l [in] : Handle of String
;Position.l [in] : Position of character to replace
;ASCII.l [in] : ASCII code that replaces char at given position
;RETURN : #False = Position was outside length of string #True = Success!
Procedure mSetChar(hString.l, Position.l, ASCII.l)
Protected sString.l, *z.Byte
sString = HeapSize_(PbHeap(), 0, hString)
If sString - 1 < Position Or Position < 1
ProcedureReturn #False
EndIf
*z = hString + Position - 1
*z\b = ASCII
ProcedureReturn #True
EndProcedure
; Google screwed this one up too.
; Looks like it sets the first NULL byte it encounters to the given ASCII character
; I guess this is useful for those of you that want to have NULLs in your strings!
;hString.l [in] : Handle of String
;ASCII.l [in] : ASCII code used to replace the NULL
;RETURN : #False = Didn't find a NULL to replace, #True = Found and replaced first NULL successfully
Procedure mSetCharEx(hString.l, ASCII.l)
Protected *z.Byte, sString.l
sString = HeapSize_(PbHeap(), 0, hString)
*z = hString
While *z\b : *z + 1 : Wend
If *z - hString = sString - 1
ProcedureReturn #False
EndIf
*z\b = ASCII
ProcedureReturn #True
EndProcedure
Debug " -- Strings s1, s2 and s3 --"
s1 = mNewString("abcdefghabcd")
s2 = mNewString("abc")
s3 = mNewString("Today we learn the ABC")
Debug mStrVal(s1)
Debug mStrVal(s2)
Debug mStrVal(s3)
Debug " -- Position of s2 in s1 starting from pos 2 --"
Debug mFindString(s1, s2, 2)
Debug "Value at pos 9 with length 4 in s1"
Debug mStrVal(mMid(s1, 9, 4))
Debug " (s2 in s4 copy)"
;s4 = mNewString("")
s4 = mCopyStringEx(s2)
Debug " -- RSet(s2, 10, 45) --"
s2 = mRSet(s2, 10, 45) ;45 = "-"
Debug mStrVal(s2)
Debug " -- 3.Word in s3 --"
Debug mStrVal(mStringField(s3, 3, 32))
Debug " -- Does pos 6 in s3 = blanks? --"
Debug mCompareChar(s3, 6, 32) ;32 = " "
Debug " -- Is pos 7 in s3 L ? --"
Debug mCompareChar(s3, 7, 76) ;76 = "L"
Debug " -- ASCII Code at Pos 7 in s3 --"
Debug mAscPosition(s3, 7)
Debug " -- Does the right part of s3 = s4? --"
Debug mRightCompare(s3, s4)
Debug " -- s5 = s3 + s1 --"
s5 = mAddString(s3, s1)
Debug mStrVal(s5)
Debug " (s6 = 100 - Reserves a 100 character string.)"
s6 = mReserveString(100)
Debug " -- First position with ASCII code 65 in s6--"
mSetChar(s6, 1, 65)
Debug mStrVal(s6)
Debug " -- Second position with ASCII code 98 in s6 --"
mSetChar(s6, 2, 98)
Debug mStrVal(s6)
Debug " -- SEts the NULL in s6 (if there is one) to ASCII 67 --"
mSetCharEx(s6, 67)
Debug mStrVal(s6)
Debug " -- Length not counting NULL byte--"
Debug mLenZero(s6)
Debug " -- Length of s6 --"
Debug mLen(s6)
