*----------------------------------------------------------------*
*  Programm zur Erstellung eines Disketten-Datei-Verzeichnisses  *
*                                                                *
*  erforderliche Programme: REDABAS, FILE.COM, FILESAVE.COM      *
*              und Dateien: FILE.PRG, FILE.VAR, RUBRIK.PRG       *
*                           FILES.DBD, RUBRIK.DBD, SORT.IDX      *
*                           DISK.IDX, RDBCLOCK.HEX, ZUSATZ.PRG   *
*                                                                *
*  Autor:           Mario Leubner                                *
*                   Chemnitztalstra~e 25                         *
*             09236 Markersdorf                                  *
*                                                                *
*  letzte [nderung: 23.06.1997 (Zuordnung Disk-Rubrik)           *
*----------------------------------------------------------------*

SET TALK OFF
SET ESCAPE ON
SET CONFIRM ON
SET RAW OFF
ERASE
?? CHR(14)
CLEAR
LOAD RDBCLOCK
STORE '????????' TO DATE
SET CALL TO 44032
CALL DATE
SET DATE TO &DATE
RESTORE FROM FILE
IF DATE()= '00.00.00'
 @ 12,15 SAY 'Bitte Datum eingeben (tt.mm.jj) ' GET xadr0 PICTURE '99.99.99'
 READ
 SET DATE TO &xadr0
 SAVE TO FILE ALL LIKE xadr?
ENDIF
SET CONFIRM OFF
SELECT SECONDARY
USE rubrik
GO BOTTOM
STORE # TO maxr
SELECT PRIMARY
USE files
GO BOTTOM
STORE # TO max
IF .NOT. FILE( 'SORT.IDX' )
 @ 20,10 SAY 'Datei SORT.IDX nicht gefunden --> Neuaufbau, Bitte warten!'
 INDEX ON art+name+typ TO sort
ENDIF
IF .NOT. FILE( 'DISK.IDX' )
 @ 20,10 SAY 'Datei DISK.IDX nicht gefunden --> Neuaufbau, Bitte warten!'
 INDEX ON disk+name TO disk
ENDIF
STORE t TO weiter
DO WHILE weiter
 SELECT PRIMARY
 SET INDEX TO sort,disk
 ERASE
 @ 0,69 SAY DATE()
 @ 1,8 SAY '======================================================='
 ? '        #           F I L E S - M A N A G E M E N T           #'
 ? '        #           -------------------------------           #'
 ? '        #  '+STR(max,4)+' Dateien in '+STR(maxr,2)+' Rubriken '
 ?? "      (c) MLsoft '97  #"
 ? '        ======================================================='
 @  6,26 SAY '(N)eueingabe'
 @  7,26 SAY '(K)orrektur'
 @  8,26 SAY '(S)uchen'
 @  9,26 SAY '(A)nzeigen'
 @ 10,26 SAY '(B)eenden'
 @ 11,26 SAY '(D)rucken'
 @ 12,26 SAY '(R)ubriken'
 @ 13,26 SAY '(T)extauszug'
 @ 14,26 SAY '(E)igene Anschrift'
 @ 15,26 SAY '(L)ist Directory'
 @ 16,26 SAY '(Z)uordnung Dirk-Rubrik'
 STORE ' ' TO wahl
 DO WHILE .NOT. wahl$ 'ABDEKLNRSTZ'
  @ 18,10 SAY 'Bitte den entsprechenden Buchstaben eingeben!  '
  SET CONSOLE OFF
  WAIT TO wahl
  SET CONSOLE ON
  STORE !(wahl) TO wahl
 ENDDO
 ?? wahl
 DO CASE

  CASE wahl= "B"
   ?
   ?' E N D E   nach    1. REDABAS'
   ?'                   2. Betriebssystem'
   ?'                   3. Betriebssystem mit Kopie auf Laufwerk B:'
   ?
   ?' Nummer eingeben: '
   SET CONSOLE OFF
   WAIT TO end
   SET CONSOLE ON
   ?? end
   DO CASE
    CASE end= '1'
     SET TALK ON
     RETURN
    CASE end= '2'
     ?? CHR(15)
     QUIT
    CASE end= '3'
     ?? CHR(15)
     SET CONSOLE OFF
     QUIT TO 'DBASE:FILESAVE'
    OTHERWISE
     LOOP
   ENDCASE

  CASE wahl= "L"
   ?
   ACCEPT "DIR-Maske" TO mask
   IF mask= " "
    LIST FILES
   ELSE
    LIST FILES LIKE &mask
   ENDIF
   WAIT
   LOOP

  CASE wahl= "R"
   STORE f TO input
   DO rubrik
   LOOP

  CASE wahl= "A"
   STORE t TO testi
   DO WHILE testi
    STORE ' ' TO ru
    @ 20,0 SAY '<D>iskette oder <R>ubrik ? ' GET ru
    READ
    STORE !(ru) TO ru
    IF ru$ 'DR '
     STORE f TO testi
    ENDIF
   ENDDO
   DO CASE
    CASE ru=" "
     LOOP
    CASE ru="R"
     STORE t TO input
     STORE '(nur Return = Ende, 00 = gel|schte Daten)' TO stext
     DO rubrik
     IF rub='  '
      LOOP
     ENDIF
     IF rub='00'
      STORE ' gel|schte Daten' TO stext
     ENDIF
     ERASE
     ?'Rubrik: ',stext
     ?
     SET INDEX TO sort
     FIND '&rub'
     STORE 0 TO za
     DO WHILE art='&rub' .AND..NOT.EOF
      IF druck
       DISPLAY FIELD STR(#,4),art+'-'+disk+' ',name+'.'+typ,' ',;
       TRIM(bemerkung) OFF
      ELSE
       DISPLAY FIELD STR(#,4),art+'-'+disk+'*',name+'.'+typ,' ',;
       TRIM(bemerkung) OFF
      ENDIF
      SKIP
      STORE za+1 TO za
      IF za=12
       STORE 0 TO za
       WAIT
      ENDIF
     ENDDO
    CASE ru="D"
     STORE '   ' TO diskn
     @ 22,0 SAY 'Bezeichnung der Diskette ' GET diskn
     READ
     ERASE
     ?'Diskette:',diskn
     ?
     SET INDEX TO disk
     FIND '&diskn'
     STORE 0 TO za
     DO WHILE disk='&diskn' .AND..NOT.EOF
      IF druck
       DISPLAY FIELD STR(#,4),art+'-'+disk+' ',name+'.'+typ,' ',;
       TRIM(bemerkung) OFF
      ELSE
       DISPLAY FIELD STR(#,4),art+'-'+disk+'*',name+'.'+typ,' ',;
       TRIM(bemerkung) OFF
      ENDIF
      SKIP
      STORE za+1 TO za
      IF za=12
       STORE 0 TO za
       WAIT
      ENDIF
     ENDDO
   ENDCASE
   ?'***  Dateiende erreicht ***'
   WAIT
   LOOP

  CASE wahl= "S"
   ?
   ACCEPT 'Bitte Suchbegriff eingeben ' TO su
   ERASE
   USE FILES
   ? 'Suche nach',su,'in der unsortierten Datei:'
   ?
   DISPLAY ALL FIELD STR(#,4),art+'-'+disk,' '+name+'.'+typ,;
   TRIM(bemerkung) FOR '&su' $name .OR. '&su' $typ .OR. '&su' $bemerkung OFF
   ?'***  Dateiende erreicht ***'
   WAIT
   LOOP

  CASE wahl= "N"
   ERASE
   @ 2,20 SAY "N E U E I N G A B E"
   @ 3,20 SAY "===================="
   STORE "J" TO ein
   DO WHILE ein= "J"
    GO TOP
     IF VAL(ART)>0
      APPEND BLANK
      STORE # TO max
     ENDIF
    REPLACE art WITH '  '
    @ 6,1 SAY 'Nummer     :'+STR(#,4)
    @ 6,30 SAY 'Diskette ' GET disk PICTURE '!!!'
    @ 8,1 SAY 'Dateiname  ' GET name PICTURE '!!!!!!!!'
    @ 8,21 GET typ PICTURE '!!!'
    @ 8,30 SAY 'Rubrik   ' GET art PICTURE "99"
    ?? CHR(20)
    READ
    DO CASE
     CASE VAL(art)=0
      @ 8,40 SAY '00: (gel|scht)'
      REPLACE art WITH '00'
     CASE VAL(art)>maxr
      @ 8,44 SAY '(ung}ltige Rubrik!)'
     OTHERWISE
      STORE art TO rub
      SELECT SECONDARY
      GO &rub
      @ 8,44 SAY '('+TRIM(KURZ)+')'
      @ 10,13 SAY quelle
      SELECT PRIMARY
    ENDCASE
    CLEAR GETS
    @ 11,1 SAY 'Adressen   ' GET adressen
    @ 13,1 SAY 'Druck      ' GET druck PICTURE "!"
    @ 14,1 SAY 'Bemerkungen' GET bemerkung
    READ
    @ 17,1 SAY 'Weitere Dateien eingeben' GET ein PICTURE "!"
    READ
   ENDDO
   LOOP

  CASE wahl= "K"
   ?
   ?'Geben Sie die Nummer des Files an.'
   ?'(eventuell vorher mit dem Kommando "A" oder "S" anzeigen lassen)'
   STORE t TO testi
   STORE t TO cls
   DO WHILE testi
    STORE t TO ok
    ?'Filenummer 1 bis '+STR(max,4)+'   oder nur Return = Ende'
    IF .NOT. cls
     ?'                                      R = r}ckw{rts in Liste'
     ?'                                      V = vorw{rts in Liste'
    ENDIF
    ACCEPT 'Ihre Wahl ' TO nr
    IF nr= ' '
     STORE f TO testi
    ELSE
     IF cls
      ERASE
      @ 2,20 SAY '[ N D E R U N G E N'
      @ 3,20 SAY '-------------------'
      @ 15,0
     ELSE
      @ 15,0
      ? CHR(20)
     ENDIF
     DO CASE
      CASE !(nr)= 'V'
       STORE # TO merk
       SKIP
       IF # = merk
        STORE f TO ok
       ENDIF
      CASE !(nr)= 'R'
       IF # = 1
        STORE f TO ok
       ELSE
        SKIP-1
       ENDIF
      OTHERWISE
       IF VAL(nr)<=max .AND. VAL(nr)#0
        GO &nr
       ELSE
        STORE f TO ok
       ENDIF
     ENDCASE
     IF ok
      @ 6,1 SAY 'Nummer     :'+STR(#,4)
      @ 6,30 SAY 'Diskette ' GET disk PICTURE '!!!'
      @ 8,1 SAY 'Dateiname  ' GET name PICTURE '!!!!!!!!'
      @ 8,21 GET typ PICTURE '!!!'
      @ 8,30 SAY 'Rubrik   ' GET art PICTURE "99"
      DO CASE
       CASE VAL(art)=0
        @ 8,44 SAY '(gel|scht)'+CHR(22)
        REPLACE art WITH '00'
        @ 10,0
       CASE VAL(art)>maxr
        @ 8,44 SAY '(00=l{schen)'+CHR(22)
       OTHERWISE
        STORE art TO rub
        SELECT SECONDARY
        GO &rub
        @ 8,44 SAY '('+TRIM(KURZ)+', 00=l|schen)'
        @ 10,13 SAY quelle
        SELECT PRIMARY
      ENDCASE
      @ 11,1 SAY 'Adressen   :'+adressen
      @ 13,1 SAY 'Druck      '
      ?? druck
      @ 14,1 SAY 'Bemerkungen:'+bemerkung
      READ
      DO CASE
       CASE VAL(art)=0
        @ 8,40 SAY '00: (gel|scht)'+CHR(22)
        REPLACE art WITH '00'
        @ 10,0
       CASE VAL(art)>maxr
        @ 8,44 SAY '(ung}ltige Rubrik!)'+CHR(22)
        @ 10,0
       OTHERWISE
        STORE art TO rub
        SELECT SECONDARY
        GO &rub
        @ 8,44 SAY '('+TRIM(KURZ)+')'+CHR(22)
        @ 10,13 SAY quelle
        SELECT PRIMARY
      ENDCASE
      CLEAR GETS
      @ 11,12 GET adressen
      @ 13,12 GET druck PICTURE "!"
      @ 14,12 GET bemerkung
      READ
     ELSE
      ?'          Eingabefehler !'
      SET CONSOLE OFF
      WAIT
      SET CONSOLE ON
     ENDIF
     @ 15,0
     STORE f TO cls
    ENDIF
   ENDDO

  CASE wahl= "T"
   STORE t TO input
   STORE '(Return = Ende, 00 = alle)' TO stext
   DO rubrik
   IF rub# '  '
    IF rub# '00'
     FIND '&rub'
     IF # # 0
      ERASE
      STORE 'RUBRIK'+rub TO stext
      SET ALTERNATE TO &stext
      ?'Datei: '+stext+'.TXT'
      ?'-------------------'
      SET ALTERNATE ON
      IF VAL(rub)>0 .AND. VAL(rub)<=maxr
       SELECT SECONDARY
       GO &rub
       ? TEXT
       SELECT PRIMARY
      ENDIF
      STORE 0 TO za
      DO WHILE (art=rub).AND.(.NOT.EOF)
       IF druck
        ? name+'.'+typ+'  '+adressen+'  '+TRIM(bemerkung)
        STORE za+1 TO za
       ENDIF
       SKIP
      ENDDO
      ?'------------',STR(za,3),'Dateien in dieser Rubrik  ------------'
      SET ALTERNATE OFF
     ELSE
      ?'Keine Eintragungen in dieser Rubrik!'
      WAIT
     ENDIF
    ELSE
     ERASE
     GO TOP
     DO WHILE VAL(art)=0
      SKIP
     ENDDO
     ?'Datei: FILES.TXT'
     ?'----------------'
     ?
     SET ALTERNATE TO files
     SET ALTERNATE ON
     ?' '+xadr1
     ?' '+xadr2
     ?' '+xadr3
     ?' '+$( '-----------------------------',1,len(xadr3))
     ?
     ?'  >>> KC85/4 - Softwareliste <<<                        Stand: '+DATE()
     ?
     STORE 0 TO za
     STORE '**' TO mask
     DO WHILE .NOT.EOF
      IF druck
       IF mask=art
        ? name+'.'+typ+'  '+adressen+'  '+TRIM(bemerkung)
        STORE za+1 TO za
        SKIP
       ELSE
        IF za>0
         ?'------------',STR(za,3),'Dateien in dieser Rubrik ------------'
         ?
         STORE 0 TO za
        ENDIF
        STORE art TO mask
        IF VAL(mask)>0 .AND. VAL(mask)<=maxr
         SELECT SECONDARY
         GO &mask
         ? TRIM(TEXT)+':'
         ?
         ?'Filename     ',quelle,'             Bemerkungen'
         SELECT PRIMARY
        ENDIF
       ENDIF
      ELSE
       SKIP
      ENDIF
     ENDDO
     IF za>0
      ?'------------',STR(za,3),'Dateien in dieser Rubrik ------------'
      ?
     ENDIF
     SET ALTERNATE OFF
    ENDIF
   ENDIF

  CASE wahl= "D"
   ?
   ACCEPT "Liste ausdrucken (J/N) " TO dru1
   STORE !(dru1) TO dru1
   IF dru1= "J"
    ?
    ACCEPT "Liste vollst{ndig ausdrucken (J/N)" TO dru2
    STORE !(dru2) TO dru2
    ?
    ACCEPT "Bedingung eingeben (J/N)" TO dru3
    STORE !(dru3) TO dru3
    IF dru3= "J"
     STORE t TO testi
     DO WHILE testi
      ?
      ACCEPT "Bedingung " TO bed
      IF test(&bed) # 0
       STORE f TO testi
      ENDIF
     ENDDO
    ELSE
     STORE '"A"="A"' TO bed
    ENDIF
    GO TOP
    DO WHILE VAL(art)=0
     SKIP
    ENDDO
    ERASE
    STORE 1 TO seite
    DO WHILE .NOT. EOF
     STORE 1 TO zeile
     SET PRINT OFF
     ?
     ? " *** Bitte neue Seite einlegen ! ***"
     ?
     WAIT
     ?
     SET PRINT ON
     SET CONSOLE OFF
     SET MARGIN TO 3
     IF dru2= "J"
      * elite, deutsch
      ? CHR(27)+'M'+CHR(27)+'R'+CHR(2)
     ELSE
      * pica, deutsch
      ? CHR(27)+'P'+CHR(27)+'R'+CHR(2)
     ENDIF
     SET CONSOLE ON
     DO WHILE (zeile<63.AND..NOT.EOF)
      IF zeile=1
       IF seite = 1
        ?'   '+xadr1
        ?'   '+xadr2
        SET PRINT OFF
        ?'   '+xadr3
        SET CONSOLE OFF
        SET PRINT ON
        ?'   '+CHR(27)+'-1'+xadr3+CHR(27)+'-0'
        SET CONSOLE ON
        ?
        STORE zeile+4 TO zeile
       ENDIF
       STORE STR(seite,2) TO seits
       ?'   Seite',seits
       ?'  ',DATE(),'            '
       SET PRINT OFF
       ??'>>> KC85/4 - Softwareliste <<<'
       SET CONSOLE OFF
       SET PRINT ON
       ?? CHR(27)+'-1>>>  KC85/4 - Softwareliste  <<<'+CHR(27)+'-0'
       SET CONSOLE ON
       STORE zeile+4 TO zeile
       STORE '**' TO mask
      ENDIF
      IF (!(dru2)= "J" .OR.druck).AND.(!(dru3)= "N" .OR.(&bed))
       IF mask=art
        IF dru2= "J"
         ? STR(#,4)+' '+art+'-'+disk
         IF druck
          ??' '
         ELSE
          ??'*'
         ENDIF
         ?? name+'.'+typ+'  '+adressen+'  '+TRIM(bemerkung)
        ELSE
         ? name+'.'+typ,adressen,TRIM(bemerkung)
        ENDIF
        STORE zeile+1 TO zeile
        SKIP
       ELSE
        STORE zeile+4 TO zeile
        IF zeile<62
         STORE art TO mask
         ?
         SELECT SECONDARY
         IF VAL(mask)>0 .AND. VAL(mask)<=maxr
          GO &mask
          ?'   '+TRIM(TEXT)+':'
          ?
         ELSE
          STORE zeile-2 TO zeile
         ENDIF
         IF dru2= "J"
          ?'Nr. Art Disk  Filename '
         ELSE
          ?'Filename'
         ENDIF
         ??'   ',quelle,'               Bemerkungen'
         SELECT PRIMARY
        ELSE
         STORE zeile+1 TO zeile
        ENDIF
       ENDIF
      ELSE
       SKIP
      ENDIF
     ENDDO
     STORE seite+1 TO seite
     EJECT
    ENDDO
    SET PRINT OFF
   ENDIF

  CASE wahl= "E"
   ERASE
   @ 2,15 SAY "E i g e n e   A n s c h r i f t"
   @ 3,15 SAY "================================"
   @ 5,0
   ?'     Name  :',xadr1
   ?
   ?'     Stra~e:',xadr2
   ?
   ?'     Ort   :',xadr3
   @ 13,5 SAY 'Sollen Ver{nderungen vorgenommen werden (J/N) ?'
   SET CONSOLE OFF
   WAIT TO ein
   SET CONSOLE ON
   IF !(ein)= 'J'
    ?? CHR(8)+'Ja'
    @ 15,0
    ACCEPT '     Name  ' TO xadr1
    ?
    ACCEPT '     Stra~e' TO xadr2
    ?
    ACCEPT '     Ort   ' TO xadr3
    SAVE TO FILE ALL LIKE xadr?
   ELSE
    ?? CHR(8)+'Nein'
   ENDIF

  CASE wahl= "Z"
   DO ZUSATZ

  OTHERWISE
   LOOP
 ENDCASE
ENDDO