Simtel MSDOS - Coast to Coast/simteldosarchivecoasttocoast.iso/pcmag/vol9n21.zip/DGFILE.PAS

Pascal/Delphi Source File | 1990-09-25 | 8KB | 234 lines

{
 ▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄
 █                                                                         █
 █        TITLE :      DGFILE.TPU                                          █
 █      PURPOSE :      File handling routines.                             █
 █       AUTHOR :      David Gerrold, CompuServe ID:  70307,544            █
 █  _____________________________________________________________________  █
 █                                                                         █
 █   Written in Turbo Pascal, Version 5.5,                                 █
 █   with routines from TurboPower, Object Professional.                   █
 █                                                                         █
 █   Turbo Pascal is a product of Borland International.                   █
 █   Object Professional is a product of TurboPower Software.              █
 █  _____________________________________________________________________  █
 █                                                                         █
 █   This is not public domain software.                                   █
 █   This software is copyright 1990, by David Gerrold.                    █
 █   Permission is hereby granted for personal use.                        █
 █                                                                         █
 █        The Brass Cannon Corporation                                     █
 █        9420 Reseda Blvd., #804                                          █
 █        Northridge, CA  91324-2932.                                      █
 █                                                                         █
 ▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀
                                                                            }
{ Compiler Directives ===================================================== }

{$A-}    {Switch word alignment off, necessary for cloning}
{$R-}    {Range checking off}
{$B-}    {Boolean complete evaluation off}
{$S-}    {Stack checking off}
{$I-}    {I/O checking off}
{$N+,E+} {Simulate numeric coprocessor}
{$M 16384,0,327680} {stack and heap}
{$V-}    {Variable range checking off}

{ Name ==================================================================== }

UNIT DgFile;
{
  The purpose of this code is to provide additional file-handling routines.
}

{ Interface =============================================================== }

INTERFACE

USES
{ Turbo Pascal 5.5 Units }
  Dos,

{ Object Professional Units }
  OpAbsFld,
  OpCrt,
  OpDos,
  OpEntry,
  OpString,
  OpStrDev,

{ Dg Units }
  DgMath,
  DgWryte;

{ Declarations ============================================================ }
{ Variables --------------------------------------------------------------= }

TYPE
  FileNameStr = string [12];                     { store a filename }

CONST
  ProgramName    : string [16] = '';             { name + version number }

  ExeFileName    : string  = '';                 { name of executable }
  LogFileName    : string  = '';                 { name of log file }
  ConfigFileName : string  = '';                 { name of config file }
  ProgramPath    : string  = '';                 { where to find it }

VAR
  ExeFile        : file;                         { executable file }
  LogFile        : text;                         { log program operations }
  ConfigFile     : file;                         { configuration file }

{ Functions =============================================================== }

FUNCTION DosVer : real;
{ Returns DOS version }

FUNCTION ExistAnyFile (FileName : String) : boolean;
{ Does this file exist? }

FUNCTION FileIsOpen (Var F {: File }) : boolean;
{ Returns true if file is open }

PROCEDURE SetProgramName (Name : FileNameStr;  Version : real);
{ Saves program name in variables for use by other functions. }

{ ========================================================================= }
{ Implementation ========================================================== }

IMPLEMENTATION

{ ========================================================================= }
{ DosVer ================================================================== }

FUNCTION DosVer : real;
{ returns DOS version }
VAR
  V : word;
BEGIN
  V := DosVersion;
  DosVer := Hi (V) + Lo (V)/100;
END;

{ ExistAnyFile ============================================================ }

FUNCTION ExistAnyFile (FileName : string) : Boolean;

VAR
  StoreMode : Byte;

BEGIN
   StoreMode := FileMode;
   FileMode  := 0;
   ExistAnyFile := ExistFile (FileName);
   FileMode  := StoreMode;
END;

{ FileIsOpen ============================================================== }

FUNCTION FileIsOpen (Var F {: File }) : boolean;
{ returns true if file is open }

BEGIN
  Case FileRec (F).Mode of
    fmInput, fmOutput, fmInOut : FileIsOpen := true;
  else
    FileIsOpen := false;
  end;
END;

{ SetProgramName ========================================================== }

PROCEDURE SetProgramName (Name : FileNameStr;  Version : real);
{ Saves program name in variables for use by other functions. }

{
  Stashes program name in a variable for use by other functions.
  Also creates the names for LogFile and ConfigFile, if needed.

  NOTE:  there is no checking for valid characters.  It is up
  to the programmer to make sure that the program name and the
  resulting logfile name will be acceptable to DOS.
}
VAR
  Flag : boolean;

BEGIN
  Write (TpStr, ' v', Version:4:2);
  ProgramName    := StUpCase (Name) + ReturnStr; { tell program its name }

{
  Can't use ParamStr (0) to get program path unless Dos 3.0 is installed.
  User shouldn't be running an obsolete version of Dos anyway.
}
  if DosVer < 3.0 then begin
    WryteLn (ProgramName +
             ':  Sorry.  This program requires DOS 3.0 or later.');
    halt;
   end;

  ExeFileName := ForceExtension (Name, 'EXE');   { name of executable }
  ProgramPath := JustPathName (ParamStr (0));    { get program path }
  if                                             { if needed, then }
    (ProgramPath > '') and
    (ProgramPath [Length (ProgramPath)] <> '\')
  then
    ProgramPath := ProgramPath + '\';            { add backslash }

  ExeFileName := ProgramPath + ExeFileName;      { full name of exe file }
  LogFileName :=
    ForceExtension (ExeFileName, 'LOG');         { where is log file }
  ConfigFileName :=
    ForceExtension (ExeFileName, 'CFG');         { where is cfg file }

  Assign (ExeFile, ExeFileName);                 { ready to r/w }
  Assign (LogFile, LogFileName);                 { ready to r/w }
  Assign (ConfigFile, ConfigFileName);           { ready to r/w }
END;

{ ========================================================================= }
{ Initialization Variables ================================================ }

VAR
  ExitSave : pointer;                            { for ExitProc }

{ ExitUnit ================================================================ }

{$F+} PROCEDURE ExitUnit; {$F-}

BEGIN
  ExitProc := ExitSave;                          { reset original address }

  if FileIsOpen (ExeFile) then Close (ExeFile);
  if FileIsOpen (LogFile) then Close (LogFile);
  if FileIsOpen (ConfigFile) then Close (ConfigFile);
END;

{ Initialization ========================================================== }

BEGIN
  ExitSave := ExitProc;                          { save old exit address }
  ExitProc := @ExitUnit;                         { get new exit address }

END.

{ ========================================================================= }
{ DgFile History ========================================================== }

VERSION HISTORY:
  9005.05
    Completely restructured for compatibility with Object Professional 5.5.

{ DgFile Needs ============================================================ }

NEED TO ADD:
  Nothing right now.

{ Bugs ==================================================================== }

BUG REPORTS:
  No known bugs.

{ ========================================================================= }