home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / PCPTK10.ZIP / MOVEPCP.PAS next >
Encoding:
Pascal/Delphi Source File  |  1989-04-03  |  5.0 KB  |  137 lines
  1. Program ProComm_Plus_Directory;
  2. { ---------------------------------------------------------------------
  3.   --                                                                 --
  4.   --  Sample program which moves a block of entries from one PCPlus  --
  5.   --  directory file to another.                                     --
  6.   --                                                                 --
  7.   --  Author:  Todd A. Scalzott                                      --
  8.   --           Metro Consulting Group, Inc.                          --
  9.   --           10605 Lakeside Oak Court                              --
  10.   --           Burke, VA  22015                                      --
  11.   --           (703) 250-9271                                        --
  12.   --------------------------------------------------------------------- }
  13. USES
  14.    PCPLUS;
  15.  
  16. VAR
  17.    Source_Dir,                       { Pointer to the source directory     }
  18.    Dest_Dir    : ProComm_File;       { Pointer to the dest directory       }
  19.    Source,                           { User specified source directory name}
  20.    Dest        : STRING[255];        { User specified dest directory name  }
  21.    Entry       : ProComm_Entry;      { User specified source dir name      }
  22.  
  23.    Result,                           { Result of a PCPLUS operation        }
  24.    Dir_Count,
  25.    Source_Start,                     { Starting entry into the source dir  }
  26.    Source_End,                       { Ending entry into the source dir    }
  27.    Dest_Start    : INTEGER;          { Starting entry into the dest dir    }
  28.  
  29.  
  30.  
  31. FUNCTION File_Exists ( File_To_Find : STRING ) : BOOLEAN;
  32. { ---------------------------------------------------------------------
  33.   --                                                                 --
  34.   --  Function to return TRUE or FALSE based upon the existence of   --
  35.   --  a file.                                                        --
  36.   --                                                                 --
  37.   --------------------------------------------------------------------- }
  38.  
  39. VAR
  40.    File_Var   : FILE;                   { File variable for attempting OPEN   }
  41.    Throw_Away : INTEGER;                { Result of IO operations (discarded) }
  42.  
  43.  
  44. BEGIN
  45.  
  46.    ASSIGN (File_Var, File_To_Find);
  47.    {$I-}
  48.    RESET (File_Var);
  49.    File_Exists := (IORESULT = 0);
  50.    CLOSE(File_Var);
  51.    Throw_Away := IORESULT;
  52.    {$I+}
  53.  
  54. END;   { Function File_Exists }
  55.  
  56.  
  57. FUNCTION Get_Directory_Name : STRING;
  58. { ---------------------------------------------------------------------
  59.   --                                                                 --
  60.   --  Get the name of the directory file from the user.              --
  61.   --  Will return the result of "#QUIT#" if the user pressed CR to   --
  62.   --  quit the program.                                              --
  63.   --                                                                 --
  64.   --------------------------------------------------------------------- }
  65. VAR
  66.    Valid_File : BOOLEAN;
  67.    Temp_Name  : STRING;
  68.  
  69.  
  70. BEGIN
  71.  
  72.    REPEAT
  73.       Valid_File := FALSE;
  74.       READLN ( Temp_Name );
  75.       IF (LENGTH(Temp_Name) > 0) THEN
  76.          Valid_File := File_Exists(Temp_Name);
  77.    UNTIL (Valid_File) OR (Temp_Name = '');
  78.  
  79.    IF (LENGTH(Temp_Name) = 0) THEN
  80.       Get_Directory_Name := '#QUIT#'
  81.    ELSE
  82.       Get_Directory_Name := Temp_Name;
  83.  
  84. END;  { Function Get_Directory_Name }
  85.  
  86.  
  87.  
  88. {    *      M A I N      *     }
  89.  
  90. BEGIN
  91.  
  92.    WRITELN;
  93.    WRITELN ('Enter The Name Of The Source Directory:');
  94.    Source := Get_Directory_Name;
  95.  
  96.    IF (Source <> '#QUIT#') THEN
  97.       { Attempt to open the source directory }
  98.       Open_Dir_File ( Source, Source_Dir, Result );
  99.  
  100.    IF (Result = 0) THEN BEGIN
  101.       WRITELN ('Enter The Name Of The Destination Directory:');
  102.       Dest := Get_Directory_Name;
  103.       { Attempt to open the destination directory }
  104.       Open_Dir_File ( Dest, Dest_Dir, Result );
  105.    END;
  106.  
  107.    IF (Result = 0) THEN BEGIN
  108.       WRITELN;
  109.       WRITE ('Source Beginning Entry Number:  ');
  110.       READLN (Source_Start);
  111.       WRITE ('Source Ending Entry Number   :  ');
  112.       READLN (Source_End);
  113.       WRITE ('Destination Beginning Entry Number:  ');
  114.       READLN (Dest_Start);
  115.    END;
  116.  
  117.    { Do a little bit of error checking }
  118.    IF (Source_End < 1) OR (Source_End > 200) THEN              HALT;
  119.    IF (Source_Start < 1) OR (Source_Start > Source_End) THEN   HALT;
  120.    IF (Dest_Start > 200) OR (Dest_Start < 1) THEN              HALT;
  121.  
  122.    { Get and write each entry.  Could be done with the block read and
  123.      write procedures. }
  124.    FOR Dir_Count := Source_Start TO Source_End DO BEGIN
  125.       Get_Entry(Source_Dir,Dir_Count,Entry,Result);
  126.  
  127.       IF (Result = 0) AND (Dest_Start < 201) THEN
  128.          { Write in raw mode since we have not modified anything }
  129.          Write_Entry(Dest_Dir,Dest_Start,Entry,TRUE,Result);
  130.       Dest_Start := Dest_Start + 1;
  131.    END;
  132.  
  133.    { Close down the files }
  134.    Close_Dir_File ( Source_Dir, Result );
  135.    Close_Dir_File ( Dest_Dir, Result );
  136.  
  137. END.