home *** CD-ROM | disk | FTP | other *** search
/ Amiga MA Magazine 1998 #6 / amigamamagazinepolishissue1998.iso / nieuûytki / dbf2asc / deutsch / dbf2asc2.bas < prev    next >
BASIC Source File  |  1996-07-29  |  8KB  |  338 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 dBASE-Convert 1.0.4, Rev. 29.07.1996 - ©FR-SW"
  17. WINDOW 5,MID$(revision$,7,29)
  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.   datei$=LEFT$(back$,LEN(back$)-3)+"ASC"
  84.   PRINT "Konvertiere ";back$;" -> ";datei$
  85.   PRINT
  86.   feld&=0
  87.   FOR i&=1 TO fieldcount&
  88.     r&=Seek&(fhdos&,(32*i&),(-1&))
  89.     r&=xRead&(fhdos&,fhbuf&,11&)
  90.     POKE fhbuf&+11,0
  91.     fldnam$=PEEK$(fhbuf&)
  92.     fldnam$(i&)=trim$(fldnam$)
  93.     r&=xRead&(fhdos&,fhbuf&,1&)
  94.     fldtyp$(i&)=CHR$(PEEK(fhbuf&))
  95.     r&=xRead&(fhdos&,fhbuf&,4&)
  96.     reverse$=CHR$(PEEK(fhbuf&))+CHR$(PEEK(fhbuf&+1))+CHR$(PEEK(fhbuf&+2))+CHR$(PEEK(fhbuf&+3))
  97.     GOSUB umdrehen
  98.     fldadr&(i&)=CVL(reverse$)
  99.     r&=xRead&(fhdos&,fhbuf&,1&)
  100.     fldlen&(i&)=PEEK(fhbuf&)
  101.     r&=xRead&(fhdos&,fhbuf&,1&)
  102.     flddec&(i&)=PEEK(fhbuf&)
  103.     IF fldtyp$(i&)="M"
  104.       q&(i&)=0
  105.       PRINT fldnam$(i&);" {";i&;"}: Memo-Feld (wird ignoriert)"
  106.     ELSE
  107.       INCR feld&
  108.       q&(i&)=fldlen&(i&)
  109.     END IF
  110.     IF fldtyp$(i&)="D"
  111.       q&(i&)=q&(i&)+2
  112.     END IF
  113.   NEXT i&
  114.   PRINT
  115.   PRINT "Felder: ";fieldcount&;" -> ";feld&
  116.   PRINT
  117.   PRINT "Feldbegrenzer (<Return> für '";CHR$(34);"'): ";
  118.   anf$="34"
  119.   forminput 3,anf$
  120.   PRINT
  121.   IF anf$=""
  122.     anf$="34"
  123.   END IF
  124.   anf$=CHR$(VAL(anf$))
  125.   WHILE INKEY$<>""
  126.   WEND
  127.   PRINT "Feldtrenner (<Return> für ','): ";
  128.   trenn$="44"
  129.   forminput 3,trenn$
  130.   PRINT
  131.   IF trenn$=""
  132.     trenn$="44"
  133.   END IF
  134.   trenn$=CHR$(VAL(trenn$))
  135.   PRINT "Feldnamen speichern (J|N)? ";
  136.   fs$="J"
  137.   forminput 1,fs$
  138.   PRINT
  139.   OPEN "o",#3,datei$
  140.   trenner = 0
  141.   IF fs$="J"
  142.       FOR i&=1 TO fieldcount&
  143.           IF (q&(i&)<>0)
  144.             IF (trenner<>0)
  145.               PRINT #3,trenn$;
  146.             END IF
  147.             trenner = 1
  148.             PRINT #3,anf$;fldnam$(i&);anf$;
  149.           END IF
  150.       NEXT i&
  151.       PRINT #3
  152.   END IF
  153.   ic$="J"
  154.   PRINT "ASCII nach ANSI konvertieren (J|N) ";
  155.   forminput 1,ic$
  156.   PRINT
  157.   IF UCASE$(ic$)="J"
  158.     ic!=1
  159.   END IF
  160.   PRINT
  161.   aktuell&=0
  162.   FOR i&=1 TO reccount&
  163.     p&=Seek&(fhdos&,headerlength&+reclength&*(i&-1),-1&)
  164.     r&=xRead&(fhdos&,fhbuf&,1&)
  165.     recdel$=CHR$(PEEK(fhbuf&))
  166.     out$=""
  167.     trenner = 0
  168.     FOR t&=1 TO fieldcount&
  169.       r&=xRead&(fhdos&,fhbuf&,fldlen&(t&))
  170.       POKE fhbuf&+fldlen&(t&),0
  171.       a$=PEEK$(fhbuf&)
  172.       d$ = ""
  173.       ft$= fldtyp$(t&)
  174.       IF ft$ = "C"
  175.         IF ic!
  176.           ibm2ansi (a$)
  177.           d$=ibm2ansi$
  178.         ELSE
  179.           d$=a$
  180.         END IF
  181.       END IF
  182.       IF ft$ = "N"
  183.         IF flddec&(t&)=0
  184.           d$=a$
  185.         ELSE
  186.           d$=LEFT$(a$,fldlen&(t&)-flddec&(t&)-1)+"."+MID$(a$,fldlen&(t&)-flddec&(t&)+1)
  187.           IF LEFT$(d$,1)="."
  188.             d$=MID$(d$,2)
  189.           END IF
  190.         END IF
  191.         uix&=INSTR(d$,",")
  192.         IF uix&<>0
  193.           MID$(d$,uix&,1)="."
  194.         END IF
  195.       END IF
  196.       IF ft$ = "D"
  197.         d$=RIGHT$(a$,2)+"."+MID$(a$,5,2)+"."+LEFT$(a$,4)
  198.       END IF
  199.       IF (ft$ <> "M")
  200.         IF trenner
  201.           out$=out$+trenn$
  202.         END IF
  203.         trenner = 1
  204.         out$=out$+anf$+trim$(d$)+anf$
  205.       END IF
  206.     NEXT t&
  207.     IF recdel$<>"*"
  208.       INCR aktuell&
  209.       PRINT #3,out$
  210.     END IF
  211.     PRINT INT(100*i&/reccount&+0.5);" % fertig            ";
  212.     LOCATE CSRLIN,1
  213.   NEXT i&
  214.   PRINT
  215.   PRINT
  216.   PRINT reccount&-aktuell&;" gelöschte Datensätze überlesen"
  217.   PRINT aktuell&;" Datensätze kopiert"
  218.   r&=xClose&(fhdos&)
  219.   r&=FreeMem&(fhbuf&,DBFBUFLEN&)
  220.   PRINT
  221.   PRINT "Konvertierung abgeschlossen."
  222. END IF
  223. END
  224.  
  225. umdrehen:
  226.     tvi$=reverse$
  227.     reverse$=""
  228.     FOR tt&=LEN(tvi$) TO 1 STEP -1
  229.       reverse$=reverse$+MID$(tvi$,tt&,1)
  230.     NEXT tt&
  231. RETURN
  232.  
  233. SUB ibm2ansi(tvi$)
  234.     SHARED ibm2ansi$, dbfansi$
  235.     ibm2ansi$=""
  236.     FOR tt&=1 TO LEN(tvi$)
  237.         ft%=ASC(MID$(tvi$,tt&,1))
  238.         tvw$=MID$(dbfansi$,ft%+1,1)
  239.         IF tvw$<>CHR$(1)
  240.           ibm2ansi$=ibm2ansi$+tvw$
  241.         END IF
  242.     NEXT tt&
  243. END SUB
  244.  
  245. aslreq:
  246.     back$=""
  247.     TAGLIST VARPTR(frtags&(0)),ASLFR_TitleText&,"Bitte dBASE-Datei wählen", _
  248.             ASLFR_InitialFile&,"", _
  249.             ASLFR_InitialDrawer&, CURDIR$, _
  250.             TAG_DONE&
  251.  
  252.     fr&=AllocAslRequest&(ASL_FileRequest&,VARPTR(frtags&(0)))
  253.     IF fr& THEN
  254.         IF AslRequest&(fr&,0) THEN
  255.             aslfile$=PEEK$(PEEKL(fr&+fr_File))
  256.             asldir$=PEEK$(PEEKL(fr&+fr_Drawer))
  257.             IF RIGHT$(asldir$,1)<>":" AND RIGHT$(asldir$,1)<>"/"
  258.               asldir$=asldir$+"/"
  259.             END IF
  260.             back$=asldir$+aslfile$
  261.         END IF
  262.         FreeASlRequest fr&
  263.     END IF
  264. RETURN    
  265.  
  266. FUNCTION trim$(a$)
  267. 'Ersatz für GFA-Trim$()
  268.   trim$=LTRIM$(RTRIM$(a$))
  269. END FUNCTION
  270.  
  271. SUB forminput(fil%,a$)
  272. 'Ersatz für GFA-Form Input. fil%=Maximallänge, a$=Eingabestring
  273. 'Beenden mit Return, Löschen mit ESC.
  274.   fiz%=CSRLIN
  275.   fis%=POS(0)
  276.   fis$=SPACE$(fil%)
  277.   fip%=1
  278.   fi$=""
  279.   a$=LEFT$(LTRIM$(RTRIM$(a$)),fil%)
  280.   WHILE fi$<>CHR$(13)
  281.     LOCATE fiz%,fis%
  282.     PRINT LEFT$(a$+fis$,fil%);
  283.     LOCATE fiz%,fis%+fip%-1
  284.     COLOR 0,1
  285.     PRINT LEFT$(MID$(a$,fip%,1)+" ",1);
  286.     COLOR 1,0
  287.     fi:
  288.     fi$=INKEY$
  289.     IF fi$="" GOTO fi
  290.     fia%=ASC(fi$)
  291.     SELECT CASE fia%
  292.     CASE 13
  293.     CASE 30
  294.       INCR fip%
  295.     CASE 31
  296.       DECR fip%
  297.     CASE 8
  298.       IF fip%>1
  299.         a$=LEFT$(a$,fip%-2)+MID$(a$,fip%)
  300.         DECR fip%
  301.       END IF
  302.     CASE 27
  303.       a$=""
  304.       fip%=1
  305.     CASE ELSE
  306.       IF ((ASC(fi$) AND 127) > 31)
  307.         a$=LEFT$(a$+fis$,fip%-1)+fi$+MID$(a$,fip%)
  308.       END IF
  309.     END SELECT
  310.     IF fip%<1
  311.       fip%=1
  312.     END IF
  313.     IF fip%>fil%
  314.       fip%=fil%
  315.     END IF
  316.   WEND
  317.   a$=LEFT$(a$,fil%)
  318.   LOCATE fiz%,fis%
  319.   PRINT LEFT$(a$+fis$,fil%);
  320. END SUB
  321.  
  322. ibm:
  323. DATA 1, 1, 1, 1, 1, 1, 1, 183, 176, 1, 1, 1, 1, 1, 1, 45, 1, 1
  324. DATA 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 32, 33, 34, 35, 36
  325. DATA 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, 48, 49, 50, 51, 52, 53, 54, 55
  326. DATA 56, 57, 58, 59, 60, 61, 62, 63, 64, 65, 66, 67, 68, 69, 70, 71, 72, 73, 74
  327. DATA 75, 76, 77, 78, 79, 80, 81, 82, 83, 84, 85, 86, 87, 88, 89, 90, 91, 92, 93
  328. DATA 94, 95, 96, 97, 98, 99, 100, 101, 102, 103, 104, 105, 106, 107, 108, 109
  329. DATA 110, 111, 112, 113, 114, 115, 116, 117, 118, 119, 120, 121, 122, 123, 124
  330. DATA 125, 126, 1, 199, 252, 233, 226, 228, 224, 229, 231, 234, 235, 232, 239
  331. DATA 238, 236, 196, 197, 201, 230, 198, 244, 246, 242, 251, 249, 255, 214, 220
  332. DATA 162, 163, 165, 1, 1, 225, 237, 243, 250, 241, 209, 170, 186, 191, 1, 172
  333. DATA 189, 188, 161, 171, 187, 1, 1, 1, 124, 1, 1, 1, 1, 1, 1, 1, 1
  334. DATA 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1
  335. DATA 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1
  336. DATA 223, 1, 182, 1, 1, 181, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 177, 1
  337. DATA 1, 1, 1, 1, 1, 176, 183, 183, 1, 1, 178, 183, 32
  338.