home *** CD-ROM | disk | FTP | other *** search
/ SPACE 2 / SPACE - Library 2 - Volume 1.iso / demos / 57 / pascal / accload.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1986-09-18  |  7.1 KB  |  291 lines
  1. Program ACC_Load;
  2.  
  3.  TYPE
  4.    fn_range = 1..14 ;
  5.    y_n_range=-1..1;
  6.    fname = PACKED ARRAY [ fn_range ] OF char ;
  7.    frec = PACKED RECORD
  8.             reserved : PACKED ARRAY [ 0..19 ] OF byte ;
  9.             resvd2 : byte ;
  10.             attrib : byte ;
  11.             time_stamp : integer ;
  12.             date_stamp : integer ;
  13.             size : long_integer ;
  14.             name : fname ;
  15.           END ;
  16.    path_name2 = PACKED ARRAY [ 1..80 ] OF char ;
  17.    name_array= ARRAY [1..120] of fname;
  18.    yes_no    = ARRAY [1..120] of y_n_Range;
  19.    String2   =String[2];
  20.    String3   =String[3];
  21.  VAR
  22.    f1,f2:TEXT;
  23.    kount,m,number:Integer;
  24.    r : Frec;
  25.    change,yes_array:Yes_no;
  26.    Names: name_Array;
  27.    i : fn_range ;
  28.    path_string : STRING ;
  29.    path : path_name2 ;
  30.    dummy:STRING;
  31.    s: STRING2;
  32.  {$I D:CURSOR.PAS}
  33.  
  34.  PROCEDURE init;
  35.   BEGIN
  36.    clrScr;
  37.    InverseVideo;
  38.    CursOn;
  39.    Write (CHR(14),CHR(15));
  40.    Writeln(' Accessory Loader, by Eric Robishaw ',CHR(14),CHR(15));
  41.    NormVideo;
  42.    Writeln ('Written in Personal Pascal, Portions of');
  43.    Writeln ('this product are Copyright (c) 1986,');
  44.    Writeln ('OSS and CCD. Used by permission of OSS.');
  45.   END;
  46.  
  47.  
  48.  PROCEDURE set_dta( VAR buf : frec ) ;
  49.    GEMDOS( $1a ) ;
  50.  
  51.  FUNCTION get_first( VAR path : path_name2; search_attrib :integer ):integer ;
  52.    GEMDOS( $4e ) ;
  53.  
  54.  FUNCTION get_next : integer ;
  55.    GEMDOS( $4f ) ;
  56.  
  57. (*******************************************************************)
  58.  
  59.  PROCEDURE Show_it;
  60.   VAR Kount:INTEGER;
  61.   BEGIN
  62.   Kount:=1;
  63.     While (Kount<=Number) AND (KOUNT<=20) DO
  64.       BEGIN
  65.           if Kount<10 THEN Write ('0');
  66.           Write (KOUNT,')  ');
  67.           if yes_array[kount]=1 THEN
  68.               InverseVideo;
  69.           m:=1;
  70.              While (names[kount,m]<>'.') AND (m<=14) DO
  71.                BEGIN
  72.                     Write (names[kount,m]);
  73.                     m:=m+1;
  74.                END;
  75.           Writeln;
  76.           NormVideo;
  77.           Kount:=Kount+1;
  78.       END;
  79.      IF (Kount<=Number) THEN
  80.       BEGIN
  81.        For Kount:=21 to Number DO
  82.         BEGIN
  83.           GotoXY (Kount-19,20);
  84.           Write (KOUNT,') ');
  85.           if yes_array[KOUNT]=1 THEN
  86.             InverseVideo;
  87.           m:=1;
  88.             While (names[kount,m]<>'.') AND (m<=14) DO
  89.              BEGIN
  90.                 Write (names[kount,m]);
  91.                 m:=m+1;
  92.              END; (*WHILE*)
  93.          NormVideo;
  94.        END; (*FOR KOUNT*)
  95.       END; (*IF*)
  96.      InverseVideo;
  97.      GotoXY (22,1);
  98.      Write ('+-');
  99.      Normvideo;
  100.      Write(' to end, ');
  101.      InverseVideo;
  102.      Write ('ENTER');
  103.      NormVideo;
  104.      Write (' to undo');
  105.      InverseVideo;
  106.      GotoXY (24,10);
  107.      Write ('Change:');
  108.      NormVideo;
  109.      Write ('__');
  110.   END;
  111.  
  112. (******************************************************************)
  113.  
  114. Procedure Get_answer (VAR Change:Yes_no);
  115.  VAR DONE:BOOLEAN;
  116.      The_Number,over,x,y,move1,Kount2:INTEGER;
  117.      move:Long_Integer;
  118.  
  119.       Procedure Change_it;
  120.         VAR i:INTEGER;
  121.        BEGIN
  122.         For i:=1 to NUMBER DO
  123.          change[i]:=-1;
  124.         For i:=NUMBER+1 TO 120 DO
  125.          change[i]:=0;
  126.        END; (*Change_it*)
  127.  
  128.   FUNCTION val( s: STRING3): integer;
  129.  
  130.     VAR
  131.        minus:Boolean;
  132.        i,n    :Integer;
  133.  
  134.     BEGIN
  135.       i := 1;
  136.       WHILE (i < length(s)) AND ((s[i] = ' ') OR (s[i]='0')) DO
  137.         i := i + 1;
  138.       n := 0;
  139.       IF length(s) >= i THEN
  140.         BEGIN
  141.           IF s[i] <> '-' THEN
  142.             minus := false
  143.           ELSE
  144.             BEGIN
  145.               minus := true;
  146.               i := i + 1;
  147.             END;
  148.           WHILE (i <= length(s)) AND (s[i] IN ['0'..'9']) DO
  149.             BEGIN
  150.               n := (n * 10) + ord(s[i]) - ord('0');
  151.               i := i + 1;
  152.             END;
  153.           IF minus THEN
  154.             n := -n;
  155.         END;
  156.       val := n;
  157.     END;
  158.  
  159.      Procedure Change_again (The_Number:Integer);
  160.      VAR Down,Over,m:Integer;
  161.  
  162.      BEGIN
  163.       change[The_Number]:=-Change [The_Number];
  164.       If The_Number<=Number THEN
  165.        BEGIN
  166.             If The_Number >20 Then
  167.               BEGIN
  168.                Down:=(The_Number-19);
  169.                Over:=24;
  170.               END
  171.            ELSE
  172.             BEGIN
  173.              Down:=The_Number+1;
  174.              Over:=6;
  175.             END;
  176.             IF (yes_array[The_Number]=1) and (change[The_Number]=1) THEN
  177.              NormVideo
  178.             ELSE if (yes_Array[The_Number]=1) AND (Change[The_Number]=-1) THEN
  179.              InverseVideo
  180.             ELSE if (Yes_Array[The_Number]=-1) AND (Change[The_Number]=-1) THEN
  181.              NormVideo
  182.             ELSE if (Yes_Array[The_Number]=-1) AND (Change[The_Number]=1) THEN
  183.              InverseVideo;
  184.         m:=1;
  185.         GotoXY (down,over);
  186.         While (names[The_Number,m]<>'.') AND (m<=14) DO
  187.          BEGIN
  188.             Write (names[The_Number,m]);
  189.             m:=m+1;
  190.          END;
  191.       END;
  192.      END;
  193.  
  194.  BEGIN (*Get_answer*)
  195.     done:=FALSE;
  196.     The_Number:=Number+1;
  197.     change_it;
  198.     While (not DONE) DO
  199.       BEGIN
  200.        NormVideo;
  201.        s[1]:=CHR(13);
  202.        GotoXY (24,17);
  203.        Write ('__');
  204.        GotoXY (24,17);
  205.        Readln (s);
  206.        If S='+-' THEN DONE:=TRUE
  207.        ELSE If (ORD(s[1])=13) OR (ORD(s[2])=13) THEN
  208.           change_again(The_Number)
  209.        ELSE
  210.          BEGIN
  211.            The_Number:=VAL (s);
  212.            if The_Number<>0 THEN
  213.              change_again(The_Number)
  214.            ELSE The_Number:=Number+1;
  215.          END;
  216.       END; (*While*)
  217.  END;
  218.  
  219. (******************************************************************)
  220.  
  221. Procedure Rename_all (Change:Yes_No);
  222. VAR Kount:Integer;
  223.  
  224.    Procedure Rename_it (Kount:Integer);
  225.    Var
  226.       old,new:fname;
  227.       zero,m:Integer;
  228.       ch:Char;
  229.  
  230.     Procedure Rename2 ( zero:Integer ; VAR Old,New:fname);
  231.       GEMDOS ( $56 ) ;
  232.  
  233.    BEGIN
  234.     zero:=0;
  235.     old:=Names[Kount];
  236.     m:=1;
  237.      While (Names[kount,m]<>'.') DO
  238.       m:=m+1;
  239.      m:=m+3;
  240.      ch:=names[kount,m];
  241.       CASE ch OF
  242.        'X'   :   Names[Kount,m]:='C';
  243.        'C'   :   Names[Kount,m]:='X';
  244.       END; (*Case*)
  245.      New:=Names[Kount];
  246.     Rename2 (zero,old,new);
  247.    END;
  248.  
  249.  
  250.  
  251.  BEGIN
  252.    For Kount:=1 to Number DO
  253.      BEGIN
  254.        If change[Kount]=1 THEN
  255.          Rename_it (kount);
  256.      END;
  257.  END;
  258.  
  259. (**************************************************************)
  260.  
  261.  BEGIN
  262.      INIT;
  263.      number:=0;
  264.      path_string:='A:*.AC?';
  265.      For i:=1 to length (path_string) DO
  266.        path[i]:=path_string [i];
  267.      path[length(path_String)+1]:=chr(0);
  268.      set_dta( r) ;
  269.      If Get_first (path,0)<0 THEN
  270.        writeln( 'no files match specification!' )
  271.      ELSE
  272.        REPEAT
  273.          m:=1;
  274.          number:=number+1;
  275.          names[number]:=r.name;
  276.           While (names[number,m]<>chr(0)) AND (m<=14) DO
  277.             m:=m+1;
  278.           if (names[number,m-1])='C' THEN yes_array[number]:=1
  279.             ELSE
  280.               yes_array[number]:=-1;
  281.        UNTIL get_next < 0 ;
  282.       For Kount:=1 to 10000 DO;
  283.       Curshome;
  284.       Cursdown;
  285.       clrEos;
  286.       show_it;
  287.       get_answer (change);
  288.       Rename_all (change);
  289.      Writeln ('Desktop.........');
  290.  END.
  291.