Inoffizielles deutsches Xbase-Forum

Code: Alles auswählen

FUNCTION Countat( cFile, cExt )
LOCAL nRet  := 0
LOCAL nPosi := 1
LOCAL nMax  := LEN(cFile)

   DO WHILE nPosi > 0
      nPosi := AT(cExt,cFile,nPosi+1)
      IF nPosi > 0
         nRet++
      ELSE
         EXIT
      ENDIF
   ENDDO
RETURN nRet

Beispiel :

  nPosi := Countat( UPPER(cFile),".AVI")
 cSuch := STRTRAN( UPPER(cFile),".AVI" ,".AVS", nPosi )

Code: Alles auswählen

   DBESETDEFAULT("deldbe")
   // Umschalten zu Multi-Field
   DbeInfo( COMPONENT_DATA, DELDBE_MODE, DELDBE_MULTIFIELD )

   // Semikolon als Trennzeichen zwischen den Spalten
   DBEINFO(COMPONENT_DATA, DELDBE_FIELD_TOKEN,";")

   // Kein Trennzeichen für Zeichenwerte
   DBEINFO(COMPONENT_DATA, DELDBE_DELIMITER_TOKEN, Chr(0) )

   DBEINFO(COMPONENT_DATA, DELDBE_MAX_BUFFERSIZE, 128*1024)
   // Währungen werden mit Komma getrennt
   DBEINFO(COMPONENT_DATA, DELDBE_DECIMAL_TOKEN, ",")

   CLS
*   Dbusearea(.T.,"DELDBE","SEMIKO.TXT",,.F.)
   USE ("SEMIKO.TXT") VIA DELDBE
   browse()

RETURN

Code: Alles auswählen

/*****
 *
 * TBR28.PRG
 * Browsing a text file - first approach
 *
 */

#include "inkey.ch"
#include "fileio.ch"
#include "setcurs.ch"

#include "samples.ch"
#include "tbrowse.ch"

#define           WHAT_IT_DOES           "ESC - Quit"

#xtranslate       BOFile()      =>       (n == nFirstRec)
#xtranslate       EOFile()      =>       (n == nLastRec)

// Global stuff
STATIC   cBuffer
STATIC   n
STATIC   nLastRec
STATIC   nFirstRec

/*****
 *
 * Main Function
 * WARNING: This program does not handle line overflow
 *
 */
PROCEDURE MAIN(cFile)
     TBR28(cFile)
RETURN

FUNCTION Tbr28( cFile )
   LOCAL nHandle, oBrow, nKey, nMaxRow, nMaxCol
   LOCAL oCol

   // Open file
   nHandle := FOPEN( cFile, FO_READ )
   IF nHandle < 0
      SCROLL()
      QOUT( MSG_TBR28_ERR )
      QUIT

   ENDIF

   // Screen (not handled by TBrowse
   SETCURSOR(SC_NONE)
   SETBLINK(.F.)   // This way you have more colors
   SETCOLOR(BR_TXT_BGND_CLR)
   SCROLL()
   nMaxRow := MAXROW()
   nMaxCol := MAXCOLUMN
   SCROLL()
   // "Shadow"
   SETCOLOR(BR_TXT_BLACK)
   SCROLL( 3, 4, nMaxRow - 2, nMaxCol - 2)
   SETCOLOR(BR_TXT_CLR_SPEC)
   @ 0, 0 SAY PADC(BR_TXT_HEADER, nMaxCol + 1) COLOR BR_TXT_HEAD_CLR
   @ nMaxRow, 0 SAY PADC(WHAT_IT_DOES, nMaxCol + 1) COLOR MSG_ROW_CLR

   // Positioning
   nLastRec  := FindBottom(nHandle)
   nFirstRec := n := FindTop(nHandle)

   // STEP 1
   oBrow := TBROWSEDB( 2, 2, nMaxRow - 3, nMaxCol - 4)
   oBrow:skipBlock     := {|x| SkipRec(x, nHandle)}
   oBrow:goTopBlock    := {||  n := FindTop(nHandle)}
   oBrow:goBottomBlock := {||  n := FindBottom(nHandle)}
   
   // STEP 2
   cBuffer := SPACE(RECSIZE)
   oCol := TBCOLUMNNEW( , {|| cBuffer} )
   oCol:width := nMaxCol - 5
   oBrow:addColumn(oCol)

   WHILE .T.
      // STEP 3
      ForceStable(oBrow)

      // STEP 4
      nKey := INKEY(0)
      IF !TBMoveCursor( nKey, oBrow )
         IF nKey == K_ESC
            EXIT

         ENDIF

      ENDIF

   END

   SCROLL()
   RETURN (NIL)

/*****
 *
 * Main Skipper
 *
 */

FUNCTION SkipRec( nRequest, nHandle )
   LOCAL nActually := 0

   IF (nRequest == 0)
      ReadLine(nHandle, 0)

   ELSEIF (nRequest > 0)
      WHILE (nActually < nRequest) .AND. ;
            (!EOFile())
         ReadLine(nHandle, 1)
         nActually++

      END

   ELSEIF (nRequest < 0)
      WHILE (nActually > nRequest) .AND. ;
         (!BOFile())
         ReadLine(nHandle, -1)
         nActually--

      END

   ENDIF

   RETURN (nActually)

/*****
 *
 * Top of File
 *
 */

FUNCTION FindTop(nHandle)
   LOCAL cBuff := SPACE(RECSIZE)
   LOCAL nAt

   FSEEK(nHandle, 0, FS_SET)
   FREAD(nHandle, @cBuff, RECSIZE)
   nAt := AT(CR, cBuff)

   RETURN (FSEEK(nHandle, nAt + 1, FS_SET))

/*****
 *
 * Bottom of File
 *
 */

FUNCTION FindBottom(nHandle)
   // Assume last byte is an LF
   RETURN (FSEEK(nHandle, 0, FS_END))

/*****
 *
 * Reads a line of text
 *
 */

FUNCTION ReadLine( nHandle, nRec )
   LOCAL cBuff := SPACE( RECSIZE )
   LOCAL nAt

   IF (nRec == 0)
      BackCRLF(nHandle, 1)

   ELSEIF (nRec < 0)
      BackCRLF(nHandle, 2)

   ENDIF

   FREAD(nHandle, @cBuff, RECSIZE)
   nAt := AT(CR, cBuff)
   FSEEK(nHandle, n, FS_SET)

   cBuff := SPACE(RECSIZE)
   FREAD(nHandle, @cBuff, nAt + 1)
   n := FSEEK(nHandle, 0, FS_RELATIVE)
   cBuffer := SUBSTR(cBuff, 1, RAT(CR, cBuff) - 1)

   RETURN (NIL)

/*****
 *
 * Pointer at proper place
 *
 */

FUNCTION BackCRLF(nHandle, nTimes)
   LOCAL cBuff
   LOCAL nCnt := 0

   FSEEK(nHandle, -2, FS_RELATIVE)

   WHILE (nCnt < nTimes)
      cBuff := SPACE(1)

      WHILE (cBuff != CR) .AND.;
            (FSEEK(nHandle, 0, FS_RELATIVE) != 0)
         FSEEK(nHandle, -1, FS_RELATIVE)
         FREAD(nHandle, @cBuff, 1)
         FSEEK(nHandle, -1, FS_RELATIVE)

      END
      nCnt++

   END

   IF (FSEEK(nHandle, 0, FS_RELATIVE) != 0)
      n := FSEEK(nHandle, 2, FS_RELATIVE)

   ELSE
      n := FSEEK(nHandle, 0, FS_SET)

   ENDIF

   RETURN (NIL)

// EOF - TBR28.PRG //

Code: Alles auswählen

#include "deldbe.ch"
#include "Fileio.ch"
PROCEDURE main()
          DBESETDEFAULT("deldbe")
          DBEINFO(COMPONENT_DATA, DELDBE_FIELD_TOKEN,CHR(9))                    
          DBEINFO(COMPONENT_DATA, DELDBE_DELIMITER_TOKEN, Chr(0) )              //
          DBEINFO(COMPONENT_DATA, DELDBE_MAX_BUFFERSIZE, 128*1024)
          DBEINFO(COMPONENT_DATA, DELDBE_DECIMAL_TOKEN, ",")                    // Währungen werden mit Komma getrennt
          DbeInfo(COMPONENT_DATA, DBE_EXTENSION,"")
          DBEINFO(COMPONENT_DATA, DELDBE_FIELD_TYPES, "NCCNNCNCCCCCNCCNNCCCCCC")

          Dbusearea(.T.,"DELDBE","generic",,.F.)
          RETURN

Code: Alles auswählen

use ( iquellpfad + ausdatei ) via ("DELDBE")

Code: Alles auswählen

use ( "Daten." ) via ("DELDBE")