1 'XDB-PLUS Modul:INIT Z=90     XDB-COM Z=1000  Statistik Z=300 (c) by G. Schwandtner 10/1993
5 CLEAR :SPC$="                                                                "
10 CLS:INPUT "XDB-PLUS Modul: INIT (c) by G.S.Dateiname:";@7;D$
20 D$="ó"+LEFT$(D$,7)
30 RESTORE#:RESTORE# D$,,57
40 READ#D$,ANZF,MFL,MMP,TMAS$
41 GOTO 60
42 IF MFLD<MFL THEN MFLD=MFL
43 IF MMPO<MMP THEN MMPO=MMP
44 IF ANZF=0 THEN ANZF=1:DIM FLD$(1,MFLD),MAS$(MMPO):GOTO 100
45 DIM FLD$(ANZF,MFLD),MAS$(MMPO)
48 FOR A=0 TO MMP:READ#MAS$(A):NEXT A
50 FOR A=0 TO ANZF:FOR B=0 TO MFL:READ#FLD$(A,B):NEXT B,A
55 GOTO 100
57 ANZF=0
60 CLS:INPUT "Eingabe/Aenderung der Parameter.Anzahl der Felder="+STR$(MFL)+"?";@5;MFD:IF MFD>=MFLD THEN MFLD=MFD
70 CLS:INPUT "Anzahl der Maskenseiten fuer dieneue Datei angeben("+STR$(MMP)+")?";@2;MMO:IF MMO>=MMPO THEN MMPO=MMO
80 ERASE FLD$,MAS$: GOTO 42
90 IF D$="" THEN 10 ELSE IF MFLD=0 OR ANZF=0 THEN 60
100 AKM=0:AKP=0:GOSUB 2000
110 IF FLD$(0,MFLD)="" THEN IF MFLD>0 THEN MFLD=MFLD-1:GOTO 110 ELSE 195
120 IF MAS$(MMPO)="" THEN IF MMPO>0 THEN MMPO=MMPO-1:GOTO 120 ELSE 195
140 GOSUB 200
142 IF DN>0 THEN RETURN
147 CLS:PRINT "Speichern ?";:$=INPUT$(1,@):IF $<>"J" AND $<>"j"THEN 195
150 RESTORE#:RESTORE#D$,,170
160 WRITE#:WRITE#:FOR A=0 TO MMPO:WRITE#:NEXT A:FOR A=0 TO ANZF:FOR B=0 TO MFLD:WRITE#:NEXT B,A
170 RESTORE#CHR$(26),,180
180 WRITE# D$+","+STR$(ANZF)+","+STR$(MFLD)+","+STR$(MMPO)
185 WRITE# CHR$(34)+TMAS$
190 FOR A=0 TO MMPO:WRITE# CHR$(34)+MAS$(A):NEXT A:FOR A=0 TO ANZF:FOR B=0 TO MFLD :WRITE# CHR$(34)+FLD$(A,B):NEXT B,A
195 IF ABB=1 OR DN>0 THENABB=0:RETURN ELSE END
200 IF TMAS$="" THEN FOR A=0 TO MFLD:TMAS$=TMAS$+RIGHT$(HEX$(A),2):NEXT A
210 RETURN
300 CLS:PRINT "Die Datenbank besteht aus";ANZF-1;:LOCATE0,1:PRINT "Datensaetzen. (EXE)";:$=INPUT$(1,@):RETURN
1000 ONERRORGOTO1060:RESTORE#:RESTORE# "\\\XCom\",,1020
1010 READ#$,PAR$
1020 CLS:PRINT "[1]Sp. [2]Lad. [3]Exp. [4]Imp.  [5]SET [0] Ende  XDB-COM (c)G.S.";CHR$(11);
1030 ON VAL(INPUT$(1,@))+1 GOTO 1050,1100,1200,1400,1500,1300
1040 GOTO 1030
1050 ONERRORGOTO0:RETURN
1060 CLOSE: RESUME 1020
1100 IF PAR$="" THEN 1300
1105 IF ANZF=0 THEN 1020
1107 CLS:PRINT "Speichere";
1110 OPEN "COM0:"+PAR$ AS 1
1115 PRINT #1,ANZF,MFLD,MMPO,TMAS$
1117 FOR A=0 TO MMPO:PRINT #1,MAS$(A):NEXT A
1120 FOR A=0 TO ANZF:FOR B=0 TO MFLD:PRINT #1,CHR$(34)+FLD$(A,B):NEXT B:NEXT A
1125 CLOSE
1130 GOTO 1020
1200 IF PAR$="" THEN 1300
1205 CLS: PRINT "Lade";:ERASE MAS$,FLD$
1210 OPEN "COM0:"+PAR$ AS 1
1220 INPUT #1,ANZF,MFLD,MMPO,TMAS$
1221 IF ANZF>STP(4) THEN DIM FLD$(ANZF,MFLD) ELSE DIM FLD$(STP(4),MFLD)
1222 DIM MAS$(MMPO)
1225 FOR A=0 TO MMPO:INPUT #1,MAS$(A):NEXT A
1230 FOR A=0 TO ANZF:FOR B=0 TO MFLD:INPUT #1,FLD$(A,B):NEXT B:NEXT A
1235 CLOSE
1237 EXIST=1
1240 GOTO 1020
1300 CLS:PRINT "Kommunikationsparameter gemaess CASIO-Handbuch eingeben !!";:$=INPUT$(1,@)
1310 CLS:PRINT "COM0:"+PAR$;CHR$(11);:LOCATE 5,0:INPUT @20;PAR$
1320 RESTORE#:RESTORE#"\\\XCom\",,1330:WRITE#:RESTORE#CHR$(26),,1330
1330 WRITE#"\\\XCom\,"+CHR$(34)+PAR$
1340 GOTO 1020
1400 IF PAR$="" THEN 1300
1405 IF ANZF=0 THEN 1020
1407 CLS:PRINT "Exportiere";
1410 OPEN "COM0:"+PAR$ AS 1
1420 FOR A=2 TO ANZF:FOR B=0 TO MFLD:PRINT #1,FLD$(A,B):NEXT B:NEXT A
1425 CLOSE
1430 GOTO 1020
1500 IF PAR$="" THEN 1300
1510 IF ANZF=0 THEN CLS:PRINT "Datenbank muss zuerst mit INIT  erzeugt werden !!";:$=INPUT$(1,@):GOTO 1020
1520 CLS:INPUT "Import - Anzahl Datensaetze     ANZ=(1...)";@5;ANZDS:ANZDS=ANZDS-1:IF ANZDS<0 THEN1520
1530 IF ANZDS+ANZF>STP(4) THEN CLS:PRINT "Datenbereich zu klein. Mit Setupneue Groesse festlegen !!";:$=INPUT$(1,@):GOTO 1020
1535 CLS:PRINT "Importiere";
1540 OPEN "COM0:"+PAR$ AS 1
1550 B=ANZF:ANZF=ANZF+ANZDS
1560 FOR A=B TO ANZF:FOR C=0 TO MFLD: INPUT #1,FLD$(A,C):NEXT C:NEXT A
1570 CLOSE
1580 GOTO 1020
2000 CLS
2010 FOR A=1 TO LEN(MAS$(AKM))/4
2020 F=VAL("&H"+MID$(MAS$(AKM),A*4-3,2)):P=VAL("&H"+MID$(MAS$(AKM),A*4-1,2):L=VAL("&H"+LEFT$(FLD$(0,F),2))
2030 LOCATE P MOD32,P\32:PRINT MID$(FLD$(0,F),3);":";LEFT$(SPC$,L-1);"]";
2040 NEXT A
2050 P=VAL("&H"+MID$(MAS$(AKM),4*AKP+3,2))
2055 LOCATE P MOD32,P\32:$=INPUT$(1)
2060 IF $=CHR$(29) AND AKP>0 THEN AKP=AKP-1:GOTO 2050
2065 IF $=CHR$(28) AND AKP<LEN(MAS$(AKM))/4-1 THEN AKP=AKP+1:GOTO 2050
2070 IF $=CHR$(30) AND AKM>0 THEN AKM=AKM-1:AKP=0:GOTO 2000
2075 IF $=CHR$(31) AND AKM<MMPO THEN AKM=AKM+1:AKP=0:GOTO 2000
2080 ON (VAL($) AND (LEN(MAS$(AKM))>0)) GOTO 2100,2200,2250,2300
2082 IF $="7" THEN 2350
2085 IF $="0" THEN RETURN
2090 IF $=CHR$(218) THEN CLS:PRINT "[1]POS [2]NAME [3]LEN [4]VORG.  [7]NEU [0]ENDE XDB-Init (c)G.S.";:$=INPUT$(1,@):GOTO 2000
2095 GOTO 2055
2100 AK=VAL("&H"+MID$(MAS$(AKM),AKP*4+1,2))
2105 L=LEN(MID$(FLD$(0,AK),3))+1+VAL("&H"+LEFT$(FLD$(0,AK),2))
2110 IF AKP=0 THEN XM=0 ELSE XM=LEN(MID$(FLD$(0,AK-1),3))+1+VAL("&H"+LEFT$(FLD$(0,AK-1),2))+VAL("&H"+MID$(MAS$(AKM),AKP*4-1,2))
2120 IF LEN(MAS$(AKM))/4-1=AKP THEN XE=63-L ELSE XE=VAL("&H"+MID$(MAS$(AKM),AKP*4+7,2))-L
2130 LOCATE P MOD32,P\32:$=INPUT$(1)
2140 IF $=CHR$(29) AND P>XM THEN P=P-1
2145 IF $=CHR$(28) AND P<XE THEN P=P+1
2150 IF $=CHR$(13) THEN MAS$(AKM)=LEFT$(MAS$(AKM),AKP*4+2)+RIGHT$(HEX$(P),2)+MID$(MAS$(AKM),AKP*4+5):GOTO 2000
2155 GOTO 2130
2200 AK=VAL("&H"+MID$(MAS$(AKM),AKP*4+1,2))
2205 L=LEN(MID$(FLD$(0,AK),3))+VAL("&H"+LEFT$(FLD$(0,AK),2))-1:IF L=0 THEN 2000
2210 PRINT MID$(FLD$(0,AK)+SPC$,3,L);:LOCATE P MOD32,P\32:INPUT @L;NM$:IF LEN(NM$)>L THEN 2000
2220 L=L-LEN(NM$)+1
2230 FLD$(0,AK)=RIGHT$(HEX$(L),2)+NM$
2240 GOTO 2000
2250 AK=VAL("&H"+MID$(MAS$(AKM),AKP*4+1,2))
2252 L=P+LEN(MID$(FLD$(0,AK),3))+VAL("&H"+LEFT$(FLD$(0,AK),2))
2255 XM=P+LEN(FLD$(0,AK))-1
2260 IF LEN(MAS$(AKM))/4-1=AKP THEN XE=62 ELSE XE=VAL("&H"+MID$(MAS$(AKM),AKP*4+7,2))-1
2270 LOCATE L MOD32,L\32:$=INPUT$(1)
2275 IF $=CHR$(28) AND L<XE THEN L=L+1:GOTO 2270
2277 IF $=CHR$(29) AND L>XM THEN L=L-1:GOTO 2270
2280 IF $=CHR$(13) THEN FLD$(0,AK)=RIGHT$(HEX$(L-XM+1),2)+MID$(FLD$(0,AK),3):GOTO 2000
2290 GOTO 2270
2300 AK=VAL("&H"+MID$(MAS$(AKM),AKP*4+1,2))
2305 P=P+LEN(FLD$(0,AK))-1:L=VAL("&H"+LEFT$(FLD$(0,AK),2))
2310 LOCATE P MOD32,P\32:PRINT LEFT$(FLD$(1,AK)+SPC$,L);:LOCATE P MOD32,P\32:INPUT @L;VG$
2320 IF LEN(VG$)>L THEN 2000
2325 FLD$(1,AK)=VG$
2330 GOTO 2000
2350 IF LEN(MAS$(AKM))>0 THEN B=LEN(MAS$(AKM))-3:LF=VAL("&H"+MID$(MAS$(AKM),B,2)):E=VAL("&H"+RIGHT$(MAS$(AKM),2))+VAL("&H"+LEFT$(FLD$(0,LF),2))+LEN(MID$(FLD$(0,LF),3))+2 ELSE E=0
2355 IF E>60 THEN 2000
2357 IF FLD$(0,MFL)<>"" THEN IF MFLD>MFL THEN MFL=MFL+1 ELSE 2000
2360 MAS$(AKM)=MAS$(AKM)+RIGHT$(HEX$(MFL),2)+RIGHT$(HEX$(E),2)
2365 FLD$(0,MFL)="01"
2370 GOTO 2000