LIBXL: ohne fpqcall und ot4xb möglich ?

Moderator: Moderatoren

Antworten
Benutzeravatar
BJelinek
Rekursionen-Architekt
Rekursionen-Architekt
Beiträge: 178
Registriert: Sa, 02. Jun 2012 20:57
Wohnort: 73257 Köngen
Hat sich bedankt: 1 Mal

LIBXL: ohne fpqcall und ot4xb möglich ?

Beitrag von BJelinek »

Hallo zusammen.

Kann man LIBXL auch ohne fpqcall und ot4xb nutzen ?

Kann man EXTERN in der 2.0 verwenden ?
Hat das jemand schon gemacht ?

Über Tipps und Hinweise würde ich mich sehr freuen.
Gruß
Bernd
Benutzeravatar
Jan
Marvin
Marvin
Beiträge: 14061
Registriert: Fr, 23. Sep 2005 18:23
Wohnort: 49328 Melle
Hat sich bedankt: 6 Mal
Danksagung erhalten: 30 Mal
Kontaktdaten:

Re: LIBXL: ohne fpqcall und ot4xb möglich ?

Beitrag von Jan »

Hallo Bernd,

da kann ich nur zu EXTERN was sagen. Nein, nicht auch in 2.0. Sondern nur in 2.0. Das hat Alaska mit irgend einem der Updates dort eingeführt. Ich benutze das, klappt hervorragend.

Jan
Mitglied der XUG Osnabrück
Mitglied der XUG Berlin/Brandenburg
Mitglied des Deutschsprachige Xbase-Entwickler e. V.
Benutzeravatar
BJelinek
Rekursionen-Architekt
Rekursionen-Architekt
Beiträge: 178
Registriert: Sa, 02. Jun 2012 20:57
Wohnort: 73257 Köngen
Hat sich bedankt: 1 Mal

Re: LIBXL: ohne fpqcall und ot4xb möglich ?

Beitrag von BJelinek »

Hallo Jan,
auch mit LIBXL ?

Wenn ja, dann kann ich mich mal an umbauen wagen.

Danke für die Info.
Gruß
Bernd
Benutzeravatar
Tom
Der Entwickler von "Deep Thought"
Der Entwickler von "Deep Thought"
Beiträge: 8367
Registriert: Do, 22. Sep 2005 23:11
Wohnort: Berlin
Hat sich bedankt: 16 Mal
Danksagung erhalten: 68 Mal
Kontaktdaten:

Re: LIBXL: ohne fpqcall und ot4xb möglich ?

Beitrag von Tom »

Ja, mit EXTERN ist einiges besser geworden, aber wenn man einen Pointer zurückbekommt (wie z.B. von QPDF), muss man doch noch mit ot4xb peeken.
Herzlich,
Tom
Benutzeravatar
AUGE_OHR
Marvin
Marvin
Beiträge: 12527
Registriert: Do, 16. Mär 2006 7:55
Wohnort: Hamburg
Hat sich bedankt: 3 Mal
Danksagung erhalten: 9 Mal

Re: LIBXL: ohne fpqcall und ot4xb möglich ?

Beitrag von AUGE_OHR »

hi Bernd,

deine Frage zu Ot4xb bezieht sich ja auf LibXL aber der Zweck war doch ein XLSx Sheed zu erzeugen welches mit Daten aus einer DBF "gefüttert" wurde.

anbei xBase Code mit HMG Syntax was aber leicht mach Xbase++ umzusetzen ist ( z.b. Syntax Progressbar)

ALLES was ActiveX OOP Syntax angeht ist 100% kompatible.
Unterschiede ergeben sich aus UTF8 und Codepage der DBF

der Code kann mit INSERT oder ADO Recordset arbeiten

Code: Alles auswählen

FUNCTION ADOxlsxWrite( ... )

   SET CENTURY ON
   SET DATE GERMAN

   oConnect := CreateObject( "ADODB.Connection" )

   bError := ERRORBLOCK( { | oErr | BREAK( oErr ) } )
   BEGIN SEQUENCE
      oConnect:Execute( "DROP TABLE " + myXlsFile )
   END SEQUENCE
   ERRORBLOCK( bError )

   //  ---------------------- Catalog -------------------------- *

   oCatalog := CreateObject( "ADOX.Catalog" )
   oCatalog:ActiveConnection := 'Provider=Microsoft.ACE.OLEDB.12.0;' + ;
                                'Data Source=' + myXlsFile + ';' + ;
                                'Extended Properties="Excel 12.0 Xml";'

   //  ---------------------- Create Table --------------------- *

   oTable := CreateObject( "ADOX.Table" )
   oTable:Name := "Sheet1"

   ii := 1
   FOR ii := 1 TO iMax
      cField := aStructure[ ii ] [ DBS_NAME ]
      cType := aStructure[ ii ] [ DBS_TYPE ]
      nLen := aStructure[ ii ] [ DBS_LEN ]
      nDec := aStructure[ ii ] [ DBS_DEC ]

      oColumn := CreateObject( "ADOX.Column" )
      oColumn:Name := cField

      DO CASE
         CASE cType = "C"
            oColumn:Type := adVarWChar
            oColumn:DefinedSize := nLen
            oColumn:Attributes := 2                                   // adColNullable
         CASE cType = "M"
            oColumn:Type := adLongVarWChar
            oColumn:Attributes := 2                                   // adColNullable
         CASE cType = "N"
            oColumn:Type := adDouble
            oColumn:DefinedSize := nLen
            oColumn:NumericScale := nDec
         CASE cType = "D"
            oColumn:Type := adDate
         CASE cType = "L"
            oColumn:Type := adBoolean
      ENDCASE

      oTable:Columns:Append( oColumn )
   NEXT

   // add Table to Catalog
   oCatalog:Tables:Append( oTable )

   oConnect:ConnectionString = 'Provider=Microsoft.ACE.OLEDB.12.0;' + ;
           'Data Source=' + myXlsFile + ';' + ;
           'Extended Properties="Excel 12.0 Xml";'

   oConnect:open()

   SetProperty( "ExportDbf", "ProgressBar_1", "Value", 0 )
   DO EVENTS   // harbour

   //  #define Use_INSERT .T.
#ifdef Use_INSERT
   //  ---------------------- INSERT INTO ---------------------- *

   // prepare String for Fields
   cSelect := "( "
   ii := 1
   FOR ii := 1 TO iMax
      cField := aStructure[ ii ] [ DBS_NAME ]
      cSelect += cField
      IF ii < iMax
         cSelect += ", "
      ENDIF
   NEXT
   cSelect += " ) "

   // now start
   nStart := SECONDS()
   GO TOP
   DO WHILE !EOF()
      ii := 1
      cSql := "INSERT INTO [Sheet1] " + cSelect + "VALUES ( "

      FOR ii := 1 TO iMax
         cField := aStructure[ ii ] [ DBS_NAME ]
         cType := aStructure[ ii ] [ DBS_TYPE ]
         nPosi := FIELDPOS( cField )
         xValue := FIELDGET( nPosi )

         DO CASE
            CASE cType = "C"
               xValue := "'" + STRTRAN( xValue, "'", " " ) + "'"
            CASE cType = "M"
               IF LEN( xValue ) > 64
                  xValue := "'Memo'"
               ELSE
                  xValue := "'" + STRTRAN( xValue, "'", " " ) + "'"
               ENDIF
            CASE cType = "D"

               IF EMPTY( xValue )
                  xValue := "0"
               ELSE
                  //  xValue := DTOC( xValue )
                  //  xValue := DTOS( xValue ) + "000001"
                  //  xValue := HB_STOT( DTOS( xValue ) + "000000" )
                  //  xValue := serial2dt(xValue )

                  xValue := STR( dt2serial( xValue ) )
               ENDIF

            CASE cType = "L"
               xValue := IF( xValue = .T., "TRUE", "FALSE" )
            CASE cType = "N"
               xValue := STR( xValue )
         ENDCASE

         cSql += xValue
         IF ii < iMax
            cSql += ","
         ENDIF
      NEXT
      cSql += ")"
      oConnect:Execute( cSql )
      onDummy( TIME(), cSql )

      nRowLine ++
      IF ( nRowLine % nEvery ) = 0
         nProz := CalcPos( nRowLine, nMax )
         IF nProz > 100
            nProz := 100
         ENDIF
         SetProperty( "ExportDbf", "ProgressBar_1", "Value", nProz )
         DO EVENTS
      ENDIF

      SKIP
   ENDDO

#ELSE
   //  ---------------------- ADO Recordset -------------------- *
   //    ALTD()

   objRS := CreateObject( "ADODB.Recordset" )
   objRS:Open( "Select * from [Sheet1]", oConnect, adOpenKeyset, adLockOptimistic )

   // now start
   nStart := SECONDS()
   GO TOP
   DO WHILE !EOF()
      aField := {}
      aValue := {}
      ii := 1
      FOR ii := 1 TO iMax
         cField := aStructure[ ii ] [ DBS_NAME ]
         cType := aStructure[ ii ] [ DBS_TYPE ]
         nPosi := FIELDPOS( cField )
         xValue := FIELDGET( nPosi )

         IF EMPTY( xValue )
            DO CASE
               CASE cType = "C"
                  xValue := " "
               CASE cType = "M"
                  xValue := " "
               CASE cType = "N"
                  xValue := 0.00
               CASE cType = "D"
                  xValue := CTOD( "  .  .  " )
               CASE cType = "L"
                  xValue := .F.
            ENDCASE
         ENDIF

         AADD( aField, cField )
         AADD( aValue, xValue )
      NEXT
      objRS:AddNew( aField, aValue )
      objRS:Update()                                                  // objRS:UpdateBatch()

      nRowLine ++
      IF ( nRowLine % nEvery ) = 0
         nProz := CalcPos( nRowLine, nMax )
         IF nProz > 100
            nProz := 100
         ENDIF

         SetProperty( "ExportDbf", "ProgressBar_1", "Value", nProz )
         DO EVENTS   // harbour
      ENDIF

      SKIP
   ENDDO

   objRS:Close()
   objRS := NIL

#ENDIF

   oConnect:Close()
   oConnect := NIL

   nStop := SECONDS() - nStart
   onDummy( TIME(), "finish after " + LTRIM( STR( nStop ) ) )

   oCatalog := NIL
   oTable := NIL
   oColumn := NIL

   hb_cdpSelect( cOldLang )

   SetCursorWait( "WinLeft", .F. )
   SetCursorWait( "WinRight", .F. )

   DO EVENTS    // harbour
   //    Msginfo( "finish after " + LTRIM( STR( nStop ) ) )

RETURN .T.
wenn Office installiert ist die jeweilige xxxx Version installiueren damit die "selbe" Runtime verwendet wird

Microsoft Access Database Engine xxxx Redistributable
hier link für v2010
https://www.microsoft.com/en-us/downloa ... n&id=13255
gruss by OHR
Jimmy
Antworten