CopyStructure - with strings

Developed or developing a new product in PureBasic? Tell the world about it.
Post Reply
User avatar
mk-soft
Always Here
Always Here
Posts: 6209
Joined: Fri May 12, 2006 6:51 pm
Location: Germany

CopyStructure - with strings

Post 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(...)
Last edited by mk-soft on Sat Mar 28, 2009 2:14 pm, edited 4 times in total.
My Projects ThreadToGUI / OOP-BaseClass / EventDesigner V3
PB v3.30 / v5.75 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace / OneDrive
Top
User avatar
mk-soft
Always Here
Always Here
Posts: 6209
Joined: Fri May 12, 2006 6:51 pm
Location: Germany

Post 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:
My Projects ThreadToGUI / OOP-BaseClass / EventDesigner V3
PB v3.30 / v5.75 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace / OneDrive
Top
Karbon
PureBasic Expert
PureBasic Expert
Posts: 2010
Joined: Mon Jun 02, 2003 1:42 am
Location: Ashland, KY
Contact:
Contact Karbon

Post 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!!!
-Mitchell
Check out kBilling for all your billing software needs!
http://www.k-billing.com
Code Signing / Authenticode Certificates (Get rid of those Unknown Publisher warnings!)
http://codesigning.ksoftware.net
Top
rsts
Addict
Addict
Posts: 2736
Joined: Wed Aug 24, 2005 8:39 am
Location: Southwest OH - USA

Post by rsts »

Very helpful. (and educational)

Many thanks for sharing this.

cheers
Top
srod
PureBasic Expert
PureBasic Expert
Posts: 10589
Joined: Wed Oct 29, 2003 4:35 pm
Location: Beyond the pale...

Post by srod »

That is very clever mk-soft, very nice indeed! :)

Will this work cross platform?
I may look like a mule, but I'm not a complete ass.
Top
Dare
Addict
Addict
Posts: 1965
Joined: Mon May 29, 2006 1:01 am
Location: Outback

Post by Dare »

Cunning.
Dare2 cut down to size
Top
rsts
Addict
Addict
Posts: 2736
Joined: Wed Aug 24, 2005 8:39 am
Location: Southwest OH - USA

Post by rsts »

Dare wrote:Cunning.
What a linguist

cheers
Top
Dare
Addict
Addict
Posts: 1965
Joined: Mon May 29, 2006 1:01 am
Location: Outback

Post by Dare »

:lol:

What a fella!
Dare2 cut down to size
Top
User avatar
mk-soft
Always Here
Always Here
Posts: 6209
Joined: Fri May 12, 2006 6:51 pm
Location: Germany

Post by mk-soft »

Update v1.06

Macro: better performance

GT :wink:
My Projects ThreadToGUI / OOP-BaseClass / EventDesigner V3
PB v3.30 / v5.75 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace / OneDrive
Top
Karbon
PureBasic Expert
PureBasic Expert
Posts: 2010
Joined: Mon Jun 02, 2003 1:42 am
Location: Ashland, KY
Contact:
Contact Karbon

Post 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?
-Mitchell
Check out kBilling for all your billing software needs!
http://www.k-billing.com
Code Signing / Authenticode Certificates (Get rid of those Unknown Publisher warnings!)
http://codesigning.ksoftware.net
Top
User avatar
mk-soft
Always Here
Always Here
Posts: 6209
Joined: Fri May 12, 2006 6:51 pm
Location: Germany

Post 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
My Projects ThreadToGUI / OOP-BaseClass / EventDesigner V3
PB v3.30 / v5.75 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace / OneDrive
Top
Karbon
PureBasic Expert
PureBasic Expert
Posts: 2010
Joined: Mon Jun 02, 2003 1:42 am
Location: Ashland, KY
Contact:
Contact Karbon

Post 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.
-Mitchell
Check out kBilling for all your billing software needs!
http://www.k-billing.com
Code Signing / Authenticode Certificates (Get rid of those Unknown Publisher warnings!)
http://codesigning.ksoftware.net
Top
User avatar
mk-soft
Always Here
Always Here
Posts: 6209
Joined: Fri May 12, 2006 6:51 pm
Location: Germany

Post by mk-soft »

Update v1.09
- compatible with x86 and x64

GT :wink:
My Projects ThreadToGUI / OOP-BaseClass / EventDesigner V3
PB v3.30 / v5.75 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace / OneDrive
Top
User avatar
eddy
Addict
Addict
Posts: 1479
Joined: Mon May 26, 2003 3:07 pm
Location: Nantes

Post by eddy »

Is it cross-platform ?
Imagewin10 x64 5.72 | IDE | PB plugin | Tools | Sprite | JSON | visual tool
Top
User avatar
mk-soft
Always Here
Always Here
Posts: 6209
Joined: Fri May 12, 2006 6:51 pm
Location: Germany

Post 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:
My Projects ThreadToGUI / OOP-BaseClass / EventDesigner V3
PB v3.30 / v5.75 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace / OneDrive
Top
Post Reply

Return to “Announcement”