Inoffizielles deutsches Xbase-Forum

Code: Alles auswählen

      AAdd( aStructure, {"FREI_TERMS","D",8,0} )
      AAdd( aStructure, {"FREI_TERMI","D",8,0} )

      ADDFIELDS(cPath, cAlias, aStructure)

      FUNCTION ADDFIELDS(cPfad, cAlias, aNeu)
      // Datei um Felder erweitern oder falls bereits vorhanden, in der Größe ändern
      // Vorsicht, wenn Felder kleiner gemacht werden, kann Inhalt verloren gehen
      
      LOCAL aStructure
      LOCAL I := 0
      LOCAL nPos := 0
      LOCAL cDat := ""
      LOCAL cTemp:= ""
      local cFullPath := cPfad+cAlias

      dbUseArea( .t. ,,cFullPath, cAlias,.t.,.f.) // shared
      aStructure := DbStruct()         // Datei-Struktur einlesen
      (cAlias)->DbCloseArea()

      FOR I:= 1 TO len(aNeu)
         nPos := ascan(aStructure, {|a| a[1] == aNeu[I,1]})
         if nPos > 0
            // Feld bereits vorhanden, Grösse ändern
            aStructure[nPos,3] := aNeu[I,3]
            aStructure[nPos,4] := aNeu[I,4]
         else
            AAdd( aStructure, aNeu[I] )             // neu
         endif
      NEXT

      DbCreate(cPfad+"TEMP", aStructure )    // Temporaere Datei mit neuer Struktur erzeugen
      dbUseArea( .t. ,,cPfad+"TEMP", "TEMP",.t.,.f.) // exclusive

      APPEND FROM &cFullPath                // Datensaetze laden aus Quelldatei 
      CLOSE TEMP

      COPY FILE (cFullPath+".dbf") TO (cFullPath+"_si.dbf")    // Quelldatei sichern
      FERASE(cFullPath+".dbf")    // Quelldatei löschen
      cTemp:= cPfad+"TEMP.DBF"
      cDat :=  cFullPath+".dbf"
      RENAME (cTemp) TO (cDat)        // Temporäre Datei umbenennen

      IF File( cPfad+"TEMP.DBT" )            // Wenn Memo-Datei existiert
         COPY FILE (cFullPath+".dbt") TO (cFullPath+"_si.dbt")
         FERASE(cFullPath+".dbt")           // Alte Datei l”schen
         cTemp:= cPfad+"TEMP.DBT"
         cDat := cFullPath+".dbt"
         RENAME (cTemp) TO (cDat)     // Temporäre Datei umbenennen
      ENDIF


      RETURN .T.

Code: Alles auswählen

// - Feldnamen einer DBF (mittels Low-Level-Dateifunktionen) aendern
// - die DBF darf nicht in Benutzung sein, da die Funktion sie exklusiv oeffnen muss
// - bei erfolgreicher Aenderung des Feldnamens wird .T. zurueckgegeben, andernfalls .F.
// - Bsp.:  RenameField( "d:\temp\artikel.dbf", "artnr", "artikelnr" )
FUNCTION RenameField( cFileName, cOldFieldName, cNewFieldName )

  LOCAL lSuccess := .F.
  LOCAL nHandle
  LOCAL nHeaderLength
  LOCAL nPointer := 32, nPos
  LOCAL cFieldName, aFieldNames := {}
  LOCAL cBytes

  cFileName := AllTrim( cFileName )
  cOldFieldName := Upper( AllTrim( cOldFieldName ) )
  cNewFieldName := Upper( AllTrim( cNewFieldName ) )

  // Feldname darf nicht laenger als 10 Zeichen sein
  if Len( cNewFieldName ) > 10
    RETURN .F.
  endif

  // File konnte geoeffnet werden
  if (  nHandle := FOpen( cFileName, FO_READWRITE )  )  !=  -1

    cBytes := Space( 2 )
    FSeek( nHandle, 8, FS_SET )  // beim 8ten Byte steht die Groesse des Dateiheaders
    FRead( nHandle, @cBytes, 2 )  // die 2 Bytes, die die Laenge des Dateiheaders enthalten, auslesen
    nHeaderLength := Bin2I( cBytes )  // in numerischen Wert umwandeln

    // - die Feldbeschreibung beginnt bei Byte 32
    // - die Angaben fuer ein Feld sind 32 Bytes lang
    // - im Folgenden werden alle Feldnamen mit Pointer in das Array aFieldNames eingelesen

    cBytes := Space( 10 )

    while ( nPointer + 32 ) < nHeaderLength  // in 32er Schritten, so lange bis nHeaderLength ueberschritten

      FSeek( nHandle, nPointer, FS_SET )  // auf Feldbeschreibung f. Feld n positionieren

      // - Feldnamen lesen (10 Zeichen)
      // - Chr(0) durch Nullstring "" ersetzen

      FRead( nHandle, @cBytes, 10 )  // Feldnamen einlesen

      cFieldName := StrTran( cBytes, Chr(0), "" )
      cFieldName := Upper( AllTrim( cFieldName ) )

      AAdd( aFieldNames, { cFieldName, nPointer } )

      nPointer += 32

    enddo

    // neuer Feldname existiert noch nicht
    if AScan( aFieldNames, { |a| a[1] == cNewFieldName } )  ==  0

      // alter Feldname wurde gefunden
      if (  nPos := AScan( aFieldNames, { |a| a[1] == cOldFieldName } )  )  >  0

        // ggf. auf 11 Zeichen mit Chr(0) auffuellen
        cNewFieldName := PadR( cNewFieldName, 11, Chr(0) )

        nPointer := aFieldNames[nPos][2]
        FSeek( nHandle, nPointer, FS_SET )  // auf zu aendernden Feldnamen positionieren

        if (  FWrite( nHandle, cNewFieldName )  >  0  )  // neuen Feldnamen in Datei schreiben
          lSuccess := .T.
        endif

      endif

    endif

    FClose( nHandle )

  endif

RETURN lSuccess

Code: Alles auswählen

*--------------------------------------------------------------------------
function DBMixStru(cZielDBF,acHinzu, nZielDBF)   // cZielDBF = Pfad+Dateiname der alten DBF.
                                                 // acHinzu  = Array mit neuen Feldern nach dbstru()
                                                 // oder     = Pfad+Dateiname der hinzuzufügenden DBF.
                                                 // nZielDBF = wenn cZielDBF schon exclusiv offen ist, hier den Selectbereich oder Alias angeben.
                                                 // DATEN werden nicht hinzugefügt !
                                                 // nur neue Felder / Feldlängen als Vorbereitung
                                                 // Wenn beide gleich sind, wird nichts geändert.
                                                 // .t. -> keine Fehler
                                                 // .f. -> Fehler sind aufgetreten.
   local lFehler     := .f.
   local aQuellStru, aHinzuStru, cTempDat
   local lStruNeu    := .f.
   local x, nQI

   /*
      die DBF etc. Endungen müssen entfernt werden, da
          1. temporäre Dateinamen gebildet werden müssen
          2. eventuelle DBT oder FPT Dateien vorhanden sein könnten.
   */

   if ! empty(nZielDBF)
      if ! (nZielDBF)->(used())
         nZielDBF := NIL
      endif
   endif

   if right(cZielDBF,4) = ".DBF"    // Endung abtrennen
      cZielDBF := left(cZielDBF,len(cZielDBF)-4)
   endif

   cTempDat := cZielDBF+"_TMP_"+strTran(time(),":","")

   if empty(nZielDBF) // nil oder leer => cZielDBF ist nicht offen.
      USE (cZielDBF) NEW exclusive alias MixStruQuelle  // diese Datei muß exclusiv öffenbar sein.
      if neterr()
         lFehler := .t.
      else
         nZielDBF := select()
      endif
   endif
   if ! lFehler
      // die Quelldatei bleibt offen, bis geklärt ist ob eine Anpassung nötig ist.
      // sonst könnte ein anderes Programm die Datei öffnen.
      aQuellStru := (nZielDBF)->(dbstruct())
   endif
   // Strukturarrays erzeugen
   do case
      case lFehler
           // ohne Quelldatei geht nichts mehr.
      case ValType(acHinzu) = "A"
           aHinzuStru := acHinzu
      case ValType(acHinzu) = "C"
           if right(acHinzu,4) = ".DBF"    // Endung abtrennen
              acHinzu := left(acHinzu,len(acHinzu)-4)
           endif
           USE (acHinzu) NEW readonly alias MixStruHinzu
           if neterr()
              lFehler := .t.
           else
              aHinzuStru := MixStruHinzu->(dbstruct())
           endif
      otherwise
           lFehler := .t.
   endcase
   // Neue Struktur ermitteln
   do case
      case lFehler
           // ohne Quelldatei geht nichts mehr.
      case empty(aQuellStru) .or. empty(aHinzuStru)
           lFehler := .t.
      otherwise
           for x := 1 to len(aHinzuStru) // alle neuen Felder prüfen !
               nQI := aScan(aQuellStru,{|aF| aF[DBS_NAME] == upper(aHinzuStru[x,DBS_NAME])})
               if nQI > 0               // Feld ist vorhanden, TYP und Längen prüfen
                  if aQuellStru[nQI,DBS_TYPE] == aHinzuStru[x,DBS_TYPE] // TYP ist gleich
                     if aQuellStru[nQI,DBS_LEN] # aHinzuStru[x,DBS_LEN] .or. ;
                        aQuellStru[nQI,DBS_DEC] # aHinzuStru[x,DBS_DEC]
                        lStruNeu := .t.     // Länge der Felder wurde geändert.
                        aQuellStru[nQI,DBS_LEN] := max(aQuellStru[nQI,DBS_LEN],aHinzuStru[x,DBS_LEN])
                        aQuellStru[nQI,DBS_DEC] := max(aQuellStru[nQI,DBS_DEC],aHinzuStru[x,DBS_DEC])
                     endif
                  else                  // Neuer TYP, neue Werte übernehmen
                     lStruNeu := .t.
                     aQuellStru[nQI,DBS_TYPE] := aHinzuStru[x,DBS_TYPE]
                     aQuellStru[nQI,DBS_LEN]  := aHinzuStru[x,DBS_LEN]
                     aQuellStru[nQI,DBS_DEC]  := aHinzuStru[x,DBS_DEC]
                  endif
               else                     // neues Feld, alles übernehmen
                  lStruNeu := .t.
                  aadd(aQuellStru, {aHinzuStru[x,1],aHinzuStru[x,2],aHinzuStru[x,3],aHinzuStru[x,4]})
               endif
           next
   endcase
   // nun haben wir die neue Struktur der Datei falls Änderungen vorhanden waren.
   if (nZielDBF)->(USED())
      (nZielDBF)->(dbCloseArea())
   endif
   if USED("MixStruHinzu")
      close MixStruHinzu
   endif
   // Änderungen nötig ?
   if lStruNeu   // Anpassungen nötig
      // dürfte nicht vorkommen, aber sicher ist sicher
      delete file (cTempDat+".DBF")
      delete file (cTempDat+".DBT")
      delete file (cTempDat+".FPT")
      rename (cZielDBF+".DBF") to (cTempDat+".DBF")
      rename (cZielDBF+".DBT") to (cTempDat+".DBT")
      rename (cZielDBF+".FPT") to (cTempDat+".FPT")
      dbcreate(cZielDBF, aQuellStru)
      use (cZielDBF) NEW exclusive ALIAS MixStruZiel
      DbImport(cTempDat)
      close MixStruZiel
      // alte Versionen bis zur nächsten Anpassung stehen lassen
*      delete file (cTempDat+".DBF")
*      delete file (cTempDat+".DBT")
*      delete file (cTempDat+".FPT")
   endif

return ! lFehler

Code: Alles auswählen

      AAdd( aStructure, {"FREI_TERMS","D",8,0} )
      AAdd( aStructure, {"FREI_TERMI","D",8,0} )

Code: Alles auswählen

ARemove( <aArray>    , [<nStartPos>],  [<nCount>]     ) 

Code: Alles auswählen

ADel()
ASize()