Menü

Mail Listen Archiv | Code Startseite | Anzeige aller Code Fragmente

4D Code Library

4D Support Center - 4D Code Beispiel zum Thema:

Generischer XML Export/Import

Erfaßt von: Thomas Maul am 18.01.2007 ; -
Letzte Änderung: 18.04.2007

Kurzbeschriebung:

Update für Tech Note 06/07 This Tech Note introduces a generic single 4D method which exports or imports a whole database in XML format, including pictures, blob and subtables. ;;

Beschreibung

This Tech Note introduces a generic single 4D method which exports or imports a whole database in XML format, including pictures, blob and subtables.

A full text export/import is useful for long time archiving and to repair damaged data files. Exporting all data in text only mode and re-importing into a new created data file guarantees a clean data and indexes. Beside it produces a perfectly defragmented data file, which increases sequential access.

The sequence number for each table is automatically restored.

All code is in a single method, this allows easy installation (copy&paste) into existing structures.

Copy the code below into a method named “ExportImport” . The name must be exactly “ExportImport”, if you want to use another name you need to edit the method.

Compile or Syntax Check to make sure the method is correctly inserted.

The method can be directly executed from User mode. If called without any parameter; it will open a window to ask if to export or import. Then it will request to select an export/import folder.

During the export it creates for each table one file. Even 4D can handle on Windows XP files larger than 2 GB, it may produces problems on Mac OS, so it automatically segments the files and starts additional files at 1.5 GB. The file is in XML format, pictures and blob fields are encoded as Base64.

Note for import:
The routine automatically deletes existing records and then start the import. It is supposed to be used in an empty (new created) data file.
Existing indexes are removed before importing and then recreated. This improves the import speed and helps to have records and index pages defragmented.  
The sequence number is automatically restored.

Two parameters allows to integrate the method in your own user interface:

Result := ExportImport(direction; path)

Parameter	Type	Description
Direction	String	Import or Export
Path	String	path to export/import folder

Example:
$result := ExportImport ("Export";"C:\\myxmlfolder")
$result := ExportImport ("Import";"C:\\myxmlfolder")

Beschreibung ändern (nur für Autor - Kennwort geschützt) Keine Beschreibung für Generischer XML Export/Import

4D Code Beispiel

If (False)
	  ` Generic Export/Import of whole database as XML files
	  ` handles automatically all field types, including blobs or subtables
	  ` command must be called BEFORE Set Field Titles is used - else only fields from that list, specially for subtables, are used...
	
	  `call it as:
	  ` ALERT(ExportImport ("Import";""))
	  ` or
	  ` ALERT(ExportImport ("Import";"C:\\myxmlfolder"))
	  ` or similar to export:
	  ` ALERT(ExportImport ("Export";""))
	
	  ` IMPORTANT: 
	  ` A) Logfile:
	  `  specially for large databases you should disable 4D's logfile (for backup integration)
	  ` before you start importing. Else all operations are written to the logfile, which makes import slower
	  ` if you include this method for your customer into your application, you can check using the command Log File if a log file is used.
	  ` don't forget to alert the user to enable the logfile (run a full backup + create logfile) after reimport is completed!
	
	  ` b) Trigger:
	  ` if you are using Triggers to modify the content on saving a record (like time stamp or counter)
	  ` you must disable them during the import
	  ` this can be done by temporarly modifying your source code or by using a variable as a flag
	
	  ` c) subtables:
	  `  a subtable field must not have the same name than the subtable itself!
	
	  `  XML documents are named with the table name, field names are used for XML Tags
	  ` invalid character in table/field names are replaced by "_", also leading numbers (like [table]3field)
	  ` this may lead to non unique field names. To avoid that it is possible to use table/field numbers as identifiers
	  ` to enable that call the routine like:
	  `  ALERT(ExportImport ("Import";"C:\\myxmlfolder";->OK;1))  ` use 0 for names, 1 for numbers - similar for Export
	  `  parameter 3 is an unused pointer to any existing variable, you may use the system variable OK
	  ` note: using table/field names allow a reorganization of the structure. A new build structure with different table/field order
	  ` can be used to reimport, because field names are used as identifiers. 
	  ` even XML Files can be on XP larger than 2 GB this produces problems on Mac OS X, so created xml files are segmented to stay smaller than 2 GB
	
	  ` copy into Compiler_xxx method to allow compilations with all variables are typed:
	  `C_TEXT(ExportImport ;$0;$1;$2)
	  `C_POINTER(ExportImport ;$3)
	  `C_LONGINT(ExportImport ;$4)
	  `C_BOOLEAN(EXPORTIMPORT_STOP)  ` this is the only project variable, to allow an external stop through a dialog/Even call
	
	  ` written by Thomas Maul, 4D Germany, January 2006. to be used with 4D 2004.3 or newer
	  ` note: it can be used starting with 2004.1, but large databases (SAX commands) can lead to a memory leak, fixed in 2004.3.
	  `  history:
	  `  2006-03-06: text fields may be after conversation > 32k,  now use blobs to read/write text fields
	  `  2007-01-18: errors with Subfields found /corrected by Peter Grün, thanks
          ` 2007-03-07: changed encoding to UTF-8, was ISO-8859-1, to keep some MacRoman chars
	
	  ` $result:=exportimport("job";$textpara;$blobparapointer;$longintpara)
End if

C_TEXT($0;$1;$2;$result;$job;$textpara)
C_POINTER($3;$blobpara)  ` mulitpurpose parameter, also used for pointer on field
C_LONGINT($4;$longintpara)

C_BOOLEAN(ExportImport_Stop)  ` this is the only global variable

C_BLOB($internalrecord;$SaveIndex;$blob)
C_TIME($ref)
C_LONGINT($tablenr;$fieldnr;$tableID;$length;$reccounter;$vlchar;$newseqnumber;$loop;$loopfields;$subloop)
C_LONGINT($pos;$pos2;$index;$i;$fieldlength;$vlsystem;$fieldtyp;$vlascii;$total;$vlplatform;$vlmachine)
C_LONGINT($findpos;$myevent;$subtablefield;$tablecount;$count;$maxloop;$table;$xmllevel;$segment)
C_PICTURE($pict;$pictvariable)
C_POINTER($tableptr;$tbl;$subfieldptr;$field;$fieldptr;$Table_Pointer)
C_TEXT($result2;$name;$Filename;$vname;$vprefix;$t;$t2;$vschar;$value;$dummytext;$message;$dirsymbol)
C_TEXT($subtablename;$return)
C_STRING(2;$directory)
C_BOOLEAN($isIndex;$readwrite)

C_LONGINT($MaxExportSize)
$MaxExportSize:=1500*1024*1024  ` size in Megabyte - used to segment created XML files

If (Count parameters<1)  ` usefull for testing in user mode
	CONFIRM("Export or Import?\nWARNING: Import deletes all existing records!";"Export";"Import")
	If (OK=1)
		$job:="Export"
	Else 
		$job:="Import"
	End if 
Else 
	$job:=$1
End if

$result:=""
If (Count parameters>1)
	$textpara:=$2
Else 
	$textpara:=""
End if 
If (Count parameters>2)
	$blobpara:=$3
Else 
	$blobpara:=->$internalrecord
End if 
If (Count parameters>3)
	$longintpara:=$4
Else 
	$longintpara:=0
End if

Case of 
	: ($job="Export")  `  **********************************  EXPORT ***********************************************
		$result:="Export successfull"
		If ($textpara="")
			$textpara:=Select folder("Select Targetfolder")
		End if 
		If ($textpara#"")
			$dirSymbol:=ExportImport ("DirSymbol")
			If ($textpara=("@"+$dirSymbol))
				$textpara:=Substring($textpara;1;Length($textpara)-1)
			End if 
			$ref:=Test path name($textpara)
			If ($ref=0)
				ExportImport_Stop:=False
				$tablecount:=Count tables
				For ($i;1;$tablecount)
					If (Not(ExportImport_Stop))
						If ($longintpara=1)
							$name:="Table_"+String($i)
						Else 
							$name:=ExportImport ("ReplaceChar";Table name($i);$blobpara;1)
						End if 
						$segment:=1
						$filename:=$textpara+$dirSymbol+$name+".xml"
						If (Test path name($filename)>0)
							DELETE DOCUMENT($filename)
						End if 
						$ref:=Create document($filename)
						$tbl:=Table($i)
						SAX SET XML OPTIONS($ref;"UTF-8";True)
						$NewSeqNumber:=Get database parameter($tbl->;Table Sequence Number )
						SAX OPEN XML ELEMENT($ref;"Table_"+$name;"Sequenceno";String($NewSeqNumber);"Total";String(Records in table($tbl->)))
						$readWrite:=Read only state($tbl->)
						READ ONLY($tbl->)
						ALL RECORDS($tbl->)
						$maxloop:=Records in selection($tbl->)
						For ($loop;1;$maxloop)
							If (($loop%100)=1)
								$message:=Table name($i)+" ("+String($i)+"/"+String($tablecount)+")"+": "+String($loop)+" / "+String($maxloop)
								ExportImport ("Message";$message)
								If (Get document position($ref)>$MaxExportSize)  `  create a new segment
									$segment:=$segment+1
									CLOSE DOCUMENT($ref)
									$filename:=$textpara+$dirSymbol+$name+"-"+String($segment)+".xml"
									If (Test path name($filename)>0)
										DELETE DOCUMENT($filename)
									End if 
									$ref:=Create document($filename)
									$tbl:=Table($i)
									SAX SET XML OPTIONS($ref;"UTF-8";True)
									SAX OPEN XML ELEMENT($ref;"Table_"+$name;"Total";String(Records in table($tbl->)))
								End if 
							End if 
							SAX OPEN XML ELEMENT($ref;"T_"+$name)
							  ` now loop through all fields
							For ($loopfields;1;Count fields($tbl))
								$fieldptr:=Field($i;$loopfields)
								If ($longintpara=1)
									$vname:="F_"+String($loopfields)
									$result2:=ExportImport ("ExportField";$vname;$fieldptr;$ref+0)
								Else 
									$result2:=ExportImport ("ExportField";"";$fieldptr;$ref+0)
								End if 
								If ($result2#"")
									ExportImport_Stop:=True
									$result:=$result2
								End if 
								If (ExportImport_Stop)
									$loopfields:=Count fields($tbl)+1
								End if 
							End for 
							SAX CLOSE XML ELEMENT($ref)
							If (Process aborted)
								ExportImport_Stop:=True
							End if 
							If (ExportImport_Stop)
								$loop:=$maxloop+1
							End if 
							NEXT RECORD($tbl->)
						End for 
						SAX CLOSE XML ELEMENT($ref)
						REDUCE SELECTION($tbl->;0)
						If (Not($readWrite))
							READ WRITE($tbl->)
						End if 
						CLOSE DOCUMENT($ref)
					End if 
					If (ExportImport_Stop)
						$i:=Count tables+1
					End if 
				End for 
			Else 
				$result:="ExportImport: Wrong call -Target path for export is not a valid path to a folder"
			End if 
		End if 
		
		
	: ($job="Import")  `  **********************************  IMPORT ***********************************************
		$result:="Import successfull"
		If ($textpara="")
			$textpara:=Select folder("Select Folder with XML Export")
		End if 
		If ($textpara#"")
			$dirSymbol:=ExportImport ("DirSymbol")
			If ($textpara=("@"+$dirSymbol))
				$textpara:=Substring($textpara;1;Length($textpara)-1)
			End if 
			$ref:=Test path name($textpara)
			If ($ref=0)
				ExportImport_Stop:=False
				For ($table;1;Count tables)
					If (Not(ExportImport_Stop))
						If ($longintpara=1)
							$name:="Table_"+String($i)
						Else 
							$name:=ExportImport ("ReplaceChar";Table name($table);$blobpara;1)
						End if 
						$filename:=$textpara+$dirSymbol+$name+".xml"
						If (Test path name($filename)=1)
							SET BLOB SIZE($SaveIndex;0)
							ExportImport ("GetAllIndex";"";->$SaveIndex;$table)
							ExportImport ("SetIndex";"Clear";->$SaveIndex;$table)
							$Table_Pointer:=Table($table)
							$readWrite:=Read only state($Table_Pointer->)
							READ WRITE($Table_Pointer->)
							$maxloop:=Count fields($Table_Pointer)
							ARRAY STRING(32;$fieldnames;$maxloop)
							ALL RECORDS($Table_Pointer->)
							DELETE SELECTION($Table_Pointer->)
							$Reccounter:=1
							For ($loopfields;1;$maxloop)
								If ($longintpara=1)
									$fieldnames{$loopfields}:="F_"+String($loopfields)  `  2007-01-18
								Else 
									$fieldnames{$loopfields}:=ExportImport ("ReplaceChar";Field name($table;$loopfields);$blobpara;1)
								End if 
							End for 
							$xmllevel:=0
							$total:=0
							$segment:=1
							
							Repeat 
								If ($segment>1)  ` only for additional segments - large XML files
									$filename:=$textpara+$dirSymbol+$name+"-"+String($segment)+".xml"
								End if 
								If (Test path name($filename)=1)
									$ref:=Open document($filename;"TEXT";Read Mode )
									Repeat 
										$MyEvent:=SAX Get XML node($ref)
										Case of 
											: ($MyEvent=XML Start Document )
												  ` nothing?
											: ($MyEvent=XML Start Element )
												SAX GET XML ELEMENT($ref;$vName;$vPrefix;$attrName;$attrvalue)
												Case of 
													: ($xmllevel=0)  ` start of XML file, main level
														If ($vName#("table_"+$name))
															$result:="Wrong main content "+$vName+" - Table_"+$name
															ExportImport_Stop:=True
														Else 
															$xmllevel:=1
															$NewSeqNumber:=0
															$findpos:=Find in array($attrName;"Sequenceno")
															If ($findpos>0)
																$NewSeqNumber:=Num($attrvalue{$findpos})
															End if 
															$findpos:=Find in array($attrName;"Total")
															If ($findpos>0)
																$total:=Num($attrvalue{$findpos})
															End if 
														End if 
													: ($xmllevel=1)  ` start of new record, check table name
														If ($vName#("T_"+$name))
															$result:="Wrong table name "+$vName+" T_"+$name
															ExportImport_Stop:=True
														Else 
															$xmllevel:=2
															CREATE RECORD($Table_Pointer->)
															$Reccounter:=$Reccounter+1
															If (($Reccounter%100)=1)
																$message:=Table name($table)+" "+String($Reccounter)+" / "+String($total)
																ExportImport ("Message";$message)
																  `If (($Reccounter%1000)=1)  `  this slows down the import drastically for huge databases
																  `FLUSH BUFFERS  ` best to use a cache of 500 MB and let 4D handle the flushing
																  `End if 
															End if 
														End if 
														
													: ($xmllevel>=2)  ` subtable?
														If ($vName="Sub_@")
															$subtablename:=Substring($vName;5)  ` remove "Sub_"
															$loopfields:=Find in array($fieldnames;$subtablename)
															If ($loopfields>0)
																  ` create array subtables ...
																$fieldptr:=Field($table;$loopfields)
																GET FIELD TITLES($fieldptr->;$subnames;$subid)
																If ($longintpara=1)  ` use field numbers
																	For ($i;1;Size of array($subnames))
																		$subnames{$i}:="Sub_"+String($i)
																	End for 
																End if 
																CREATE SUBRECORD($fieldptr->)
																$subtablefield:=$loopfields
															End if 
														End if 
														$xmllevel:=$xmllevel+1
												End case   ` $MyEvent=XML Start Element 
												
											: ($MyEvent=XML CDATA )
												If ($xmllevel=3)
													$loopfields:=Find in array($fieldnames;$vName)
													If ($loopfields>0)
														SAX GET XML CDATA($ref;$blob)
														If (OK=1)
															DECODE($blob)
															$fieldptr:=Field($table;$loopfields)
															$Fieldtyp:=Type($fieldptr->)
															Case of 
																: ($Fieldtyp=Is BLOB )
																	$fieldptr->:=$blob
																	SET BLOB SIZE($blob;0)
																: ($Fieldtyp=Is Picture )
																	BLOB TO VARIABLE($blob;$pictVariable)
																	SET BLOB SIZE($blob;0)  ` to free up memory
																	$fieldptr->:=$pictVariable
															End case 
														End if 
													End if 
												End if 
												
											: ($MyEvent=XML DATA )
												Case of 
													: ($xmllevel=3)
														  ` Name of element is already in $vName
														$loopfields:=Find in array($fieldnames;$vName)
														If ($loopfields>0)
															  ` known field, get field value and assign
															$result2:=ExportImport ("ImportField";$value;Field($table;$loopfields);$ref+0)
															If ($result2#"")
																ExportImport_Stop:=True
																$result:=$result2
															End if 
														End if 
														
													: ($xmllevel=4)  ` subtable
														  ` Name of element is already in $vName
														$loopfields:=Find in array($subnames;$vName)
														If ($loopfields>0)
															  ` known field, get field value and assign
															  `  SAX GET XML ELEMENT VALUE($ref;$value)  ` line removed, 2007-1-18
															$subfieldptr:=Field($table;$subtablefield;$subid{$loopfields})
															$result2:=ExportImport ("ImportField";$value;$subfieldptr;$ref+0)
															If ($result2#"")
																ExportImport_Stop:=True
																$result:=$result2
															End if 
														End if 
												End case 
												
											: ($MyEvent=XML End Element )
												$xmllevel:=$xmllevel-1
												Case of 
													: ($xmllevel=1)
														SAVE RECORD($Table_Pointer->)
													: ($xmllevel=0)  ` table ready
														If ($NewSeqNumber#0)
															SET DATABASE PARAMETER($Table_Pointer->;Table Sequence Number ;$NewSeqNumber)
														End if 
												End case 
										End case 
										If (Process aborted)
											ExportImport_Stop:=True
										End if 
									Until (($MyEvent=XML End Document ) | (ExportImport_Stop))
									CLOSE DOCUMENT($ref)
									$segment:=$segment+1
								Else   ` last segment used - but still data missing!
									ALERT("Import for table "+Table name($table)+"uncompleted!\n"+String($Reccounter)+" of "+String($total)+" imported.")
								End if 
							Until (($Reccounter>=$Total) | (ExportImport_Stop))
							
							REDUCE SELECTION($Table_Pointer->;0)
							ExportImport ("SetIndex";"Set";->$SaveIndex;$table)
							If (Not($readWrite))
								READ WRITE($Table_Pointer->)
							End if 
							
							If (Process aborted)
								ExportImport_Stop:=True
							End if 
							If (ExportImport_Stop)
								$loop:=$maxloop+1
							End if 
						End if 
					End if 
					If (ExportImport_Stop)
						$table:=Count tables+1  `  2007-18-1
					End if 
				End for 
			Else 
				$result:="ExportImport: Wrong call -Target path for export is not a valid path to a folder"
			End if 
		End if 
		
		
		  `  **********************************  INTERNAL CALLS - NOT FOR DIRECT USAGE ***********************************************
		
	: ($job="ImportField")  `  **********************************  ImportField ***********************************************
		$fieldptr:=$blobpara
		$ref:=?00:00:00?+$longintpara
		$Fieldtyp:=Type($fieldptr->)
		
		If ($fieldtyp=Is Text )
			SAX GET XML ELEMENT VALUE($ref;$blob)
			$textpara:=BLOB to text($blob;Text without length )
		Else 
			SAX GET XML ELEMENT VALUE($ref;$textpara)
		End if 
		
		If ($fieldtyp#Is Subtable )
			Case of 
				: ($fieldtyp=Is Alpha Field )
					GET FIELD PROPERTIES($fieldptr;$fieldtyp;$Fieldlength)
					If ($Fieldlength=0)  ` subfield, checking is not possible, as long as export is unmodified it will work perfect
						$fieldptr->:=$textpara  ` may need character conversation, depends on ACI0043259
						  `   $fieldptr->:=ExportImport ("ReplaceCharBack";$textpara;$blobpara;0)
					Else 
						$fieldptr->:=Substring($textpara;1;$Fieldlength)
						  ` may need character conversation, depends on ACI0043259
					End if 
				: ($fieldtyp=Is Text )
					  ` $fieldptr->:=ExportImport ("ReplaceCharBackBlob";"";->$blob;0) ` may need character conversation, depends on ACI0043259
					$fieldptr->:=$textpara
				: (($fieldtyp=Is Integer ) | ($fieldtyp=Is LongInt ))
					$fieldptr->:=Num($textpara)
				: ($fieldtyp=Is Real )
					If (String(1,2)="1,2")  ` system use comma, not point
						$textpara:=Replace string($textpara;".";",")
					End if 
					$fieldptr->:=Num($textpara)
				: (($fieldtyp=Is Date ))
					$fieldptr->:=Date($textpara)
				: (($fieldtyp=Is Time ))
					$fieldptr->:=Time($textpara)
				: (($fieldtyp=Is Boolean ))
					$fieldptr->:=(Num($textpara)=1)
				: (($fieldtyp=Is BLOB ) | ($fieldtyp=Is Picture ))
					If ($textpara#"")
						$result:="ExportImport: Internal Error, found Blob without CData"+Field name($fieldptr)
					End if 
			End case 
		Else   `subtable, oops
			$result:="ExportImport: Internal Error, found Subtable "+Field name($fieldptr)
		End if 
		
		
	: ($job="ExportField")  `  **********************************  ExportField ***********************************************
		$fieldptr:=$blobpara
		$ref:=?00:00:00?+$longintpara
		  ` check the type to convert the content
		  `  GET FIELD PROPERTIES($fieldptr;$Fieldtyp)
		$Fieldtyp:=Type($fieldptr->)
		If ($textpara#"")
			$name:=ExportImport ("ReplaceChar";$textpara;$blobpara;1)
		Else 
			$name:=ExportImport ("ReplaceChar";Field name($fieldptr);$blobpara;1)
		End if 
		If ($fieldtyp#Is Subtable )
			If (ExportImport ("CheckFieldEmpty";"";$fieldptr;$Fieldtyp)="0")
				SAX OPEN XML ELEMENT($ref;$name)
				Case of 
					: ($fieldtyp=Is Alpha Field )
						  ` conversation maybe not needed, depends on ACI0043259
						SAX ADD XML ELEMENT VALUE($ref;ExportImport ("ReplaceChar";$fieldptr->;$blobpara;0))
						SAX CLOSE XML ELEMENT($ref)
					: ($fieldtyp=Is Text )
						  ` conversation maybe not needed, depends on ACI0043259
						SET BLOB SIZE($blob;0)
						  ` Text may be >32k after conversation
						$dummytext:=ExportImport ("ReplaceCharBlob";$fieldptr->;->$blob;0)
						SAX ADD XML ELEMENT VALUE($ref;$blob)
						SAX CLOSE XML ELEMENT($ref)
					: ($fieldtyp=Is Real )
						$dummytext:=String($fieldptr->)
						$dummytext:=Replace string($dummytext;",";".")  ` needed if used on a system with decimal comma
						SAX ADD XML ELEMENT VALUE($ref;$dummytext)
						SAX CLOSE XML ELEMENT($ref)
					: (($fieldtyp=Is Integer ) | ($fieldtyp=Is LongInt ))
						SAX ADD XML ELEMENT VALUE($ref;String($fieldptr->))
						SAX CLOSE XML ELEMENT($ref)
					: (($fieldtyp=Is Date ))
						SAX ADD XML ELEMENT VALUE($ref;String($fieldptr->;8))  ` XML Date format
						SAX CLOSE XML ELEMENT($ref)
					: (($fieldtyp=Is Time ))
						SAX ADD XML ELEMENT VALUE($ref;String($fieldptr->;8))  ` XML Date format
						SAX CLOSE XML ELEMENT($ref)
					: (($fieldtyp=Is Boolean ))
						SAX ADD XML ELEMENT VALUE($ref;String(Num($fieldptr->)))
						SAX CLOSE XML ELEMENT($ref)
					: ($fieldtyp=Is BLOB )
						$blob:=$fieldptr->
						If (BLOB size($blob)#0)
							ENCODE($blob)
							SAX ADD XML CDATA($ref;$blob)
						End if 
						SAX CLOSE XML ELEMENT($ref)
					: ($fieldtyp=Is Picture )
						$pict:=$fieldptr->
						VARIABLE TO BLOB($pict;$blob)
						If (BLOB size($blob)#0)
							ENCODE($blob)
							SAX ADD XML CDATA($ref;$blob)
						End if 
						SAX CLOSE XML ELEMENT($ref)
					Else 
						$result:="ExportImport: Internal Error - Unkown Fieldtyp - cannot handle "+Field name($fieldptr)
				End case 
			End if 
		Else   `subtable, oops
			ALL SUBRECORDS($fieldptr->)
			ARRAY TEXT($subnames;0)
			ARRAY LONGINT($subid;0)
			GET FIELD TITLES($fieldptr->;$subnames;$subid)
			If ($textpara#"")  `  2007-01-18
				For ($i;1;Size of array($subnames))
					$subnames{$i}:="Sub_"+String($i)
				End for 
			End if 
			$tablenr:=Table($fieldptr)
			$fieldnr:=Field($fieldptr)
			While (Not(End subselection($fieldptr->)))
				SAX OPEN XML ELEMENT($ref;"Sub_"+$name)
				For ($subloop;1;Size of array($subnames))
					$subfieldptr:=Field($tablenr;$fieldnr;$subid{$subloop})
					$result:=ExportImport ("ExportField";$subnames{$subloop};$subfieldptr;$ref+0)
					If ($result#"")
						ExportImport_Stop:=True
					End if 
				End for 
				SAX CLOSE XML ELEMENT($ref)
				If (Process aborted)
					ExportImport_Stop:=True
				End if 
				If (ExportImport_Stop)
					LAST SUBRECORD($fieldptr->)
				End if 
				NEXT SUBRECORD($fieldptr->)
			End while 
		End if 
		
		
	: ($job="CheckFieldEmpty")  `  **********************************  CheckFieldEmpty ***********************************************
		$result:="0"
		$fieldtyp:=$longintpara
		$fieldptr:=$blobpara
		Case of 
			: (($fieldtyp=Is Alpha Field ) | ($fieldtyp=Is Text ))
				If ($fieldptr->="")
					$result:="1"
				End if 
			: (($fieldtyp=Is Real ) | ($fieldtyp=Is Integer ) | ($fieldtyp=Is LongInt ))
				If ($fieldptr->=0)
					$result:="1"
				End if 
			: (($fieldtyp=Is Date ))
				If ($fieldptr->=!00.00.00!)
					$result:="1"
				End if 
			: (($fieldtyp=Is Time ))
				If ($fieldptr->=?00:00:00?)
					$result:="1"
				End if 
			: (($fieldtyp=Is Boolean ))
				  ` nothing
			: ($fieldtyp=Is BLOB )
				If (BLOB size($fieldptr->)=0)
					$result:="1"
				End if 
			: ($fieldtyp=Is Picture )
				If (Picture size($fieldptr->)=0)
					$result:="1"
				End if 
		End case 
		
	: ($job="Message")  `  **********************************  Message ***********************************************
		MESSAGE($textpara)
		
	: ($job="DirSymbol")  `  **********************************  DirSymbol ***********************************************
		PLATFORM PROPERTIES($vlPlatform;$vlSystem;$vlMachine)
		If ($vlPlatform=Windows )
			$Directory:="\\"
		Else 
			$Directory:=":"
		End if 
		$result:=$Directory
		
	: ($job="ReplaceChar")  `  **********************************  ReplaceChar ***********************************************
		$t:=$textpara
		If ($longintpara#0)  `  remove
			$return:=""
			If (Length($t)>0)
				$vlAscii:=Ascii($t[[1]])
				If (($vlAscii>=48) & ($vlAscii<=58))
					$return:="_"
				End if 
			End if 
			For ($vlChar;1;Length($t))
				$vlAscii:=Ascii($t[[$vlChar]])
				Case of 
					: (($vlAscii>=127) | ($vlAscii<=31))
						$vsChar:="_"
					: (Position(Char($vlAscii);":<>&%=' ()[]{}"+Char(34))>0)
						$vsChar:="_"
					Else 
						$vsChar:=Char($vlAscii)
				End case 
				$return:=$return+$vsChar
			End for 
		Else 
			$return:=""
			For ($vlChar;1;Length($t))
				$vsChar:=$t[[$vlChar]]
				Case of 
					: (Position($vsChar;"<>&\r\n\t")>0)  `  &#9;
						$return:=$return+"&#"+String((Ascii($vsChar)))+";"
					: (Ascii($vsChar)<32)
						  ` filter char!!!
					: (Ascii($vsChar)>127)  `  &#9;
						  `  $return:=$return+"&#"+String((Ascii($vsChar)))+";"
						$return:=$return+$vsChar
					Else 
						$return:=$return+$vsChar
				End case 
			End for 
		End if 
		$result:=$return
		
	: ($job="ReplaceCharBlob")  `  **********************************  ReplaceCharBlob ***********************************************
		  ` similar to ReplaceChar, but expects data in text and returns in blob, for returned text > 32k
		$t:=$textpara
		$return:=""
		For ($vlChar;1;Length($t))
			$vsChar:=$t[[$vlChar]]
			Case of 
				: (Position($vsChar;"<>&\r\n\t")>0)  `  &#9;
					$return:=$return+"&#"+String((Ascii($vsChar)))+";"
				: (Ascii($vsChar)<32)
					  ` filter char!!!
				: (Ascii($vsChar)>127)  `  &#9;
					$return:=$return+$vsChar
				Else 
					$return:=$return+$vsChar
			End case 
			If (Length($return)>30000)
				TEXT TO BLOB($return;$blobpara->;Text without length ;*)
				$return:=""
			End if 
		End for 
		TEXT TO BLOB($return;$blobpara->;Text without length ;*)
		$result:=""
		
	: ($job="ReplaceCharBack")  `  **********************************  ReplaceCharBack ***********************************************
		$result:=$textpara
		$pos2:=0
		Repeat 
			If ($pos2>0)
				$result2:=Substring($result;$pos2)
			Else 
				$result2:=$result
			End if 
			$pos:=Position("&#";$result2)
			If ($pos>0)
				$pos:=$pos+$pos2
				$t2:=Substring($result;$pos)
				$pos2:=Position(";";$t2)
				$t2:=Substring($t2;1;$pos2)
				$vsChar:=Substring($t2;3;Length($t2)-3)
				$vlAscii:=Num($vsChar)
				$result:=Replace string($result;$t2;Char($vlAscii))
				$pos2:=$pos+1
			End if 
		Until ($pos<1)
		$result:=Replace string($result;"&lt;";"<")
		$result:=Replace string($result;"&gt;";">")
		$result:=Replace string($result;"&amp;";"&")
		
	: ($job="ReplaceCharBackBlob")  `  **********************************  ReplaceCharBackBlob ***********************************************
		  ` simular to ReplaceCharBack, expects blob, returns text, for text > 32k
		$result:=""
		$offset:=0
		$textpara:=BLOB to text($blobpara->;Text without length ;$offset;32000)
		While ($textpara#"")
			$result:=$result+ExportImport ("ReplaceCharBack";$textpara;$blobpara;0)
			$textpara:=BLOB to text($blobpara->;Text without length ;$offset;32000)
		End while 
		$result:=ExportImport ("ReplaceCharBack";$result;$blobpara;0)  ` again for full result - if a &# combination was in between  two pieces
		
	: ($job="GetAllIndex")  `  **********************************  GetAllIndex ***********************************************
		  ` returns Blob (Boolean) Area with all index fields for the table $longintpara in $blobpara (Pointer expected)
		$tableptr:=Table($longintpara)
		$count:=Count fields($tableptr)
		ARRAY BOOLEAN($indexfields;$count)
		For ($loop;1;Count fields($tableptr))
			GET FIELD PROPERTIES(Table($tableptr);$loop;$fieldtyp;$length;$IsIndex)
			$indexfields{$loop}:=$IsIndex
		End for 
		VARIABLE TO BLOB($indexfields;$blobpara->)
		
	: ($job="SetIndex")  `  **********************************  SetIndex ***********************************************
		  ` uses Blob (Boolean) Area with all index fields for the table $longintpara from $blobpara (Pointer expected)
		  `  $textpara="set" or "clear"
		$TablePtr:=Table($longintpara)
		ARRAY BOOLEAN($Indexfields;0)
		BLOB TO VARIABLE($blobpara->;$Indexfields)
		For ($index;1;Size of array($indexfields))
			If ($indexfields{$index})
				$field:=Field(Table($tableptr);$index)
				If ($textpara="set")
					SET INDEX($field->;True;50)
				Else 
					SET INDEX($field->;False;50)
				End if 
			End if 
		End for 
		
	Else 
		$result:="ExportImport: Wrong call - invalid job ID"
End case

If (Count parameters<1)  ` debug, call from user mode or design mode
	ALERT($result)
Else 
	$0:=$result
End if

Code ändern (nur für Autor - Kennwort geschützt)

Zurück

When the solution matters

International Sites

4D Produkte

Referenzen

Corporate

Support

Vertrieb

Menü

4D Code Library