Sync on

	rem ---------------------------------------------------------------------
	rem First we make a string
	rem ---------------------------------------------------------------------
	ThisString$="01234567890123456789012345678901234567890123456789"
	ThisString$=ThisString$+ThisString$
	for lp =1 to 7
		ThisString$=ThisString$+ThisString$
	next


	rem ---------------------------------------------------------------------
	rem --[ START TESTS]-----------------------------------------------------
	rem ---------------------------------------------------------------------

	Max=10
	print "String Size:"+Str$(Len(ThisString$))

	print ""
	print ""
	

	print "-----------------------------------------------------------------"
	print "Testing WRITE MEMBLOCK Functions"
	print "-----------------------------------------------------------------"
	Sync
	Sync

	Size=Len(ThisString$)
	make memblock 1,0xffff
	t=timer()
		For lp =0 to max
			WriteMemBlockString(1,ThisString$,Address)
		next
	print "     Test Write Average Time:"+str$((timer()-t)/lp)	
	Sync
	Sync


	t=timer()
		For lp =0 to max
			WriteMemBlockString_SLOW(1,ThisString$,Address)
		next
	print "Test Write SLOW Average Time:"+str$((timer()-t)/lp)	


	sync
	sync
	print ""
	print ""
	print ""
	
	print "-----------------------------------------------------------------"
	print "Testing READ MEMBLOCK String Functions"
	print "-----------------------------------------------------------------"
	print 
	
	t=timer()
		For lp =0 to max
			Result$=ReadMemBlockString_STANDARD$(1,Address,Size)
		next
	print "       Test Read SLOW Average Time:"+str$((timer()-t)/lp)	
	print " ResultSize:"+Str$(Len(Result$))
	print "ResultMatch:"+Str$(Result$=ThisString$)
	Sync
	Sync


	t=timer()
		For lp =0 to max
			Result$=ReadMemBlockString_INTERLEAVED$(1,Address,Size)
		next
	print "Test Read Interleaved Average Time:"+str$((timer()-t)/lp)	
	print " ResultSize:"+str$(Len(Result$))
	print "ResultMatch:"+Str$(Result$=ThisString$)
	Sync
	Sync


	t=timer()
		For lp =0 to max
			Result$=ReadMemBlockString_CACHED$(1,Address,Size)
		next
	print "     Test Read Cached Average Time:"+str$((timer()-t)/lp)	
	print " ResultSize:"+Str$(Len(Result$))
	print "ResultMatch:"+Str$(Result$=ThisString$)
	Sync
	Sync

	delete memblock 1

	print ""
	print ""
	print "Benchmark Sample ="+Str$(Max)+" Tests"
	print "Test Complete- Press Space To End"

	Sync
	Sync
	 wait key
	 end







	

rem ---------------------------------------------------------------------
rem ---------------------------------------------------------------------
rem ---[ WRITE MEMBLOCK STRING ]------------------------------------------
rem ---------------------------------------------------------------------
rem ---------------------------------------------------------------------

rem  This function writes a string to a memblock at a given address(offset)
rem in the block.  The function is set out to avoid polling  MID$() on long
rem strings, this is because DBpro's uses NULL terminated strings, so every
rem time you call MID$() (or any standard DBpro string function) the command
rem runs through the all the bytes in the string looking for the end character (a zero).  
rem 
rem  If you break the input string down into smaller chunks, you can remove
rem lot of the brute force overhead, but it'll never be all that fast.
//
//

Function WriteMemBlockString(TargetMemblock,ThisString$,Address)

		rem original size of string
		Size=Len(ThisString$)

		rem The max chunk size of the temp string.
		FragSize=64
		if Size>4096 then FragSize=FragSize*2
		
        rem how many chunks are in this string
		Fragments =Size/FragSize
				
		if fragments>0

			rem compute the total size of the all the fragments together
			TotalChrs=Fragments*FragSize

			rem Clip the left over characters from the main string
			s$=Left$(ThisString$,TotalChrs)

			rem Compute the left over characters size
			Size=Size-TotalChrs

			rem grab the left over characters (if any)
			ThisString$=Right$(ThisString$,Size)

			Temp$=" "

			rem run through and copy the characters in smaller chunks
			For Frag=1 to Fragments

				rem grab the first chuck of character from the temp  
				Fragment$=Left$(s$,FragSize)
				
				rem write the smaller frag into mem block
		 		for Chrlp=1 to Fragsize
					Temp$=mid$(Fragment$,Chrlp)					
				    Write memblock byte TargetMemBlock,Address,asc(Temp$)
	     		    inc Address
	     		next

				rem copy the string down over itself
				TotalChrs=TotalChrs-FragSize
	     		s$=Right$(s$,TotalChrs)
			next


		endif

		rem  write any left overs character.
		for chrlp=1 to size
			Thischr=asc(mid$(ThisString$,chrlp))  
			write memblock byte TargetMemBlock,Address,ThisChr
			inc address
		next

EndFunction




	
rem ---------------------------------------------------------------------
rem ---------------------------------------------------------------------
rem ---[ WRITE MEMBLOCK STRING SLOW ]------------------------------------------
rem ---------------------------------------------------------------------
rem ---------------------------------------------------------------------

rem Note: DBpro string funcitons have length operations in them, so using the
rem the first version is way to slow if speed is 
	
Function WriteMemBlockString_SLOW(TargetMemBlock,ThisString$,Address)

		Size=Len(ThisString$)

		rem  Super slow string writing, since MID$() does a string length operation every time :(
		for lp=1 to size
			Thischr=asc(mid$(ThisString$,lp))    : rem This is massive time hog..  
			write memblock byte TargetMemBlock,Address,ThisChr
			inc Address			
		next


EndFunction








rem ---------------------------------------------------------------------
rem ---------------------------------------------------------------------
rem ---[ READ MEMBLOCK STRING SLOW ]-------------------------------------
rem ---------------------------------------------------------------------
rem ---------------------------------------------------------------------
	
Function ReadMemBlockString_Standard$(SrcMemBlock,Address,Size)
		Size=Size-1
		for lp=0 to size
	            ThisCHR=Memblock Byte(SrcMemBlock,Address+lp) 		    
				Result$=Result$+Chr$(ThisCHR)				
		next

EndFunction Result$



rem ---------------------------------------------------------------------
rem ---------------------------------------------------------------------
rem ---[ READ MEMBLOCK STRING INTERLEAVED ]------------------------------
rem ---------------------------------------------------------------------
rem ---------------------------------------------------------------------

rem This version cuts the run into 4 chunks, so we're avoiding 1/4 the hidden
rem len() operations and potential string allocations.

Function ReadMemBlockString_Interleaved$(SrcMemBlock,Address,Size)

		SizeBy4=(Size/4)
			
		SrcAddress1=Address
		SrcAddress2=SrcAddress1+SizeBy4
		SrcAddress3=SrcAddress2+SizeBy4
		SrcAddress4=SrcAddress3+SizeBy4

		for lp=1 to sizeby4
			    ThisCHR=Memblock Byte(SrcMemBlock,SrcAddress1)
				inc SrcAddress1
				Chunk1$=Chunk1$+Chr$(ThisCHR)				

			    ThisCHR=Memblock Byte(SrcMemBlock,SrcAddress2)
				inc SrcAddress2
				Chunk2$=Chunk2$+Chr$(ThisCHR)				

			    ThisCHR=Memblock Byte(SrcMemBlock,SrcAddress3)
				inc SrcAddress3
				Chunk3$=Chunk3$+Chr$(ThisCHR)				

			    ThisCHR=Memblock Byte(SrcMemBlock,SrcAddress4)
				inc SrcAddress4
				Chunk4$=Chunk4$+Chr$(ThisCHR)				

		next

		rem Check for possible left overs, if so,tact them on the end of for chunk4
		Size=Size and 3
		if Size			

			for lp=1 to size
			    ThisCHR=Memblock Byte(SrcMemBlock,SrcAddress4)
				inc SrcAddress4
				Chunk4$=Chunk4$+Chr$(ThisCHR)				
			next

		endif

		result$=Chunk1$+Chunk2$+Chunk3$+Chunk4$

EndFunction Result$




rem ---------------------------------------------------------------------
rem ---------------------------------------------------------------------
rem ---[ READ MEMBLOCK STRING (CACHED) ]------------------------------------------
rem ---------------------------------------------------------------------
rem ---------------------------------------------------------------------

rem   This version tries to cache the string into smaller chunks, even so 
rem reading a long string fragment from a memblock means a lot of memory thrashing
rem If the target buffer overflows it'll been to be allocated each time.
rem If you could get it to alloc the target string the size you need up front,
rem this would help, but it seems to be still doing internal LEN()'s on the strings.  


Function ReadMemBlockString_CACHED$(SrcMemBlock,SrcAddress,Size)

		rem Split the work up into 16 smaller strings
		SizeBy16=(Size/16)
			
		if SizeBy16

			for CurrentChunk=1 to 16 

				Chunk$=""
				for lp=1 to sizeby16
				    ThisCHR=Memblock Byte(SrcMemBlock,SrcAddress)
					inc SrcAddress
					Chunk$=Chunk$+Chr$(ThisCHR)				
				next lp
			
				Result$=Result$+Chunk$
			next CurrentChunk
		
		endif
	
		rem Check for possible left overs, if so,tact them on the end of the result
		Size=Size and 15
		if Size			

			for lp=1 to size
			    ThisCHR=Memblock Byte(SrcMemBlock,SrcAddress)
				inc SrcAddress
				LeftOver$=LeftOver$+Chr$(ThisCHR)				
			next
			
			result$=result$+LeftOver$

		endif


EndFunction Result$

function WriteStringToMemblock(mem as dword, offset as dword, s as string)
    strlen = len(s)
    if offset + strlen + 1 >= get memblock size(mem)
        exit prompt "Cannot write string '" + s + "' to memblock " + str$(mem) + " as there isn't enough space for it in the memblock!", "WriteStringToMemblock"
        end
    endif
    
    call dll kernel32, "RtlMoveMemory", get memblock ptr(mem) + offset, s, strlen
    write memblock byte mem, offset + strlen, 0 rem Write terminating null character
endfunction

#constant kernel32          1
#constant dbproCore         2
load dll "kernel32.dll",    kernel32
load dll "DBProCore.dll",   dbproCore

function WriteStringToMemblock(mem as dword, offset as dword, s as string)
    rem Pre-compute string length and store it since it will be used several times
    strlen = len(s)
    rem Is there enough room in the memblock to write the given string?
    if offset + strlen + 5 >= get memblock size(mem)
        exit prompt "Cannot write string '" + s + "' to memblock " + str$(mem) + " as there isn't enough space for it in the memblock!", "WriteStringToMemblock"
        end
    endif
    
    rem We will store a prefix of the string length for faster retrieval. We'll still store a null character
    rem at the end of the string even though this isn't necessary when we know the string length. If we omit
    rem this character from the memblock it would have to be manually added to the end of the DBP string for
    rem it to be valid however, which would be overly complicated since standard DBPro doesn't allow writing 
    rem a single byte to a memory address.
    write memblock dword mem, offset, strlen
    call dll kernel32, "RtlMoveMemory", get memblock ptr(mem) + offset + 4, s, strlen
    write memblock byte mem, offset + 4 + strlen, 0
endfunction

function ReadMemblockString(mem as dword, offset as dword)
    rem Here we just assume there's actually a string at the provided offset in the memblock; if not this function may cause a crash
    
    rem Create and resize a DBP string to the required size
    s$ = ""
    rem This function reallocates a pre-existing DBP string which is why we had to create the s$ string variable above
    call dll dbproCore, "?CreateSingleString@@YAXPAKK@Z", s$, memblock dword(mem, offset) + 1
    rem Copy memblock data to the string; include the terminating null character at the end
    call dll kernel32, "RtlMoveMemory", s$, get memblock ptr(mem) + offset + 4, memblock dword(mem, offset) + 1
endfunction s$