home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / TURBOPAS / PIBCAT14.ZIP / PIBCATS1.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1988-05-29  |  34.6 KB  |  671 lines
  1. (*--------------------------------------------------------------------------*)
  2. (*               Trim --- Trim trailing blanks from a string                *)
  3. (*--------------------------------------------------------------------------*)
  4.  
  5. FUNCTION Trim( S : AnyStr ) : AnyStr;
  6.  
  7. (*--------------------------------------------------------------------------*)
  8. (*                                                                          *)
  9. (*     Function:   Trim                                                     *)
  10. (*                                                                          *)
  11. (*     Purpose:    Trims trailing blanks from a string                      *)
  12. (*                                                                          *)
  13. (*     Calling sequence:                                                    *)
  14. (*                                                                          *)
  15. (*         Trimmed_S := TRIM( S );                                          *)
  16. (*                                                                          *)
  17. (*            S          --- the string to be trimmed                       *)
  18. (*            Trimmed_S  --- the trimmed version of S                       *)
  19. (*                                                                          *)
  20. (*     Calls:  None                                                         *)
  21. (*                                                                          *)
  22. (*     Remarks:                                                             *)
  23. (*                                                                          *)
  24. (*        Note that the original string itself is left untrimmed.           *)
  25. (*                                                                          *)
  26. (*     Pascal version might be written as:                                  *)
  27. (*                                                                          *)
  28. (*        VAR                                                               *)
  29. (*           I:       INTEGER;                                              *)
  30. (*                                                                          *)
  31. (*        BEGIN                                                             *)
  32. (*                                                                          *)
  33. (*           I := ORD( S[0] );                                              *)
  34. (*                                                                          *)
  35. (*           WHILE ( I > 0 ) AND ( S[I] = ' ' ) DO                          *)
  36. (*              I := PRED( I );                                             *)
  37. (*                                                                          *)
  38. (*           S[0] := CHR( I );                                              *)
  39. (*           Trim := S;                                                     *)
  40. (*                                                                          *)
  41. (*        END;                                                              *)
  42. (*                                                                          *)
  43. (*--------------------------------------------------------------------------*)
  44.  
  45. BEGIN (* Trim *)
  46.  
  47. INLINE(
  48.   $1E/                   {         PUSH    DS                ; Save DS}
  49.                          {;}
  50.   $C5/$76/$06/           {         LDS     SI,[BP+6]         ; Get address of S}
  51.   $FC/                   {         CLD                       ; Forward search}
  52.   $AC/                   {         LODSB                     ; Get length of S}
  53.   $3C/$00/               {         CMP     AL,0              ; See if length 0}
  54.   $74/$21/               {         JE      Trim2             ; If so, no trimming required}
  55.                          {;}
  56.   $30/$ED/               {         XOR     CH,CH}
  57.   $88/$C1/               {         MOV     CL,AL             ; Remember length for search loop}
  58.                          {;}
  59.   $B0/$20/               {         MOV     AL,' '            ; Blank to AL}
  60.                          {;}
  61.   $C4/$7E/$06/           {         LES     DI,[BP+6]         ; Get address of S}
  62.   $01/$CF/               {         ADD     DI,CX             ; Point to end of source string}
  63.                          {;}
  64.   $FD/                   {         STD                       ; Backwards search}
  65.   $F3/$AE/               {         REPE    SCASB             ; Scan over blanks}
  66.   $74/$01/               {         JE      Trim1             ; If CX=0, entire string is blank.}
  67.   $41/                   {         INC     CX}
  68.                          {;}
  69.   $88/$C8/               {Trim1:   MOV     AL,CL             ; Length to copy}
  70.   $C5/$76/$06/           {         LDS     SI,[BP+6]         ; Source string address}
  71.   $46/                   {         INC     SI                ; Skip length}
  72.   $C4/$7E/$0A/           {         LES     DI,[BP+10]        ; Result string address}
  73.   $FC/                   {         CLD                       ; Forward move}
  74.   $AA/                   {         STOSB                     ; Set length in result}
  75.   $F2/$A4/               {         REP     MOVSB             ; Move trimmed result}
  76.   $E9/$04/$00/           {         JMP     Exit}
  77.                          {;}
  78.   $C4/$7E/$0A/           {Trim2:   LES     DI,[BP+10]        ; Result string address}
  79.   $AA/                   {         STOSB                     ; Set length=0 in result}
  80.                          {;}
  81.   $1F);                  {Exit:    POP     DS                ; Restore DS}
  82.  
  83. END   (* Trim *);
  84.  
  85. (*--------------------------------------------------------------------------*)
  86. (*                     Dupl -- Duplicate a character n times                *)
  87. (*--------------------------------------------------------------------------*)
  88.  
  89. FUNCTION Dupl( Dup_char : Char; Dup_Count: INTEGER ) : AnyStr;
  90.  
  91. (*--------------------------------------------------------------------------*)
  92. (*                                                                          *)
  93. (*    Function: Dupl                                                        *)
  94. (*                                                                          *)
  95. (*    Purpose:  Duplicate a character n times                               *)
  96. (*                                                                          *)
  97. (*    Calling Sequence:                                                     *)
  98. (*                                                                          *)
  99. (*       Dup_String := Dupl( Dup_Char: Char; Dup_Count: INTEGER ): AnyStr;  *)
  100. (*                                                                          *)
  101. (*          Dup_Char   --- Character to be duplicated                       *)
  102. (*          Dup_Count  --- Number of times to duplicate character           *)
  103. (*          Dup_String --- Resultant duplicated string                      *)
  104. (*                                                                          *)
  105. (*    Calls:  None                                                          *)
  106. (*                                                                          *)
  107. (*    Remarks:                                                              *)
  108. (*                                                                          *)
  109. (*       This routine could be programmed directly in Turbo as:             *)
  110. (*                                                                          *)
  111. (*          VAR                                                             *)
  112. (*             S    : AnyStr;                                               *)
  113. (*                                                                          *)
  114. (*          BEGIN                                                           *)
  115. (*                                                                          *)
  116. (*             FillChar( S[1], Dup_Count, Dup_Char );                       *)
  117. (*             S[0] := CHR( Dup_Count );                                    *)
  118. (*                                                                          *)
  119. (*             Dupl := S;                                                   *)
  120. (*                                                                          *)
  121. (*          END;                                                            *)
  122. (*                                                                          *)
  123. (*--------------------------------------------------------------------------*)
  124.  
  125. BEGIN (* Dupl *)
  126.  
  127. INLINE(
  128.   $8A/$4E/$06/           {          MOV       CL,[BP+6]  ; Pick up dup count (0..255)}
  129.   $30/$ED/               {          XOR       CH,CH      ; Clear upper byte of count}
  130.   $C4/$7E/$0A/           {          LES       DI,[BP+10] ; Result address}
  131.   $FC/                   {          CLD                  ; Set direction flag}
  132.   $88/$C8/               {          MOV       AL,CL      ; Get result length}
  133.   $AA/                   {          STOSB                ; Store result length}
  134.   $8B/$46/$08/           {          MOV       AX,[BP+8]  ; Get char to duplicate}
  135.   $F2/$AA);              {          REP       STOSB      ; Perform duplication}
  136.  
  137. END   (* Dupl *);
  138.  
  139. (*----------------------------------------------------------------------*)
  140. (*               Min --- Find minimum of two integers                   *)
  141. (*----------------------------------------------------------------------*)
  142.  
  143. FUNCTION Min( A, B: INTEGER ) : INTEGER;
  144.  
  145. (*----------------------------------------------------------------------*)
  146. (*                                                                      *)
  147. (*   Function: Min                                                      *)
  148. (*                                                                      *)
  149. (*   Purpose:  Returns smaller of two numbers                           *)
  150. (*                                                                      *)
  151. (*   Calling sequence:                                                  *)
  152. (*                                                                      *)
  153. (*      Smaller := MIN( A , B ) : INTEGER;                              *)
  154. (*                                                                      *)
  155. (*         A       --- 1st input integer number                         *)
  156. (*         B       --- 2nd input integer number                         *)
  157. (*         Smaller --- smaller of A, B returned                         *)
  158. (*                                                                      *)
  159. (*                                                                      *)
  160. (*   Calls:  None                                                       *)
  161. (*                                                                      *)
  162. (*                                                                      *)
  163. (*----------------------------------------------------------------------*)
  164.  
  165. BEGIN (* Min *)
  166.  
  167.    IF A < B Then
  168.       Min := A
  169.    Else
  170.       Min := B;
  171.  
  172. END   (* Min *);
  173.  
  174. (*----------------------------------------------------------------------*)
  175. (*               Max --- Find maximum of two integers                   *)
  176. (*----------------------------------------------------------------------*)
  177.  
  178. FUNCTION Max( A, B: INTEGER ) : INTEGER;
  179.  
  180. (*----------------------------------------------------------------------*)
  181. (*                                                                      *)
  182. (*   Function:  Max                                                     *)
  183. (*                                                                      *)
  184. (*   Purpose:  Returns larger of two numbers                            *)
  185. (*                                                                      *)
  186. (*   Calling sequence:                                                  *)
  187. (*                                                                      *)
  188. (*      Larger := MAX( A , B ) : INTEGER;                               *)
  189. (*                                                                      *)
  190. (*         A       --- 1st input integer number                         *)
  191. (*         B       --- 2nd input integer number                         *)
  192. (*         Larger  --- Larger of A, B returned                          *)
  193. (*                                                                      *)
  194. (*                                                                      *)
  195. (*   Calls:  None                                                       *)
  196. (*                                                                      *)
  197. (*----------------------------------------------------------------------*)
  198.  
  199. BEGIN (* Max *)
  200.  
  201.    IF A > B Then
  202.       Max := A
  203.    Else
  204.       Max := B;
  205.  
  206. END   (* Max *);
  207.  
  208. (*--------------------------------------------------------------------------*)
  209. (*               UpperCase --- Convert string to upper case                 *)
  210. (*--------------------------------------------------------------------------*)
  211.  
  212. FUNCTION UpperCase( S: AnyStr ): AnyStr;
  213.  
  214. (*--------------------------------------------------------------------------*)
  215. (*                                                                          *)
  216. (*    Function: UpperCase                                                   *)
  217. (*                                                                          *)
  218. (*    Purpose:  Convert string to upper case                                *)
  219. (*                                                                          *)
  220. (*    Calling Sequence:                                                     *)
  221. (*                                                                          *)
  222. (*       Upper_String := UpperCase( S : AnyStr ): AnyStr;                   *)
  223. (*                                                                          *)
  224. (*          S            --- String to be converted to upper case           *)
  225. (*          Upper_String --- Resultant uppercase string                     *)
  226. (*                                                                          *)
  227. (*    Calls:  UpCase                                                        *)
  228. (*                                                                          *)
  229. (*    Remarks:                                                              *)
  230. (*                                                                          *)
  231. (*       This routine could be coded directly in Turbo as:                  *)
  232. (*                                                                          *)
  233. (*          VAR                                                             *)
  234. (*              I    : INTEGER;                                             *)
  235. (*              L    : INTEGER;                                             *)
  236. (*              T    : AnyStr;                                              *)
  237. (*                                                                          *)
  238. (*          BEGIN                                                           *)
  239. (*                                                                          *)
  240. (*             L := ORD( S[0] );                                            *)
  241. (*                                                                          *)
  242. (*             FOR I := 1 TO L DO                                           *)
  243. (*                T[I] := UpCase( S[I] );                                   *)
  244. (*                                                                          *)
  245. (*             T[0]      := CHR( L );                                       *)
  246. (*             UpperCase := T;                                              *)
  247. (*                                                                          *)
  248. (*         END;                                                             *)
  249. (*                                                                          *)
  250. (*--------------------------------------------------------------------------*)
  251.  
  252. BEGIN (* UpperCase *)
  253.  
  254. INLINE(
  255.   $1E/                   {         PUSH    DS                ; Save DS}
  256.   $C5/$76/$06/           {         LDS     SI,[BP+6]         ; Get source string address}
  257.   $C4/$7E/$0A/           {         LES     DI,[BP+10]        ; Get result string address}
  258.   $FC/                   {         CLD                       ; Forward direction for strings}
  259.   $AC/                   {         LODSB                     ; Get length of source string}
  260.   $AA/                   {         STOSB                     ; Copy to result string}
  261.   $30/$ED/               {         XOR     CH,CH}
  262.   $88/$C1/               {         MOV     CL,AL             ; Move string length to CL}
  263.   $E3/$0E/               {         JCXZ    Exit              ; Skip if null string}
  264.                          {;}
  265.   $AC/                   {UpCase1: LODSB                     ; Get next source character}
  266.   $3C/$61/               {         CMP     AL,'a'            ; Check if lower-case letter}
  267.   $72/$06/               {         JB      UpCase2}
  268.   $3C/$7A/               {         CMP     AL,'z'}
  269.   $77/$02/               {         JA      UpCase2}
  270.   $2C/$20/               {         SUB     AL,'a'-'A'        ; Convert to uppercase}
  271.                          {;}
  272.   $AA/                   {UpCase2: STOSB                     ; Store in result}
  273.   $E2/$F2/               {         LOOP    UpCase1}
  274.                          {;}
  275.   $1F);                  {Exit:    POP     DS                ; Restore DS}
  276.  
  277. END   (* UpperCase *);
  278.  
  279. (*--------------------------------------------------------------------------*)
  280. (*             Get_Dos_Version  --- Get MS DOS version number               *)
  281. (*--------------------------------------------------------------------------*)
  282.  
  283. FUNCTION Get_Dos_Version : INTEGER;
  284.  
  285. (*--------------------------------------------------------------------------*)
  286. (*                                                                          *)
  287. (*     Function:  Get_Dos_Version                                           *)
  288. (*                                                                          *)
  289. (*     Purpose:   Returns current date in string form                       *)
  290. (*                                                                          *)
  291. (*     Calling sequence:                                                    *)
  292. (*                                                                          *)
  293. (*        Dos_Version := Get_Dos_Version: INTEGER;                          *)
  294. (*                                                                          *)
  295. (*           Dos_Version --- Returns MS DOS version in packed form          *)
  296. (*                           LO( Dos_Version ) = Major version number       *)
  297. (*                           HI( Dos_Version ) = Minor version number       *)
  298. (*                                                                          *)
  299. (*     Calls:  MsDos                                                        *)
  300. (*                                                                          *)
  301. (*--------------------------------------------------------------------------*)
  302.  
  303. VAR
  304.    Regs: Registers;
  305.  
  306. BEGIN (* Get_Dos_Version *)
  307.                                    (* Get version number function *)
  308.    Regs.AX := $3000;
  309.    MsDos( Regs );
  310.  
  311.    Get_Dos_Version := Regs.AX;
  312.  
  313. END   (* Get_Dos_Version *);
  314.  
  315. (*--------------------------------------------------------------------------*)
  316. (*        Adjust_Hour --- Convert 24 hour time to 12 hour am/pm             *)
  317. (*--------------------------------------------------------------------------*)
  318.  
  319. PROCEDURE Adjust_Hour( VAR Hour : WORD;
  320.                        VAR AmPm : STRING2 );
  321.  
  322. (*----------------------------------------------------------------------*)
  323. (*                                                                      *)
  324. (*    Procedure: Adjust_Hour                                            *)
  325. (*                                                                      *)
  326. (*    Purpose:   Converts 24 hour time to 12 hour am/pm time            *)
  327. (*                                                                      *)
  328. (*    Calling sequence:                                                 *)
  329. (*                                                                      *)
  330. (*       Adjust_Hour( VAR Hour : WORD; AmPm : String2 );                *)
  331. (*                                                                      *)
  332. (*          Hour --- Input = Hours in 24 hour form;                     *)
  333. (*                   Output = Hours in 12 hour form.                    *)
  334. (*          AmPm --- Output 'am' or 'pm' indicator                      *)
  335. (*                                                                      *)
  336. (*----------------------------------------------------------------------*)
  337.  
  338. BEGIN (* Adjust_Hour *)
  339.  
  340.    IF ( Hour < 12 ) THEN
  341.       BEGIN
  342.          AmPm := 'am';
  343.          IF ( Hour = 0 ) THEN
  344.             Hour := 12;
  345.       END
  346.    ELSE
  347.       BEGIN
  348.          AmPm := 'pm';
  349.          IF ( Hour <> 12 ) THEN
  350.             Hour := Hour - 12;
  351.       END;
  352.  
  353. END   (* Adjust_Hour *);
  354.  
  355. (*----------------------------------------------------------------------*)
  356. (*   Dir_Convert_Date_And_Time --- Convert directory creation date/time *)
  357. (*----------------------------------------------------------------------*)
  358.  
  359. PROCEDURE Dir_Convert_Date_And_Time(     Time   : LONGINT;
  360.                                      VAR S_Date : AnyStr;
  361.                                      VAR S_Time : AnyStr  );
  362.  
  363. (*----------------------------------------------------------------------*)
  364. (*                                                                      *)
  365. (*     Procedure: Dir_Convert_Date_And_Time                             *)
  366. (*                                                                      *)
  367. (*     Purpose:   Convert creation date/time from DOS directory entry.  *)
  368. (*                                                                      *)
  369. (*     Calling Sequence:                                                *)
  370. (*                                                                      *)
  371. (*        Dir_Convert_Date_And_Time(     Time   : LONGINT;              *)
  372. (*                                   VAR S_Date : AnyStr;               *)
  373. (*                                   VAR S_Time : AnyStr );             *)
  374. (*                                                                      *)
  375. (*           Time   --- Packed time/date as read from DOS directory     *)
  376. (*           S_Date --- converted date in dd-mon-yy format              *)
  377. (*           S_Time --- converted time in hh:mm ampm format             *)
  378. (*                                                                      *)
  379. (*     Calls:                                                           *)
  380. (*                                                                      *)
  381. (*        UnPackTime                                                    *)
  382. (*                                                                      *)
  383. (*----------------------------------------------------------------------*)
  384.  
  385. VAR
  386.    DT   : DateTime;
  387.    YY   : String[2];
  388.    HH   : String[2];
  389.    MM   : String[3];
  390.    DD   : String[2];
  391.    AmPm : STRING[2];
  392.  
  393. BEGIN (* Dir_Convert_Date *)
  394.                                    (* If time stamp is 0, don't bother *)
  395.                                    (* to unpack it.                    *)
  396.    IF ( Time = 0 ) THEN
  397.       BEGIN
  398.          S_Date := '         ';
  399.          S_Time := '        ';
  400.       END
  401.    ELSE
  402.       BEGIN
  403.                                    (* Get date/time values *)
  404.          UnpackTime( Time , DT );
  405.  
  406.          WITH DT DO
  407.             BEGIN
  408.  
  409.                STR( ( Year - 1900 ): 2 , YY );
  410.  
  411.                MM := Month_Names[ Month ];
  412.  
  413.                STR( Day:2 , DD );
  414.  
  415.                S_Date := DD + '-' + MM + '-' + YY;
  416.  
  417.                IF ( ( Hour + Min + Sec ) = 0 ) THEN
  418.                   S_Time := '        '
  419.                ELSE
  420.                   BEGIN
  421.  
  422.                      Adjust_Hour( WORD( Hour ) , AmPm );
  423.  
  424.                      STR( Hour:2 , HH );
  425.                      STR( Min: 2 , MM );
  426.  
  427.                      IF ( MM[1] = ' ' ) THEN MM[1] := '0';
  428.  
  429.                      S_Time := HH + ':' + MM + ' ' + AmPm;
  430.  
  431.                   END;
  432.  
  433.             END;
  434.  
  435.       END;
  436.  
  437. END  (* Dir_Convert_Date_And_Time *);
  438.  
  439. (*----------------------------------------------------------------------*)
  440. (*   Convert_String_To_AsciiZ -- Convert Turbo string to Ascii Z String *)
  441. (*----------------------------------------------------------------------*)
  442.  
  443. PROCEDURE Convert_String_To_AsciiZ( VAR S: AnyStr );
  444.  
  445. (*----------------------------------------------------------------------*)
  446. (*                                                                      *)
  447. (*     Procedure:  Convert_String_To_AsciiZ                             *)
  448. (*                                                                      *)
  449. (*     Purpose:    Convert Turbo string to ascii Z string               *)
  450. (*                                                                      *)
  451. (*     Calling Sequence:                                                *)
  452. (*                                                                      *)
  453. (*        Convert_String_To_AsciiZ( VAR S: AnyStr );                    *)
  454. (*                                                                      *)
  455. (*           S --- Turbo string to be turned into Ascii Z string        *)
  456. (*                                                                      *)
  457. (*     Calls:                                                           *)
  458. (*                                                                      *)
  459. (*        None                                                          *)
  460. (*                                                                      *)
  461. (*----------------------------------------------------------------------*)
  462.  
  463. BEGIN (* Convert_String_To_AsciiZ *)
  464.  
  465.    S := S + CHR( 0 );
  466.  
  467. END   (* Convert_String_To_AsciiZ *);
  468.  
  469. (*----------------------------------------------------------------------*)
  470. (*     Dir_Set_Disk_Transfer_Address --- Set DMA address for disk I/O   *)
  471. (*----------------------------------------------------------------------*)
  472.  
  473. PROCEDURE Dir_Set_Disk_Transfer_Address( VAR DMA_Buffer );
  474.  
  475. (*----------------------------------------------------------------------*)
  476. (*                                                                      *)
  477. (*     Procedure:  Dir_Set_Disk_Transfer_Address                        *)
  478. (*                                                                      *)
  479. (*     Purpose:    Sets DMA address for disk transfers                  *)
  480. (*                                                                      *)
  481. (*     Calling Sequence:                                                *)
  482. (*                                                                      *)
  483. (*        Dir_Set_Disk_Transfer_Address( VAR DMA_Buffer );              *)
  484. (*                                                                      *)
  485. (*           DMA_Buffer --- direct memory access buffer                 *)
  486. (*                                                                      *)
  487. (*     Calls:                                                           *)
  488. (*                                                                      *)
  489. (*        MsDos                                                         *)
  490. (*                                                                      *)
  491. (*----------------------------------------------------------------------*)
  492.  
  493. VAR
  494.    Dir_Reg: Registers;
  495.  
  496. BEGIN (* Dir_Set_Disk_Transfer_Address *)
  497.  
  498.    Dir_Reg.Ax := $1A00;
  499.    Dir_Reg.Ds := SEG( DMA_Buffer );
  500.    Dir_Reg.Dx := OFS( DMA_Buffer );
  501.  
  502.    MsDos( Dir_Reg );
  503.  
  504. END   (* Dir_Set_Disk_Transfer_Address *);
  505.  
  506. (*----------------------------------------------------------------------*)
  507. (*     Dir_Get_Volume_Label   ---  Get volume label of a disk           *)
  508. (*----------------------------------------------------------------------*)
  509.  
  510. PROCEDURE Dir_Get_Volume_Label(     Volume       : CHAR;
  511.                                 VAR Volume_Label : AnyStr;
  512.                                 VAR Time         : LONGINT );
  513.  
  514. (*----------------------------------------------------------------------*)
  515. (*                                                                      *)
  516. (*    Procedure: Dir_Get_Volume_Label                                   *)
  517. (*                                                                      *)
  518. (*    Purpose:   Gets volume label for specified disk                   *)
  519. (*                                                                      *)
  520. (*    Calling sequence:                                                 *)
  521. (*                                                                      *)
  522. (*       Dir_Get_Volume_Label(     Volume       : CHAR;                 *)
  523. (*                             VAR Volume_Label : AnyStr;               *)
  524. (*                             VAR Time         : LONGINT );            *)
  525. (*                                                                      *)
  526. (*          Volume       --- Disk letter for which to get label         *)
  527. (*          Volume_Label --- Actual label itself                        *)
  528. (*          Time         --- Packed creation date/time of volume label  *)
  529. (*                                                                      *)
  530. (*    Remarks:                                                          *)
  531. (*                                                                      *)
  532. (*       Because of various bugs in the MS DOS 2.x file searching       *)
  533. (*       facilities, this routine will not return a volume date or time *)
  534. (*       for DOS 2.x.                                                   *)
  535. (*                                                                      *)
  536. (*----------------------------------------------------------------------*)
  537.  
  538. TYPE
  539.    Directory_Record = RECORD
  540.                          Filler    : ARRAY[1..21] Of BYTE;
  541.                          File_Attr : BYTE      (* File attributes *);
  542.                          File_Time : LONGINT   (* Creation time   *);
  543.                          File_Size : LONGINT   (* Size in bytes   *);
  544.                          File_Name : ARRAY[1..80] Of CHAR (* Name *);
  545.                       END;
  546.  
  547.    Extended_FCB    = RECORD
  548.                         Fcb_Flag    : BYTE                 (* $FF = extended FCB *);
  549.                         Filler1     : ARRAY[1..5] OF BYTE;
  550.                         FCB_Attr    : BYTE                 (* File attribute *);
  551.                         FCB_Drive   : BYTE                 (* Drive *) ;
  552.                         FCB_FileName: ARRAY[1..11] OF CHAR (* File name *);
  553.                         FCB_BlockNo : INTEGER              (* Block # *);
  554.                         FCB_RecSize : INTEGER              (* Record size *);
  555.                         FCB_FileSize: Longint              (* File size *);
  556.                         FCB_Date    : INTEGER              (* File date *);
  557.                         FCB_Time    : INTEGER              (* File time *);
  558.                         Filler2     : ARRAY[1..33] OF BYTE (* Make 64 bytes *);
  559.                      END;
  560.                                    (* File attribute values *)
  561. CONST
  562.    Dir_Attr_Read_Only    =  1;
  563.    Dir_Attr_Hidden       =  2;
  564.    Dir_Attr_System       =  4;
  565.    Dir_Attr_Volume_Label =  8;
  566.    Dir_Attr_Subdirectory = 16;
  567.    Dir_Attr_Archive      = 32;
  568.  
  569.                                    (* File access modes *)
  570.    Access_Read_Mode           = 0;
  571.    Access_Write_Mode          = 1;
  572.    Access_Read_And_Write_Mode = 2;
  573.  
  574.                                    (* File attributes *)
  575.    Attribute_None             = 0;
  576.    Attribute_Read_Only        = 1;
  577.    Attribute_Hidden           = 2;
  578.    Attribute_System           = 4;
  579.    Attribute_Volume_Label     = 8;
  580.    Attribute_Subdirectory     = 16;
  581.    Attribute_Archive          = 32;
  582.  
  583. VAR
  584.    Volume_Data  : Directory_Record;
  585.    Regs         : Registers;
  586.    Volume_Pat   : STRING[15];
  587.    OVolume_Data : Extended_FCB;
  588.    Volume_FCB   : Extended_FCB;
  589.  
  590. BEGIN (* Dir_Get_Volume_Label *)
  591.                                    (* Use FCB code for DOS 2.x *)
  592.  
  593.    IF ( LO( Get_Dos_Version ) = 2 ) THEN
  594.       WITH Regs DO
  595.          BEGIN (* Dos 2.x *)
  596.                                    (* Clear out FCBs *)
  597.  
  598.             FillChar( Volume_FCB  , 64, 0 );
  599.             FillChar( OVolume_Data, 64, 0 );
  600.  
  601.                                    (* Set up extended FCB for volume *)
  602.                                    (* label search.                  *)
  603.  
  604.             Volume_FCB.FCB_Flag    := $FF;
  605.             Volume_FCB.FCB_Attr    := Attribute_Volume_Label;
  606.             Volume_FCB.FCB_Drive   := ORD( Volume ) - ORD('A') + 1;
  607.  
  608.             FillChar( Volume_FCB.FCB_FileName, 11, '?' );
  609.  
  610.                                    (* Set address to receive volume label *)
  611.  
  612.             Dir_Set_Disk_Transfer_Address( OVolume_Data );
  613.  
  614.                                    (* Call DOS to search for volume label *)
  615.  
  616.             Regs.Ds := SEG( Volume_FCB );
  617.             Regs.Dx := OFS( Volume_FCB );
  618.             Regs.Ax := $1100;
  619.             MsDos( Regs );
  620.                                    (* Check if we got label.  If so,      *)
  621.                                    (* get it.  Date and time will most    *)
  622.                                    (* likely be garbage, so set them to   *)
  623.                                    (* zero so they won't be listed later. *)
  624.  
  625.             IF ( Regs.Al = $FF ) THEN
  626.                Volume_Label := ''
  627.             ELSE
  628.                Volume_Label := OVolume_Data.FCB_FileName;
  629.  
  630.             Time := 0;
  631.  
  632.          END   (* Dos 2.x *)
  633.    ELSE
  634.       WITH Regs DO
  635.          BEGIN  (* Dos 3.x and higher *)
  636.  
  637.                                    (* Set up DMA address for volume info *)
  638.  
  639.             Dir_Set_Disk_Transfer_Address( Volume_Data );
  640.  
  641.                                    (* Search root directory for label *)
  642.  
  643.             Volume_Pat := Volume + ':*.*';
  644.  
  645.             Convert_String_To_AsciiZ( Volume_Pat );
  646.  
  647.             Regs.Ds := SEG( Volume_Pat[1] );
  648.             Regs.Dx := OFS( Volume_Pat[1] );
  649.             Regs.Ax := $4E00;
  650.             Regs.Cx := Attribute_Volume_Label;
  651.  
  652.                                    (* Find volume label *)
  653.             MsDos( Regs );
  654.  
  655.             IF ( FCarry AND Regs.Flags ) <> 0 THEN
  656.                BEGIN                  (* No volume label found *)
  657.                   Volume_Label := '';
  658.                   Time         := 0;
  659.                END
  660.             ELSE
  661.                WITH Volume_Data DO
  662.                   BEGIN               (* Extract volume label *)
  663.                      Volume_Label := TRIM( COPY( File_Name, 1, POS( #0 , File_Name ) - 1 ) );
  664.                      Time         := File_Time;
  665.                   END;
  666.  
  667.          END (* Dos 3.x and higher *);
  668.  
  669. END   (* Dir_Get_Volume_Label *);
  670.  
  671.