PureBoard

Das deutsche PureBasic-Forum
https://www.purebasic.fr/german/

Write-, ReadStructure (3. Update)

https://www.purebasic.fr/german/viewtopic.php?t=11492

Seite 1 von 6

Write-, ReadStructure (3. Update)

Verfasst: 05.01.2007 15:17
von NicTheQuick
Hallo Leute,

ich habe hier mal wieder meine altbewährten Funktionen zum Schreiben und
Lesen von strukturierten Variablen in und aus einer Datei und zum Kopieren
einer strukturierten Variablen in eine andere ausgepackt und erneuert.

///Edit 1:
+ Funktionen etwas verkürzt.

///Edit 2:
+ Vielleicht etwas schneller
+ WriteSizeStructure() zum Ermitteln der Bytes, die bei WriteStructure() geschrieben werden

///Edit 3:
+ Vereinfachung für Strukturen mit statischen Arrays (s. Beispiel)

///Edit 4:
+ Ascii, Unicode und Integer hinzugefügt
+ CopyStructure() entfernt, da es das jetzt nativ gibt
+ Funktioniert erst ab der nächsten Beta

///Edit 5:
+ Jetzt geht es auch mit der aktuellen Beta

///Edit 6:
+ Proceduren geben nun einen Integer zurück (Danke ts-soft)
+ Beispiele sind kompatibel zu Windows und Linux (Danke ts-soft)

///Edit 7:
+ Code verkürzt
+ Code schneller gemacht

Der folgende Code funktioniert mit PB V4.50 beta 3 unter Linux und Windows.

Code: Alles auswählen

Structure test1
	id.l
	Name.s
	points.f[10]  ;<-----------
EndStructure         ;        |
Structure Strukt     ;        |
	Byte.b           ;        |
	word.w           ;        |
	Long.l           ;        |
	Quad.q           ;        |
	String1.s        ;        |
	Float.f          ;        |
	test1.test1[5]   ;<----   |
	String2.s        ;    |   |
	Double.d         ;    |   |
EndStructure         ;    |   |
Global Struc_Strukt.s    ;|   |
Struc_Strukt =    "bwlqsf[5ls[10f]]sd" ; Die Struktur selbst in einem String

Structure AllTypes
	StructureUnion
		b.b : c.c : w.w : l.l : f.f : d.d : q.q : a.a : u.u : i.i
	EndStructureUnion
EndStructure
Procedure.i WriteSizeStructure(*Var.AllTypes, *Struc.Character, *extralength.Integer = 0)
	Protected length.l = 0, mode.l = 0, c.l, *Start, alllength.l = 0, strlength.i
	
	While *Struc\c And (*Struc\c <> ']' Or mode)
		If mode = 0
			If *Struc\c = 's'
				*Var + length
				alllength + length + SizeOf(String)
				If *extralength
					*extralength\i + Len(PeekS(*Var\i))
				Else
					strlength + Len(PeekS(*Var\i))
				EndIf
				*Var + SizeOf(String)
				length = 0
			ElseIf *Struc\c = '['
				*Var + length
				alllength + length
				*Start = *Struc
				mode = 1
				c = 0
				length = 0
			Else
				length + PeekA(?WriteReadStructure + *Struc\c - 'a')
			EndIf
		Else
			Select *Struc\c
				Case '[' : mode + 1 ;weitere Verschachtelungen ignorieren
				Case ']' : mode - 1
				Default
					If *Struc\c >= '0' And *Struc\c <= '9' And mode = 1
						c * 10 + *Struc\c - '0'
						*Start + SizeOf(Character)
					EndIf
			EndSelect
			If mode = 0 ;Wenn Ende der Verschachtelung gefunden
				While c
					length = WriteSizeStructure(*Var, *Start + SizeOf(Character), @strlength)
					alllength + length
					*Var + length
					c - 1
				Wend
				length = 0
			EndIf
		EndIf
		*Struc + SizeOf(Character)
	Wend
	ProcedureReturn alllength + length + strlength
EndProcedure
Procedure.i WriteStructure(FileID, *Var.AllTypes, *Struc.Character)
	Protected length.l = 0, mode.l = 0, c.l, *Start, alllength.l = 0
	
	While *Struc\c And (*Struc\c <> ']' Or mode)
		If mode = 0
			If *Struc\c = 's'
				If length : WriteData(FileID, *Var, length) : *Var + length : alllength + length : EndIf
				length = StringByteLength(PeekS(*Var\i))
				WriteInteger(FileID, length)
				If length : WriteData(FileID, *Var\i, length) : EndIf
				alllength + SizeOf(Integer)
				*Var + SizeOf(Integer)
				length = 0
			ElseIf *Struc\c = '['
				If length : WriteData(FileID, *Var, length) : *Var + length : alllength + length : EndIf
				*Start = *Struc
				mode = 1
				c = 0
				length = 0
			Else
				length + PeekA(?WriteReadStructure + *Struc\c - 'a')
			EndIf
		Else
			Select *Struc\c
				Case '[' : mode + 1 ;weitere Verschachtelungen ignorieren
				Case ']' : mode - 1
				Default
					If *Struc\c >= '0' And *Struc\c <= '9' And mode = 1
						c * 10 + *Struc\c - '0'
						*Start + SizeOf(Character)
					EndIf
			EndSelect
			If mode = 0 ;Wenn Ende der Verschachtelung gefunden
				While c
					length = WriteStructure(FileID, *Var, *Start + SizeOf(Character))
					alllength + length
					*Var + length
					c - 1
				Wend
				length = 0
			EndIf
		EndIf
		*Struc + SizeOf(Character)
	Wend
	If length : WriteData(FileID, *Var, length) : EndIf
	ProcedureReturn alllength + length
EndProcedure
Procedure.i ReadStructure(FileID, *Var.AllTypes, *Struc.Character)
	Protected length.l, alllength.l, mode.l, c.l, *Start, *s.String, *mem
	
	While *Struc\c And (*Struc\c <> ']' Or mode)
		If mode = 0
			If *Struc\c = 's'
				If length : ReadData(FileID, *Var, length) : *Var + length : alllength + length : EndIf
				length = ReadInteger(FileID)
				*s = *Var
				InitializeStructure(*s, String)
				If length
					*mem = AllocateMemory(length)
					If *mem
						ReadData(FileID, *mem, length)
						*s\s = PeekS(*mem, length)
						FreeMemory(*mem)
					EndIf
				EndIf
				alllength + SizeOf(Integer)
				*Var + SizeOf(Integer)
				length = 0
			ElseIf *Struc\c = '['
				If length : ReadData(FileID, *Var, length) : *Var + length : alllength + length : EndIf
				*Start = *Struc
				mode = 1
				c = 0
				length = 0
			Else
				length + PeekA(?WriteReadStructure + *Struc\c - 'a')
			EndIf
		Else
			Select *Struc\c
				Case '[' : mode + 1
				Case ']' : mode - 1
				Default
					If *Struc\c >= '0' And *Struc\c <= '9' And mode = 1
						c * 10 + *Struc\c - '0'
						*Start + SizeOf(Character)
					EndIf
			EndSelect
			If mode = 0
				While c
					length = ReadStructure(FileID, *Var, *Start + SizeOf(Character))
					alllength + length
					*Var + length
					c - 1
				Wend
				length = 0
			EndIf
		EndIf
		*Struc + SizeOf(Character)
	Wend
	If length : ReadData(FileID, *Var, length) : EndIf
	ProcedureReturn alllength + length
EndProcedure
DataSection
	WriteReadStructure:
		Data.a SizeOf(Ascii), SizeOf(Byte), SizeOf(Character), SizeOf(Double), 0
		Data.a SizeOf(Float), 0, 0, SizeOf(Integer), 0
		Data.a 0, SizeOf(Long), 0, 0, 0
		Data.a 0, SizeOf(Quad), 0, 0, 0
		Data.a SizeOf(Unicode), 0, SizeOf(Word), 0, 0
		Data.a 0
EndDataSection

Var1.Strukt
Var1\Byte = 123
Var1\word = 23432
Var1\Long = 13579123
Var1\Quad = 2468012343344533
Var1\String1 = "Hallo du!"
Var1\Float = 1234.1234
Var1\String2 = "Ich bin NTQ!"
Var1\Double = 123456789.123456789
For a = 0 To 4
	Var1\test1[a]\id = a + 1
	Var1\test1[a]\Name = "Name: " + Str(Random(100000000))
	For b = 0 To 9
		Var1\test1[a]\points[b] = a * 100 + b + 101
	Next
Next

MessageRequester("Struktur Größe", Str(WriteSizeStructure(Var1, @Struc_Strukt)) + " Bytes")

Var2.Strukt
CopyStructure(Var1, Var2, Strukt)

MessageRequester("Kopierte Struktur", "Byte: " + Str(Var2\Byte) + Chr(13) + "Word: " + Str(Var2\word) + Chr(13) + "Long: " + Str(Var2\Long) + Chr(13) + "Quad: " + Str(Var2\Quad) + Chr(13) + "String1: " + Var2\String1 + Chr(13) + "Float: " + Str(Var2\Float) + Chr(13) + "String2: " + Var2\String2 + Chr(13) + "Double: " + StrD(Var2\Double))
For a = 0 To 4
	Debug Var2\test1[a]\id
	Debug Var2\test1[a]\Name
	For b = 0 To 9
		Debug Var2\test1[a]\points[b]
	Next
Next

Debug GetCurrentDirectory()
If CreateFile(0, ".\test_structure.txt")
	WriteStructure(0, Var1, @Struc_Strukt)
	CloseFile(0)
	CompilerSelect #PB_Compiler_OS
		CompilerCase #PB_OS_Linux
			If FileSize("/usr/bin/bless") >= 0
				RunProgram("bless", ".\test_structure.txt", "./", #PB_Program_Wait)
			Else
				MessageRequester("Warnung!", "Hexeditor 'bless' wurde nicht gefunden.")
			EndIf
		CompilerCase #PB_OS_Windows
			RunProgram(".\test_structure.txt", "", "./", #PB_Program_Wait)
	CompilerEndSelect
EndIf

If ReadFile(0, ".\test_structure.txt")
	Var3.Strukt
	ReadStructure(0, Var3, @Struc_Strukt)
	CloseFile(0)
	MessageRequester("Ausgelesene Struktur", "Byte: " + Str(Var3\Byte) + Chr(13) + "Word: " + Str(Var3\word) + Chr(13) + "Long: " + Str(Var3\Long) + Chr(13) + "Quad: " + Str(Var3\Quad) + Chr(13) + "String1: " + Var3\String1 + Chr(13) + "Float: " + Str(Var3\Float) + Chr(13) + "String2: " + Var3\String2 + Chr(13) + "Double: " + StrD(Var3\Double))
	For a = 0 To 4
		Debug Var3\test1[a]\id
		Debug Var3\test1[a]\Name
		For b = 0 To 9
			Debug Var3\test1[a]\points[b]
		Next
	Next
EndIf

Verfasst: 11.01.2007 22:49
von Hyper
Hallo Nic,

mit diesem Tipp hast Du mir damals schon sehr geholfen. Ich verwende es, um strukturierte Listen aus einem File zu lesen und wieder hineinzuspeichern. Ist auch eine super Sache!

Es ist nur schade, dass es bei größeren Dateien ziemlich lange dauert. Wahrscheinlich, da das Programm ja nun je Einzelfeld ReadData() macht. Könnte man das auch noch irgendwie verallgemeinert mit AllocateMemory o.ä.? Das Pinzip bei mir ist:

Code: Alles auswählen

; Speichern (Lesen ist umgekehrt)
; --------------------------------------

; (File öffen)

; Liste 1 auf Datei speichern
ForEach Liste1()
  WriteStructure(#File, @Liste1(), @Struc1)
Next  

; String1
  WriteStringN(#File, String)  

; Liste 2 auf Datei speichern
ForEach Liste2()
  WriteStructure(#File, @Liste2(), @Struc2)
Next  

; Byte1
WriteByte(#File, Wert)

; ....weiteres

; (File schließen)

Verfasst: 12.01.2007 10:35
von NicTheQuick
Ich hab die Procedures etwas abgeändert und noch eine neue hinzugefügt.
Ein Beispiel ist dabei.

Du kannst ja mal testen, ob es jetzt schneller geht.

Wenn es nicht schnell genug geht, dann liegt es eher an deinem
Festplattencache oder allgemein an deinem Datenträger, auf den du
schreibst.

Verfasst: 12.01.2007 14:16
von jear
Die Prozeduren WriteDataStructure() und ReadDataStructure() nach der Methode von NTQ als Include. Die beiden Testprogramme dazu zeigen auch die Anwendung mit Arrays und LinkedLists.

StoreStructuresWithStrings.zip (3KB)

@Hyper
Die von NTQ angewandte Methode bedingt, dass die einzelnen Felder einer Struktur nacheinander abgearbeitet und geschrieben/gelesen werden. Nur so ist es ja möglich, auch Stringfelder direkt mit abzuspeichern.
Strings sind ja in der Struktur tatsächlich nur als Pointer abgelegt. Die Inhalte der Strings stehen in einem besonderen Speicherbereich einer Anwendung. Sie müssen also von dort geholt und beim Lesen wieder dort hingeschrieben werden, was die Routinen sauber und schnell erledigen.
In meiner Version habe ich versucht, noch minimale Geschwindigkeitsvorteile herauszukitzeln. Du kannst ja mal ausprobieren, ob dem so ist.

Verfasst: 12.01.2007 19:21
von Hyper
Ja, wie es funktioniert ist schon klar. Ich verwende genau das Prinzip von NTQ in einer Anwendung bei uns in der Firma. Damit liest man über Netzwerk ca. 2 MB große Files, die hauptsächlich aus strukturierten Listen bestehen. Leider dauert das Öffnen deutlich länger, als bspw. MS Word braucht, um eine 2MB-Datei zu öffnen. Das ärgert mich halt.

Ich kuck mir das neue Coding dann an - Danke vorweg...

Verfasst: 29.01.2007 04:32
von PMV
Da will ich den alten Thread mal ausgraben :mrgreen:
ok ... so alt isser auch nicht :lol:

Da ich grad vor dem selben Problem stand, hilft der obige Code schon
mal sehr. ... die einzigste Möglichkeit, allgemeingültig Strukturen in PB
schnell zu kopieren /:->

Da ich auch einen Vergleich von Strukturen brauche, hab ich die Kopier-
Prozedur etwas umgeschrieben. Für alle, die zu faul sind das selber zu
machen und demnächst vor dem selben Problem stehen wie ich:

Code: Alles auswählen

Procedure CompareStructure(*Var1.AllTypes, *Var2.AllTypes, *Struc.Character)
  While *Struc\c 
    Select *Struc\c 
      Case 'b' 
        If *Var2\b <> *Var1\b : ProcedureReturn #False : EndIf 
        *Var1 + SizeOf(Byte) : *Var2 + SizeOf(Byte) 
      Case 'c' 
        If *Var2\c <> *Var1\c : ProcedureReturn #False : EndIf
        *Var1 + SizeOf(Character) : *Var2 + SizeOf(Character) 
      Case 'w'
        If *Var2\w <> *Var1\w : ProcedureReturn #False : EndIf
        *Var1 + SizeOf(Word) : *Var2 + SizeOf(Word) 
      Case 'l' 
        If *Var2\l <> *Var1\l : ProcedureReturn #False : EndIf
        *Var1 + SizeOf(Long) : *Var2 + SizeOf(Long) 
      Case 'f' 
        If *Var2\f <> *Var1\f : ProcedureReturn #False : EndIf
        *Var1 + SizeOf(Float) : *Var2 + SizeOf(Float) 
      Case 'd' 
        If *Var2\d <> *Var1\d : ProcedureReturn #False : EndIf
        *Var1 + SizeOf(Double) : *Var2 + SizeOf(Double) 
      Case 'q' 
        If *Var2\q <> *Var1\q : ProcedureReturn #False : EndIf
        *Var1 + SizeOf(Quad) : *Var2 + SizeOf(Quad) 
      Case 's' 
        If *Var2\s <> *Var1\s : ProcedureReturn #False : EndIf
        *Var1 + SizeOf(String) : *Var2 + SizeOf(String) 
    EndSelect 
    *Struc + SizeOf(Character) 
  Wend 
  ProcedureReturn #True
EndProcedure
MFG PMV

Verfasst: 11.06.2007 19:41
von STARGÅTE
ich habe mal n frage zu dem CODE.

Vorab erst mal danke, er ist sehr nützich.

Nun zur Frage :

Wie muss man mit Array in der Structure umgehen ?
Structure Waffe
 Art.b
 Zeit.l
EndStructure
Structure T
 x.l
 y.l
 w.f
 Waffe.Waffe[4]
EndStructure

Struc_T.s = "llfblblblblbl"
Müsste man da dann als Struc_T.s = "llfblblblblbl" angeben ? also je nach größe das Arrays und Art die menge an Zeichen ?
Und geht das auch wenn Felder im Array nicht gefüllt sind ? also Lücken drin sind ?

Verfasst: 11.06.2007 21:11
von Fluid Byte
Ich weiss nicht ganz genau was du meinst aber hilft das?

Code: Alles auswählen

Structure Waffe
	Art.b
	Zeit.l[4]
EndStructure

Structure T
	x.l
	y.l
	w.f
	Waffe.Waffe[4]
EndStructure

New_T.T
New_T\x = 120
New_T\y = 250
New_T\w = 30

New_T\Waffe[0]\Art = 1
New_T\Waffe[0]\Zeit[0] = 10
New_T\Waffe[0]\Zeit[1] = 20
New_T\Waffe[0]\Zeit[2] = 30
New_T\Waffe[0]\Zeit[3] = 40

New_T\Waffe[1]\Art = 2
New_T\Waffe[1]\Zeit[0] = 80
New_T\Waffe[1]\Zeit[1] = 150
; ......

Verfasst: 11.06.2007 22:05
von STARGÅTE
nein.

das ist mir ja klar,

es ging ja um die Proceduren von NicTheQuick

WriteStructure()

dort muss man die Structure als String angeben, und ob das dann mit Arrays in der Structure geht ...

Habe oben die Structure etwas geändert, hatte n fehler drin

Verfasst: 12.06.2007 00:10
von jear
@STARGÅTE

Eriwansche Antwort: Im Prinzip ja!

Code: Alles auswählen

Struc_T.s = "llf bl bl bl bl bl"

Code: Alles auswählen

Waffe.Waffe[4]
Waffe.Waffe[4] hat aber nur 4 Mitglieder (0 - 3)! 5 mal "bl" muss also schief gehen!
Alle Zeiten sind UTC+02:00
Seite 1 von 6

Powered by phpBB® Forum Software © phpBB Limited

Deutsche Übersetzung durch phpBB.de