CopyStructure - with strings
Posted: Fri Jan 11, 2008 1:40 am
				
				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.
Please testing for bugs.
FF :allright:
P.S.
New funtions
- GetStructureStrings(...)
- SetStructureStrings(...)
- ClearStructureStrings(...)
			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))
FF :allright:
P.S.
New funtions
- GetStructureStrings(...)
- SetStructureStrings(...)
- ClearStructureStrings(...)