A Tool for DBF

dbmate.prg

PARAMETERS p1, p2, p3, p4, p5, p6
SET TALK OFF
SET DELETED ON
SET EXACT ON
SET ESCAPE OFF
SET EXCLUSIVE ON
SET CENTURY ON
SET REPROCESS TO AUTOMATIC
SET RESOURCE OFF
SET STATUS OFF
SET SAFETY OFF
SET COLOR TO w+/n
SET COLOR OF FIELDS TO w/n

paracount=PARAMETERS()
IF paracount==0
  iserror=.T.
  p1=''
ELSE
  iserror=.F.
  p1=UPPER(p1)
  ERASE *.CDX
ENDIF

DO CASE
  CASE p1=='IMPORT'
    IF paracount==3
      handle=FOPEN(p2)
      USE (p3)
      DIMENSION fname[32]
      DIMENSION fvalue[32]
      oneline=ALLTRIM(STRTRAN(FGETS(handle),CHR(9),' '))+' '
      j=1
      DO WHILE !EMPTY(oneline)
        fname[j]=LEFT(oneline,AT(' ',oneline)-1)
        oneline=LTRIM(SUBSTR(oneline,AT(' ',oneline)))
        j=j+1
      ENDDO
      DO WHILE !FEOF(handle)
        APPEND BLANK
        oneline=ALLTRIM(STRTRAN(FGETS(handle),CHR(9),' '))+' '
        i=1
        DO WHILE !EMPTY(oneline) .AND. i<j
          fvalue[i]=LEFT(oneline,AT(' ',oneline)-1)
          oneline=LTRIM(SUBSTR(oneline,AT(' ',oneline)))
          fieldname=fname[i]
          DO CASE
            CASE TYPE(fieldname)=='C'
              fieldvalue=STRTRAN(fvalue[i],'_',' ')
            CASE TYPE(fieldname)=='L'
              fieldvalue=AT(LEFT(fvalue[i],1),'TtYy1')>0
            CASE TYPE(fieldname)=='N'
              fieldvalue=VAL(fvalue[i])
            CASE TYPE(fieldname)=='D'
              fieldvalue=CTOD(fvalue[i])
            OTHERWISE
              fieldvalue=fvalue[i]
          ENDCASE
          REPLACE (fieldname) WITH fieldvalue
          i=i+1
        ENDDO
      ENDDO
      handle=FCLOSE(handle)
    ELSE
      iserror=.T.
    ENDIF
  CASE p1=='APPEND'
    DO CASE
      CASE paracount==3
        USE (p3)
        APPEND FROM (p2)
      CASE paracount==4 .OR. paracount==5 .OR. paracount==6
        p6=IIF(paracount==5,p5,p6)
        USE (p3) IN 0
        INDEX ON EVALUATE(p4) TAG indextag
        SET ORDER TO indextag
        SELECT 0
        USE (p2)
        SCAN
          tagvalue=EVALUATE(p4)
          IF paracount==4
            SCATTER MEMVAR
            SELECT (p3)
            IF !SEEK(tagvalue)
              APPEND BLANK
              GATHER MEMVAR
            ENDIF
          ELSE
            newvalue=EVALUATE(p5)
            SELECT (p3)
            IF !SEEK(tagvalue)
              APPEND BLANK
              REPLACE (p6) WITH newvalue
            ENDIF
          ENDIF
          SELECT (p2)
        ENDSCAN
      OTHERWISE
        iserror=.T.
    ENDCASE
  CASE p1=='REPLACE'
    IF paracount==4 .OR. paracount==5 .OR. paracount==6
      p6=IIF(paracount==5,p5,p6)
      USE (p3) IN 0
      INDEX ON EVALUATE(p4) TAG indextag
      SET ORDER TO indextag
      SELECT 0
      USE (p2)
      SCAN
        tagvalue=EVALUATE(p4)
        IF paracount==4
          SCATTER MEMVAR
          SELECT (p3)
          IF SEEK(tagvalue)
            GATHER MEMVAR
          ENDIF
        ELSE
          newvalue=EVALUATE(p5)
          SELECT (p3)
          IF SEEK(tagvalue)
            REPLACE (p6) WITH newvalue
          ENDIF
        ENDIF
        SELECT (p2)
      ENDSCAN
    ELSE
      iserror=.T.
    ENDIF
  CASE p1=='UNIQUE'
    IF paracount==3
      USE (p2)
      INDEX ON EVALUATE(p3) TAG indextag
      SET ORDER TO indextag
      prevalue=EVALUATE(p3)
      needask=.T.
      SKIP
      DO WHILE !EOF()
        IF prevalue==EVALUATE(p3)
          IF needask
            SKIP -1
            DISPLAY
            WAIT "Press any key to see the next one ....."
            SKIP
            DISPLAY
            ?? 'Which one should be deleted '
            ?? '(0:only2nd,1:first,2:second,3:both,other:none)? '
            choice=INKEY(0)
            ?? CHR(choice)
            IF choice==48
              needask=.F.
              choice=50
            ENDIF
          ENDIF
          DO CASE
            CASE choice==49
              SKIP -1
              DELETE
              SKIP
            CASE choice==50
              DELETE
            CASE choice==51
              SKIP -1
              DELETE NEXT 2
          ENDCASE
        ENDIF
        prevalue=EVALUATE(p3)
        SKIP
      ENDDO
    ELSE
      iserror=.T.
    ENDIF
  CASE p1=='DO'
    SET STATUS ON
    SET SAFETY ON
    DO CASE
      CASE paracount==1
        oneline=SPACE(128)
        oldcom=oneline
        DO WHILE .T.
          @ 21,0 SAY '.' GET oneline PICTURE '@s78'
          READ
          keyvalue=MOD(READKEY(),256)
          DO CASE
            CASE keyvalue==4
              oneline=oldcom
            CASE keyvalue==12
              oneline=SPACE(128)
            CASE keyvalue==15
              oldcom=oneline
              oneline=ALLTRIM(oneline)
              &oneline
              SCROLL 0,0,21,79,1
              oneline=SPACE(128)
          ENDCASE
        ENDDO
      CASE paracount==2
        FOR i=1 TO ADIR(dbfarray,'*.DBF')
          filename=dbfarray[i,1]
          ? '(',ALLTRIM(STR(i)),') ',filename
          USE (filename)
          &p2
        ENDFOR
      CASE paracount==3
        USE (p3)
        &p2
      OTHERWISE
        iserror=.T.
    ENDCASE
    SET STATUS OFF
  OTHERWISE
    iserror=.T.
ENDCASE

IF iserror
  ? 'DBMATE v2.6 by Chao, Wei-Lun 2000-04-15'
  ? 'usage:'
  ? '      DBMATE IMPORT  old.txt newalias'
  ? '      DBMATE APPEND  oldalias newalias [indexexpress [oldexpress [newfield]]]'
  ? '      DBMATE REPLACE  oldalias newalias indexexpress [oldexpress [newfield]]'
  ? '      DBMATE UNIQUE  alias indexexpress'
  ? '      DBMATE DO  [command [alias]]'
ELSE
  CLOSE ALL
  ERASE *.CDX
ENDIF
*SET COLOR TO w/n
*QUIT

PROCEDURE dumb
  MODIFY STRUCTURE
  PACK
  COPY TO dumb
  CREATE dumb
  SELECT * FROM dumb INTO CURSOR dumb
  RUN dumb
  LOCATE FOR dumb==dumb
  ZAP
  MODIFY REPORT dumb
  REPORT