home *** CD-ROM | disk | FTP | other *** search
/ Amiga MA Magazine 1998 #6 / amigamamagazinepolishissue1998.iso / nieuûytki / dbf2asc / deutsch / dbview2.bas < prev    next >
BASIC Source File  |  1996-07-29  |  9KB  |  364 lines
  1. REM $STACK
  2. REM $NOEVENT
  3. REM $NOBREAK
  4. REM $NOAUTODIM
  5. REM $NOLINES
  6. REM $NODEBUG
  7. REM $OVERFLOW
  8. REM $ADDICON
  9. REM $ERRORS
  10. REM $INCPATH MB_INCLUDES:BH
  11. REM $LIBPATH MB_INCLUDES:BMAP
  12. REM $NOWINDOW
  13. REM $NOLIBRARY
  14. REM MAXONBASIC3
  15.  
  16. revision$="$VER: MicroBase dBView 1.0.3, Rev. 29.07.1996 - ©FR-SW"
  17. WINDOW 5,MID$(revision$,7,22)
  18. DEFINT a - z
  19. CONST TAG_DONE&=0
  20. CONST DBFBUFLEN&=4097
  21. DIM frtags&(20)
  22. DIM q&(4097)
  23. ext$=".DBF"
  24. reverse$=""
  25. accept$=""
  26.  
  27. DECLARE FUNCTION trim$(a$)
  28. DECLARE SUB forminput(fil%,a$)
  29.  
  30. LIBRARY "exec.library"
  31. DECLARE FUNCTION AllocMem&(l&,r&) LIBRARY
  32. DECLARE FUNCTION FreeMem&(b&,l&) LIBRARY
  33. LIBRARY "dos.library"
  34. DECLARE FUNCTION xOpen&(n&,m&) LIBRARY
  35. DECLARE FUNCTION xClose&(fh&) LIBRARY
  36. DECLARE FUNCTION xRead&(fh&,buf&,l&) LIBRARY
  37. DECLARE FUNCTION Seek&(fh&,p&,m&) LIBRARY
  38. REM $include asl.bh
  39. LIBRARY OPEN "exec.library"
  40. LIBRARY OPEN "dos.library"
  41. LIBRARY OPEN "asl.library"
  42.  
  43. dbfansi$=""
  44. RESTORE ibm
  45. FOR i%=0 TO 255
  46.   READ t%
  47.   dbfansi$=dbfansi$+CHR$(t%)
  48. NEXT i%
  49.  
  50. GOSUB aslreq
  51.  
  52. IF back$>""
  53.   fhbuf&=AllocMem&(DBFBUFLEN&,65539&)
  54.   bac$=back$+CHR$(0)
  55.   back&=SADD(bac$)
  56.   fhdos&=xOpen&(back&,1004)
  57.   r&=xRead&(fhdos&,fhbuf&,1)
  58.   dbfvers$=CHR$(PEEK(fhbuf&))
  59.   dbf&=ASC(dbfvers$)
  60.   update$=""
  61.   r&=xRead(fhdos&,fhbuf&,1)
  62.   update$=update$+RIGHT$("00"+STR$(PEEK(fhbuf&)),2)
  63.   r&=xRead(fhdos&,fhbuf&,1)
  64.   update$=update$+RIGHT$("00"+STR$(PEEK(fhbuf&)),2)
  65.   r&=xRead(fhdos&,fhbuf&,1)
  66.   update$=update$+RIGHT$("00"+STR$(PEEK(fhbuf&)),2)
  67.   update$=RIGHT$(update$,2)+"."+MID$(update$,3,2)+"."+LEFT$(update$,2)
  68.   r&=xRead&(fhdos&,fhbuf&,4)
  69.   reverse$=CHR$(PEEK(fhbuf&))+CHR$(PEEK(fhbuf&+1))+CHR$(PEEK(fhbuf&+2))+CHR$(PEEK(fhbuf&+3))
  70.   GOSUB umdrehen
  71.   reccount&=CVL(reverse$) 
  72.   r&=xRead&(fhdos&,fhbuf&,2)
  73.   reverse$=CHR$(PEEK(fhbuf&))+CHR$(PEEK(fhbuf&+1))
  74.   GOSUB umdrehen
  75.   headerlength&=CVI(reverse$)
  76.   r&=xRead&(fhdos&,fhbuf&,2)
  77.   reverse$=CHR$(PEEK(fhbuf&))+CHR$(PEEK(fhbuf&+1))
  78.   GOSUB umdrehen
  79.   reclength&=CVI(reverse$)
  80.   fieldcount&=(headerlength&-1)/32-1
  81.   DIM fldnam$(fieldcount&),fldtyp$(fieldcount&),fldadr&(fieldcount&)
  82.   DIM fldlen&(fieldcount&),flddec&(fieldcount&)
  83.   dbf$="<unbekannt>"
  84.   dbt$=dbf$
  85.   db3p$="Ashton Tate dBASE III+"
  86.   fp25$="Microsoft FoxPro 2.5"
  87.   la3$="Lotus Approach 3.0 [dBASE IV]"
  88.   IF dbf&=3
  89.     dbf$=db3p$
  90.     dbt$=""
  91.   END IF
  92.   IF dbf&=131
  93.     dbf$=db3p$
  94.     dbt$=LEFT$(back$,LEN(back$)-3)+"DBT"
  95.   END IF
  96.   IF dbf&=139
  97.     dbf$=la3$
  98.     dbt$=LEFT$(back$,LEN(back$)-3)+"DBT"
  99.   END IF
  100.   IF dbf&=245
  101.     dbf$=fp25$
  102.     dbt$=LEFT$(back$,LEN(back$)-3)+"FPT"
  103.   END IF
  104.   PRINT "1. Datei"
  105.   PRINT "--------"
  106.   PRINT
  107.   PRINT "Datei:       ";back$
  108.   PRINT "Version :    ";dbf$
  109.   PRINT "Memos:       ";dbt$
  110.   PRINT "Datum:       ";update$
  111.   PRINT "Felder:      "fieldcount&
  112.   PRINT "Sätze:       ";reccount&
  113.   PRINT "Headerlänge: ";headerlength&
  114.   PRINT
  115.   a$=INPUT$(1)
  116.   feld&=0
  117.   FOR i&=1 TO fieldcount&
  118.     CLS
  119.     PRINT "2. Felder"
  120.     PRINT "---------"    
  121.     PRINT
  122.     r&=Seek&(fhdos&,(32*i&),(-1&))
  123.     r&=xRead&(fhdos&,fhbuf&,11&)
  124.     POKE fhbuf&+11,0
  125.     PRINT "Feld: ";i&
  126.     fldnam$=PEEK$(fhbuf&)
  127.     fldnam$(i&)=trim$(fldnam$)
  128.     PRINT "Name: ";fldnam$(i&)
  129.     r&=xRead&(fhdos&,fhbuf&,1&)
  130.     fldtyp$(i&)=CHR$(PEEK(fhbuf&))
  131.     PRINT "Typ: ";fldtyp$(i&)
  132.     r&=xRead&(fhdos&,fhbuf&,4&)
  133.     reverse$=CHR$(PEEK(fhbuf&))+CHR$(PEEK(fhbuf&+1))+CHR$(PEEK(fhbuf&+2))+CHR$(PEEK(fhbuf&+3))
  134.     GOSUB umdrehen
  135.     fldadr&(i&)=CVL(reverse$)
  136.     PRINT "Adresse: ";fldadr&(i&)
  137.     r&=xRead&(fhdos&,fhbuf&,1&)
  138.     fldlen&(i&)=PEEK(fhbuf&)
  139.     PRINT "Länge: ";fldlen&(i&);",";
  140.     r&=xRead&(fhdos&,fhbuf&,1&)
  141.     flddec&(i&)=PEEK(fhbuf&)
  142.     PRINT fld_dec&(i&)
  143.     IF fldtyp$(i&)="M"
  144.       q&(i&)=0
  145.     ELSE
  146.       INCR feld&
  147.       q&(i&)=fldlen&(i&)
  148.     END IF
  149.     IF fldtyp$(i&)="D"
  150.       q&(i&)=q&(i&)+2
  151.     END IF
  152.     a$=INPUT$(1)
  153.   NEXT i&
  154.     CLS
  155.     PRINT "3. Anzeige der Datensätze"
  156.     PRINT "-------------------------"
  157.     PRINT
  158.     ic$="J"
  159.   PRINT "ASCII nach ANSI konvertieren (J|N) ";
  160.   forminput 1,ic$
  161.   IF UCASE$(ic$)="J"
  162.     ic!=1
  163.   END IF
  164.   PRINT
  165.   PRINT
  166.   i&=1
  167.   WHILE UCASE$(weiter$)<>"Q"
  168.     p&=Seek&(fhdos&,headerlength&+reclength&*(i&-1),-1&)
  169.     r&=xRead&(fhdos&,fhbuf&,1&)
  170.     recdel$=CHR$(PEEK(fhbuf&))
  171.     out$=""
  172.     CLS
  173.     PRINT "3. Anzeige der Datensätze"
  174.     PRINT "-------------------------"
  175.     PRINT
  176.     PRINT "Satz: ";i&;
  177.     LOCATE CSRLIN,50
  178.     IF recdel$="*"
  179.       PRINT "*Löschmarkierung*"
  180.     END IF
  181.     PRINT
  182.     FOR t&=1 TO fieldcount&
  183.       PRINT fldnam$(t&);":";
  184.       LOCATE CSRLIN,15
  185.       r&=xRead&(fhdos&,fhbuf&,fldlen&(t&))
  186.       POKE fhbuf&+fldlen&(t&),0
  187.       a$=PEEK$(fhbuf&)
  188.       d$ = ""
  189.       ft$= fldtyp$(t&)
  190.       IF ft$ = "C"
  191.         IF ic!
  192.           ibm2ansi (a$)
  193.           d$=ibm2ansi$
  194.         ELSE
  195.           d$=a$
  196.         END IF
  197.       END IF
  198.       IF ft$ = "N"
  199.         IF flddec&(t&)=0
  200.           d$=a$
  201.         ELSE
  202.           d$=LEFT$(a$,fldlen&(t&)-flddec&(t&)-1)+"."+MID$(a$,fldlen&(t&)-flddec&(t&)+1)
  203.           IF LEFT$(d$,1)="."
  204.             d$=MID$(d$,2)
  205.           END IF
  206.         END IF
  207.         uix&=INSTR(d$,",")
  208.         IF uix&<>0
  209.           MID$(d$,uix&,1)="."
  210.         END IF
  211.       END IF
  212.       IF ft$ = "D"
  213.         d$=RIGHT$(a$,2)+"."+MID$(a$,5,2)+"."+LEFT$(a$,4)
  214.       END IF
  215.       IF ft$ = "M"
  216.         d$="<Memos werden nicht unterstützt>"
  217.       END IF
  218.       IF ft$="L"
  219.         d$=a$
  220.       END IF
  221.       PRINT d$
  222.       IF INKEY$<>""
  223.         x$=INPUT$(1)
  224.       END IF
  225.     NEXT t&
  226.     weiter$=INPUT$(1)
  227.     IF weiter$="+"
  228.       INCR i&
  229.     END IF
  230.     IF weiter$="*"
  231.       i& = i& + 10
  232.     END IF
  233.     IF weiter$="-"
  234.       DECR i&
  235.     END IF
  236.     IF weiter$="_"
  237.       i& = i& - 10
  238.     END IF  
  239.     IF (i& > reccount&)
  240.       i&=1
  241.     END IF
  242.     IF (i& < 1)
  243.       i&=reccount&
  244.     END IF
  245.   WEND
  246.   r&=xClose&(fhdos&)
  247.   r&=FreeMem&(fhbuf&,DBFBUFLEN&)
  248. END IF
  249. END
  250.  
  251. umdrehen:
  252.     tvi$=reverse$
  253.     reverse$=""
  254.     FOR tt&=LEN(tvi$) TO 1 STEP -1
  255.       reverse$=reverse$+MID$(tvi$,tt&,1)
  256.     NEXT tt&
  257. RETURN
  258.  
  259. SUB ibm2ansi(tvi$)
  260.     SHARED ibm2ansi$, dbfansi$
  261.     ibm2ansi$=""
  262.     FOR tt&=1 TO LEN(tvi$)
  263.         ft%=ASC(MID$(tvi$,tt&,1))
  264.         tvw$=MID$(dbfansi$,ft%+1,1)
  265.         IF tvw$<>CHR$(1)
  266.           ibm2ansi$=ibm2ansi$+tvw$
  267.         END IF
  268.     NEXT tt&
  269. END SUB
  270.  
  271. aslreq:
  272.     back$=""
  273.     TAGLIST VARPTR(frtags&(0)),ASLFR_TitleText&,"Bitte dBASE-Datei wählen", _
  274.             ASLFR_InitialFile&,"", _
  275.             ASLFR_InitialDrawer&, CURDIR$, _
  276.             TAG_DONE&
  277.  
  278.     fr&=AllocAslRequest&(ASL_FileRequest&,VARPTR(frtags&(0)))
  279.     IF fr& THEN
  280.         IF AslRequest&(fr&,0) THEN
  281.             aslfile$=PEEK$(PEEKL(fr&+fr_File))
  282.             asldir$=PEEK$(PEEKL(fr&+fr_Drawer))
  283.             IF RIGHT$(asldir$,1)<>":" AND RIGHT$(asldir$,1)<>"/"
  284.               asldir$=asldir$+"/"
  285.             END IF
  286.             back$=asldir$+aslfile$
  287.         END IF
  288.         FreeASlRequest fr&
  289.     END IF
  290. RETURN    
  291.  
  292. FUNCTION trim$(a$)
  293. 'Ersatz für GFA-Trim$()
  294.   trim$=LTRIM$(RTRIM$(a$))
  295. END FUNCTION
  296.  
  297. SUB forminput(fil%,a$)
  298. 'Ersatz für GFA-Form Input. fil%=Maximallänge, a$=Eingabestring
  299. 'Beenden mit Return, Löschen mit ESC.
  300.   fiz%=CSRLIN
  301.   fis%=POS(0)
  302.   fis$=SPACE$(fil%)
  303.   fip%=1
  304.   fi$=""
  305.   a$=LEFT$(LTRIM$(RTRIM$(a$)),fil%)
  306.   WHILE fi$<>CHR$(13)
  307.     LOCATE fiz%,fis%
  308.     PRINT LEFT$(a$+fis$,fil%);
  309.     LOCATE fiz%,fis%+fip%-1
  310.     COLOR 0,1
  311.     PRINT LEFT$(MID$(a$,fip%,1)+" ",1);
  312.     COLOR 1,0
  313.     fi:
  314.     fi$=INKEY$
  315.     IF fi$="" GOTO fi
  316.     fia%=ASC(fi$)
  317.     SELECT CASE fia%
  318.     CASE 13
  319.     CASE 30
  320.       INCR fip%
  321.     CASE 31
  322.       DECR fip%
  323.     CASE 8
  324.       IF fip%>1
  325.         a$=LEFT$(a$,fip%-2)+MID$(a$,fip%)
  326.         DECR fip%
  327.       END IF
  328.     CASE 27
  329.       a$=""
  330.       fip%=1
  331.     CASE ELSE
  332.       IF ((ASC(fi$) AND 127) > 31)
  333.         a$=LEFT$(a$+fis$,fip%-1)+fi$+MID$(a$,fip%)
  334.       END IF
  335.     END SELECT
  336.     IF fip%<1
  337.       fip%=1
  338.     END IF
  339.     IF fip%>fil%
  340.       fip%=fil%
  341.     END IF
  342.   WEND
  343.   a$=LEFT$(a$,fil%)
  344.   LOCATE fiz%,fis%
  345.   PRINT LEFT$(a$+fis$,fil%);
  346. END SUB
  347.  
  348. ibm:
  349. DATA 1, 1, 1, 1, 1, 1, 1, 183, 176, 1, 1, 1, 1, 1, 1, 45, 1, 1
  350. DATA 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 32, 33, 34, 35, 36
  351. DATA 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, 48, 49, 50, 51, 52, 53, 54, 55
  352. DATA 56, 57, 58, 59, 60, 61, 62, 63, 64, 65, 66, 67, 68, 69, 70, 71, 72, 73, 74
  353. DATA 75, 76, 77, 78, 79, 80, 81, 82, 83, 84, 85, 86, 87, 88, 89, 90, 91, 92, 93
  354. DATA 94, 95, 96, 97, 98, 99, 100, 101, 102, 103, 104, 105, 106, 107, 108, 109
  355. DATA 110, 111, 112, 113, 114, 115, 116, 117, 118, 119, 120, 121, 122, 123, 124
  356. DATA 125, 126, 1, 199, 252, 233, 226, 228, 224, 229, 231, 234, 235, 232, 239
  357. DATA 238, 236, 196, 197, 201, 230, 198, 244, 246, 242, 251, 249, 255, 214, 220
  358. DATA 162, 163, 165, 1, 1, 225, 237, 243, 250, 241, 209, 170, 186, 191, 1, 172
  359. DATA 189, 188, 161, 171, 187, 1, 1, 1, 124, 1, 1, 1, 1, 1, 1, 1, 1
  360. DATA 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1
  361. DATA 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1
  362. DATA 223, 1, 182, 1, 1, 181, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 177, 1
  363. DATA 1, 1, 1, 1, 1, 176, 183, 183, 1, 1, 178, 183, 32
  364.