//////////////////////////////////////////////////////////////////////
//
//  DBBULK.PRG
//
//  Copyright:
//      Alaska Software, (c) 1998-2002. Alle Rechte vorbehalten.         
//  
//  Inhalt:
//      Funktionen f�r Bulk-Operationen auf DBF-Dateien 
//   
//        - DbSetListLines()
//        - _DbExport()
//        - DbExport()
//        - _DbImport()
//        - DbImport()
//        - DbJoin()
//        - DbList()
//        - DbTotal()
//        - DbUpdate()
//   
//////////////////////////////////////////////////////////////////////

#include "Dmlb.ch"
#include "Error.ch"
#include "Deldbe.ch"
#include "Sdfdbe.ch"
#include "DbStruct.ch"

// Statische Einstellung f�r ListLines
STATIC snListLines := 0


//////////////////////////////////////////////////////////////////////////////
// 
// Funktion DbSetListLines()
//    Die Anzahl der Zeilen einstellen nach denen bei dbList gewartet werden
//    soll.
//
// Hinweis  :
//    Der Standardwert ist 0, d.h. nicht warten.
//
///////////////////////////////////////////////////////////////////////////////

FUNCTION DbSetListLines ( nLines )

  LOCAL nRet := snListLines

  IF Valtype( nLines ) == "N"
    snListLines := nLines
  ENDIF

  RETURN nRet


//////////////////////////////////////////////////////////////////////////////
//
// Funktion _DbExport()
//    Datens„tze von einem Arbeitsbereich in eine Datei exportieren
//
// Hinweis  :
//    Die Funktion wird bei dem Befehl COPY TO genutzt und l„dt
//    automatisch eine ben”tigte DBE. Falls die DBE nicht geladen 
//    war, wird sie am Ende automatisch wieder freigegeben.
//
///////////////////////////////////////////////////////////////////////////////
FUNCTION _DbExport( cFile, ;            // Name f�r Zieldatei
                    aFieldNames, ;      // Array mit Feldnamen
                    bFor, ;             // Codeblock f�r FOR-Bedingung
                    bWhile, ;           // Codeblock f�r WHILE-Bedingung
                    nNext, ;            // Anzahl Datens„tze ab aktuellem
                    nRecord, ;          // Nur diesen Datensatz
                    lRest, ;            // Alle bis Eof() 
                    cDbe, ;             // DBE f�r neue Datei
                    cDelimiter )        // Delimiter f�r DEL DBE
   LOCAL aDbeInfo, i, cOldDbe, cDataComponent
   LOCAL cFieldToken
   
   IF Valtype( cDbe ) <> "C"
      cDbe := DbeSetDefault()
   ENDIF

   /*
    * DBE ist nicht geladen
    */
   cDbe     := Upper( cDbe )         
   aDbeInfo := DbeList()
   i        := AScan( aDbeInfo , {|a| cDbe $ a[1] .AND. .NOT. a[2]} )

   IF i == 0
      DbeLoad( cDbe, .F.)
   ELSE
      cDbe := Upper( aDbeInfo[i,1] )
   ENDIF

   cOldDbe        := DbeSetDefault( cDbe )
   cDataComponent := DbeInfo( COMPONENT_DATA, DBE_NAME )

   DO CASE
   /*
    * Standardwerte f�r DbeInfo()
    */
   CASE cDataComponent == "SDFDBE" 
      aDbeInfo := {{ SDFDBE_AUTOCREATION, .T. }}
   CASE cDataComponent == "DELDBE"
      cFieldToken := ","
      IF Valtype( cDelimiter ) <> "C"
         cDelimiter := '"'
      ELSEIF "BLANK" $ Upper( cDelimiter )
         cFieldToken := " "
         cDelimiter  := Chr(0)
      ELSEIF Empty( cDelimiter )
         cDelimiter := '"'
      ENDIF

      aDbeInfo := { ;
        { DELDBE_FIELD_TOKEN    , cFieldToken      }, ;
        { DELDBE_DELIMITER_TOKEN, cDelimiter       }, ;
        { DELDBE_MODE           , DELDBE_AUTOFIELD }}

   OTHERWISE
      aDbeInfo := {}
   ENDCASE

   DbeSetDefault( cOldDbe )

   /*
    * Daten exportieren
    */
   DbExport( cFile, ;              
             aFieldNames, ;
             bFor, ;
             bWhile, ;
             nNext, ;
             nRecord, ;
             lRest, ;
             cDbe, ;
             aDbeInfo )

RETURN NIL


//////////////////////////////////////////////////////////////////////////////
//
// Funktion DbExport()
//    Datens„tze von einem Arbeitsbereich in eine Datei exportieren
//
// Hinweis  :
//    Es m�ssen alle ben”tigten DBEs geladen sein, bevor DbExport()
//    ausgef�hrt werden kann.
//
///////////////////////////////////////////////////////////////////////////////
FUNCTION DbExport( cFile, ;            // Name f�r Zieldatei
                   aFieldNames, ;      // Array mit Feldnamen
                   bFor, ;             // Codeblock f�r FOR-Bedingung
                   bWhile, ;           // Codeblock f�r WHILE-Bedingung
                   nNext, ;            // Anzahl Datens„tze ab aktuellem
                   nRecord, ;          // Nur diesen Datensatz
                   lRest, ;            // Alle bis Eof() 
                   cDbe, ;             // DBE f�r neue Datei
                   aDbeInfo )          // Einstellungen f�r DBE
   LOCAL nTargetArea, nSourceArea, aSource, aTarget, nCount, aFieldPos
   LOCAL cOldDbe, i:=0 , cFieldTypes
   LOCAL nSourceRecno, cTargetTypes, lSupportDel
   /*
    * Keine Feldnamen angegeben
    */
   IF Valtype( aFieldNames ) <> "A"
      aFieldNames := {}
   ENDIF

   /*
    * Keine DBE angegeben
    */
   IF Valtype( cDbe ) <> "C"       
      cDbe := DbeSetDefault()
   ENDIF

   /*
    * Keine DBE Infos angegeben
    */
   IF Valtype( aDbeInfo ) <> "A"   
      aDbeInfo := {}
   ENDIF

   /*
    * Strukturarray f�r Quelldatei
    */
   aSource      := DbStruct()       
   nCount       := Len( aFieldNames )
   nSourceArea  := Select()
   nSourceRecno := Recno()

   /*
    * Keine Feldnamen angegeben, alle Felder kopieren
    */
   IF nCount == 0                  
      nCount    := Len( aSource )  
      aTarget   := aSource
      aFieldPos := Array( nCount )
      DO WHILE ++i <= nCount
         aFieldPos[i] := i
      ENDDO
   ELSE
      /*
       * Strukturarray f�r Zieldatei
       */
      aTarget   := Array( nCount ) 
      /*
       * Array f�r Feldpositionen
       */
      aFieldPos := Array( nCount ) 
      DO WHILE ++i <= nCount
         aFieldPos[i] := FieldPos( aFieldNames[i] )
         aTarget[i]   := aSource[ aFieldPos[i] ]
      ENDDO
   ENDIF

   /*
    * Einstellungen f�r DBE setzen
    */
   cDbe        := Upper( cDbe )    
   cOldDbe     := DbeSetDefault( cDbe )
   AEval( aDbeInfo, {|a| a[2] := DbeInfo( COMPONENT_DATA, a[1], a[2] ) } )
   cFieldTypes := DbeInfo( COMPONENT_DATA, DBE_DATATYPES )

   /*
    * Memofelder bei SDF und DEL entfernen (genauer: nicht
    * unterst�tzte Datentypen entfernen)
    */
   i:=0                            
   DO WHILE ++i <= nCount          
      IF ! aTarget[i,2] $ cFieldTypes
         ADel( aTarget, i )        
         ADel( aFieldPos, i )
         i--
         nCount--
      ENDIF
   ENDDO

   IF ATail( aTarget ) == NIL
      ASize( aTarget  , nCount )
      ASize( aFieldPos, nCount )
   ENDIF

   /*  
    *  ermittle Feldtypen von Zieldatei
    */

   IF DbeInfo( COMPONENT_DATA, DBE_NAME ) == "DELDBE"
     cTargetTypes := ""
     FOR i := 1 TO Len(aTarget)
       cTargetTypes += aTarget[i, DBS_TYPE]
     NEXT

     DbeInfo(COMPONENT_DATA, DELDBE_FIELD_TYPES, cTargetTypes)
   ENDIF


   /*  
    *  stelle fest ob Ziel Delete unterst�tzt
    */
   IF DbeInfo( COMPONENT_DATA, DBE_NAME ) == "SDFDBE"
     lSupportDel = .F.
   ELSE
     lSupportDel = .T.
   ENDIF


   /*
    * Zieldatei erzeugen und exklusiv ”ffnen
    */
   DbCreate( cFile, aTarget, cDbe )
   USE (cFile) NEW EXCLUSIVE       
   nTargetArea := Select()

   /*
    * Datens„tze exportieren
    */
   SELECT (nSourceArea)            

   DbEval( {|| DbExportRecord( aFieldPos  , ;
                               aTarget    , ;
                               nCount     , ;
                               nSourceArea, ;
                               nTargetArea, ;
                               lSupportDel) }, ;
           bFor, bWhile, nNext, nRecord, lRest )

   SELECT (nTargetArea)

   /*
    * Aufr„umen
    */
   DbCloseArea()                   
   SELECT ( nSourceArea )
   DbGoto ( nSourceRecno )
   AEval( aDbeInfo, {|a| a[2] := DbeInfo( COMPONENT_DATA, a[1], a[2] ) } )
   DbeSetDefault( cOldDbe )

RETURN NIL

*****************************************************************************
* Aktuellen Datensatz in Zieldatei kopieren
*****************************************************************************
STATIC PROCEDURE DbExportRecord( aFieldPos, aTarget, nCount, nSource, nTarget, lSupportDel)
   LOCAL i := 0, lDeleted := Deleted()


   /*
    * Felder aus Arbeitsbereich lesen
    */
   DO WHILE ++i <= nCount           
      aTarget[i] := FieldGet( aFieldPos[i] )
   ENDDO

   SELECT (nTarget)
   /*
    * Werte in Zieldatei schreiben
    */
   DbAppend()                       

   i := 0
   DO WHILE ++i <= nCount
      FieldPut( i, aTarget[i] )
   ENDDO

   IF lDeleted .AND. lSupportDel
     DELETE
   ENDIF

   SELECT (nSource)
RETURN


//////////////////////////////////////////////////////////////////////////////
//
// Funktion _DbImport()
//    Datens„tze aus einer Datei in einen Arbeitsbereich importieren
//
// Hinweis  :
//    Die Funktion wird bei dem Befehl APPEND FROM genutzt und l„dt
//    automatisch eine ben”tigte DBE. Falls die DBE nicht geladen 
//    war, wird sie am Ende automatisch wieder freigegeben.
//
///////////////////////////////////////////////////////////////////////////////
FUNCTION _DbImport( cFile, ;            // Name f�r Quelldatei
                    aFieldNames, ;      // Array mit Feldnamen
                    bFor, ;             // Codeblock f�r FOR-Bedingung
                    bWhile, ;           // Codeblock f�r WHILE-Bedingung
                    nNext, ;            // Anzahl Datens„tze ab nRecord
                    nRecord, ;          // Erster Datensatz zum importieren
                    lRest, ;            // Alle bis Eof() 
                    cDbe, ;             // DBE f�r neue Datei
                    cDelimiter )        // Delimiter f�r DEL DBE
   LOCAL aDbeInfo, i, cOldDbe, cDataComponent, cFieldToken

   IF Valtype( cDbe ) <> "C"
      cDbe := DbeSetDefault()
   ENDIF

   /*
    * Ist DBE geladen ?
    */
   cDbe     := Upper( cDbe )         
   aDbeInfo := DbeList()
   i        := AScan( aDbeInfo , {|a| cDbe $ a[1] .AND. .NOT. a[2]} )

   IF i == 0
      DbeLoad( cDbe, .F.)
   ELSE
      cDbe := Upper( aDbeInfo[i,1] )
   ENDIF

   cOldDbe        := DbeSetDefault( cDbe )
   cDataComponent := DbeInfo( COMPONENT_DATA, DBE_NAME )

   DO CASE
   /*
    * Standardwerte f�r DbeInfo()
    */
   CASE cDataComponent == "SDFDBE" 
      aDbeInfo := {}
   CASE cDataComponent == "DELDBE"
      IF Valtype( cDelimiter ) <> "C"
         cDelimiter := '"'
      ELSEIF "BLANK" $ Upper( cDelimiter )
         cFieldToken := " "
         cDelimiter  := Chr(0)
      ELSEIF Empty( cDelimiter )
         cDelimiter := '"'
      ENDIF

      aDbeInfo := { ;
        { DELDBE_FIELD_TOKEN    , cFieldToken      }, ;
        { DELDBE_DELIMITER_TOKEN, cDelimiter       }, ;
        { DELDBE_MODE           , DELDBE_AUTOFIELD }}

   OTHERWISE
      aDbeInfo := {}
   ENDCASE

   DbeSetDefault( cOldDbe )

   /*
    * Daten Importieren
    */
   DbImport( cFile, ;              
             aFieldNames, ;
             bFor, ;
             bWhile, ;
             nNext, ;
             nRecord, ;
             lRest, ;
             cDbe, ;
             aDbeInfo )
RETURN NIL


//////////////////////////////////////////////////////////////////////////////
//
// Funktion DbImport()
//    Datens„tze von einer Datei in einen Arbeitsbereich Importieren
//
// Hinweis  :
//    Es m�ssen alle ben”tigten DBEs geladen sein, bevor DbImport()
//    ausgef�hrt werden kann.
//
///////////////////////////////////////////////////////////////////////////////
FUNCTION DbImport( cFile, ;            // Name f�r Quelldatei
                   aFieldNames, ;      // Array mit Feldnamen
                   bFor, ;             // Codeblock f�r FOR-Bedingung
                   bWhile, ;           // Codeblock f�r WHILE-Bedingung
                   nNext, ;            // Anzahl Datens„tze ab nRecord
                   nRecord, ;          // Erster Datensatz zum importieren
                   lRest, ;            // Alle bis Eof() 
                   cDbe, ;             // DBE f�r neue Datei
                   aDbeInfo )          // Einstellungen f�r DBE
   LOCAL nTargetArea, aTargetStruct, aTargetPos
   LOCAL nSourceArea, aSourceStruct, aSourcePos
   LOCAL cOldDbe, i, j, nCount, aTemp, cSdfFile, cTargetTypes, cTypes
   LOCAL cDataComponent, lSupportDel

   /*
    * Keine DBE angegeben
    */
   IF Valtype( cDbe ) <> "C"       
      cDbe := DbeSetDefault()
   ENDIF

   /*
    * Keine DBE Infos angegeben
    */
   IF Valtype( aDbeInfo ) <> "A"   
      aDbeInfo := {}
   ENDIF

   /*
    * Keine Feldnamen angegeben
    */
   IF Valtype( aFieldNames) <> "A" 
      aFieldNames := {}
   ENDIF

   /*
    * Strukturarray f�r Zieldatei
    */
   aTargetStruct := DbStruct()     
   nTargetArea   := Select()
//   cTargetTypes  := DbeInfo( COMPONENT_DATA, DBE_DATATYPES )

   /*
    * Einstellungen f�r DBE setzen
    */
   cDbe          := Upper( cDbe )  
   cOldDbe       := DbeSetDefault( cDbe )
   cTargetTypes  := DbeInfo( COMPONENT_DATA, DBE_DATATYPES )	//07.08.2024 18:46 von 7 Zeilen h”her hierher verschoben (Knowledgebase)
   AEval( aDbeInfo, {|a| a[2] := DbeInfo( COMPONENT_DATA, a[1], a[2] ) } )

   cDataComponent := DbeInfo( COMPONENT_DATA, DBE_NAME )

   IF cDataComponent == "SDFDBE"
      /*
       * Erzeuge strukturerweiterte .SDF Datei, wenn sie fehlt
       */
      cSdfFile := IIf( (i:=RAt( ".", cFile)) > 0, SubStr(cFile,1,i-1), cFile )

      IF ! FILE( cSdfFile + "." + DbeInfo( COMPONENT_DATA, SDFDBE_STRUCTURE_EXT));
          .AND. PROCNAME(1) == "_DBIMPORT"
         dbCreate( cFile, aTargetStruct)
         USE (cFile) NEW SHARED READONLY 
         DbCloseArea()
      ENDIF
   ENDIF

   /*  
    *  ermittle Feldtypen von Zieldatei
    */
   IF cDataComponent == "DELDBE"
     cTypes := ""
     FOR i := 1 TO Len(aTargetStruct)
       cTypes += aTargetStruct[i, DBS_TYPE]
     NEXT

     DbeInfo(COMPONENT_DATA, DELDBE_FIELD_TYPES, cTypes)
   ENDIF

   /*  
    *  stelle fest ob Ziel Delete unterst�tzt
    */
   IF DbeInfo( COMPONENT_DATA, DBE_NAME ) == "SDFDBE"
     lSupportDel = .F.
   ELSE
     lSupportDel = .T.
   ENDIF


   /*
    * Quelldatei ”ffnen
    */
   USE (cFile) NEW SHARED READONLY 

   /*
    * Strukturarray f�r Quelldatei
    */
   aSourceStruct := DbStruct()     
   nSourceArea   := Select()

   /*
    * Keine Feldnamen angegeben
    */
   IF Empty( aFieldNames )         
      nCount      := Len( aSourceStruct )
      aFieldNames := Array( nCount )
      i           := 0
      DO WHILE ++i <= nCount
         aFieldNames[i] := aSourceStruct[i,1]
      ENDDO
   ENDIF

   /*
    * Feldpositionen in der Zieldatei ermitteln
    */
   aSourcePos := (nSourceArea)->( FieldPosArray( aFieldNames ) )
   nCount     := Len( aSourcePos )
   aTargetPos := {}
   aTemp      := Array( nCount )
   AEval( aSourcePos, {|n,i| aTemp[i] := (nSourceArea)->(FieldName(n)) } ) 

   FOR i:=1 TO nCount
      j := (nTargetArea)->( FieldPos( aTemp[i] ) )
      IF j > 0
         AAdd( aTargetPos, j )
      ELSE
         ADel( aSourcePos, i )
         ADel( aTemp, i )
         i --
         nCount --   
         ASize( aSourcePos, nCount )
         ASize( aTemp     , nCount )
      ENDIF
   NEXT

   i:=0
   DO CASE
   /*
    * Quelldatei ist DELimited
    */
   CASE Empty( aSourcePos )        
      aTargetPos := FieldPosArray( aFieldNames )
      nCount     := Min(Len( aTargetPos ), Len(aTargetStruct))
      j          := 0
      /*
       * Felder mit gleichem Datentyp
       */
      DO WHILE ++i <= nCount       
         IF aSourceStruct[++j,2] == aTargetStruct[ aTargetPos[i], 2]
            AAdd( aSourcePos, j )
         ENDIF
         IF j > Len( aSourceStruct )
            EXIT
         ENDIF
      ENDDO

      /*
       * Zieldatei ist DELimited
       */
   CASE Empty( aTargetPos )        
      nCount := Min(Len( aSourcePos ), Len(aSourceStruct))
      j      := 0
      /*
       * Felder mit gleichem Datentyp
       */
      DO WHILE ++i <= nCount       
         IF aTargetStruct[++j,2] == aSourceStruct[ aSourcePos[i], 2]
            AAdd( aTargetPos, j )
         ENDIF
         IF j > Len( aTargetStruct )
            EXIT
         ENDIF
      ENDDO
   ENDCASE

   nCount := Min( Len(aSourcePos), Len(aTargetPos) )
   /*
    * Gleiche Anzahl an Feldern
    */
   ASize( aSourcePos, nCount )     
   ASize( aTargetPos, nCount )
   /*
    * Memofelder bei SDF und DEL entfernen (genauer: nicht unterst�tzte Datentypen)
    */
   i:=0                            
   DO WHILE ++i <= nCount          
      IF ! aSourceStruct[ aSourcePos[i], 2] $ cTargetTypes .OR. ;
           aSourceStruct[ aSourcePos[i], 2] <> ;
           aTargetStruct[ aTargetPos[i], 2]

         ADel( aTargetPos, i )
         ADel( aSourcePos, i )
         i--
         nCount--
      ENDIF
   ENDDO

   /*
    * Inkompatible Datentypen existieren
    */
   IF ATail( aTargetPos ) == NIL   
      ASize( aTargetPos, nCount )  
      ASize( aSourcePos, nCount )
   ENDIF

   /*
    * Datens„tze importieren
    */
   SELECT (nSourceArea)            
   /*
    * Array zum Einlesen von Feldern
    */
   aFieldNames := Array( nCount )  

   DbEval( {|| DbImportRecord( aFieldNames, ;
                               aSourcePos , ;
                               aTargetPos , ;
                               nCount     , ;
                               nSourceArea, ;
                               nTargetArea, ;
                               lSupportDel) }, ;
           bFor, bWhile, nNext, nRecord, lRest )

   AEval( aDbeInfo, {|a| a[2] := DbeInfo( COMPONENT_DATA, a[1], a[2] ) } )

   /*
    * Aufr„umen
    */
   DbCloseArea()                   
   DbeSetDefault( cOldDbe )
   SELECT (nTargetArea)

RETURN NIL

*****************************************************************************
* Array mit Feldpositionen aus Array mit Feldnamen erzeugen
*****************************************************************************
STATIC FUNCTION FieldPosArray( aFieldNames )
   LOCAL i :=0, nCount := Len(aFieldNames), nFCount := 0
   LOCAL aFieldPos[nCount], nPos

   DO WHILE ++i <= nCount
      IF ( nPos := FieldPos( aFieldNames[i] ) ) > 0
         aFieldPos[++nFCount] := nPos
      ENDIF
   ENDDO

RETURN ASize( aFieldPos, nFCount )

*****************************************************************************
* Datensatz aus Quelldatei in Arbeitsbereich kopieren
*****************************************************************************
STATIC PROCEDURE DbImportRecord( aFieldVal, aSourcePos , aTargetPos , ;
                                 nCount   , nSourceArea, nTargetArea, ;
                                 lSupportDel)
   LOCAL i := 0, lDeleted := Deleted()

   /*
    */
   DO WHILE ++i <= nCount           
      aFieldVal[i] := FieldGet( aSourcePos[i] )
   ENDDO

   SELECT (nTargetArea)
   /*
    */
   DbAppend()                       

   i := 0
   DO WHILE ++i <= nCount
      FieldPut( aTargetPos[i], aFieldVal[i] )
   ENDDO

   IF lDeleted .AND. lSupportDel
     DELETE
   ENDIF

   SELECT (nSourceArea)
RETURN


///////////////////////////////////////////////////////////////////////////////
//
// Funktion DbJoin()
//   Datens„tze aus zwei Arbeitsbereichen in eine dritte Datei mischen
//
// Hinweis  :
//   Die Funktion wird vom Befehl JOIN genutzt
//
///////////////////////////////////////////////////////////////////////////////
FUNCTION DbJoin( cSecAlias, ;          // Sekund„rer Arbeitsbereich
                 cFilename, ;          // Zieldatei    
                 aFieldNames, ;        // Array mit Feldnamen
                 bFor     )            // Codeblock f�r FOR
   LOCAL nTarget, i, imax, j, jmax, cFieldName, nFieldPos, bReplace, aFields
   LOCAL aPrimary, aSecondary, aTarget, nPFCount, nSFCount, nTFCount
   LOCAL cPrimAlias := Alias()
   LOCAL nPrimArea  := Select()
   LOCAL nSecArea   := Select( cSecAlias )

   /*
    * Dateistrukturen
    */
   aPrimary   := DbStruct()        
   aSecondary := ( nSecArea )->( DbStruct() )

   /*
    * Anzahl der Felder prim„rer Bereich
    */
   nPFCount := Len( aPrimary )     
   /*
    * Anzahl der Felder sekund„rer Bereich
    */
   nSFCount := Len( aSecondary )   
   /*
    * Anzahl Felder Zieldatei
    */
   nTFCount := 0                   
   /*
    * Arrays f�r Zieldatei ausreichend dimensionieren
    */
   aTarget := Array(nPFCount+nSFCount)
   aFields := Array(nPFCount+nSFCount)
   /*
    * Keine Feldnamen angegeben
    */
   IF Valtype( aFieldNames ) <> "A"
      aFieldNames := {}
   ENDIF

   /*
    * Keine FOR-Bedingung angegeben
    */
   IF Valtype( bFor ) <> "B"       
      bFor := {||.T.}
   ENDIF

   imax := Len( aFieldNames )
   /*
    * Alle Felder aus beiden Arbeitsbereichen �bernehmen
    */
   IF imax == 0                    
      i := 0                       
      /*
       * Prim„rer Arbeitsbereich
       */
      DO WHILE ++i <= nPFCount     
         aTarget[i] := aPrimary[i]
         aFields[i] := cPrimAlias+"->"+aPrimary[i,1]
      ENDDO

      nTFCount := nPFCount
      imax     := Len( aSecondary )
      jmax     := Len( aPrimary )
      i        := 0

      /*
       * Sekund„rer Arbeitsbereich
       */
      DO WHILE ++i <= imax         
         j := 0
         /*
          * doppelte Feldnamen verhindern
          */
         DO WHILE ++j <= jmax      
            IF aSecondary[i,1] == aPrimary[j,1]
               EXIT
            ENDIF
         ENDDO
         /*
          * Kein doppelter Feldname
          */
         IF j > jmax               
            nTFCount ++
            aTarget[nTFCount] := aSecondary[i]
            aFields[nTFCount] := cSecAlias+"->"+aSecondary[i,1]
         ENDIF
      ENDDO
   ELSE                            
      /*
       * Struktur der Zieldatei mit Felddefinition aus beiden Bereichen
       */
      cSecAlias := Upper( Alltrim( cSecAlias ) )
      i         := 0
      DO WHILE ++i <= imax
         cFieldName := Upper( StrTran( aFieldNames[i], " ", "" ) )
          /*
           * Feldname mit Alias bedeutet sekund„rer Arbeitsbereich
           */
          IF "->" $ cFieldName      
            IF cSecAlias $ cFieldName
               cFieldName := SubStr( cFieldName, Len(cSecAlias)+3 )
               nFieldPos  := (nSecArea)->( FieldPos(cFieldName) )
                         /*
                          * Achtung: Doppelte Feldnamen verhindern
                          */
               IF nFieldPos > 0 .AND. ;             
                        ( j := FieldPos(cFieldName) ) == 0  
                  /*
                   * Feld existiert im sekund„ren Arbeitsbereich
                   */
                  nTFCount ++                       
                  aTarget[nTFCount] := aSecondary[nFieldPos]
                  aFields[nTFCount] := cSecAlias+"->"+cFieldName
               ELSEIF j > 0                         
                  /*
                   * Feld existiert im prim„renArbeitsbereich
                   */
                  nTFCount ++                       
                  aTarget[nTFCount] := aPrimary[j]  
                  aFields[nTFCount] := cPrimAlias+"->"+cFieldName
               ENDIF
            ENDIF
         ELSE
            /*
             * Feld ohne Alias im prim„ren Arbeitsbereich
             */
            nFieldPos  := FieldPos(cFieldName)      
            IF nFieldPos > 0                        
               nTFCount ++                          
               aTarget[nTFCount] := aPrimary[nFieldPos]
               aFields[nTFCount] := cPrimAlias+"->"+cFieldName
            ENDIF
         ENDIF
      ENDDO
   END

   /*
    * Arrays f�r Zieldatei auf richtige Gr”áe dimensionieren
    */
   ASize( aTarget, nTFCount )      
   ASize( aFields, nTFCount )      

   /*
    * Zieldatei erzeugen und ”ffnen
    */
   DbCreate( cFilename, aTarget )  
   USE (cFilename) NEW EXCLUSIVE   
   nTarget   := Select()
   cFilename := Alias()

   /*
    * Codeblock erzeugen, der alle Felder in der Zieldatei aktualisiert
    */
   bReplace  := "{||" + cFilename + "->" + ;
                        aTarget[1,1] + ":=" + aFields[1]
   i         := 1                  
   DO WHILE ++i <= nTFCount        
      bReplace += "," + cFilename + "->" + ;
                        aTarget[i,1] + ":=" + aFields[i]
   ENDDO
   /*
    * Codeblock compilieren
    */
   bReplace := &( bReplace + "}" ) 
   /*
    * Prim„rer Bereich ist aktiv
    */
   SELECT (nPrimArea)              
   DbGoTop()
   /*
    * Daten �bertragen
    */
   DO WHILE ! Eof()                

   /*
    * Sekund„rer Bereich ist aktiv
    */
      SELECT (nSecArea)            
      DbGoTop()
      DO WHILE ! Eof()
         /*
          * FOR Bedingung im prim„ren Arbeitsbereich pr�fen
          */
         IF (nPrimArea)->(Eval(bFor))  
            /*
             * Daten in Zieldatei schreiben
             */
            SELECT (nTarget)       
            DbAppend()
            Eval( bReplace )
            SELECT (nSecArea)

         ENDIF
         DbSkip()
      ENDDO

      /*
       * Prim„rer Bereich ist aktiv
       */
      SELECT (nPrimArea)           
      DbSkip()
   ENDDO

   /*
    * Zieldatei schlieáen
    */
   (nTarget)->( DbCloseArea() )    

RETURN NIL

///////////////////////////////////////////////////////////////////////////////
//
//  Funktion DbList() 
//    Ausgabe von Datens„tzen
//
//  Hinweis  :
//    Die Funktion wird bei den Befehlen DISPLAY und LIST genutzt
//
///////////////////////////////////////////////////////////////////////////////
FUNCTION DbList( aBlocks, ;            // Array mit Codebl”cken
                 lOff, ;               // Recno() anzeigen .T. | .f.
                 lAll, ;               // Alle Datens„tze anzeigen .T. | .f.
                 bFor, ;               // Codeblock f�r FOR-Bedingung
                 bWhile, ;             // Codeblock f�r WHILE-Bedingung
                 nNext, ;              // Anzahl Datens„tze ab aktuellem
                 nRecord, ;            // Nur diesen Datensatz
                 lRest, ;              // Alle bis Eof() 
                 lPrint, ;             // Ausgabe auf dem Drucker .t. | .F.
                 cFilename )           // Ausgabe in Datei 
   LOCAL bDeleted, nCount, lToFile, nLine

   /*
    * Schalter f�r die Anzeige von Recno()
    */
   IF Valtype( lOff ) <> "L"       
      lOff := .F.                  
   ENDIF
   /*
    * Standardm„áig alle Felder anzeigen
    */
   IF Empty( aBlocks )             
      aBlocks := Array( FCount() ) 
      AEval( aBlocks, ;
            {|x,i| x:= &("{||FIELD->"+FieldName(i)+"}") },,, .T. )
   ENDIF
   /*
    * Schalter f�r ALL
    */
   IF Valtype( lAll ) <> "L"       
      lAll := .T.
   ENDIF

   IF ! lAll .AND. Valtype( nNext ) <> "N"
      nNext := 1                   
      /*
       * Bei DISPLAY wird standardm„áig nur der aktuelle Datensatz angezeigt
       */
   ENDIF                           

   lToFile := ( Valtype( cFilename ) == "C" )
   /*
    * Schalter f�r Druckerausgabe
    */
   IF Valtype( lPrint ) <> "L" .OR. lToFile
      lPrint := lToFile
   ENDIF

   nCount  := Len( aBlocks )

   /*
    * Ausgabe von Deleted() und Recno()
    */
   IF lOff                         
      bDeleted := {|| QOut( IIf( Deleted(), "*", " " ) ) }
   ELSE
      bDeleted := {|| QOut( Recno(), IIf( Deleted(), "*", " " ) ) }
   ENDIF

   /*
    * Druckkanal ”ffnen
    */
   IF lPrint
      SET CONSOLE OFF
      IF lToFile
        /*
         * Ausgabe in Datei
         */
         SET PRINTER TO (cFileName)
      ENDIF
      SET PRINTER ON               
   ENDIF

   nLine := 1
   DbEval( {|| DbQout( bDeleted, nCount, aBlocks, @nLine ) }, ;
           bFor, bWhile, nNext, nRecord, lRest )

   /*
    * Druckkanal schlieáen
    */
   IF lPrint
      SET PRINTER OFF              
      SET CONSOLE ON
      IF lToFile
         SET PRINTER TO
      ENDIF
   ENDIF

RETURN NIL

*****************************************************************************
* Alle Codebl”cke evaluieren und ausgeben
*****************************************************************************
STATIC PROCEDURE DbQOut( bDeleted, nCount, aBlocks, nLine )
   LOCAL i := 0
   Eval( bDeleted )

   DO WHILE ++i <= nCount
      QQOut( Eval( aBlocks[i] ), "" )
   ENDDO
   /*
    * ggf. auf Tastendruck warten 
    */
   IF nLine == snListLines          
      INKEY( 0 )
      nLine := 1
   ELSE
      nLine++
   ENDIF
RETURN


///////////////////////////////////////////////////////////////////////////////
//
//  Funktion DbTotal() 
//    Datens„tze in eine zweite Datei summieren
//
//  Hinweis  :
//    Die Funktion wird vom Befehl TOTAL ON..TO genutzt
//
///////////////////////////////////////////////////////////////////////////////
FUNCTION DbTotal( cFile, ;             // Name f�r Zieldatei
                  bIndex, ;            // Indexausdruck
                  aFieldNames, ;       // Array mit Feldnamen
                  bFor, ;              // Codeblock f�r FOR-Bedingung
                  bWhile, ;            // Codeblock f�r WHILE-Bedingung
                  nNext, ;             // Anzahl Datens„tze ab aktuellem
                  nRecord, ;           // Nur diesen Datensatz
                  lRest )              // Alle bis Eof() 
   LOCAL nCount  , nFCount, nSourceArea , nTargetArea
   LOCAL xIndexVal, aFieldPos, aSum, i:=0

   /*
    * Keine Felder angegeben
    */
   IF Valtype( aFieldNames ) <> "A"
      /*
       * Es muá ein Array sein
       */
      aFieldNames := {}            
   ENDIF
   /*
    * Ein Index-Ausdruck ist erforderlich
    */
   IF Valtype( bIndex ) <> "B"     
      bIndex  := {|| Recno() }     
   ENDIF
   /*
    * Anzahl zu summierender Felder
    */
   nCount      := Len( aFieldNames )
   /*
    * Gesamte Anzahl Felder
    */
   nFCount     := FCount()         
   aFieldPos   := Array( nCount )
   aSum        := Array( nCount )
   nSourceArea := Select()
   AFill( aSum, 0 )
   /*
    * Feldpositionen feststellen
    */
   DO WHILE ++i <= nCount          
      aFieldPos[i] := FieldPos( aFieldNames[i] )
   ENDDO
   /*
    * Zieldatei erzeugen und ”ffnen
    */
   COPY STRUCTURE TO (cFile)       
   USE (cFile) NEW EXCLUSIVE       
   nTargetArea := Select()
   /*
    * Werte summieren
    */
   SELECT (nSourceArea)            
   DbEval( {|| DbSum( @xIndexVal, ;
                      bIndex, ;
                      nTargetArea, ;
                      nCount, ;
                      nFCount, ;
                      aFieldPos, ;
                      aSum ) }, ;
            bFor, bWhile, nNext, nRecord, lRest )

   SELECT (nTargetArea)
   i := 0
   /*
    * Letzte Summe in Datei schreiben
    */
   DO WHILE ++i <= nCount          
      FieldPut( aFieldPos[i], aSum[i] )
   ENDDO
   /*
    * Aufr„umen
    */
   DbCloseArea()                   
   SELECT (nSourceArea)

RETURN NIL

*****************************************************************************
* Werte in Array summieren und ggf. in Datei schreiben
*****************************************************************************
STATIC PROCEDURE DbSum( xIndexVal, ;
                        bIndex, ;
                        nTarget, ;
                        nCount, ;
                        nFCount, ;
                        aFieldPos, ;
                        aSum )
   LOCAL i := 0, xValue := Eval(bIndex)

   /*
    * Index hat sich ge„ndert
    */
   IF xIndexVal <> xValue          
      /*
       * ist nicht der erste Datensatz
       */
      IF xIndexVal <> NIL          
         /*
          * Summe in Zieldatei schreiben
          */
         DO WHILE ++i <= nCount    
            ( nTarget )->( FieldPut( aFieldPos[i], aSum[i] ) )
         ENDDO
      ENDIF
      /*
       * Aktuellen Indexwert merken
       */
      xIndexVal := xValue          
      i         := 0
      /*
       * Datensatz in Zieldatei �bertragen
       */
      ( nTarget )->( DbAppend() )  
      DO WHILE ++i <= nFCount      
         IF "M" <> TYPE( FieldName(i) )
            xValue := FieldGet( i )
            ( nTarget )->( FieldPut( i, xValue ) )
         ENDIF
      ENDDO

      i := 0
      /*
       * Anfangswert f�r Summe einlesen
       */
      DO WHILE ++i <= nCount       
         aSum[i] := FieldGet( aFieldPos[i] )
      ENDDO

   ELSE
   /*
    * Werte addieren
    */
      DO WHILE ++i <= nCount       
         aSum[i] += FieldGet( aFieldPos[i] )
      ENDDO
   ENDIF

RETURN


///////////////////////////////////////////////////////////////////////////////
//
// Funktion DbUpdate()
//    Datens„tze im aktuellen Arbeitsbereich durch Datens„tze in einem
//    sekund„ren Arbeitsbereich aktualisieren
//
//  Hinweis  :
//    Die Funktion wird vom Befehl UPDATE genutzt
//
///////////////////////////////////////////////////////////////////////////////
FUNCTION DbUpdate( cAlias, ;           // Sekund„rer Arbeitsbereich
                   bReplace, ;         // Codeblock f�r REPLACE
                   bIndex, ;           // Indexausdruck
                   lRandom )           // cAlias ist sortiert .F. | .T
   LOCAL xSourceVal, xTargetVal
   LOCAL nSource := Select( cAlias )
   LOCAL nTarget := Select()

   /*
    * Beide Arbeitsbereiche sind indiziert
    */
   IF Valtype( lRandom ) <> "L"    
      lRandom := .F.               
   ENDIF

   /*
    * Anfangsbedingung herstellen
    */
   DbGoTop()                       
   xTargetVal := Eval( bIndex )
   SELECT (nSource)
   DbGoTop()

   /*
    * Quell-Arbeitsbereich ist der aktuelle
    */
   DO WHILE ! Eof()                
      xSourceVal := Eval( bIndex )

      /*
       * Ziel-Arbeitsbereich w„hlen
       */
      SELECT (nTarget)             
      IF lRandom .OR. ! xTargetVal == xSourceVal
         DbSeek( xSourceVal )
      ENDIF
      xTargetVal := Eval( bIndex )

      IF xTargetVal == xSourceVal
      /*
       * šbereinstimmung, update Ziel-Arbeitsbereich
       */
         Eval( bReplace )              
      ENDIF

      SELECT (nSource)
      DbSkip()
   ENDDO

   SELECT (nTarget)
RETURN NIL

///////////////////////////////////////////////////////////////////////////////
//
// Funktion DbCreateExtStruct()
//    Die Funktion erzeugt eine leere strukturerweiterte Datenbank
//
//  Hinweis  :
//    Die Funktion wird durch das Kommando CREATE <Datenbank> verwendet
//
///////////////////////////////////////////////////////////////////////////////

FUNCTION DbCreateExtStruct( cFile )
   LOCAL aStruct := { ;
            { "FIELD_NAME" , "C", 10 , 0 }, ;
            { "FIELD_TYPE" , "C",  1 , 0 }, ;
            { "FIELD_LEN"  , "N",  5 , 0 }, ;
            { "FIELD_DEC"  , "N",  4 , 0 }  }

   DbCreate( cFile , aStruct )

   DbUseArea( , ,cFile )

RETURN NIL

///////////////////////////////////////////////////////////////////////////////
//
// Funktion DbCreateFrom()
//    Die Funktion erzeugt eine Datenbank auf der Grundlage einer 
//    Definition aus einer strukturerweiterten Datenbank
//
//  Hinweis  :
//    Die Funktion wird durch das Kommando CREATE <Datenbank> FROM <Datenbank> 
//    verwendet
//
///////////////////////////////////////////////////////////////////////////////

FUNCTION DbCreateFrom( cTargetFile, cTargetDbe, ;
                       cStructFile, cStructDBE, ;
                       lNew       , cAlias      )
   LOCAL aStruct

   IF Empty( cTargetDbe )
      cTargetDbe := DbeSetDefault()
   ENDIF

   IF Empty( cStructDbe )
      cStructDbe := DbeSetDefault()
   ENDIF

   IF lNew == NIL
      lNew := .F.
   ENDIF

   /*
    * ™ffnen der strukturerweiterten Datenbank in neuer Area
    * Einlesen der Strukturdefinition in Array
    */
   DbUseArea( lNew , cStructDbe, cStructFile )

   aStruct := {}
   DO WHILE ! Eof()

      IF( !Deleted() )
        AAdd( aStruct            , ;
             { FIELD->FIELD_NAME , ;
               FIELD->FIELD_TYPE , ;
               FIELD->FIELD_LEN  , ;
               FIELD->FIELD_DEC    } )
      ENDIF
      DbSkip()
   ENDDO
   /*
    * Strukturerweiterte Datenbank schlieáen, neue Datenbank 
    * aus aStruct erzeugen und Datei ”ffnen
    */
   DbCloseArea()
   DbCreate( cTargetFile , aStruct , cTargetDbe )

   DbUseArea( .F. , cTargetDbe, cTargetFile, cAlias )

RETURN NIL