MEM-Datei aus Clipper

Auf dem Weg von Clipper, FoxPro u.ä. nach Xbase++

Moderator: Moderatoren

Antworten
Benutzeravatar
Rolf Ramacher
Der Entwickler von "Deep Thought"
Der Entwickler von "Deep Thought"
Beiträge: 1930
Registriert: Do, 09. Nov 2006 10:33
Wohnort: Bergheim
Danksagung erhalten: 3 Mal
Kontaktdaten:

MEM-Datei aus Clipper

Beitrag von Rolf Ramacher »

Hallo,

kann ich *.mem - Dateien mit Xbase öffnen. ??
Gruß Rolf

Mitglied der Gruppe XUG-Cologne
www.xug-cologne.de
Benutzeravatar
Tom
Der Entwickler von "Deep Thought"
Der Entwickler von "Deep Thought"
Beiträge: 9361
Registriert: Do, 22. Sep 2005 23:11
Wohnort: Berlin
Hat sich bedankt: 101 Mal
Danksagung erhalten: 361 Mal
Kontaktdaten:

Beitrag von Tom »

Hallo, Rolf.

Steinalter Code, ich weiß auch nicht, woher die Vorlage stammt:

Code: Alles auswählen

    cMemData := filestr(cMemFile)
    cMemRec := space(32)
    fHandle := FOPEN(cMemFile, FO_READ + FO_DENYWRITE)
    WHILE FREAD(fHandle, @cMemRec, 32) == 32
            /*
             * Get info about variable.
             */
            cName := LEFT(cMemRec, AT(CHR(0), cMemRec) - 1)
            cType := CHR(ASC(SUBSTR(cMemRec, 12, 1)) - 128)
            nLen  := ASC(SUBSTR(cMemRec, 17, 1))
            nDec  := ASC(SUBSTR(cMemRec, 18, 1))
            xVar := cName

            /*
             * dump variable's value
             */
            DO CASE
                    /*
                     * string of length 'nLen' + 'nDec' * 256 follows record
                     */
                    CASE cType == 'C'
                            nSize := nLen + nDec * 256
                            cStr := SPACE(nSize)
                            FREAD(fHandle, @cStr, nSize)
                            /*
                             * cut trailing CHR(0)
                             */
                            cStr := SUBSTR(cStr, 1, LEN(cStr)-1)
                            &xVar := cStr

                    /*
                     * one byte (0 or 1) follows if of type LOGICAL
                     */
                    CASE cType == 'L'
                            cStr := SPACE(1)
                            FREAD(fHandle, @cStr, 1)
                            &xVar := IF(ASC(cStr) == 0, ".F.", ".T.")

                    /*
                     * 8 byte (sizeof(double)) follow if of type NUMERIC
                     */
                    CASE cType == 'N'
                            cStr := SPACE(8)
                            FREAD(fHandle, @cStr, 8)
                            &xVar := _BIN2NUM(cStr)

                    /*
                     * 8 byte (sizeof(double)) follow if of type DATE
                     */
                    CASE cType == 'D'
                            cStr := SPACE(8)
                            FREAD(fHandle, @cStr, 8)
                            &xVar := CTOD('01.01.0100') + _BIN2NUM(cStr) - 1757585
            END

    END
    FCLOSE(fHandle)
Edit: Verlangt fileio.ch und die XBase-Tools. Dieser Code erzeugt Memvars, die denjenigen aus der MEM-Datei entsprechen. Kann man natürlich auch anders machen. :wink:
Herzlich,
Tom
Benutzeravatar
Rolf Ramacher
Der Entwickler von "Deep Thought"
Der Entwickler von "Deep Thought"
Beiträge: 1930
Registriert: Do, 09. Nov 2006 10:33
Wohnort: Bergheim
Danksagung erhalten: 3 Mal
Kontaktdaten:

Beitrag von Rolf Ramacher »

Hi Tom,

wo finde ich denn die Function _BIN2NUM ??
- In der Doku aber auch in Tools nicht zu finden
Gruß Rolf

Mitglied der Gruppe XUG-Cologne
www.xug-cologne.de
Benutzeravatar
AUGE_OHR
Marvin
Marvin
Beiträge: 12906
Registriert: Do, 16. Mär 2006 7:55
Wohnort: Hamburg
Hat sich bedankt: 19 Mal
Danksagung erhalten: 45 Mal

Beitrag von AUGE_OHR »

hi,

vielleicht hilft diese Routine von PHIL IDE

Code: Alles auswählen

/*****************************
* Source : memedit.prg
* System : 
* Author : Phil Ide
* Created: 07-Dec-2004
*
* Purpose: 
* ----------------------------
* History:                    
* ----------------------------
* 07-Dec-2004 14:39:39 idep - Created
*
* ----------------------------
* Last Revision:
*    $Rev$
*    $Date$
*    $Author$
*    $URL$
*    
*****************************/

#include "common.ch"
#include "fileio.ch"

#define CRLF Chr(13)+Chr(10)
#define SIZEOF_MEM_RECORD       32

#define VAR_NAME  1
#define VAR_TYPE  2
#define VAR_LEN   3
#define VAR_DEC   4
#define VAR_VALUE 5

#define VAR_SIZE 5

STATIC nIn
STATIC nOut

Procedure main( cMemFile )
   local fHandle

   set century on
   set epoch to 1950

   if PCount() < 1
      Help()
   else
      if FExists(cMemFile)
         ManipulateMemFile(cMemFile)
      else
         Help()
      endif
   endif
   return

Procedure Help()
   ? 'Usage: MemEdit <memfile>'
   return

Procedure ManipulateMemFile(cMemFile)
   local aVars

   aVars := ReadMemFile(cMemFile)
   if Len(aVars) > 0
      EditVars(aVars)
      WriteVars(aVars, cMemFile)
   endif
   return

Function ReadMemFile(cMemFile)
   local aVars := {}
   local cMemRec := Space(SIZEOF_MEM_RECORD)
   local cName
   local cType
   local nLen
   local nDec
   local nSize
   local fHandle

   if (fHandle := FOPEN(cMemFile, FO_READ + FO_DENYWRITE)) > 0

      while FRead(fHandle, @cMemRec, SIZEOF_MEM_RECORD ) == SIZEOF_MEM_RECORD
         cName := Left( cMemRec, At(Chr(0),cMemRec) -1 )
         cType := Chr(Asc(SubStr(cMemrec,12,1))-128)
         nLen  := Asc(SubStr(cMemRec,17,1))
         nDec  := Asc(SubStr(cMemRec,18,1))

         Aadd( aVars, Cast2Var(fHandle,cName,cType,nLen,nDec) )
      enddo
      FClose(fHandle)
   endif
   return aVars

Function WriteVars(aVars, cMemFile)
   local i
   local cVar
   local cBuff := ''
   local cType
   local x
   local nH
   local lOk := FALSE

   if (nH := FCreate(cMemFile)) > 0
      for i := 1 to Len(aVars)
         cVar := Replicate(Chr(0),SIZEOF_MEM_RECORD)

         cVar := Stuff( cVar, 1, Len(aVars[i][VAR_NAME]), upper(aVars[i][VAR_NAME]) )

         cType := aVars[i][VAR_TYPE]

         cVar[12] := Chr(Asc(aVars[i][VAR_TYPE])+128)
         cVar[17] := Chr(aVars[i][VAR_LEN])
         cVar[18] := Chr(aVars[i][VAR_DEC])

         do case
            case cType == 'C'
               cVar[17] := Chr(aVars[i][VAR_LEN]%256)
               cVar[18] := Chr(Int(aVars[i][VAR_DEC]/256))
               cVar += aVars[i][VAR_VALUE]+Chr(0)

            case cType == 'D'

               //x := ctod('01/01/0100')//-1757585
               x := aVars[i][VAR_VALUE]
               x := Val(DtoS(x))-17587860

               nOut := F2Bin( x )
               x := F2Bin( x )
               cVar += x

            case cType == 'N'
               cVar += F2Bin(aVars[i][VAR_VALUE])

            case cType == 'L'
               cVar += Chr(iif(aVars[i][VAR_VALUE],1,0))

         endcase
         FWrite(nH,cVar)
      next
      FWrite(nH,Chr(0x1a))
      FClose(nH)
      lOk := (FError() == 0)
   endif
   return lOk

Function Cast2Var(fHandle,cName,cType,nLen,nDec)
   local aRet := Array(VAR_SIZE)
   local nSize
   local cStr

   aRet[VAR_NAME ] := cName
   aRet[VAR_TYPE ] := cType
   aRet[VAR_LEN  ] := nLen
   aRet[VAR_DEC  ] := nDec

   do case
      case cType == 'C'
         nSize := nLen + nDec * 256
         cStr := SPACE(nSize)
         FREAD(fHandle, @cStr, nSize)
         cStr := SUBSTR(cStr, 1, LEN(cStr)-1)
         aRet[VAR_VALUE] := cStr

      case cType == 'L'
         cStr := SPACE(1)
         FREAD(fHandle, @cStr, 1)
         aRet[VAR_VALUE] := IF(ASC(cStr) == 0, .F., .T.)

      case cType == 'N'
         cStr := Space(8)
         FRead(fHandle,@cStr,8)
         aRet[VAR_VALUE] := Bin2F(cStr)

      case cType == 'D'
         cStr := SPACE(8)
         FREAD(fHandle, @cStr, 8)
         aRet[VAR_VALUE] := CTOD(DTOC(CTOD('01/01/0100') +        ;
            Bin2F(cStr) - 1757585))
         nIn := Bin2F(cStr)

   endcase
   return aRet

Procedure EditVars(aVars)
   local i

   // do some editing here

   // add a couple of new records if these variabes are missing
   if (i := AScan( aVars, {|e| e[VAR_NAME] == "DVAR2" } )) == 0
      aadd( aVars, {"dVar2","D",8,0,Date()+2} )
      aadd( aVars, {"nVar2","N",8,0,Val(Dtos(Date()))} )
   endif

   // demonstrate changing a variable
   if (i := AScan( aVars, {|e| e[VAR_NAME] == "LVAR" } )) > 0
      aVars[i][VAR_VALUE] := !aVars[i][VAR_VALUE]
   endif
   return

gruss by OHR
Jimmy
Antworten