home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / pibsoft / terminal / source / pibdir.mod < prev    next >
Encoding:
Text File  |  1987-12-02  |  31.7 KB  |  656 lines
  1. (*----------------------------------------------------------------------*)
  2. (*        PIBDIR.PAS --- MSDOS Directory Routines for Turbo Pascal      *)
  3. (*----------------------------------------------------------------------*)
  4. (*                                                                      *)
  5. (*  Author:  Philip R. Burns                                            *)
  6. (*  Version: 1.0  (January,1985)                                        *)
  7. (*           2.0  (June,1985)                                           *)
  8. (*           3.0  (October,1985)                                        *)
  9. (*           4.0  (May,1986)                                            *)
  10. (*  Systems: For MS-DOS on IBM PCs and close compatibles only.          *)
  11. (*           Note:  I have checked these on Zenith 151s under           *)
  12. (*                  MSDOS 2.1 and IBM PCs under PCDOS 2.0.              *)
  13. (*                                                                      *)
  14. (*  Needs:   Global types from PIBTERM.GLO.                             *)
  15. (*                                                                      *)
  16. (*  History: Original with me.                                          *)
  17. (*                                                                      *)
  18. (*           Suggestions for improvements or corrections are welcome.   *)
  19. (*           Please leave messages on Gene Plantz's BBS (312) 882 4145  *)
  20. (*           or Ron Fox's BBS (312) 940 6496.                           *)
  21. (*                                                                      *)
  22. (*           IF you use this code in your own programs, please be nice  *)
  23. (*           and give proper credit.                                    *)
  24. (*                                                                      *)
  25. (*----------------------------------------------------------------------*)
  26. (*                                                                      *)
  27. (*  Routines:                                                           *)
  28. (*                                                                      *)
  29. (*      Convert_AsciiZ_To_String                                        *)
  30. (*      Convert_String_To_AsciiZ                                        *)
  31. (*      Dir_Get_Default_Drive                                           *)
  32. (*      Dir_Set_Default_Drive                                           *)
  33. (*      Dir_Get_Current_Path                                            *)
  34. (*      Dir_Set_Current_Path                                            *)
  35. (*      Dir_Set_Disk_Transfer_Address                                   *)
  36. (*      Dir_Delete_File                                                 *)
  37. (*      Dir_Count_Drives                                                *)
  38. (*      Dir_Convert_Time                                                *)
  39. (*      Dir_Convert_Date                                                *)
  40. (*      Dir_Find_First_File                                             *)
  41. (*      Dir_Find_Next_File                                              *)
  42. (*      Dir_Get_Free_Space                                              *)
  43. (*      Dir_Set_File_Date_And_Time                                      *)
  44. (*                                                                      *)
  45. (*----------------------------------------------------------------------*)
  46.  
  47. PROCEDURE Convert_AsciiZ_To_String( VAR S: AnyStr );
  48.  
  49. (*----------------------------------------------------------------------*)
  50. (*                                                                      *)
  51. (*     Procedure:  Convert_AsciiZ_To_String                             *)
  52. (*                                                                      *)
  53. (*     Purpose:    Convert Ascii Z string to Turbo String               *)
  54. (*                                                                      *)
  55. (*     Calling Sequence:                                                *)
  56. (*                                                                      *)
  57. (*        Convert_AsciiZ_To_String( VAR S: AnyStr );                    *)
  58. (*                                                                      *)
  59. (*           S --- Ascii Z string to be turned into Turbo string        *)
  60. (*                                                                      *)
  61. (*     Calls:                                                           *)
  62. (*                                                                      *)
  63. (*        None                                                          *)
  64. (*                                                                      *)
  65. (*     Remarks:                                                         *)
  66. (*                                                                      *)
  67. (*        The string S is assumed to have already received the Ascii Z  *)
  68. (*        string in its [1]st thru [l]th locations.                     *)
  69. (*        This routine searches for the 0-character marking the end of  *)
  70. (*        the string and changes the Turbo string length (in S[0]) to   *)
  71. (*        reflect the actual string length.                             *)
  72. (*                                                                      *)
  73. (*----------------------------------------------------------------------*)
  74.  
  75. VAR
  76.    I: INTEGER;
  77.  
  78. BEGIN (* Convert_AsciiZ_To_String *)
  79.  
  80.    I := 1;
  81.  
  82.    WHILE( S[I] <> CHR(0) ) DO
  83.       I := SUCC( I );
  84.  
  85.    S[0] := CHR( PRED( I ) );
  86.  
  87. END   (* Convert_AsciiZ_To_String *);
  88.  
  89. (*----------------------------------------------------------------------*)
  90. (*   Convert_String_To_AsciiZ -- Convert Turbo string to Ascii Z String *)
  91. (*----------------------------------------------------------------------*)
  92.  
  93. PROCEDURE Convert_String_To_AsciiZ( VAR S: AnyStr );
  94.  
  95. (*----------------------------------------------------------------------*)
  96. (*                                                                      *)
  97. (*     Procedure:  Convert_String_To_AsciiZ                             *)
  98. (*                                                                      *)
  99. (*     Purpose:    Convert Turbo string to ascii Z string               *)
  100. (*                                                                      *)
  101. (*     Calling Sequence:                                                *)
  102. (*                                                                      *)
  103. (*        Convert_String_To_AsciiZ( VAR S: AnyStr );                    *)
  104. (*                                                                      *)
  105. (*           S --- Turbo string to be turned into Ascii Z string        *)
  106. (*                                                                      *)
  107. (*     Calls:                                                           *)
  108. (*                                                                      *)
  109. (*        None                                                          *)
  110. (*                                                                      *)
  111. (*----------------------------------------------------------------------*)
  112.  
  113. BEGIN (* Convert_String_To_AsciiZ *)
  114.  
  115.    S := S + CHR( 0 );
  116.  
  117. END   (* Convert_String_To_AsciiZ *);
  118.  
  119. (*----------------------------------------------------------------------*)
  120. (*     Dir_Get_Current_Path -- Get current directory path name          *)
  121. (*----------------------------------------------------------------------*)
  122.  
  123. FUNCTION Dir_Get_Current_Path( Drive         : CHAR;
  124.                                VAR Path_Name : AnyStr ) : INTEGER;
  125.  
  126. (*----------------------------------------------------------------------*)
  127. (*                                                                      *)
  128. (*     Function:   Dir_Get_Current_Path                                 *)
  129. (*                                                                      *)
  130. (*     Purpose:    Gets text of current directory path name             *)
  131. (*                                                                      *)
  132. (*     Calling Sequence:                                                *)
  133. (*                                                                      *)
  134. (*        Iok := Dir_Get_Current_Path( Drive : CHAR;                    *)
  135. (*                                     VAR Path_Name : AnyStr ) :       *)
  136. (*                                     INTEGER;                         *)
  137. (*                                                                      *)
  138. (*           Drive      --- Drive to look on                            *)
  139. (*           Path_Name  --- returned current path name                  *)
  140. (*                                                                      *)
  141. (*           Iok        --- 0 if all went well, else DOS return code    *)
  142. (*                                                                      *)
  143. (*     Calls:                                                           *)
  144. (*                                                                      *)
  145. (*        MsDos                                                         *)
  146. (*        Convert_String_To_AsciiZ                                      *)
  147. (*                                                                      *)
  148. (*----------------------------------------------------------------------*)
  149.  
  150. VAR
  151.    Dir_Reg: Registers;
  152.  
  153. BEGIN (* Dir_Get_Current_Path *)
  154.  
  155.     Dir_Reg.Ah := $47;
  156.     Dir_Reg.Ds := SEG( Path_Name[1] );
  157.     Dir_Reg.Si := OFS( Path_Name[1] );
  158.     Dir_Reg.Dl := ORD( UpCase( Drive ) ) - ORD( '@' );
  159.  
  160.     MsDos( Dir_Reg );
  161.  
  162.     IF ( Carry_Flag AND Dir_Reg.Flags ) = 0 THEN
  163.        BEGIN
  164.           Dir_Get_Current_Path := 0;
  165.           Convert_AsciiZ_To_String( Path_Name );
  166.        END
  167.     ELSE
  168.        Dir_Get_Current_Path := Dir_Reg.Ax;
  169.  
  170. END   (* Dir_Get_Current_Path *);
  171.  
  172. (*----------------------------------------------------------------------*)
  173. (*     Dir_Set_Current_Path -- Set current directory path name          *)
  174. (*----------------------------------------------------------------------*)
  175.  
  176. FUNCTION Dir_Set_Current_Path( Path_Name : AnyStr ) : INTEGER;
  177.  
  178. (*----------------------------------------------------------------------*)
  179. (*                                                                      *)
  180. (*     Function:   Dir_Set_Current_Path                                 *)
  181. (*                                                                      *)
  182. (*     Purpose:    Sets new current directory path name                 *)
  183. (*                                                                      *)
  184. (*     Calling Sequence:                                                *)
  185. (*                                                                      *)
  186. (*        Iok := Dir_Set_Current_Path( Path_Name : AnyStr ) :           *)
  187. (*                                     INTEGER;                         *)
  188. (*                                                                      *)
  189. (*           Path_Name  --- New current path name                       *)
  190. (*                                                                      *)
  191. (*     Calls:                                                           *)
  192. (*                                                                      *)
  193. (*        MsDos                                                         *)
  194. (*        Convert_AsciiZ_To_String                                      *)
  195. (*                                                                      *)
  196. (*----------------------------------------------------------------------*)
  197.  
  198. VAR
  199.    Dir_Reg: Registers;
  200.    I      : INTEGER;
  201.  
  202. BEGIN (* Dir_Set_Current_Path *)
  203.  
  204.    Convert_String_To_AsciiZ( Path_Name );
  205.  
  206.    Dir_Reg.Ah := $3B;
  207.    Dir_Reg.Ds := SEG( Path_Name[1] );
  208.    Dir_Reg.Dx := OFS( Path_Name[1] );
  209.  
  210.    MsDos( Dir_Reg );
  211.  
  212.    IF ( Carry_Flag AND Dir_Reg.Flags ) = 0 THEN
  213.       Dir_Set_Current_Path := 0
  214.    ELSE
  215.       Dir_Set_Current_Path := Dir_Reg.Ax;
  216.  
  217. END   (* Dir_Set_Current_Path *);
  218.  
  219.  
  220. (*----------------------------------------------------------------------*)
  221. (*     Dir_Set_Disk_Transfer_Address --- Set DMA address for disk I/O   *)
  222. (*----------------------------------------------------------------------*)
  223.  
  224. PROCEDURE Dir_Set_Disk_Transfer_Address( VAR DMA_Buffer );
  225.  
  226. (*----------------------------------------------------------------------*)
  227. (*                                                                      *)
  228. (*     Procedure:  Dir_Set_Disk_Transfer_Address                        *)
  229. (*                                                                      *)
  230. (*     Purpose:    Sets DMA address for disk transfers                  *)
  231. (*                                                                      *)
  232. (*     Calling Sequence:                                                *)
  233. (*                                                                      *)
  234. (*        Dir_Set_Disk_Transfer_Address( VAR DMA_Buffer );              *)
  235. (*                                                                      *)
  236. (*           DMA_Buffer --- direct memory access buffer                 *)
  237. (*                                                                      *)
  238. (*     Calls:                                                           *)
  239. (*                                                                      *)
  240. (*        MsDos                                                         *)
  241. (*                                                                      *)
  242. (*----------------------------------------------------------------------*)
  243.  
  244. VAR
  245.    Dir_Reg: Registers;
  246.  
  247. BEGIN (* Dir_Set_Disk_Transfer_Address *)
  248.  
  249.    Dir_Reg.Ax := $1A00;
  250.    Dir_Reg.Ds := SEG( DMA_Buffer );
  251.    Dir_Reg.Dx := OFS( DMA_Buffer );
  252.  
  253.    MsDos( Dir_Reg );
  254.  
  255. END   (* Dir_Set_Disk_Transfer_Address *);
  256.  
  257. (*----------------------------------------------------------------------*)
  258. (*            Dir_Set_Default_Drive --- Set Default Drive               *)
  259. (*----------------------------------------------------------------------*)
  260.  
  261. PROCEDURE Dir_Set_Default_Drive( Drive: CHAR );
  262.  
  263. (*----------------------------------------------------------------------*)
  264. (*                                                                      *)
  265. (*     Procedure:  Dir_Set_Default_Drive                                *)
  266. (*                                                                      *)
  267. (*     Purpose:    Sets default drive for disk I/O                      *)
  268. (*                                                                      *)
  269. (*     Calling Sequence:                                                *)
  270. (*                                                                      *)
  271. (*        Dir_Set_Default_Drive( Drive : CHAR );                        *)
  272. (*                                                                      *)
  273. (*           Drive --- letter of default drive                          *)
  274. (*                                                                      *)
  275. (*     Calls:                                                           *)
  276. (*                                                                      *)
  277. (*        MsDos                                                         *)
  278. (*                                                                      *)
  279. (*----------------------------------------------------------------------*)
  280.  
  281. VAR
  282.    Dir_Reg: Registers;
  283.  
  284. BEGIN  (* Dir_Set_Default_Drive *)
  285.  
  286.    Dir_Reg.Ah := $0E;
  287.    Dir_Reg.Dl := ORD( UpCase( Drive ) ) - ORD( 'A' );
  288.  
  289.    MsDos( Dir_Reg );
  290.  
  291. END   (* Dir_Set_Default_Drive *);
  292.  
  293. (*----------------------------------------------------------------------*)
  294. (*            Dir_Get_Default_Drive --- Get Default Drive               *)
  295. (*----------------------------------------------------------------------*)
  296.  
  297. FUNCTION Dir_Get_Default_Drive: CHAR;
  298.  
  299. (*----------------------------------------------------------------------*)
  300. (*                                                                      *)
  301. (*     Function:  Dir_Get_Default_Drive                                 *)
  302. (*                                                                      *)
  303. (*     Purpose:   Gets default drive for disk I/O                       *)
  304. (*                                                                      *)
  305. (*     Calling Sequence:                                                *)
  306. (*                                                                      *)
  307. (*        Def_Drive := Dir_Get_Default_Drive : CHAR;                    *)
  308. (*                                                                      *)
  309. (*           Def_Drive --- Letter of default drive                      *)
  310. (*                                                                      *)
  311. (*     Calls:                                                           *)
  312. (*                                                                      *)
  313. (*        MsDos                                                         *)
  314. (*                                                                      *)
  315. (*----------------------------------------------------------------------*)
  316.  
  317. VAR
  318.    Dir_Reg: Registers;
  319.  
  320. BEGIN  (* Dir_Get_Default_Drive *)
  321.  
  322.    Dir_Reg.Ah := $19;
  323.  
  324.    MsDos( Dir_Reg );
  325.  
  326.    Dir_Get_Default_Drive := CHR( Dir_Reg.Al + ORD( 'A' ) );
  327.  
  328. END   (* Dir_Get_Default_Drive *);
  329.  
  330. (*----------------------------------------------------------------------*)
  331. (*            Dir_Count_Drives --- Count number of drives in system     *)
  332. (*----------------------------------------------------------------------*)
  333.  
  334. FUNCTION Dir_Count_Drives : INTEGER;
  335.  
  336. (*----------------------------------------------------------------------*)
  337. (*                                                                      *)
  338. (*     Function:  Dir_Count_Drives                                      *)
  339. (*                                                                      *)
  340. (*     Purpose:   Finds number of installed DOS drives                  *)
  341. (*                                                                      *)
  342. (*     Calling Sequence:                                                *)
  343. (*                                                                      *)
  344. (*        ndrives := Dir_Count_Drives : INTEGER;                        *)
  345. (*                                                                      *)
  346. (*           ndrives --- number of drives in system                     *)
  347. (*                                                                      *)
  348. (*     Calls:                                                           *)
  349. (*                                                                      *)
  350. (*        MsDos                                                         *)
  351. (*                                                                      *)
  352. (*----------------------------------------------------------------------*)
  353.  
  354. VAR
  355.    Dir_Reg: Registers;
  356.  
  357. BEGIN  (* Dir_Count_Drives *)
  358.  
  359.    Dir_Reg.Ah := $19;
  360.  
  361.    MsDos( Dir_Reg );
  362.  
  363.    Dir_Reg.Ah := $0E;
  364.    Dir_Reg.Dl := Dir_Reg.Al;
  365.  
  366.    MsDos( Dir_Reg );
  367.  
  368.    Dir_Count_Drives := Dir_Reg.Al;
  369.  
  370. END   (* Dir_Count_Drives *);
  371.  
  372. (*----------------------------------------------------------------------*)
  373. (*            Dir_Convert_Time --- Convert directory creation time      *)
  374. (*----------------------------------------------------------------------*)
  375.  
  376. PROCEDURE Dir_Convert_Time ( Time : WORD; VAR S_Time : AnyStr );
  377.  
  378. (*----------------------------------------------------------------------*)
  379. (*                                                                      *)
  380. (*     Procedure: Dir_Convert_Time                                      *)
  381. (*                                                                      *)
  382. (*     Purpose:   Convert creation time from directory to characters.   *)
  383. (*                                                                      *)
  384. (*     Calling Sequence:                                                *)
  385. (*                                                                      *)
  386. (*        Dir_Convert_Time( Time       : WORD;                          *)
  387. (*                          VAR S_Time : AnyStr ) : INTEGER;            *)
  388. (*                                                                      *)
  389. (*           Time   --- time as read from directory                     *)
  390. (*           S_Time --- converted time in hh:mm am/pm                   *)
  391. (*                                                                      *)
  392. (*     Calls:                                                           *)
  393. (*                                                                      *)
  394. (*        STR                                                           *)
  395. (*                                                                      *)
  396. (*----------------------------------------------------------------------*)
  397.  
  398. VAR
  399.    HH   : String[2];
  400.    MM   : String[2];
  401.    SS   : String[2];
  402.    AmPm : String[2];
  403.    Hour : INTEGER;
  404.  
  405. BEGIN (* Dir_Convert_Time *)
  406.  
  407.    IF ( Time = 0 ) THEN
  408.  
  409.       S_Time := '        '
  410.  
  411.    ELSE
  412.       CASE Time_Format OF
  413.  
  414.          Military_Time : BEGIN
  415.  
  416.                             STR( ( Time SHR 11 ):2 , HH );
  417.                             IF HH[1] = ' ' THEN HH[1] := '0';
  418.  
  419.                             STR( ( ( Time AND $07E0 ) SHR 5 ):2 , MM );
  420.                             IF MM[1] = ' ' THEN MM[1] := '0';
  421.  
  422.                             STR( ( ( Time AND $001F ) * 2 ):2 , SS );
  423.                             IF SS[1] = ' ' THEN SS[1] := '0';
  424.  
  425.                             S_Time := HH + ':' + MM + ':' + SS;
  426.  
  427.                          END;
  428.  
  429.          AMPM_Time     : BEGIN
  430.  
  431.                             Hour := ( Time SHR 11 );
  432.  
  433.                             Adjust_Hour( Hour , AmPm );
  434.  
  435.                             STR( Hour:2 , HH );
  436.  
  437.                             STR( ( ( Time AND $07E0 ) SHR 5 ):2 , MM );
  438.                             IF MM[1] = ' ' THEN MM[1] := '0';
  439.  
  440.                             S_Time := HH + ':' + MM + ' ' + AmPm;
  441.  
  442.                          END;
  443.  
  444.       END (* CASE *);
  445.  
  446. END  (* Dir_Convert_Time *);
  447.  
  448. (*----------------------------------------------------------------------*)
  449. (*            Dir_Convert_Date --- Convert directory creation date      *)
  450. (*----------------------------------------------------------------------*)
  451.  
  452. PROCEDURE Dir_Convert_Date ( Date : WORD; VAR S_Date : AnyStr );
  453.  
  454. (*----------------------------------------------------------------------*)
  455. (*                                                                      *)
  456. (*     Procedure: Dir_Convert_Date                                      *)
  457. (*                                                                      *)
  458. (*     Purpose:   Convert creation date from directory to characters.   *)
  459. (*                                                                      *)
  460. (*     Calling Sequence:                                                *)
  461. (*                                                                      *)
  462. (*        Dir_Convert_Date( Date       : WORD;                          *)
  463. (*                          VAR S_Date : AnyStr ) : INTEGER;            *)
  464. (*                                                                      *)
  465. (*           Date   --- date as read from directory                     *)
  466. (*           S_Date --- converted date in yy/mm/dd                      *)
  467. (*                                                                      *)
  468. (*     Calls:                                                           *)
  469. (*                                                                      *)
  470. (*        STR                                                           *)
  471. (*                                                                      *)
  472. (*----------------------------------------------------------------------*)
  473.  
  474. VAR
  475.    YY : String[2];
  476.    MM : String[2];
  477.    DD : String[2];
  478.  
  479. BEGIN (* Dir_Convert_Date *)
  480.  
  481.    STR( ( 80 + ( Date SHR 9 ) ) : 2 , YY );
  482.  
  483.    STR( ( ( Date AND $01E0 ) SHR 5 ):2 , MM );
  484.    IF MM[1] = ' ' THEN MM[1] := '0';
  485.  
  486.    STR( ( Date AND $001F ):2 , DD );
  487.    IF DD[1] = ' ' THEN DD[1] := '0';
  488.  
  489.    CASE Date_Format OF
  490.       MDY_Style: S_Date := MM + '/' + DD + '/' + YY;
  491.       YMD_Style: S_Date := YY + '/' + MM + '/' + DD;
  492.       DMY_Style: S_Date := DD + '/' + MM + '/' + YY;
  493.       ELSE
  494.          S_Date := MM + '/' + DD + '/' + YY;
  495.    END (* CASE *);
  496.  
  497. END  (* Dir_Convert_Date *);
  498.  
  499. (*----------------------------------------------------------------------*)
  500. (*     Dir_Set_File_Date_And_Time -- Set file date and time stamp       *)
  501. (*----------------------------------------------------------------------*)
  502.  
  503. FUNCTION Dir_Set_File_Date_And_Time( File_Handle: INTEGER;
  504.                                      File_Date  : INTEGER;
  505.                                      File_Time  : INTEGER  ) : INTEGER;
  506.  
  507. (*----------------------------------------------------------------------*)
  508. (*                                                                      *)
  509. (*     Function:   Dir_Set_File_Date_And_Time                           *)
  510. (*                                                                      *)
  511. (*     Purpose:    Sets file time and date stamp                        *)
  512. (*                                                                      *)
  513. (*     Calling Sequence:                                                *)
  514. (*                                                                      *)
  515. (*        Error := Dir_Set_File_Date_And_Time( File_Handle: INTEGER;    *)
  516. (*                                             File_Date  : INTEGER;    *)
  517. (*                                             File_Time  : INTEGER ):  *)
  518. (*                                             INTEGER;                 *)
  519. (*                                                                      *)
  520. (*           File_Handle --- File handle of file to set time/date on    *)
  521. (*           File_Date   --- File date in packed DOS form               *)
  522. (*           File_Time   --- File time in packed DOS form               *)
  523. (*           Error       --- DOS error return code                      *)
  524. (*                                                                      *)
  525. (*     Calls:                                                           *)
  526. (*                                                                      *)
  527. (*        MsDos                                                         *)
  528. (*                                                                      *)
  529. (*----------------------------------------------------------------------*)
  530.  
  531. VAR
  532.    Dir_Reg  : Registers;
  533.  
  534. BEGIN (* Dir_Set_File_Date_And_Time *)
  535.  
  536.                                    (* Set up parameters to DOS call *)
  537.    WITH Dir_Reg DO
  538.       BEGIN
  539.          Cx := File_Time;
  540.          Dx := File_Date;
  541.          Bx := File_Handle;
  542.          Ah := $57;
  543.          Al := 1;
  544.       END;
  545.                                    (* Set date and time *)
  546.    MsDos( Dir_Reg );
  547.                                    (* Check for bad return  *)
  548.  
  549.    IF ( Carry_Flag AND Dir_Reg.Flags ) = 0 THEN
  550.       Dir_Set_File_Date_And_Time := 0
  551.    ELSE
  552.       Dir_Set_File_Date_And_Time := Dir_Reg.Ax;
  553.  
  554. END   (* Dir_Set_File_Date_And_Time *);
  555.  
  556. (*----------------------------------------------------------------------*)
  557. (*     Dir_Get_File_Date_And_Time -- Get file date and time stamp       *)
  558. (*----------------------------------------------------------------------*)
  559.  
  560. FUNCTION Dir_Get_File_Date_And_Time(     File_Handle: INTEGER;
  561.                                      VAR File_Date  : INTEGER;
  562.                                      VAR File_Time  : INTEGER  ) : INTEGER;
  563.  
  564. (*----------------------------------------------------------------------*)
  565. (*                                                                      *)
  566. (*     Function:   Dir_Get_File_Date_And_Time                           *)
  567. (*                                                                      *)
  568. (*     Purpose:    Gets file time and date stamp                        *)
  569. (*                                                                      *)
  570. (*     Calling Sequence:                                                *)
  571. (*                                                                      *)
  572. (*        Error := Dir_Get_File_Date_And_Time(     File_Handle: INTEGER;*)
  573. (*                                             VAR File_Date  : INTEGER;*)
  574. (*                                                 File_Time  : INTEGER *)
  575. (*                                           ): INTEGER;                *)
  576. (*                                                                      *)
  577. (*           File_Handle --- File handle of file to set time/date on    *)
  578. (*           File_Date   --- File date in packed DOS form               *)
  579. (*           File_Time   --- File time in packed DOS form               *)
  580. (*           Error       --- DOS error return code                      *)
  581. (*                                                                      *)
  582. (*     Calls:                                                           *)
  583. (*                                                                      *)
  584. (*        MsDos                                                         *)
  585. (*                                                                      *)
  586. (*----------------------------------------------------------------------*)
  587.  
  588. VAR
  589.    Dir_Reg  : Registers;
  590.  
  591. BEGIN (* Dir_Get_File_Date_And_Time *)
  592.  
  593.                                    (* Set up parameters to DOS call *)
  594.    WITH Dir_Reg DO
  595.       BEGIN
  596.          Bx := File_Handle;
  597.          Ah := $57;
  598.          Al := 0;
  599.       END;
  600.                                    (* Get date and time *)
  601.    MsDos( Dir_Reg );
  602.                                    (* Check for bad return  *)
  603.  
  604.    IF ( Carry_Flag AND Dir_Reg.Flags ) = 0 THEN
  605.       BEGIN
  606.          Dir_Get_File_Date_And_Time := 0;
  607.          File_Time                  := Dir_Reg.Cx;
  608.          File_Date                  := Dir_Reg.Dx;
  609.       END
  610.    ELSE
  611.       BEGIN
  612.          Dir_Get_File_Date_And_Time := Dir_Reg.Ax;
  613.          File_Time                  := 0;
  614.          File_Date                  := 0;
  615.       END;
  616.  
  617. END   (* Dir_Get_File_Date_And_Time *);
  618.  
  619. (*----------------------------------------------------------------------*)
  620. (*     Dir_Convert_File_Date_And_Time -- Get file date and time stamp   *)
  621. (*----------------------------------------------------------------------*)
  622.  
  623. PROCEDURE Dir_Convert_File_Date_And_Time(      Date_Time  : LONGINT;
  624.                                            VAR SFile_Date : AnyStr;
  625.                                            VAR SDate_Time : AnyStr  );
  626.  
  627. (*----------------------------------------------------------------------*)
  628. (*                                                                      *)
  629. (*     Function:   Dir_Convert_File_Date_And_Time                       *)
  630. (*                                                                      *)
  631. (*     Purpose:    Gets file time and date stamp in string format       *)
  632. (*                                                                      *)
  633. (*     Calling Sequence:                                                *)
  634. (*                                                                      *)
  635. (*        Dir_Convert_File_Date_And_Time(     Date_Time  : LONGINT;     *)
  636. (*                                        VAR SFile_Date : AnyStr;      *)
  637. (*                                        VAR SDate_Time : AnyStr );    *)
  638. (*                                                                      *)
  639. (*           Date_Time   --- File time/date in packed DOS form          *)
  640. (*           SFile_Date  --- File date in string form                   *)
  641. (*           SDate_Time  --- File time in string form                   *)
  642. (*                                                                      *)
  643. (*----------------------------------------------------------------------*)
  644.  
  645. VAR
  646.    DT : ARRAY[1..2] OF WORD ABSOLUTE Date_Time;
  647.  
  648. BEGIN (* Dir_Convert_File_Date_And_Time *)
  649.  
  650.    Dir_Convert_Time ( DT[1] , SDate_Time );
  651.    Dir_Convert_Date ( DT[2] , SFile_Date );
  652.  
  653. END   (* Dir_Convert_File_Date_And_Time *);
  654.  
  655.  
  656.