home *** CD-ROM | disk | FTP | other *** search
/ Columbia Kermit / kermit.zip / archives / norskdata.tar.gz / norskdata.tar / ndkfil.pas < prev    next >
Pascal/Delphi Source File  |  1985-06-24  |  14KB  |  368 lines

  1. (*  tab  p; 
  2.  *
  3.  *        File open/close routines (machine dependent)
  4.  *
  5.  *)
  6.     procedure ParseFile (   VAR FileName    :   NameType;
  7.                             VAR NamePart    :   StringType;
  8.                             VAR TypePart    :   Char4Array;
  9.                                 QuoteName   :   boolean    );
  10.  
  11.     var i, j, parlvl : integer;
  12.         ch           : char;
  13.         NotThru      : boolean;
  14.     begin
  15.         with FileName do begin
  16.             i       := 1;
  17.             j       := MinString;
  18.             parlvl  := 0;
  19.             if QuoteName then begin
  20.                 NamePart(.j.) := '"';
  21.                 j := j + 1;
  22.             end;
  23.  
  24.             ch := String(.i.);
  25.             while ( i<=valid )
  26.           and not ( (ch=':') and (parlvl=0) ) do begin
  27.                 if ch='(' then 
  28.                     parlvl := parlvl + 1
  29.                 else if ch=')' then 
  30.                     parlvl := parlvl - 1;
  31.                 NamePart(.j.) := ch;
  32.                 i  := i + 1 ;
  33.                 j  := j + 1 ;
  34.                 ch := String(.i.);
  35.             end;
  36.             if QuoteName then begin
  37.                 NamePart(.j.) := '"';
  38.                 j := j + 1;
  39.             end;
  40.             NamePart(.j.) := '''';
  41.  
  42.             if i>valid then (* no colon - use default type *)
  43.                 TypePart := DefFtype
  44.             else
  45.             begin
  46.                 j       := 1;
  47.                 NotThru := TRUE;
  48.                 for i := i + 1 to i + MaxFType do begin
  49.                     if (i<=valid) and NotThru then begin
  50.                         ch := String(.i.);
  51.                         if (ch=';') then begin
  52.                             NotThru := FALSE;  (* watch out for version delimiter *)
  53.                             ch := ' ';
  54.                         end;
  55.                         TypePart(.j.) := ch
  56.                     end
  57.                     else
  58.                         TypePart(.j.) := ' ';
  59.                     j := j + 1;
  60.                 end;
  61.             end;
  62.         end;
  63.     end;
  64.  
  65.     function OpenRead (     VAR ReadFile    :   ByteFile ;
  66.                             VAR FileName    :   NameType ) : integer;
  67.     (* Abstract : Opens ReadFile for Read 
  68.                   Does a RESET of the file
  69.  
  70.                   Returns 0 if Open was successful,
  71.                        i.e. file existed and read access of file was granted. *)
  72.  
  73.     var     ostat    : integer;
  74.             NamePart : StringType;
  75.             TypePart : Char4Array;
  76.     begin
  77.         ParseFile ( FileName, NamePart, TypePart, OldFile );
  78.         Connect ( ReadFile, NamePart, TypePart, 'R', Ostat );
  79.         if Ostat=0 then
  80.             reset( ReadFile );
  81.         OpenRead := Ostat;
  82.     end;
  83.  
  84.  
  85.     function OpenWrite (    VAR WriteFile   :   ByteFile ;
  86.                             VAR FileName    :   NameType ) : integer;
  87.     (* Abstract:  Opens WriteFile for Write
  88.                   Does a REWRITE of the file
  89.                   Returns -1 If Open was NOT successful.
  90.                            0 If Open was immediately successful, i.e.
  91.                              new file or write access granted to existing
  92.                              file, provided FileWarning OFF.
  93.                            1 If Open was successful after renaming file, i.e.
  94.                              Kermit was able to create the new file       *)
  95.  
  96.     CONST   Existing = 62;
  97.  
  98.     var     ostat    : integer;
  99.             original : NameType;
  100.             NamePart : StringType;
  101.             TypePart : Char4Array;
  102.             Exit     : Boolean;
  103.     begin
  104.             (* First: Possible to create new file? *)
  105.         ParseFile ( FileName, NamePart, TypePart, NewFile );
  106.         OpenWrite := 0;     (* Assume no trouble at all! *)
  107.         Connect ( WriteFile, NamePart, TypePart, 'W', Ostat );
  108.         if Ostat=0 then begin
  109.             rewrite( WriteFile );
  110.         end
  111.         else begin   (* Not possible, go try something else .. *)
  112.             if Ostat<>Existing then 
  113.                 OpenWrite := -1     (* No hope if other than "File already exists" *)
  114.             else if FileWarning then begin
  115.                  (*   Exit := false;
  116.                     Original := FileName;
  117.                     repeat (* modify file name systematically
  118.                               until able to create new file
  119.                     until Exit;  *)
  120.                     OpenWrite := -1;  (* Do it simply - so far! *)
  121.                 end
  122.                 else begin  (* FileWarning is off - overwriting is permitted *)
  123.                     ParseFile ( FileName, NamePart, TypePart, OldFile );
  124.                     Connect ( WriteFile, NamePart, TypePart, 'W', Ostat );
  125.                     if Ostat=0 then
  126.                     begin
  127.                         OpenWrite := 0;
  128.                         rewrite( WriteFile );
  129.                     end
  130.                     else
  131.                         OpenWrite := -1;
  132.                 end;
  133.         end;
  134.     end;
  135.  
  136.     function CloseFile( VAR FileToClose     : ByteFile ):integer;
  137.     (*  Abstract:   Do any actions necessary when closing file *)
  138.     begin
  139.         DisConnect ( FileToClose );
  140.         CloseFile := 0;
  141.     end;
  142.  
  143.     procedure PutFileName(  VAR FileN   :   NameType;
  144.                             VAR Pack    :   Packet;
  145.                             Translate   :   Boolean );
  146.     (*  Abstract:   Puts a file name corresponding to internal format
  147.                     in FileN into a FileHeader packet (Pack).
  148.                     Does any necessary transformations of file name *)
  149.     VAR NamePart            : StringType;
  150.         TypePart            : Char4Array;
  151.         i, j                : integer;
  152.         ch                  : char;
  153.     begin
  154.         if Translate then begin
  155.             ParseFile( FileN, NamePart, TypePart, OldFile );
  156.             i := MinString;
  157.             (* skip ( <directory> : <username> ) ! *)
  158.             if NamePart(.i.)='(' then begin
  159.                 while NamePart(.i.) <> ')' do i := i + 1;
  160.                 i := i + 1;
  161.             end;
  162.             j := MinString;
  163.             ch := NamePart(.i.);
  164.             with Pack do begin
  165.                 while ch<>'''' do begin
  166.                     data(.j.) := ch;
  167.                     i := i + 1;
  168.                     j := j + 1;
  169.                     ch := NamePart(.i.);
  170.                 end;
  171.                 data(.j.) := '.';
  172.                 for i := 1 to MaxFType do begin
  173.                     j := j + 1;
  174.                     data(.j.) := TypePart(.i.);
  175.                 end;
  176.             end;
  177.         end else with Pack do begin
  178.             j := MinString;
  179.             for i := MinName to FileN.Valid do begin
  180.                 data(.j.) := FileN.String(.i.);
  181.                 j := j + 1;
  182.             end;
  183.             j := j - 1;
  184.         end;
  185.         Pack.count := ToChar ( chr ( j + 4 - MinString ) );
  186.         Pack.seq   := ToChar ( chr ( n ) );
  187.         Pack.ptype := PackToCh ( FHeadPack );
  188.     end;
  189.  
  190.     procedure GetFileName(  VAR FileN   :   NameType;
  191.                             VAR Pack    :   Packet );
  192.     (*  Abstract:   Gets a file name from a FileHeader packet and converts
  193.                     to internal format in FileN, including 
  194.                     any necessary transformations of file name *)
  195.     VAR i : integer;
  196.     begin
  197.         with Pack do begin
  198.             if ( Ptype<>PackToCh( FHeadPack ) ) and Debug then begin
  199.                 DbgWrite(' Attempts GetFileName from non-FileHeader packet!');
  200.                 DbgNL;
  201.             end;
  202.             FileN.valid := ord ( UnChar ( count ) ) - 3;
  203.                  (* Expecting DEC-10/20, CP/M / MP/M style filenames <nam>.<typ>,
  204.                     convert to Sintran simply by changing '.' to ':' *)
  205.             for i := 1 to FileN.valid do begin
  206.                     ch := data(.i - 1 + MinString.);
  207.                     if ch='.' then ch := ':';
  208.                     FileN.String(.i.) := ch;
  209.             end;
  210.         end;
  211.     end;
  212.  
  213.     function        BuildList(  Parameter : NameType;
  214.                              VAR NameList : NListPtr ): boolean;
  215.     (*
  216.      * From given Parameter - construct list of files to send.
  217.      * Possible forms of parameter:
  218.      *  @filename   -   Indicating indirect-file - default type :SYMB.
  219.      *      Indirect-file consists of a list of files (one per line)
  220.      *      to send. If the filename is followed by another string
  221.      *      separated from the filename with whitespace, this string
  222.      *      is put into file-header packet instead. This enables you
  223.      *      to specify filename on the remote machine.
  224.      *  filename    -   Sent without deabbreviation. ("." instead of ":")
  225.      *  filespec    -   * - 0 or more chars or digits
  226.      *                  % - 1 char or digit.
  227.      *      Only filename or type may contain wildcard characters.
  228.      * Return: success/error.
  229.      *)
  230.     var     IndFile :   text;
  231.             Status  :   integer;
  232.             RetVal  :   boolean;
  233.             p       :   NListPtr;
  234.             i       :   integer;
  235.  
  236.         procedure   ReadString( VAR FromFile : text;
  237.                                 VAR StrToRead: NameType );
  238.         var ch  :   char;
  239.         begin
  240.             with StrToRead do begin
  241.                 Valid := 0;
  242.                 while ( StripParity( FromFile^ ) <> ' ' )
  243.                     and not eof( FromFile )
  244.                     and not eoln( FromFile )
  245.                     and ( Valid < MaxName )
  246.                 do begin
  247.                     Valid := Valid + 1;
  248.                     read( FromFile, ch );
  249.                     String(.Valid.) := StripParity( ch );
  250.                 end;
  251.                 while not eof(FromFile)
  252.                     and not eoln(FromFile)
  253.                     and ( StripParity( FromFile^ ) <> ' ' )
  254.                 do
  255.                     read( FromFile, ch );  (* skip until space or eoln *)
  256.             end;
  257.         end;
  258.  
  259.         procedure   EatSpace( VAR FromFile : text );
  260.         var     ch  :   char;
  261.         begin
  262.             while not eof( FromFile )
  263.                 and not eoln( FromFile )
  264.                 and ( StripParity( FromFile^ ) = ' ' )
  265.             do read( FromFile, ch );
  266.         end;
  267.  
  268.         function    PosOf( ch : char; Par : NameType ): integer;
  269.         var i : integer;
  270.             Found : boolean;
  271.         begin
  272.             i := MinString;
  273.             Found := false;
  274.             while not Found and ( i < Par.Valid ) do begin
  275.                 i := i + 1;
  276.                 Found := Par.String(.i.) = ch;
  277.             end;
  278.             if not Found then i := 0;
  279.             PosOf := i;
  280.         end;
  281.  
  282.         procedure   ReverseList( VAR ThisList : NListPtr );
  283.         var     p, ToList : NListPtr;
  284.         begin
  285.             p := NIL; ToList := NIL;
  286.             while ThisList <> NIL do begin
  287.                 p := ThisList;
  288.                 ThisList := ThisList^.Next;
  289.                 p^.Next := ToList;
  290.                 ToList := p;
  291.             end;
  292.             ThisList := ToList;
  293.         end;
  294.  
  295.     begin
  296.         NameList := NIL;
  297.         RetVal := Failure;
  298.         if Parameter.String(.MinName.) = '@' then begin
  299.             with Parameter do begin
  300.                 for i := MinName to Valid - 1 do
  301.                     String(.i.) := String(.i+1.);
  302.                 Valid := Valid - 1;
  303.                 String(.Valid+1.) := '''';
  304.                 connect(IndFile,String,'SYMB','R',Status);
  305.                 if Status <> 0 then
  306.                     writeln('Could not open indirect-file')
  307.                 else begin
  308.                     reset( IndFile );
  309.                     while not eof( IndFile ) do begin
  310.                         new(p);
  311.                         EatSpace( IndFile );
  312.                         while StripParity( IndFile^ ) = '!' do begin
  313.                             readln( IndFile );
  314.                             EatSpace( IndFile );
  315.                         end;
  316.                         ReadString( IndFile, p^.Name );
  317.                         EatSpace( IndFile );
  318.                         if not eoln( IndFile ) then begin
  319.                             ReadString( IndFile,p^.AltName );
  320.                             p^.AltUsed := true;
  321.                         end else
  322.                             p^.AltUsed := false;
  323.                         readln( IndFile );
  324.                         p^.Next := NameList;
  325.                         NameList := p;
  326.                     end;
  327.                     disconnect( IndFile );
  328.                     ReverseList( NameList );
  329.                     RetVal := Success;
  330.                 end;
  331.             end;
  332.         end else if ( PosOf('%',Parameter) > 0)
  333.                  or ( PosOf('*',Parameter) > 0 ) then begin
  334.             writeln('Wildcards not yet implemented');
  335.         end else begin
  336.             new( NameList );
  337.             NameList^.Name := Parameter;
  338.             NameList^.AltUsed := False;
  339.             NameList^.Next := NIL;
  340.             RetVal := Success;
  341.         end;
  342.         BuildList := RetVal;
  343.     end;
  344.  
  345.     procedure       ShowList( FileList : NListPtr );
  346.     var     p   :   NListPtr;
  347.  
  348.         procedure   PrName( VAR f : text; Name : NameType );
  349.         var i : integer;
  350.         begin
  351.             for i := 1 to Name.Valid do
  352.                 write( f, Name.String(.i.) );
  353.         end;
  354.  
  355.     begin
  356.         p := FileList;
  357.         while p <> NIL do begin
  358.             PrName( output, p^.Name );
  359.             if p^.AltUsed then begin
  360.                 write( output, ' - ' );
  361.                 PrName( output, p^.AltName );
  362.             end;
  363.             writeln( output );
  364.             p := p^.Next;
  365.         end;
  366.     end;
  367. 
  368.