Topspeed_JPI/TS-V3/MODBASE/DRECTORY.LST

Listing:

    1  IMPLEMENTATION MODULE Drectory;
    2  (*
    3   *  REPERTOIRE
    4   *  Release 1.6
    5   *  By Charles Bradford and Cole Brecheen
    6   *  (c) Copyright 1985-1992 PMI
    7   *  Green Bay, Wisconsin
    8   *  All rights reserved
    9   *  (414) 468-6040
   10   *
   11   *  $Header:   D:/logfiles/mods/drectory.mov   1.8   17 Mar 1991 18:00:54   coleb  $
   12   *
   13   *)
   14  
   15  IMPORT ByteFiddler;
   16  IMPORT EnvironUtils;
   17  IMPORT ErrorManager;
   18  IMPORT HandleIO;
   19  IMPORT LowLevel;
   20  IMPORT M2Strings;
   21  IMPORT Numbers;
   22  IMPORT NumTypes;
   23  IMPORT PosUtils;
   24  IMPORT StrConv;
   25  IMPORT StrEdit;
   26  IMPORT StringIO;
   27  IMPORT VStorage;
   28  
   29  IMPORT FAPI;
   30  IMPORT SYSTEM;
   31  
   32  VAR
   33    Initialized : BOOLEAN;
   34  
   35    PROCEDURE Init();
   36      BEGIN
   37        IF Initialized THEN
   38          RETURN;
   39        ELSE
   40          Initialized := TRUE;
   41        END;
   42        ByteFiddler.Init();
*****        ^ not supported yet
*****                    ^ not supported yet
*****                         ^ not supported yet
   43        EnvironUtils.Init();
*****        ^ not supported yet
*****                     ^ not supported yet
*****                          ^ not supported yet
   44        ErrorManager.Init();
*****        ^ not supported yet
*****                     ^ not supported yet
*****                          ^ not supported yet
   45        HandleIO.Init();
*****        ^ not supported yet
*****                 ^ not supported yet
*****                      ^ not supported yet
   46        LowLevel.Init();
*****        ^ not supported yet
*****                 ^ not supported yet
*****                      ^ not supported yet
   47        M2Strings.Init();
*****        ^ not supported yet
*****                  ^ not supported yet
*****                       ^ not supported yet
   48        Numbers.Init();
*****        ^ not supported yet
*****                ^ not supported yet
*****                     ^ not supported yet
   49        NumTypes.Init();
*****        ^ not supported yet
*****                 ^ not supported yet
*****                      ^ not supported yet
   50        PosUtils.Init();
*****        ^ not supported yet
*****                 ^ not supported yet
*****                      ^ not supported yet
   51        StrConv.Init();
*****        ^ not supported yet
*****                ^ not supported yet
*****                     ^ not supported yet
   52        StrEdit.Init();
*****        ^ not supported yet
*****                ^ not supported yet
*****                     ^ not supported yet
   53        StringIO.Init();
*****        ^ not supported yet
*****                 ^ not supported yet
*****                      ^ not supported yet
   54        VStorage.Init();
*****        ^ not supported yet
*****                 ^ not supported yet
*****                      ^ not supported yet
   55      END Init;
*****          ^ not supported yet
   56  
   57    CONST
   58      blank = ' ';
   59      null = '';
   60      semicolon = ';';
   61      backslash = '\';
   62      fwdslash = '/';
   63      byte1 = 0;
   64      OrdA = 65;
   65  
   66    TYPE
   67      ModeSetCaster =
   68        RECORD
   69          CASE : BOOLEAN OF
*****          ^ not supported yet
*****                         ^ 'POINTER' expected
   70            TRUE :
   71            a : ModeSet;
   72          | FALSE :
   73            b : BITSET;
   74          END;
   75        END;
   76  
   77  
   78  (*==================== Utility Procedures =====================*)
   79  
   80    PROCEDURE LastByte( FileHandle: CARDINAL ): CHAR;
   81      VAR
   82        bufch: CHAR;
   83      BEGIN
   84        HandleIO.SetFilePtr(FileHandle, HandleIO.FromEnd, Numbers.Li( -1) );
   85        StringIO.PrintMessage(HandleIO.BlockRead( FileHandle,
   86            SYSTEM.ADR(bufch), 1 ));
   87        RETURN bufch;
   88      END LastByte;
   89  
   90  
   91  (*================== Exported Procedures ==================*)
   92  
   93    PROCEDURE AddBlockToFile(FileName : ARRAY OF CHAR;
   94        FileHandle : CARDINAL; BlockAdr: SYSTEM.ADDRESS;
   95        BlockSize: CARDINAL );
   96      VAR
   97        AlreadyOpen : BOOLEAN;
   98        EofChar: CHAR;
   99      BEGIN
  100        EofChar := CHR(26);
  101        IF (M2Strings.Length(FileName)=0) OR (FileHandle>4) THEN
  102          AlreadyOpen := TRUE;
  103        ELSE
  104          AlreadyOpen := FALSE;
  105          StringIO.PrintMessage(HandleIO.OpenFile(FileHandle,FileName));
  106        END;
  107        IF LastByte( FileHandle ) = CHR(26) THEN
  108          HandleIO.SetFilePtr(FileHandle, HandleIO.FromEnd, Numbers.Li( -1) );
  109            (*Back up to write over the eof.*)
  110          StringIO.PrintMessage(
  111          HandleIO.BlockWrite( FileHandle, BlockAdr, BlockSize ));
  112          StringIO.PrintMessage(
  113          HandleIO.BlockWrite( FileHandle, SYSTEM.ADR(EofChar), 1 ));
  114            (*Write a new eof.*)
  115        ELSE
  116          HandleIO.SetFilePtr(FileHandle, HandleIO.FromEnd, NumTypes.L0 );
  117            (*Don't back up to write over the eof.*)
  118          StringIO.PrintMessage(
  119          HandleIO.BlockWrite( FileHandle, BlockAdr, BlockSize ));
  120        END;
  121        IF AlreadyOpen THEN
  122          HandleIO.UpdateDisk( FileHandle )
  123        ELSE
  124          StringIO.PrintMessage(HandleIO.CloseHandle(FileHandle));
  125            (*Updates the file's directory entry.*)
  126        END;
  127      END AddBlockToFile;
  128  
  129  
  130    PROCEDURE AddToFile(FileName : ARRAY OF CHAR; FileHandle : CARDINAL;
  131        message : ARRAY OF CHAR);
  132      BEGIN
  133        (*AddToFile*)
  134        AddBlockToFile( FileName, FileHandle, SYSTEM.ADR(message),
  135            M2Strings.Length(message) );
  136      END AddToFile;
  137  
  138  
  139    PROCEDURE ChDir(DirName : ARRAY OF CHAR) : CARDINAL;
  140      VAR
  141        ErrorReturn :CARDINAL;
  142        Reserved:LONGINT;
  143      BEGIN
  144        ErrorReturn := FAPI.DOSCHDIR(SYSTEM.ADR(DirName), Reserved);
  145        RETURN ErrorReturn;
  146      END ChDir;
  147  
  148  
  149    PROCEDURE CopyFile(OldHandle : CARDINAL; NewFileName : ARRAY OF CHAR) :
  150        CARDINAL;
  151      TYPE
  152        memptr =
  153          RECORD
  154            addr : LowLevel.Address8086;
  155            size : CARDINAL;
  156          END;
  157  
  158      VAR
  159        TheDrive : CHAR;
  160        MemoryPtr : memptr;
  161        NewHandle : CARDINAL;
  162        SavedMessage : CARDINAL;
  163        FreeBytes, FileSize, BytesToBeFreed, BytesToRead : LONGINT;
  164  
  165      PROCEDURE ReadOldFile(VAR MemoryPtr : memptr);
  166        VAR
  167          BytesRead,ErrorReturn:CARDINAL;
  168          BytesAvailable : CARDINAL;
  169        BEGIN
  170        (*ReadOldFile*)
  171          IF BytesToRead <= Numbers.Lc( 0 ) THEN
  172            MemoryPtr.addr.x := NIL;
  173            RETURN;
  174          END;
  175          BytesAvailable := EnvironUtils.MemAvail( 10000);
  176          WITH MemoryPtr DO
  177            IF BytesToRead > Numbers.Lc( BytesAvailable ) THEN
  178              size := BytesAvailable;
  179            ELSE
  180              size := Numbers.C( BytesToRead );
  181            END;
  182            VStorage.DosAlloc(addr.a, size);
  183          END;
  184          ErrorReturn := FAPI.DOSREAD(OldHandle, MemoryPtr.addr.a,
  185              MemoryPtr.size, SYSTEM.ADR(BytesRead));
  186          IF BytesRead < MemoryPtr.size THEN
  187            IF BytesRead = 0 THEN
  188              StringIO.PrintMessage (StringIO.EndOfFile);
  189            ELSE
  190              StringIO.PrintMessage (StringIO.PartialRead);
  191            END;
  192          ELSE
  193            IF ErrorReturn # 0 THEN
  194              StringIO.PrintMessage(ErrorReturn);
  195            ELSE
  196              BytesToRead := BytesToRead - Numbers.Lc( MemoryPtr.size );
  197                (* Can't use DEC here because JPI doesn't allow LONGINTs
  198                   to be decremented by CARDINAL values. *)
  199            END;
  200          END;
  201        END ReadOldFile;
  202  
  203      PROCEDURE WriteNewFile(MemoryPtr : memptr);
  204        VAR
  205          ErrorReturn, BytesWritten: CARDINAL;
  206        BEGIN
  207        (*WriteNewFile*)
  208          IF MemoryPtr.addr.x=NIL THEN
  209            RETURN;
  210          END;
  211          ErrorReturn := FAPI.DOSWRITE( NewHandle, MemoryPtr.addr.a,
  212              MemoryPtr.size, SYSTEM.ADR(BytesWritten) );
  213          IF BytesWritten < MemoryPtr.size THEN
  214            ErrorManager.WARN('No room to write.');
  215          END;
  216          IF ErrorReturn # 0 THEN
  217            StringIO.PrintMessage(ErrorReturn);
  218          END;
  219          VStorage.DosDealloc(MemoryPtr.addr.x, MemoryPtr.size);
  220        END WriteNewFile;
  221  
  222      PROCEDURE SetDateAndTime();
  223        VAR
  224          month, day, year, hours, minutes, seconds : CARDINAL;
  225        BEGIN
  226          GetFileDateAndTime(OldHandle, month, day, year, hours, minutes,
  227              seconds);
  228  (*
  229    Diagnostics.diagC( 'month', month );
  230    Diagnostics.diagC( 'day', day );
  231    Diagnostics.diagC( 'year', year );
  232    Diagnostics.diagC( 'hours', hours );
  233    Diagnostics.diagC( 'minutes', minutes );
  234    Diagnostics.diagC( 'seconds', seconds );
  235  *)
  236          SetFileDateAndTime(NewHandle, month, day, year, hours, minutes,
  237              seconds);
  238        END SetDateAndTime;
  239  
  240      BEGIN
  241      (*CopyFile*)
  242        BytesToBeFreed := Numbers.Lc( 0 );
  243        FileSize := HandleIO.FileLength(OldHandle);
  244        BytesToRead := FileSize;
  245        IF M2Strings.Pos(':',NewFileName)=(1+byte1) THEN
  246          TheDrive := NewFileName[0+byte1];
  247        ELSE
  248          TheDrive := 'Z';
  249          (*Determines the drive to which we're copying.
  250          'Z' means "default drive" to FreeDiskSpace.*)
  251        END;
  252        SavedMessage := FreeDiskSpace(TheDrive,FreeBytes);
  253        IF SavedMessage # StringIO.NoError THEN
  254          RETURN SavedMessage;
  255        END;
  256        SavedMessage := HandleIO.OpenFile(NewHandle,NewFileName);
  257        IF SavedMessage = StringIO.NoError THEN
  258          BytesToBeFreed := HandleIO.FileLength(NewHandle);
  259          SavedMessage := HandleIO.CloseHandle(NewHandle);
  260        ELSE
  261          IF (SavedMessage # StringIO.FileNotFound) AND
  262              (SavedMessage # 110) THEN (* explicit fail command *)
  263            RETURN SavedMessage;
  264          END;
  265        END;
  266        IF FileSize > (FreeBytes + BytesToBeFreed) THEN
  267          SavedMessage := StringIO.AccessDenied;
  268        (*This will have to stand for 'Not enough room.'*)
  269          RETURN SavedMessage;
  270        END;
  271        SavedMessage := HandleIO.CreateFile( NewHandle, NewFileName );
  272        IF SavedMessage # StringIO.NoError THEN
  273          RETURN SavedMessage;
  274        END;
  275        REPEAT
  276          ReadOldFile(MemoryPtr);
  277          WriteNewFile(MemoryPtr);
  278        UNTIL BytesToRead <= Numbers.Lc( 0 );
  279        SetDateAndTime();
  280        RETURN HandleIO.CloseHandle(NewHandle);
  281      END CopyFile;
  282  
  283  (*
  284      We can't use this, unfortunately, because DOSCOPY isn't FAPI, and
  285      the Logitech linker can't handle unresolved symbols, even if the
  286      references aren't going to get linked in.
  287  
  288    PROCEDURE CopyFile2( SourceName, TargetName: ARRAY OF CHAR ): CARDINAL;
  289      VAR
  290        OldFileHandle, ErrorReturn, OSversion: CARDINAL;
  291        Reserved: LONGINT;
  292      BEGIN
  293        FAPI.DOSGETVERSION( SYSTEM.ADR(OSversion) );
  294        IF OSversion >= 10 THEN
  295          (* We're under some version of OS/2 *)
  296          Reserved := NumTypes.L0;
  297          ErrorReturn := FAPI.DOSCOPY( SYSTEM.ADR(SourceName),
  298              SYSTEM.ADR(TargetName), BITSET(0), Reserved );
  299        ELSE
  300          ErrorReturn := HandleIO.OpenFile( OldFileHandle, SourceName );
  301          IF ErrorReturn # 0 THEN
  302            ErrorManager.WarnNumber( 'CopyFile2 error', ErrorReturn );
  303          END;
  304          ErrorReturn := CopyFile( OldFileHandle, TargetName );
  305        END;
  306        RETURN ErrorReturn;
  307      END CopyFile2;
  308  *)
  309  
  310    PROCEDURE DeleteFile(FileName : ARRAY OF CHAR) : CARDINAL;
  311      VAR
  312        ErrorReturn:CARDINAL;
  313        Reserved:LONGINT;
  314  
  315        LocalStr: ARRAY [0..79] OF CHAR;
  316      BEGIN
  317        M2Strings.Assign( FileName, LocalStr );
  318          (*We assign to the local string to guarantee that it ends
  319            with a null byte.*)
  320        Reserved := VAL(LONGINT,0);
  321       ErrorReturn := FAPI.DOSDELETE(SYSTEM.ADR(FileName), Reserved);
  322      (* IF ErrorReturn # 0 THEN
  323         ErrorManager.WarnNumber( "DOSDELETE error", ErrorReturn );
  324       END;  let it return error JEM 2/4/92 *)
  325       RETURN ErrorReturn;
  326      END DeleteFile;
  327  
  328  
  329  
  330    PROCEDURE FindFirstFile(FileSpec : ARRAY OF
  331        CHAR; VAR DirHandle: CARDINAL; VAR
  332        FileInfo : FileInfoRec) : CARDINAL;
  333      VAR
  334        ErrorReturn : CARDINAL;
  335        Reserved    : LONGINT;
  336        SearchCount : CARDINAL;
  337        FileInfoRecord : FAPI.FILEFINDBUF;
  338        TmpSet : FAPI.USHORT;
  339        TmpStr : ARRAY [0..80] OF CHAR;
  340      BEGIN
  341        (*FindFirstFile*)
  342        StrEdit.AssignStr(FileSpec, TmpStr);
  343          (*We have to assign to a local string because the string that
  344            comes in through the parameter list may not be null terminated. *)
  345        TmpSet := FAPI.FILE_READONLY + FAPI.FILE_HIDDEN +
  346            FAPI.FILE_SYSTEM + FAPI.FILE_DIRECTORY;
  347        SearchCount := 1;
  348        Reserved :=VAL(LONGINT,0);
  349        ErrorReturn := FAPI.DOSFINDFIRST( SYSTEM.ADR(TmpStr),
  350            SYSTEM.ADR(DirHandle), TmpSet,
  351            SYSTEM.ADR(FileInfoRecord), SYSTEM.SIZE(FileInfoRecord),
  352            SYSTEM.ADR(SearchCount), Reserved);
  353        IF ErrorReturn # 0 THEN
  354          RETURN ErrorReturn;
  355        END;
  356        WITH FileInfo DO
  357          ByteFiddler.CardinalToTime( CARDINAL(FileInfoRecord.ftimeLastWrite),
  358               hour, minute, second );
  359          ByteFiddler.CardinalToDate( CARDINAL(FileInfoRecord.fdateLastWrite),
  360               month, day, year );
  361          size := FileInfoRecord.cbFile;
  362          attribute := ModeSet(FileInfoRecord.attrFile);
  363          M2Strings.Assign( FileInfoRecord.achName, name );
  364        END;
  365        RETURN StringIO.NoError;
  366      END FindFirstFile;
  367  
  368  
  369    PROCEDURE FindNextFile( DirHandle: CARDINAL;
  370        VAR FileInfo : FileInfoRec) : CARDINAL;
  371      VAR
  372        ErrorReturn : CARDINAL;
  373        Reserved    : LONGINT;
  374        SearchCount : CARDINAL;
  375        FileInfoRecord : FAPI.FILEFINDBUF;
  376      BEGIN
  377        SearchCount := 1;
  378        ErrorReturn := FAPI.DOSFINDNEXT( DirHandle,
  379            SYSTEM.ADR(FileInfoRecord), SYSTEM.SIZE(FileInfoRecord),
  380            SYSTEM.ADR(SearchCount) );
  381        IF ErrorReturn # 0 THEN
  382          RETURN ErrorReturn;
  383        END;
  384        WITH FileInfo DO
  385          ByteFiddler.CardinalToTime( CARDINAL(FileInfoRecord.ftimeLastWrite),
  386              hour, minute, second );
  387          ByteFiddler.CardinalToDate( CARDINAL(FileInfoRecord.fdateLastWrite),
  388              month, day, year );
  389          size := FileInfoRecord.cbFile;
  390          attribute := ModeSet(FileInfoRecord.attrFile);
  391          StrEdit.AssignStr( FileInfoRecord.achName, name );
  392        END;
  393        RETURN StringIO.NoError;
  394      END FindNextFile;
  395  
  396  
  397    PROCEDURE FreeDiskSpace(DriveLetter : CHAR; VAR FreeBytes : LONGINT) :
  398        CARDINAL;
  399      VAR
  400        DriveNum, ErrorReturn: CARDINAL;
  401        Level1Data:FAPI.FSALLOCATE;
  402      BEGIN
  403        FreeBytes := Numbers.Lc( 0 );
  404        DriveLetter := CAP(DriveLetter);
  405        IF (DriveLetter < 'A') OR (DriveLetter > 'Z') THEN
  406            (* 26 July 87:  changed from AND at suggestion of Marc
  407               Scheuner and Gregor Kley. *)
  408          ErrorManager.WARN('Invalid drive specification');
  409        END;
  410        IF DriveLetter='Z' THEN
  411          (*'Z' means default drive*)
  412          DriveNum := 0;
  413        ELSE
  414          DriveNum := ORD(DriveLetter)-64;
  415        END;
  416          (*turns an A into a 1, etc*)
  417        ErrorReturn := FAPI.DOSQFSINFO( DriveNum,
  418            1, SYSTEM.ADR(Level1Data), SYSTEM.SIZE(Level1Data));
  419        IF ErrorReturn # 0 THEN
  420          RETURN ErrorReturn;
  421        ELSE
  422          FreeBytes := (Level1Data.cUnitAvail) *
  423              (Numbers.Lc (Level1Data.cbSector) *
  424              Level1Data.cSectorUnit);
  425          RETURN StringIO.NoError;
  426        END;
  427      END FreeDiskSpace;
  428  
  429  
  430    PROCEDURE GetCurrentDir(TheDrive : CHAR; VAR ThePath : ARRAY OF CHAR) :
  431        CARDINAL;
  432      VAR
  433        ErrorReturn, PathLength, DriveNum:CARDINAL;
  434        cnt : CARDINAL;
  435      BEGIN
  436        TheDrive := CAP(TheDrive);
  437        IF TheDrive = 'Z' THEN
  438          DriveNum := 0;
  439        ELSE
  440          DriveNum := ((ORD(TheDrive)-OrdA)+1);
  441        END;
  442        PathLength := HIGH( ThePath ) + 1;
  443        ErrorReturn := FAPI.DOSQCURDIR(DriveNum, SYSTEM.ADR(ThePath),
  444            SYSTEM.ADR(PathLength) );
  445        M2Strings.Insert( backslash, ThePath, 0 );
  446        RETURN ErrorReturn;
  447      END GetCurrentDir;
  448  
  449  
  450    PROCEDURE GetDefaultDrive() : CHAR;
  451       (*Returns the current default drive as an upper case letter.*)
  452      VAR
  453        DriveNum, ErrorReturn: CARDINAL;
  454        LogicalDriveMap: FAPI.ULONG;
  455      BEGIN
  456        ErrorReturn := FAPI.DOSQCURDISK( SYSTEM.ADR(DriveNum),
  457            SYSTEM.ADR(LogicalDriveMap) );
  458        IF ErrorReturn # 0 THEN
  459          ErrorManager.WarnNumber("DOSQCURDISK Error", ErrorReturn );
  460        END;
  461        RETURN( CHR( ORD(DriveNum) + OrdA - 1 ) );
  462      END GetDefaultDrive;
  463  
  464  
  465    PROCEDURE GetDiskInfo( TheDrive: CHAR; VAR BytesPerSector,
  466        SectorsPerCluster, ClustersOnDisk: CARDINAL; VAR
  467        KindOfDisk: DiskTypes );
  468      VAR
  469        DriveNum, ErrorReturn: CARDINAL;
  470        FatIDByte: CHAR;
  471        Level1Data: FAPI.FSALLOCATE;
  472      BEGIN
  473        TheDrive := CAP(TheDrive);
  474        IF TheDrive = 'Z' THEN
  475          DriveNum := 0;
  476        ELSE
  477          DriveNum := (ORD(TheDrive) - OrdA) + 1;
  478        END;
  479        ErrorReturn := FAPI.DOSQFSINFO( DriveNum, 1, SYSTEM.ADR(Level1Data),
  480            SYSTEM.SIZE(Level1Data) );
  481        IF ErrorReturn # 0 THEN
  482          ErrorManager.WarnNumber( "DOSQFSINFO error", ErrorReturn );
  483        END;
  484        BytesPerSector := Level1Data.cbSector;
  485        SectorsPerCluster := Numbers.C(Level1Data.cSectorUnit);
  486        ClustersOnDisk := Numbers.C(Level1Data.cUnit);
  487        KindOfDisk := unknown;
  488      END GetDiskInfo;
  489  
  490  
  491    PROCEDURE GetDirFromList( PathStyleStr: ARRAY OF CHAR; whichDir: CARDINAL;
  492        VAR output: ARRAY OF CHAR ): BOOLEAN;
  493      VAR
  494        StartSpot, EndSpot, inStrLngth: CARDINAL;
  495      BEGIN
  496        inStrLngth := M2Strings.Length(PathStyleStr);
  497        output[0] := 0C;
  498        IF whichDir = 0 THEN
  499          RETURN( FALSE );
  500        END;
  501        IF whichDir = 1 THEN
  502          StartSpot := LowLevel.ScanEQ( inStrLngth, '=',
  503              SYSTEM.ADR(PathStyleStr) );
  504          IF StartSpot >= inStrLngth THEN
  505            StartSpot := 0;
  506          END;
  507        ELSE
  508          StartSpot := PosUtils.FindNthPattern(semicolon, whichDir - 1,
  509              PathStyleStr);
  510          IF StartSpot >= inStrLngth THEN
  511            RETURN( FALSE );
  512          END;
  513        END;
  514        EndSpot := PosUtils.FindNthPattern(semicolon, whichDir, PathStyleStr);
  515        IF EndSpot >= inStrLngth THEN
  516          IF PosUtils.LastNonMatching(blank, PathStyleStr) = semicolon THEN
  517            RETURN( FALSE );
  518          END;
  519          EndSpot := inStrLngth;
  520        END;
  521        (* At this point, EndSpot is either sitting on the trailing null
  522           or on the semicolon following the directory name we want to
  523           copy out. *)
  524        M2Strings.Copy( PathStyleStr, StartSpot, EndSpot - StartSpot,
  525              output );
  526        IF PosUtils.LastNonMatching(blank, output) # backslash THEN
  527          StrEdit.Append( output, backslash );
  528        END;
  529        RETURN( TRUE );
  530      END GetDirFromList;
  531  
  532  
  533    PROCEDURE GetDrivePathAndName( FileSpec: ARRAY OF CHAR; VAR
  534        DriveLetter: CHAR; VAR PathName, FileName : ARRAY OF CHAR);
  535      VAR
  536        TmpStr : ARRAY [0..79] OF CHAR;
  537        spot: CARDINAL;
  538        SavedMessage: CARDINAL;
  539      BEGIN
  540        (*GetDrivePathAndName*)
  541        StrEdit.AssignStr( null, PathName );
  542        StrEdit.AssignStr( null, FileName );
  543        DriveLetter := 'Z';
  544        spot := 0;
  545        WHILE spot+1 <= M2Strings.Length(FileSpec) DO
  546          IF FileSpec[spot] = ':' THEN
  547            DriveLetter := FileSpec[ spot - 1 ];
  548            M2Strings.Delete(FileSpec, 0, 1 + spot);
  549            spot := 0;
  550          ELSIF (FileSpec[spot]=backslash) OR (FileSpec[spot]=fwdslash) THEN
  551            M2Strings.Copy(FileSpec, 0, spot + 1, TmpStr);
  552            StrEdit.Append(PathName, TmpStr);
  553            M2Strings.Delete(FileSpec, 0, 1 + spot);
  554            spot := 0;
  555          ELSE
  556            INC(spot);
  557          END;
  558        END;
  559        IF DriveLetter = 'Z' THEN
  560          DriveLetter := GetDefaultDrive();
  561        END;
  562        IF M2Strings.Length(PathName) = 0 THEN
  563          SavedMessage := GetCurrentDir( DriveLetter, PathName );
  564          IF SavedMessage # StringIO.NoError THEN
  565            StringIO.PrintMessage( SavedMessage );
  566            HALT();
  567            (*This error shouldn't be possible.*)
  568          END;
  569          IF PathName[ M2Strings.Length(PathName) - 1 ] # backslash THEN
  570            StrEdit.Append( PathName, backslash );
  571          END;
  572        END;
  573        IF (M2Strings.Length(FileSpec) > 0) AND (NOT (PosUtils.Present('*',
  574            FileSpec))) AND (NOT (PosUtils.Present('?', FileSpec))) THEN
  575          StrEdit.AssignStr( FileSpec, FileName );
  576        END;
  577      END GetDrivePathAndName;
  578  
  579  
  580    PROCEDURE GetFileDateAndTime(FileHandle : CARDINAL; VAR month,
  581        day, year, hours, minutes, seconds : CARDINAL);
  582      VAR
  583        ErrorReturn: CARDINAL;
  584        FileInfoRec: FAPI.FILEFINDBUF;
  585  
  586      BEGIN
  587        (*GetFileDateAndTime*)
  588        LowLevel.Fill( SYSTEM.ADR(FileInfoRec), SYSTEM.SIZE(FileInfoRec), 0C );
  589        ErrorReturn := FAPI.DOSQFILEINFO( FileHandle, 1,
  590            SYSTEM.ADR(FileInfoRec), SYSTEM.SIZE(FileInfoRec) );
  591  (*
  592  Diagnostics.diagC( 'FileHandle', FileHandle );
  593  Diagnostics.diagC( 'fdateCreation', FileInfoRec.fdateCreation );
  594  Diagnostics.diagC( 'ftimeCreation', FileInfoRec.ftimeCreation );
  595  Diagnostics.diagC( 'fdateLastAccess', FileInfoRec.fdateLastAccess );
  596  Diagnostics.diagC( 'ftimeLastAccess', FileInfoRec.ftimeLastAccess );
  597  Diagnostics.diagC( 'fdateLastWrite', FileInfoRec.fdateLastWrite );
  598  Diagnostics.diagC( 'ftimeLastWrite', FileInfoRec.ftimeLastWrite );
  599  Diagnostics.diagL( 'file', FileInfoRec.file );
  600  Diagnostics.diagL( 'fileAlloc', FileInfoRec.fileAlloc );
  601  Diagnostics.diagC( 'attrFile', FileInfoRec.attrFile );
  602  Diagnostics.diagC( 'cname', ORD(FileInfoRec.cname) );
  603  Diagnostics.diagS( 'name', FileInfoRec.name );
  604  Diagnostics.diagBlock( 'FileInfoRec', SYSTEM.ADR(FileInfoRec), SYSTEM.SIZE(FileInfoRec) );
  605  *)
  606        IF ErrorReturn # 0 THEN
  607          ErrorManager.WarnNumber( "GetFileDateAndTime error ", ErrorReturn );
  608        ELSE
  609          ByteFiddler.CardinalToTime( CARDINAL(FileInfoRec.ftimeLastWrite),
  610              hours, minutes, seconds );
  611          ByteFiddler.CardinalToDate( CARDINAL(FileInfoRec.fdateLastWrite),
  612              month, day, year );
  613        END;
  614      END GetFileDateAndTime;
  615  
  616  
  617    PROCEDURE GetFileMode(FileName : ARRAY OF CHAR; VAR TheSet : ModeSet) :
  618        CARDINAL;
  619      VAR
  620        ErrorReturn: CARDINAL;
  621        DosFileAttr: FAPI.USHORT;
  622        Reserved: LONGINT;
  623        TmpSet: ModeSetCaster;
  624        LocalStr: ARRAY [0..79] OF CHAR;
  625      BEGIN
  626        TmpSet.a := ModeSet{};
  627        M2Strings.Assign( FileName, LocalStr );
  628        ErrorReturn:= FAPI.DOSQFILEMODE(SYSTEM.ADR(LocalStr),
  629            SYSTEM.ADR(DosFileAttr), Reserved);
  630        IF ErrorReturn # 0 THEN
  631          TheSet := TmpSet.a;
  632          ErrorManager.WarnNumber("DosQFileMode error", ErrorReturn );
  633          RETURN ErrorReturn;
  634        ELSE
  635          TmpSet.b := BITSET(CARDINAL(DosFileAttr));
  636          TheSet := TmpSet.a;
  637          RETURN StringIO.NoError;
  638        END;
  639      END GetFileMode;
  640  
  641  
  642    PROCEDURE MkDir(DirName : ARRAY OF CHAR) : CARDINAL;
  643      VAR
  644        Reserved:LONGINT;
  645        ErrorReturn:CARDINAL;
  646        LocalStr: ARRAY [0..79] OF CHAR;
  647      BEGIN
  648        M2Strings.Assign( DirName, LocalStr );
  649        ErrorReturn := FAPI.DOSMKDIR(SYSTEM.ADR(LocalStr),Reserved);
  650        RETURN ErrorReturn;
  651      END MkDir;
  652  
  653  
  654    PROCEDURE RenameFile(OldFileName, NewFileName : ARRAY OF CHAR) :
  655        CARDINAL;
  656      VAR
  657        ErrorReturn:CARDINAL;
  658        dumstr : ARRAY [0..5] OF CHAR;
  659        LocalStr1, LocalStr2: ARRAY [0..79] OF CHAR;
  660      BEGIN
  661        M2Strings.Assign( OldFileName, LocalStr1 );
  662        M2Strings.Assign( NewFileName, LocalStr2 );
  663        IF M2Strings.Pos(':',LocalStr2) = 1 THEN
  664          M2Strings.Delete(LocalStr2, 0, 2);
  665        END;
  666        IF M2Strings.Pos(':',LocalStr1) = 1 THEN
  667          M2Strings.Copy(LocalStr1, 0, 2, dumstr);
  668            (* 26 July 87:  changed from 1, 2 at suggestion of Marc
  669               Scheuner and Gregor Kley. *)
  670          M2Strings.Insert(dumstr, LocalStr2, 0+byte1);
  671        END;
  672        ErrorReturn := FAPI.DOSMOVE( SYSTEM.ADR(LocalStr1),
  673            SYSTEM.ADR(LocalStr2), NumTypes.L0);
  674        RETURN ErrorReturn;
  675      END RenameFile;
  676  
  677  
  678    PROCEDURE RmDir(DirName : ARRAY OF CHAR) : CARDINAL;
  679      VAR
  680        ErrorReturn: CARDINAL;
  681        Reserved: LONGINT;
  682        LocalStr: ARRAY [0..79] OF CHAR;
  683      BEGIN
  684        M2Strings.Assign( DirName, LocalStr );
  685        ErrorReturn := FAPI.DOSRMDIR(SYSTEM.ADR(LocalStr),
  686            Reserved);
  687        RETURN ErrorReturn;
  688      END RmDir;
  689  
  690  
  691    PROCEDURE SetDefaultDrive(DriveLetter : CHAR);
  692      (*Needs to return an ErrorMessage so that you can
  693        determine how many drives there are in the system.*)
  694      VAR
  695        ErrorReturn: CARDINAL;
  696        DriveNum: CARDINAL;
  697      BEGIN
  698        DriveLetter := CAP(DriveLetter);
  699        IF (DriveLetter<'A') OR (DriveLetter>'Z') THEN
  700          StringIO.PrintMessage(StringIO.InvalidDrive);
  701        END;
  702        DriveNum := (ORD(DriveLetter)-OrdA);
  703        ErrorReturn := FAPI.DOSSELECTDISK(DriveNum);
  704        IF ErrorReturn # 0 THEN
  705          StringIO.PrintMessage(ErrorReturn);
  706        END;
  707      END SetDefaultDrive;
  708  
  709  
  710    PROCEDURE SetFileDateAndTime(FileHandle, month, day, year, hours,
  711        minutes, seconds : CARDINAL);
  712      VAR
  713        ErrorReturn: CARDINAL;
  714        FileInfoRec: FAPI.FILEFINDBUF;
  715      BEGIN
  716        (*SetFileDateAndTime*)
  717        LowLevel.Fill( SYSTEM.ADR(FileInfoRec), SYSTEM.SIZE(FileInfoRec), 0C );
  718        FileInfoRec.fdateLastWrite := FAPI.FDATE(ByteFiddler.DateToCardinal(month, day,
  719            year));
  720        FileInfoRec.ftimeLastWrite := FAPI.FTIME(ByteFiddler.TimeToCardinal(hours,
  721            minutes, seconds));
  722        ErrorReturn := FAPI.DOSSETFILEINFO( FileHandle, 1,
  723            SYSTEM.ADR(FileInfoRec), SYSTEM.TSIZE(FAPI.FILEFINDBUF) );
  724        IF ErrorReturn # 0 THEN
  725          ErrorManager.WarnNumber( 'SetFileDateAndTime error', ErrorReturn );
  726        END;
  727      END SetFileDateAndTime;
  728  
  729  
  730    PROCEDURE SetFileMode(FileName : ARRAY OF CHAR; TheSet : ModeSet) :
  731        CARDINAL;
  732      VAR
  733        ErrorReturn: CARDINAL;
  734        Reserved: LONGINT;
  735        TmpSet: ModeSetCaster;
  736        LocalStr: ARRAY [0..79] OF CHAR;
  737      BEGIN
  738        TmpSet.a := TheSet;
  739        M2Strings.Assign( FileName, LocalStr );
  740        ErrorReturn := FAPI.DOSSETFILEMODE(SYSTEM.ADR(LocalStr),
  741                       FAPI.FILE_NORMAL, Reserved);
  742        RETURN ErrorReturn;
  743      END SetFileMode;
  744  
  745    PROCEDURE SetFileLength( TheHandle:CARDINAL;length:LONGINT):CARDINAL;
  746  
  747    BEGIN
  748      RETURN FAPI.DOSNEWSIZE(TheHandle,length);
  749    END SetFileLength;
  750  
  751  
  752    PROCEDURE ValidFile( fname: ARRAY OF CHAR ): BOOLEAN;
  753      VAR
  754        TmpHandle: CARDINAL;
  755        ErrorReturn: CARDINAL;
  756      BEGIN
  757        IF HandleIO.FileExists( fname ) THEN
  758          RETURN TRUE;
  759        END;
  760        IF HandleIO.CreateFile( TmpHandle, fname ) = StringIO.NoError THEN
  761          ErrorReturn := HandleIO.CloseHandle(TmpHandle);
  762          ErrorReturn := DeleteFile( fname );
  763          RETURN (ErrorReturn = StringIO.NoError);
  764        ELSE
  765          RETURN FALSE;
  766        END;
  767      END ValidFile;
  768  
  769  
  770    PROCEDURE VolumeLabel(TheDrive : CHAR; VAR TheLabel : ARRAY OF CHAR);
  771      (*Returns the label of the disk in TheDrive.*)
  772      VAR
  773        DriveNum, ErrorReturn: CARDINAL;
  774        Level2Data: FAPI.FSINFO;
  775        cnt : CARDINAL;
  776        nextchar : CHAR;
  777      BEGIN
  778        (*VolumeLabel*)
  779        TheDrive := CAP(TheDrive);
  780        IF TheDrive='Z' THEN
  781          DriveNum := 0;
  782        ELSE
  783          DriveNum := ORD(TheDrive) - OrdA + 1;
  784            (*sets 'A' to 1, 'B' to 2, etc.*)
  785        END;
  786        StrEdit.AssignStr(null, TheLabel);
  787        ErrorReturn := FAPI.DOSQFSINFO( DriveNum,
  788            2, SYSTEM.ADR(Level2Data), SYSTEM.TSIZE(FAPI.FSINFO));
  789        IF (ErrorReturn = 125) THEN
  790          (* DOSQFSINFO returns 125 if the drive has no volume label.
  791             In this case we set TheLabel to preserve compatibility with
  792             DOS version. *)
  793          StrEdit.AssignStr( 'unlabelled volume', TheLabel );
  794        ELSIF (ErrorReturn # 0) THEN
  795          ErrorManager.WarnNumber( "DosQFSInfo error", ErrorReturn );
  796        ELSE
  797          StrEdit.AssignStr( Level2Data.vol.szVolLabel, TheLabel );
  798        END;
  799      END VolumeLabel;
  800  
  801  
  802    PROCEDURE FindFiles(FileName : ARRAY OF CHAR; FileProc :
  803        FileInfoProc) : CARDINAL;
  804      VAR
  805        info : FileInfoRec;
  806        DirHandle, result : CARDINAL;
  807      BEGIN
  808        DirHandle := 0FFFFH;
  809        result := FindFirstFile(FileName, DirHandle, info);
  810        IF result=StringIO.NoError THEN
  811          LOOP
  812            IF NOT FileProc(info) THEN
  813              EXIT;
  814            END;
  815            result := FindNextFile(DirHandle, info);
  816            IF result#StringIO.NoError THEN
  817              IF result = StringIO.NoMoreFiles THEN
  818                result := StringIO.NoError;
  819              END;
  820              EXIT;
  821            END;
  822          END;
  823        END;
  824        IF 0 # FAPI.DOSFINDCLOSE( DirHandle ) THEN END;
  825        RETURN result;
  826      END FindFiles;
  827  
  828  
  829  BEGIN
  830    Initialized := FALSE;
  831    Init();
  832  END Drectory.

   42 errors