home *** CD-ROM | disk | FTP | other *** search
/ PC Action 1997 December / PCACTION1297.ISO / menue / POSTFACH / 97120758.TXT < prev    next >
Text File  |  1997-10-29  |  13KB  |  445 lines
  1. 0
  2. PCA CD Viewer für Dos Seite06
  3. Black Baron
  4. Programmieren
  5. Datum:   09.10.1997
  6. Betreff: PCA CD Viewer Seite 6 (FILES.PAS)
  7. From:    Black Baron
  8. To:      Alle
  9. ============================================
  10. Unit FILES;
  11. {---------}
  12.  
  13. Interface
  14. {-------}
  15.  
  16.   Const MAX_DARSTELLEN = 6;
  17.  
  18.         MAX_VERZEICHNISSE = 5;
  19.  
  20.         VERZEICHNIS_TITEL : Array [ 1 .. MAX_VERZE
  21.                             'SPIELETI' );
  22.  
  23.   Type SINGLE_DATEN_TYPE = Record
  24.           DATEI_NAME : String [ 8 ];
  25.           TITEL : String [ 44 ];
  26.           VON , ZU : String [ 21 ];
  27.           NUMMER : Word;
  28.         End;
  29.  
  30.         OPTIONEN_TYPE = Record
  31.           CD : Char;
  32.           COPY : Boolean;
  33.         End;
  34.         SAMMEL_DATEN_TYPE = Array [ 1 .. MAX_DARST
  35.  
  36.   Var MAILS_KOPIEREN : Boolean;
  37.  
  38.   Function DATENSAETZE_ANZAHL_LESEN ( TYP : Byte )
  39.  
  40.   Procedure MAIL_SPEICHERN ( TITEL , VON , ZU : St
  41.  
  42.   Function SUCHEN ( BEGRIFF , JOKER : String ; STA
  43.  
  44.   Procedure DATENSATZ_LESEN ( BILD_OBERKANTE : Wor
  45.  
  46.   Procedure ALLE_DATENSAETZE_LESEN ( BILD_OBERKANT
  47.  
  48.   Function HD_VERZEICHNIS_VORHANDEN : Boolean;
  49.  
  50.   Procedure DATEN_BEREITSTELLEN;
  51.  
  52.   Procedure LISTE_BEREITSTELLEN ( TYP : Byte );
  53.  
  54.   Function OPTION_LESEN ( Var OPTIONEN : OPTIONEN_
  55.  
  56.   Procedure OPTION_SCHREIBEN ( OPTIONEN : OPTIONEN
  57.  
  58.   Procedure DATEI_LOESCHEN ( DATEI_NAME : String )
  59.  
  60. Implementation
  61. {------------}
  62.  
  63.   Uses Crt , CRT_DOSX;
  64.  
  65.   Const ZEICHEN = [ 'a' .. 'z' , 'A' .. 'Z' ];
  66.  
  67.         SHORT_DATEI_GROESSE : Array [ 1 .. 4 ] of 
  68.  
  69.         INDEX_Z_MAX = 10;
  70.   
  71.   Type INDEX_INHALT_TYPE = Record
  72.          DATEI_NAME : String [ 8 ];
  73.          TITEL : String [ 44 ];
  74.          VON , ZU : String [ 21 ];
  75.        End;
  76.   
  77.        SHORT_INDEX_TYPE = Record
  78.          NUMMER : Word;
  79.          DATEN : String [ 44 ];
  80.        End;
  81.   
  82.        INDEX_Z_TYPE = Array [ 1 .. INDEX_Z_MAX ] o
  83.  
  84.   Function DATENSAETZE_ANZAHL_LESEN;
  85.   Var DATEI : File;
  86.       GROESSE : Word;
  87.   Begin
  88.     Assign ( DATEI , PATH . DATEN + VERZEICHNIS_TI
  89.     {$I-}
  90.     Reset ( DATEI , Sizeof ( INDEX_INHALT_TYPE ) )
  91.     FEHLER_EXIT ( 4 , 4 , 0 , True );
  92.     GROESSE := Filesize ( DATEI );
  93.     FEHLER_EXIT ( 4 , 5 , 0 , True );
  94.     {$I+}
  95.     Close ( DATEI );
  96.     DATENSAETZE_ANZAHL_LESEN := GROESSE;
  97.   End;
  98.  
  99.   Procedure MAIL_SPEICHERN;
  100.   Var DATEI1 , DATEI2 : Text;
  101.       FEHLER : Integer;
  102.       INHALT : String;
  103.       I : Word;
  104.   Begin
  105.     Case TYP of
  106.       1 : TYP := 1;
  107.       2 : TYP := 2;
  108.       3 : TYP := 5;
  109.       4 : TYP := 3;
  110.       5 : TYP := 4;
  111.     End;
  112.     I := 0;
  113.     {$I-}
  114.     Repeat
  115.       Assign ( DATEI1 , PATH . DATEN + STR_ ( TYP 
  116.       Reset ( DATEI1 );
  117.       FEHLER := Ioresult;
  118.       If FEHLER = 0 Then Begin
  119.         Close ( DATEI1 );
  120.         I := I + 1;
  121.       End;
  122.     Until ( FEHLER <> 0 ) or ( I > 65535 );
  123.     If FEHLER <> 0 Then Begin
  124.       Rewrite ( DATEI1 );
  125.       FEHLER_EXIT ( 3 , 6 , 0 , True );
  126.       Writeln ( DATEI1 , STR_ ( TYP ) );
  127.       FEHLER_EXIT ( 3 , 7 , 0 , True );
  128.       Writeln ( DATEI1 , '0' );
  129.       FEHLER_EXIT ( 3 , 8 , 0 , True );
  130.       Writeln ( DATEI1 , TITEL );
  131.       FEHLER_EXIT ( 3 , 8 , 0 , True );
  132.       Writeln ( DATEI1 , VON );
  133.       FEHLER_EXIT ( 3 , 10 , 0 , True );
  134.       Writeln ( DATEI1 , ZU );
  135.       FEHLER_EXIT ( 3 , 11 , 0 , True );
  136.       Assign ( DATEI2 , 'C:\PCACTION\BB_CDV\LASTMA
  137.       Reset ( DATEI2 );
  138.       If Ioresult = 0 Then Begin
  139.         While not Eof ( DATEI2 ) do Begin
  140.           Readln ( DATEI2 , INHALT );
  141.           FEHLER_EXIT ( 7 , 12 , 0 , True );
  142.           Writeln ( DATEI1 , INHALT );
  143.           FEHLER_EXIT ( 3 , 12 , 0 , True );
  144.         End;
  145.         Close ( DATEI2 );
  146.       End;
  147.       Close ( DATEI1 );
  148.     End
  149.     Else FEHLER_EXIT ( 6 , 14 , 0 , False );
  150.     {$I+}
  151.   End;
  152.  
  153.   Function SUCHEN;
  154.   Var DATEI : File;
  155.       INHALT : SHORT_INDEX_TYPE;
  156.       GEFUNDEN : Boolean;
  157.       GELESEN : Integer;
  158.   Begin
  159.     BEGRIFF := UPCASE_STRING ( BEGRIFF );
  160.     GEFUNDEN := False;
  161.     POS := START_POS;
  162.     Assign ( DATEI , PATH . DATEN + VERZEICHNIS_TI
  163.     {$I-}
  164.     Reset ( DATEI , SHORT_DATEI_GROESSE [ MODUS ] 
  165.     FEHLER_EXIT ( 4 , 15 , 0 , True );
  166.     Seek ( DATEI , START_POS );
  167.     FEHLER_EXIT ( 4 , 16 , 0 , True );
  168.     Repeat
  169.       Blockread ( DATEI , INHALT , 1 , GELESEN );
  170.       FEHLER_EXIT ( 4 , 17 , 0 , True );
  171.       If GELESEN = 1 Then Begin
  172.         If JOKER_VERGLEICHEN ( BEGRIFF , JOKER , U
  173.                                                   
  174.       End;
  175.     Until ( GEFUNDEN ) or ( GELESEN <> 1 );
  176.     Close ( DATEI );
  177.     SUCHEN := GEFUNDEN;
  178.   End;
  179.  
  180.   Procedure DATENSATZ_LESEN;
  181.   Var DATEI : File;
  182.       INHALT1 : SHORT_INDEX_TYPE;
  183.       INHALT2 : INDEX_INHALT_TYPE;
  184.       POS : Word;
  185.   Begin
  186.     POS := BILD_OBERKANTE + CURSOR - 2;
  187.     If MODUS <> 0 Then Begin
  188.       Assign ( DATEI , PATH . DATEN + VERZEICHNIS_
  189.       {$I-}
  190.       Reset ( DATEI , SHORT_DATEI_GROESSE [ MODUS 
  191.       FEHLER_EXIT ( 4 , 18 , MODUS + TYP * 10 , Tr
  192.       Seek ( DATEI , POS );
  193.       FEHLER_EXIT ( 4 , 19 , MODUS + TYP * 10 , Tr
  194.       Blockread ( DATEI , INHALT1 , 1 );
  195.       FEHLER_EXIT ( 4 , 20 , MODUS + TYP * 10 , Tr
  196.       Close ( DATEI );
  197.       POS := INHALT1 . NUMMER - 1
  198.     End;
  199.     Assign ( DATEI , PATH . DATEN + VERZEICHNIS_TI
  200.     Reset ( DATEI , Sizeof ( INDEX_INHALT_TYPE ) )
  201.     FEHLER_EXIT ( 4 , 21 , MODUS + TYP * 10 , True
  202.     Seek ( DATEI , POS );
  203.     FEHLER_EXIT ( 4 , 22 , MODUS + TYP * 10 , True
  204.     Blockread ( DATEI , INHALT2 , 1 );
  205.     FEHLER_EXIT ( 4 , 23 , MODUS + TYP * 10 , True
  206.     Close ( DATEI );
  207.     {$I+}
  208.     DATEN . DATEI_NAME := INHALT2 . DATEI_NAME;
  209.     DATEN . TITEL := INHALT2 . TITEL;
  210.     DATEN . VON := INHALT2 . VON;
  211.     DATEN . ZU := INHALT2 . ZU;
  212.     DATEN . NUMMER := POS + 1;
  213.   End;
  214.  
  215.   Procedure ALLE_DATENSAETZE_LESEN;
  216.   Var I : Byte;
  217.   Begin
  218.     For I := 1 to MAX_DARSTELLEN do DATENSATZ_LESE
  219.   End;
  220.  
  221.   Procedure BEEP;
  222.   Var Z : Boolean;
  223.       DUMMY : Char;
  224.   Begin
  225.     Repeat
  226.       Z := not Z;
  227.       If Z Then Sound ( 100 )
  228.            Else Sound ( 1000 );
  229.       Delay ( 250 );
  230.     Until Keypressed;
  231.     Nosound;
  232.     While Keypressed do DUMMY := Readkey;
  233.   End;
  234.  
  235.   Procedure SIGNAL;
  236.   Begin
  237.     If PARAMETER_SUCHEN ( '-Sound' ) Then BEEP;
  238.   End;
  239.  
  240.   Function HD_VERZEICHNIS_VORHANDEN;
  241.   Begin
  242.     HD_LAUFWERK_ERMITTELN;
  243.     CD_BEZEICHNUNG_LESEN;
  244.     Gotoxy ( 63 , 2 );
  245.     Write ( PATH . CD_LAUFWERK + ' = ' + PATH . CD
  246.     Window ( 3 , 10 , 50 , 20 );
  247.     PATH . HAUPT := PATH . HD_LAUFWERK + ':\PCACTI
  248.     Writeln ( 'Check HD Path (' + PATH . HAUPT + '
  249.     {$I-}
  250.     Chdir ( PATH . HAUPT );
  251.     {$I+}
  252.     If Ioresult <> 0 Then Begin
  253.       Writeln ( 'Create HD Path (' + PATH . HAUPT 
  254.       Mkdir ( PATH . HAUPT );
  255.     End;
  256.     PATH . HAUPT := PATH . HAUPT + '\' + 'BB_CDV';
  257.     Writeln ( 'Check HD Path (' + PATH . HAUPT + '
  258.     {$I-}
  259.     Chdir ( PATH . HAUPT );
  260.     {$I+}
  261.     If Ioresult <> 0 Then Begin
  262.       Writeln ( 'Create HD Path (' + PATH . HAUPT 
  263.       Mkdir ( PATH . HAUPT );
  264.     End;
  265.     PATH . HAUPT := PATH . HAUPT + '\';
  266.     PATH . DATEN := PATH . HAUPT + PATH . CD_NAME;
  267.     Writeln ( 'Check HD Path (' + PATH . DATEN + '
  268.     {$I-}
  269.     Chdir ( PATH . DATEN );
  270.     {$I+}
  271.     If Ioresult <> 0 Then Begin
  272.       Writeln ( 'Create HD Path (' + PATH . DATEN 
  273.       Mkdir ( PATH . DATEN );
  274.       HD_VERZEICHNIS_VORHANDEN := False;
  275.       Chdir ( PATH . DATEN );
  276.     End
  277.     Else HD_VERZEICHNIS_VORHANDEN := True;
  278.     PATH . DATEN := PATH . DATEN + '\';
  279.   End;
  280.  
  281.   Procedure INDEX_KOPIEREN ( TITEL : String ; NUMM
  282.   Var INHALT2 : INDEX_INHALT_TYPE;
  283.       DATEI1 , DATEI2 : File;
  284.       INHALT1 : INHALT1_TYPE;
  285.       MAILS , I1 : Word;
  286.       X , Y : Integer;
  287.       I2 : Byte;
  288.   Begin
  289.     If NUMMER = 1 Then Writeln ( 'Kopiere Index Da
  290.     X := Wherex;
  291.     Y := Wherey;
  292.     Assign ( DATEI1 , PATH . CD_LAUFWERK + ':\MENU
  293.     {$I-}
  294.     Reset ( DATEI1 , 1 );
  295.     {$I+}
  296.     FEHLER_EXIT ( 2 , 24 , 0 , True );
  297.     MAILS := ( Filesize ( DATEI1 ) - 226 ) div 104
  298.     Window ( 52 , 7 , 71 , 12 );
  299.     Gotoxy ( 1 , 1 );
  300.     Write ( 'B: 0      ' );
  301.     Gotoxy ( 12 , 1 );
  302.     Write ( 'M:       ' );
  303.     Gotoxy ( 15 , 1 );
  304.     Write ( MAILS );
  305.     Gotoxy ( 1 , 1 + NUMMER );
  306.     Write ( TITEL );
  307.     Gotoxy ( 11 , 1 + NUMMER  );
  308.     Write ( '#M: 0' );
  309.     Assign ( DATEI2 , PATH . DATEN + TITEL + '.IX0
  310.     Rewrite ( DATEI2 , 1 );
  311.     Seek ( DATEI1 , 226 );
  312.     For I1 := 1 to MAILS do Begin
  313.       Gotoxy ( 15 , 1 + NUMMER );
  314.       Write ( I1 );
  315.       Gotoxy ( 4 , 1 );
  316.       Write ( I1 * 104 + 226 );
  317.       {$I-}
  318.       Blockread ( DATEI1 , INHALT1 , 104 );
  319.       {$I+}
  320.       FEHLER_EXIT ( 2 , 25 , NUMMER , True );
  321.       COPY_STRING ( INHALT1 , INHALT2 . DATEI_NAME
  322.       COPY_STRING ( INHALT1 , INHALT2 . TITEL , 19
  323.       COPY_STRING ( INHALT1 , INHALT2 . VON , 63 ,
  324.       COPY_STRING ( INHALT1 , INHALT2 . ZU , 84 , 
  325.       {$I-}
  326.       Blockwrite ( DATEI2 , INHALT2 , Sizeof ( INH
  327.       {$I+}
  328.       FEHLER_EXIT ( 3 , 26 , NUMMER , True );
  329.     End;
  330.     Close ( DATEI1 );
  331.     Close ( DATEI2 );
  332.     If NUMMER = MAX_VERZEICHNISSE Then Clrscr;
  333.     Window ( 3 , 10 , 50 , 20 );
  334.     Gotoxy ( X , Y );
  335.   End;
  336.  
  337.   Procedure INDEX_SORTIEREN ( TITEL : String ; NUM
  338.   Var DATEI1 , DATEI2 : File;
  339.       INHALT1 : INDEX_INHALT_TYPE;
  340.       INHALT2 , INHALT3 : SHORT_INDEX_TYPE;
  341.       FEHLER , X , Y : Integer;
  342.       POS , REST , GROESSE : Longint;
  343.       P : Pointer;
  344.       I1 , I3 , I4 : Word;
  345.       I2 : Char;
  346.       UP_STRING : String [ 44 ];
  347.   Begin
  348.     If NUMMER = 1 Then Writeln ( 'Index sortieren'
  349.     X := Wherex;
  350.     Y := Wherey;
  351.     Window ( 51 , 7 , 79 , 12 );
  352.     Write ( TITEL );
  353.     For I4 := 1 to 4 do Begin
  354.       Gotoxy ( 10 , 1 );
  355.       Write ( I4 );
  356.       For I2 := 'A' to 'Z' do Begin
  357.         Assign ( DATEI2 , PATH . DATEN + TITEL + '
  358.         Rewrite ( DATEI2 , 1 );
  359.         Close ( DATEI2 );
  360.         Gotoxy ( 12 , 1 );
  361.         Write ( 'e-' , I2 );
  362.       End;
  363.       Gotoxy ( 12 , 1 );
  364.       Write ( 'e-.' );
  365.       Assign ( DATEI2 , PATH . DATEN + TITEL + '.S
  366.       Rewrite ( DATEI2 , 1 );
  367.       Close ( DATEI2 );
  368.       Gotoxy ( 12 , 1 );
  369.       Write ( '   ' );
  370.       I1 := 0;
  371.       Assign ( DATEI1 , PATH . DATEN + TITEL + '.I
  372.       Reset ( DATEI1 , Sizeof ( INHALT1 ) );
  373.       While not Eof ( DATEI1 ) do Begin
  374.         I1 := I1 + 1;
  375.         Gotoxy ( 1 , 1 + I4 );
  376.         Write ( I1 );
  377.         Blockread ( DATEI1 , INHALT1 , 1 );
  378.         INHALT3 . DATEN := '                      
  379.         INHALT3 . NUMMER := I1;
  380.         Case I4 of
  381.           1 : Begin
  382.             If INHALT1 . TITEL [ 1 ] in ZEICHEN Th
  383.                INHALT1 . TITEL [ 1 ] + '1' )
  384.                                                 El
  385.             UP_STRING := UPCASE_STRING ( INHALT1 .
  386.             INHALT3 . DATEN := INHALT1 . TITEL;
  387.           End;
  388.           2 : Begin
  389.             If INHALT1 . VON [ 1 ] in ZEICHEN Then
  390.                                               Else
  391.             UP_STRING := UPCASE_STRING ( INHALT1 .
  392.             INHALT3 . DATEN := INHALT1 . VON;
  393.           End;
  394.           3 : Begin
  395.             If INHALT1 . ZU [ 1 ] in ZEICHEN Then 
  396.                                              Else 
  397.             UP_STRING := UPCASE_STRING ( INHALT1 .
  398.             INHALT3 . DATEN := INHALT1 . ZU;
  399.           End;
  400.           4 : Begin
  401.             If INHALT1 . DATEI_NAME [ 1 ] in ZEICH
  402.              Assign ( DATEI2 , PATH . DATEN + TITE
  403.                                                   
  404.             UP_STRING := UPCASE_STRING ( INHALT1 .
  405.             INHALT3 . DATEN := INHALT1 . DATEI_NAM
  406.           End;
  407.         End;
  408.         Gotoxy ( 6 , 1 + I4 );
  409.         Write ( 'suche' );
  410.         Reset ( DATEI2 , SHORT_DATEI_GROESSE [ I4 
  411.         {$I-}
  412.         Repeat
  413.           Blockread ( DATEI2 , INHALT2 , 1 );
  414.           FEHLER := Ioresult;
  415.         Until ( UP_STRING < UPCASE_STRING ( INHALT
  416.         {$I+}
  417.         If FEHLER = 0 Then Begin
  418.           POS := Filepos ( DATEI2 ) - 1;
  419.           GROESSE := Filesize ( DATEI2 );
  420.           REST := GROESSE - POS;
  421.           Gotoxy ( 6 , 1 + I4 );
  422.           Write ( 'ver. P p' , POS , ' g' , GROESS
  423.           If ( Maxavail > REST * SHORT_DATEI_GROES
  424.             Getmem ( P , REST * SHORT_DATEI_GROESS
  425.             Seek ( DATEI2 , POS );
  426.             Blockread ( DATEI2 , P^ , REST );
  427.             Seek ( DATEI2 , POS + 1 );
  428.             Blockwrite ( DATEI2 , P^ , REST );
  429.             Freemem ( P ,  REST * SHORT_DATEI_GROE
  430.           End
  431.           Else Begin
  432.             Gotoxy ( 6 , 1 + I4 );
  433.             Write ( 'ver. F p' , POS , ' g' , GROE
  434.             For I3 := GROESSE downto POS + 1 do Be
  435.               Seek ( DATEI2 , I3 - 1 );
  436.               Blockread ( DATEI2 , INHALT2 , 1 );
  437.               Blockwrite ( DATEI2 , INHALT2 , 1 );
  438.             End;
  439.           End;
  440.           Seek ( DATEI2 , POS );
  441.         End;
  442.         Gotoxy ( 6 , 1 + I4 );
  443.         Write ( 'schreibe              ' );
  444.         Blockwrite ( DATEI2 , INHALT3 , 1 );
  445.