REM $STACK
REM $NOEVENT
REM $NOBREAK
REM $NOAUTODIM
REM $NOLINES
REM $NODEBUG
REM $OVERFLOW
REM $ADDICON
REM $ERRORS
REM $INCPATH MB_INCLUDES:BH
REM $LIBPATH MB_INCLUDES:BMAP
REM $NOWINDOW
REM $NOLIBRARY
REM MAXONBASIC3

revision$="$VER: MicroBase dBView 1.0.3, Rev. 29.07.1996 - ©FR-SW"
WINDOW 5,MID$(revision$,7,22)
DEFINT a - z
CONST TAG_DONE&=0
CONST DBFBUFLEN&=4097
DIM frtags&(20)
DIM q&(4097)
ext$=".DBF"
reverse$=""
accept$=""

DECLARE FUNCTION trim$(a$)
DECLARE SUB forminput(fil%,a$)

LIBRARY "exec.library"
DECLARE FUNCTION AllocMem&(l&,r&) LIBRARY
DECLARE FUNCTION FreeMem&(b&,l&) LIBRARY
LIBRARY "dos.library"
DECLARE FUNCTION xOpen&(n&,m&) LIBRARY
DECLARE FUNCTION xClose&(fh&) LIBRARY
DECLARE FUNCTION xRead&(fh&,buf&,l&) LIBRARY
DECLARE FUNCTION Seek&(fh&,p&,m&) LIBRARY
REM $include asl.bh
LIBRARY OPEN "exec.library"
LIBRARY OPEN "dos.library"
LIBRARY OPEN "asl.library"

dbfansi$=""
RESTORE ibm
FOR i%=0 TO 255
  READ t%
  dbfansi$=dbfansi$+CHR$(t%)
NEXT i%

GOSUB aslreq

IF back$>""
  fhbuf&=AllocMem&(DBFBUFLEN&,65539&)
  bac$=back$+CHR$(0)
  back&=SADD(bac$)
  fhdos&=xOpen&(back&,1004)
  r&=xRead&(fhdos&,fhbuf&,1)
  dbfvers$=CHR$(PEEK(fhbuf&))
  dbf&=ASC(dbfvers$)
  update$=""
  r&=xRead(fhdos&,fhbuf&,1)
  update$=update$+RIGHT$("00"+STR$(PEEK(fhbuf&)),2)
  r&=xRead(fhdos&,fhbuf&,1)
  update$=update$+RIGHT$("00"+STR$(PEEK(fhbuf&)),2)
  r&=xRead(fhdos&,fhbuf&,1)
  update$=update$+RIGHT$("00"+STR$(PEEK(fhbuf&)),2)
  update$=RIGHT$(update$,2)+"."+MID$(update$,3,2)+"."+LEFT$(update$,2)
  r&=xRead&(fhdos&,fhbuf&,4)
  reverse$=CHR$(PEEK(fhbuf&))+CHR$(PEEK(fhbuf&+1))+CHR$(PEEK(fhbuf&+2))+CHR$(PEEK(fhbuf&+3))
  GOSUB umdrehen
  reccount&=CVL(reverse$) 
  r&=xRead&(fhdos&,fhbuf&,2)
  reverse$=CHR$(PEEK(fhbuf&))+CHR$(PEEK(fhbuf&+1))
  GOSUB umdrehen
  headerlength&=CVI(reverse$)
  r&=xRead&(fhdos&,fhbuf&,2)
  reverse$=CHR$(PEEK(fhbuf&))+CHR$(PEEK(fhbuf&+1))
  GOSUB umdrehen
  reclength&=CVI(reverse$)
  fieldcount&=(headerlength&-1)/32-1
  DIM fldnam$(fieldcount&),fldtyp$(fieldcount&),fldadr&(fieldcount&)
  DIM fldlen&(fieldcount&),flddec&(fieldcount&)
  dbf$="<unbekannt>"
  dbt$=dbf$
  db3p$="Ashton Tate dBASE III+"
  fp25$="Microsoft FoxPro 2.5"
  la3$="Lotus Approach 3.0 [dBASE IV]"
  IF dbf&=3
    dbf$=db3p$
    dbt$=""
  END IF
  IF dbf&=131
    dbf$=db3p$
    dbt$=LEFT$(back$,LEN(back$)-3)+"DBT"
  END IF
  IF dbf&=139
    dbf$=la3$
    dbt$=LEFT$(back$,LEN(back$)-3)+"DBT"
  END IF
  IF dbf&=245
    dbf$=fp25$
    dbt$=LEFT$(back$,LEN(back$)-3)+"FPT"
  END IF
  PRINT "1. Datei"
  PRINT "--------"
  PRINT
  PRINT "Datei:       ";back$
  PRINT "Version :    ";dbf$
  PRINT "Memos:       ";dbt$
  PRINT "Datum:       ";update$
  PRINT "Felder:      "fieldcount&
  PRINT "Sätze:       ";reccount&
  PRINT "Headerlänge: ";headerlength&
  PRINT
  a$=INPUT$(1)
  feld&=0
  FOR i&=1 TO fieldcount&
    CLS
    PRINT "2. Felder"
    PRINT "---------"    
    PRINT
    r&=Seek&(fhdos&,(32*i&),(-1&))
    r&=xRead&(fhdos&,fhbuf&,11&)
    POKE fhbuf&+11,0
    PRINT "Feld: ";i&
    fldnam$=PEEK$(fhbuf&)
    fldnam$(i&)=trim$(fldnam$)
    PRINT "Name: ";fldnam$(i&)
    r&=xRead&(fhdos&,fhbuf&,1&)
    fldtyp$(i&)=CHR$(PEEK(fhbuf&))
    PRINT "Typ: ";fldtyp$(i&)
    r&=xRead&(fhdos&,fhbuf&,4&)
    reverse$=CHR$(PEEK(fhbuf&))+CHR$(PEEK(fhbuf&+1))+CHR$(PEEK(fhbuf&+2))+CHR$(PEEK(fhbuf&+3))
    GOSUB umdrehen
    fldadr&(i&)=CVL(reverse$)
    PRINT "Adresse: ";fldadr&(i&)
    r&=xRead&(fhdos&,fhbuf&,1&)
    fldlen&(i&)=PEEK(fhbuf&)
    PRINT "Länge: ";fldlen&(i&);",";
    r&=xRead&(fhdos&,fhbuf&,1&)
    flddec&(i&)=PEEK(fhbuf&)
    PRINT fld_dec&(i&)
    IF fldtyp$(i&)="M"
      q&(i&)=0
    ELSE
      INCR feld&
      q&(i&)=fldlen&(i&)
    END IF
    IF fldtyp$(i&)="D"
      q&(i&)=q&(i&)+2
    END IF
    a$=INPUT$(1)
  NEXT i&
    CLS
    PRINT "3. Anzeige der Datensätze"
    PRINT "-------------------------"
    PRINT
    ic$="J"
  PRINT "ASCII nach ANSI konvertieren (J|N) ";
  forminput 1,ic$
  IF UCASE$(ic$)="J"
    ic!=1
  END IF
  PRINT
  PRINT
  i&=1
  WHILE UCASE$(weiter$)<>"Q"
    p&=Seek&(fhdos&,headerlength&+reclength&*(i&-1),-1&)
    r&=xRead&(fhdos&,fhbuf&,1&)
    recdel$=CHR$(PEEK(fhbuf&))
    out$=""
    CLS
    PRINT "3. Anzeige der Datensätze"
    PRINT "-------------------------"
    PRINT
    PRINT "Satz: ";i&;
    LOCATE CSRLIN,50
    IF recdel$="*"
      PRINT "*Löschmarkierung*"
    END IF
    PRINT
    FOR t&=1 TO fieldcount&
      PRINT fldnam$(t&);":";
      LOCATE CSRLIN,15
      r&=xRead&(fhdos&,fhbuf&,fldlen&(t&))
      POKE fhbuf&+fldlen&(t&),0
      a$=PEEK$(fhbuf&)
      d$ = ""
      ft$= fldtyp$(t&)
      IF ft$ = "C"
        IF ic!
          ibm2ansi (a$)
          d$=ibm2ansi$
        ELSE
          d$=a$
        END IF
      END IF
      IF ft$ = "N"
        IF flddec&(t&)=0
          d$=a$
        ELSE
          d$=LEFT$(a$,fldlen&(t&)-flddec&(t&)-1)+"."+MID$(a$,fldlen&(t&)-flddec&(t&)+1)
          IF LEFT$(d$,1)="."
            d$=MID$(d$,2)
          END IF
        END IF
        uix&=INSTR(d$,",")
        IF uix&<>0
          MID$(d$,uix&,1)="."
        END IF
      END IF
      IF ft$ = "D"
        d$=RIGHT$(a$,2)+"."+MID$(a$,5,2)+"."+LEFT$(a$,4)
      END IF
      IF ft$ = "M"
        d$="<Memos werden nicht unterstützt>"
      END IF
      IF ft$="L"
        d$=a$
      END IF
      PRINT d$
      IF INKEY$<>""
        x$=INPUT$(1)
      END IF
    NEXT t&
    weiter$=INPUT$(1)
    IF weiter$="+"
      INCR i&
    END IF
    IF weiter$="*"
      i& = i& + 10
    END IF
    IF weiter$="-"
      DECR i&
    END IF
    IF weiter$="_"
      i& = i& - 10
    END IF  
    IF (i& > reccount&)
      i&=1
    END IF
    IF (i& < 1)
      i&=reccount&
    END IF
  WEND
  r&=xClose&(fhdos&)
  r&=FreeMem&(fhbuf&,DBFBUFLEN&)
END IF
END

umdrehen:
	tvi$=reverse$
	reverse$=""
	FOR tt&=LEN(tvi$) TO 1 STEP -1
	  reverse$=reverse$+MID$(tvi$,tt&,1)
	NEXT tt&
RETURN

SUB ibm2ansi(tvi$)
	SHARED ibm2ansi$, dbfansi$
	ibm2ansi$=""
	FOR tt&=1 TO LEN(tvi$)
		ft%=ASC(MID$(tvi$,tt&,1))
		tvw$=MID$(dbfansi$,ft%+1,1)
		IF tvw$<>CHR$(1)
  		ibm2ansi$=ibm2ansi$+tvw$
		END IF
	NEXT tt&
END SUB

aslreq:
	back$=""
	TAGLIST VARPTR(frtags&(0)),ASLFR_TitleText&,"Bitte dBASE-Datei wählen", _
			ASLFR_InitialFile&,"", _
			ASLFR_InitialDrawer&, CURDIR$, _
			TAG_DONE&

	fr&=AllocAslRequest&(ASL_FileRequest&,VARPTR(frtags&(0)))
	IF fr& THEN
		IF AslRequest&(fr&,0) THEN
			aslfile$=PEEK$(PEEKL(fr&+fr_File))
			asldir$=PEEK$(PEEKL(fr&+fr_Drawer))
			IF RIGHT$(asldir$,1)<>":" AND RIGHT$(asldir$,1)<>"/"
			  asldir$=asldir$+"/"
			END IF
			back$=asldir$+aslfile$
		END IF
		FreeASlRequest fr&
	END IF
RETURN	

FUNCTION trim$(a$)
'Ersatz für GFA-Trim$()
  trim$=LTRIM$(RTRIM$(a$))
END FUNCTION

SUB forminput(fil%,a$)
'Ersatz für GFA-Form Input. fil%=Maximallänge, a$=Eingabestring
'Beenden mit Return, Löschen mit ESC.
  fiz%=CSRLIN
  fis%=POS(0)
  fis$=SPACE$(fil%)
  fip%=1
  fi$=""
  a$=LEFT$(LTRIM$(RTRIM$(a$)),fil%)
  WHILE fi$<>CHR$(13)
    LOCATE fiz%,fis%
    PRINT LEFT$(a$+fis$,fil%);
    LOCATE fiz%,fis%+fip%-1
    COLOR 0,1
    PRINT LEFT$(MID$(a$,fip%,1)+" ",1);
    COLOR 1,0
    fi:
    fi$=INKEY$
    IF fi$="" GOTO fi
    fia%=ASC(fi$)
    SELECT CASE fia%
    CASE 13
    CASE 30
      INCR fip%
    CASE 31
      DECR fip%
    CASE 8
      IF fip%>1
        a$=LEFT$(a$,fip%-2)+MID$(a$,fip%)
        DECR fip%
      END IF
    CASE 27
      a$=""
      fip%=1
    CASE ELSE
      IF ((ASC(fi$) AND 127) > 31)
        a$=LEFT$(a$+fis$,fip%-1)+fi$+MID$(a$,fip%)
      END IF
    END SELECT
    IF fip%<1
      fip%=1
    END IF
    IF fip%>fil%
      fip%=fil%
    END IF
  WEND
  a$=LEFT$(a$,fil%)
  LOCATE fiz%,fis%
  PRINT LEFT$(a$+fis$,fil%);
END SUB

ibm:
DATA 1, 1, 1, 1, 1, 1, 1, 183, 176, 1, 1, 1, 1, 1, 1, 45, 1, 1
DATA 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 32, 33, 34, 35, 36
DATA 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, 48, 49, 50, 51, 52, 53, 54, 55
DATA 56, 57, 58, 59, 60, 61, 62, 63, 64, 65, 66, 67, 68, 69, 70, 71, 72, 73, 74
DATA 75, 76, 77, 78, 79, 80, 81, 82, 83, 84, 85, 86, 87, 88, 89, 90, 91, 92, 93
DATA 94, 95, 96, 97, 98, 99, 100, 101, 102, 103, 104, 105, 106, 107, 108, 109
DATA 110, 111, 112, 113, 114, 115, 116, 117, 118, 119, 120, 121, 122, 123, 124
DATA 125, 126, 1, 199, 252, 233, 226, 228, 224, 229, 231, 234, 235, 232, 239
DATA 238, 236, 196, 197, 201, 230, 198, 244, 246, 242, 251, 249, 255, 214, 220
DATA 162, 163, 165, 1, 1, 225, 237, 243, 250, 241, 209, 170, 186, 191, 1, 172
DATA 189, 188, 161, 171, 187, 1, 1, 1, 124, 1, 1, 1, 1, 1, 1, 1, 1
DATA 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1
DATA 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1
DATA 223, 1, 182, 1, 1, 181, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 177, 1
DATA 1, 1, 1, 1, 1, 176, 183, 183, 1, 1, 178, 183, 32