Page 1 of 2

CopyStructure - with strings

Posted: Fri Jan 11, 2008 1:40 am
by mk-soft
Edit
New + Update v1.03 -> v1.04 -> v1.05 -> v1.06

Copy structure with strings. Replace EndStructure with EndStruct(structname). This create a hide helpfunction. Write structname allways as lowercase because the compiler work at all character as lowercase.

Update v1.09
- compatible with X86 and X64

Sorry, the sample are in germany language.

Code: Select all

;-TOP
; Comment       : CopyStructure with Strings and Arrays
; Author        : mk-soft
; Second Author : 
; File          : CopyStructure.pb
; Version       : 1.09
; Create        : 
; Update        : 28.03.2009
; 
; Compilermode  :
;
; ***************************************************************************************

;- Macros EndStruct to create help functions

CompilerIf #PB_Compiler_Processor = #PB_Processor_x86
  ; X86 Processor  
  Macro EndStruct(StructureName) ; <- name of structure allways lowercase
    EndStructure
      Procedure ___dummy_#StructureName()
        Protected dummy.StructureName
      EndProcedure
      Procedure ___addr_#StructureName()
      !MOV eax, dword s_#StructureName
      ProcedureReturn
    EndProcedure
  EndMacro

CompilerElse
  ; X64 Processor
  Macro EndStruct(StructureName) ; <- name of structure allways lowercase
    EndStructure
      Procedure ___dummy_#StructureName()
        Protected dummy.StructureName
      EndProcedure
      Procedure ___addr_#StructureName()
        !MOV rax, qword s_#StructureName
        ProcedureReturn
      EndProcedure
  EndMacro

CompilerEndIf
    
Macro GetStruct(StructureName)
  ___addr_#StructureName()
EndMacro

; ***************************************************************************************

; Recursive function
Procedure SubCopyStructure(*Scoure, *Desk, StructAdress, Offset)
  
  Protected adress, loop, ofs, size, subStruct, count, *s1.string , *s2.string
  Repeat
    adress = PeekI(StructAdress)
    If adress = -1
      Break
    EndIf
    If adress = -2
      loop = PeekI(StructAdress+SizeOf(adress)) -1
      ofs = PeekI(StructAdress+SizeOf(adress)*2)
      size = PeekI(StructAdress+SizeOf(adress)*3)
      subStruct = PeekI(StructAdress+SizeOf(adress)*4)
      For count = 0 To loop
        SubCopyStructure(*Scoure, *Desk, subStruct, ofs +(count*size))
      Next
      StructAdress + SizeOf(adress)*5
    Else
      *s1 = *Scoure + adress + Offset
      *s2 = *Desk + adress + Offset
      PokeI(*s2, 0)
      *s2\s = *s1\s
      StructAdress + SizeOf(adress)
    EndIf
  ForEver

EndProcedure

; Main function
Procedure CopyStructure(*Scoure, *Desk, Size, StructAdress)
  
  CopyMemory(*Scoure, *Desk, Size)
  SubCopyStructure(*Scoure, *Desk, StructAdress, 0)
  
EndProcedure 

; ***************************************************************************************

; Recursive function
Procedure SubListStructureStrings(*Scoure, List List.i(), StructAdress, Offset)
  
  Protected adress, loop, ofs, size, subStruct, count, *s1.string , *s2.string
  Repeat
    adress = PeekI(StructAdress)
    If adress = -1
      Break
    EndIf
    If adress = -2
      loop = PeekI(StructAdress+SizeOf(adress)) -1
      ofs = PeekI(StructAdress+SizeOf(adress)*2)
      size = PeekI(StructAdress+SizeOf(adress)*3)
      subStruct = PeekI(StructAdress+SizeOf(adress)*4)
      For count = 0 To loop
        SubListStructureStrings(*Scoure, List(), subStruct, ofs +(count*size))
      Next
      StructAdress + SizeOf(adress)*5
    Else
      AddElement(List())
      List() = *Scoure + adress + Offset
      StructAdress + SizeOf(adress)
    EndIf
  ForEver

EndProcedure

; Function Get Strings
Procedure.s GetStructureStrings(*Scoure, StructAdress, Separator.s = ";")
  
  Protected NewList List.i()
  Protected *s1.string, result.s
  
  SubListStructureStrings(*Scoure, List(), StructAdress, 0)
  ForEach List()
    *s1 = List()
    result + *s1\s + Separator
  Next
  ProcedureReturn result

EndProcedure

; Function Set Strings
Procedure SetStructureStrings(*Scoure, StructAdress, Strings.s, Separator.s = ";")
  
  Protected NewList List.i()
  Protected *s1.string, count
  
  SubListStructureStrings(*Scoure, List(), StructAdress, 0)
  count = 1
  ForEach List()
    *s1 = List()
    *s1\s = StringField(Strings, count, Separator)
    count + 1
  Next
  
EndProcedure 

; Function Clear Strings
Procedure ClearStructureStrings(*Scoure, StructAdress)
  
  Protected NewList List.i()
  Protected *s1.string, count
  
  SubListStructureStrings(*Scoure, List(), StructAdress, 0)
  count = 1
  ForEach List()
    *s1 = List()
    *s1\s = ""
    count + 1
  Next
  
EndProcedure 

; ***************************************************************************************

Procedure FreeStructureMemory(*PointerToStructure, StructAdress)
  
  ClearStructureStrings(*PointerToStructure, StructAdress)
  FreeMemory(*PointerToStructure)
EndProcedure

; ***************************************************************************************

;- Test structure
Structure soso
  s1.s
  s2.s
EndStructure

Structure udttest
  w1.w
  w2.w
  l1.l
  l2.l
  s1.s
  s2.s
  d1.d
  d2.d
  s3.soso[2]
EndStruct(udttest) ; <- NEU : Erstellt eine Hilfsfuntion , Strukturname immer klein schreiben


; Test

Global quell.udttest
Global ziel.udttest

With quell
  \s1 = "Hallo Welt"
  \s2 = "Daten 1"
  \s3[0]\s1 = ";)"
  \s3[1]\s2 = ":wink:"
EndWith

Debug "Quelldaten"
With quell
  Debug \s1
  Debug \s2
  Debug \s3[0]\s1
  Debug \s3[1]\s2
EndWith
Debug "-------------------"

CopyStructure(quell, ziel, SizeOf(udttest), GetStruct(udtTest))

Debug "Zieldaten"
With ziel
  Debug \s1
  Debug \s2
  Debug \s3[0]\s1
  Debug \s3[1]\s2
EndWith
Debug "-------------------"

With quell
  \s1 = "Hallo Welt"
  \s2 = "Quelldaten geändert"
  \s3[0]\s1 = ";) ---"
  \s3[1]\s2 = ":evil:"
EndWith

With ziel
  \s1 = "Hallo Welt"
  \s2 = "Zieldaten geändert"
  \s3[0]\s1 = ";) ***"
  \s3[1]\s2 = ":allright:"
EndWith

Debug "Quelldaten neu"
With quell
  Debug \s1
  Debug \s2
  Debug \s3[0]\s1
  Debug \s3[1]\s2
EndWith
Debug "-------------------"

Debug "Zieldaten neu"
With ziel
  Debug \s1
  Debug \s2
  Debug \s3[0]\s1
  Debug \s3[1]\s2
EndWith
Debug "-------------------"

Debug "Get all strings"
temp.s = GetStructureStrings(quell, GetStruct(udtTest), #TAB$)
Debug temp
Debug "Upercase all strings"
temp.s = UCase(temp)
SetStructureStrings(quell, GetStruct(udtTest), temp, #TAB$)
Debug GetStructureStrings(quell, GetStruct(udtTest), #TAB$)
Debug "Delete all strings"
ClearStructureStrings(quell, GetStruct(udtTest))
Debug GetStructureStrings(quell, GetStruct(udtTest), #TAB$)
Debug "-------------------"
Debug "Free structure memory"
*mem.udttest = AllocateMemory(SizeOf(udttest))
FreeStructureMemory(*mem, GetStruct(udtTest))
Please testing for bugs.

FF :allright:

P.S.
New funtions
- GetStructureStrings(...)
- SetStructureStrings(...)
- ClearStructureStrings(...)

Posted: Sat Jan 12, 2008 3:52 am
by mk-soft
Update v1.04

New Function:

FreeStructureMemory(*Scoure, StructAdress)

With FreeMemory and structures generated memory leaks because FreeMemory remove only pointers to strings.

GT :wink:

Posted: Thu Feb 07, 2008 10:05 pm
by Karbon
---------------------------
jaPBe - Compiler error
---------------------------

File : C:\Projects\something\System.pbi
Line : 1148

Can't use an ASM keyword for an affectation (Inlined ASM is activated).
---------------------------
OK
---------------------------
... on the 9th lines of SubCopyStructure() and SubListStructureStrings() at :

loop = PeekL(StructAdress+4) -1

Anywhere the var "loop" is used. It was just the var name loop, easy enough to change..

BTW - thanks for this!!!

Posted: Thu Feb 07, 2008 11:27 pm
by rsts
Very helpful. (and educational)

Many thanks for sharing this.

cheers

Posted: Thu Feb 07, 2008 11:50 pm
by srod
That is very clever mk-soft, very nice indeed! :)

Will this work cross platform?

Posted: Fri Feb 08, 2008 12:51 am
by Dare
Cunning.

Posted: Fri Feb 08, 2008 3:20 am
by rsts
Dare wrote:Cunning.
What a linguist

cheers

Posted: Fri Feb 08, 2008 3:42 am
by Dare
:lol:

What a fella!

Posted: Fri Mar 28, 2008 1:29 pm
by mk-soft
Update v1.06

Macro: better performance

GT :wink:

Posted: Mon Jun 02, 2008 2:17 pm
by Karbon
This won't compile in PB 4.2.0 with the debugger on..
Assembler error
PureBasic.asm [333237]:
MP1080
PureBasic.asm [11882] MP1080 [20]:
CALL _SYS_FreeStructureStrings@8
error: undefined symbol '_SYS_FreeStructureStrings@8'.
... because of the call to _SYS_FreeStructureStrings in the FreeStructureMemory() procedure I assume?

Posted: Mon Jun 02, 2008 6:43 pm
by mk-soft
No probleme find by me. Have you code?

Very imposible to define structures with endstruct(structname), because the dummy procedure to force pb compiler importing _SYS_FreeStructureStrings

Posted: Mon Jun 02, 2008 7:39 pm
by Karbon
I wasn't even using using the code, it was just sitting there in a source file. I commented it and the compiler error went away. I can uncomment and the compiler error comes back..

I'm using the latest PB 4.2 version.

It's no worries for me anymore, just wanted to let you know.

Posted: Sat Mar 28, 2009 2:13 pm
by mk-soft
Update v1.09
- compatible with x86 and x64

GT :wink:

Posted: Sat Mar 28, 2009 2:21 pm
by eddy
Is it cross-platform ?

Posted: Sat Mar 28, 2009 2:42 pm
by mk-soft
I think yes, just a moment... I testet now under linux.

How many to do for run Suse 11.1 under Windows 7.

Yes, is cross-platform :wink: