home *** CD-ROM | disk | FTP | other *** search
/ CD Shareware Magazine 1996 December / CD_shareware_12-96.iso / WIN / Programa / LABELER.ZIP / DOSUTIL.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-05-26  |  2.4 KB  |  105 lines
  1. unit DosUtil;
  2. { DosUtil.Pas - Contains volume labeling functions for 16-bit Delphi. }
  3. { Copyright (c) 1996. All Rights Reserved. }
  4. { By Paul Kimmel. okemos, MI USA }
  5.  
  6. interface
  7.  
  8. Uses
  9.     SysUtils, WinProcs;
  10. Type
  11.     { Extended file control block. }
  12.     X_FCB = record
  13.           Extended : byte;
  14.           Reserved : array[1..5] of byte;
  15.           Attribute : byte;
  16.           Drive : shortint;
  17.           FileName : array[1..8] of char;
  18.           Extension : array[1..3] of char;
  19.           CurrentBlock : integer;
  20.           RecordSize : integer;
  21.           FileSize : Longint;
  22.           DateCreated : integer;
  23.           TimeCreated : integer;
  24.           Reserved2 : array[1..8] of byte;
  25.           CurrentRecord : byte;
  26.           Random : Longint;
  27.     end;
  28.  
  29.  
  30.     Function SetLabel( LabelName : string ) : integer;
  31.     Function GetLabel( Drive : string ) : string;
  32.     Function ClearLabel( Drive : string ) : integer;
  33.  
  34. implementation
  35.  
  36. const
  37.      DELETE_LABEL_FUNCTION = $13;
  38.  
  39. var
  40.    xfcb : X_FCB;
  41.  
  42. Function SetLabel( LabelName : string ): integer;
  43. var
  44.    Str : PChar;
  45.    Buf : array[1..128] of char;
  46.  
  47. begin
  48.      Str := Addr(Buf);
  49.      StrPCopy( Str, LabelName );
  50.      SetLabel := _lcreat( Str, faVolumeID );
  51. end;
  52.  
  53. Function GetLabel( Drive : string ) : string;
  54. var
  55.    SearchRec : TSearchRec;
  56. begin
  57.      Result := '';
  58.      if( FindFirst( Drive + '*.*', faVolumeID, SearchRec ) = 0) then
  59.          Result := SearchRec.Name;
  60. end;
  61.  
  62. { Fills the Extended FCB for a find. }
  63. Procedure FillFCBForFind(  Drive : shortint );
  64. var
  65.    i : integer;
  66. begin
  67.      { Signifies an extended File Control Block FCB }
  68.      xfcb.extended := $FF;
  69.  
  70.      { Volume label attribute. }
  71.      xfcb.attribute := $8;
  72.  
  73.      { Drive number. }
  74.      xfcb.drive := drive;
  75.  
  76.      { ????????.??? - DOS style 8.3 filemask. }
  77.      FillChar( xfcb.FileName, SizeOf( xfcb.FileName ), '?' );
  78.      FillChar( xfcb.Extension, SizeOf( xfcb.Extension ), '?' );
  79.  
  80. end;
  81.  
  82.  
  83. Function ClearLabel( Drive : string ): integer;
  84. var
  85.    RetVal : Byte;
  86.    LabelName : string;
  87. begin
  88.      if( Length( Drive ) >= 1 ) then
  89.      begin
  90.          Drive := UpperCase(Drive);
  91.          FillFCBForFind(  Ord(Drive[1]) - 64  );
  92.      end
  93.      else
  94.          FillFCBForFind( 0 );
  95.  
  96.      asm
  97.         mov   DX,offset xfcb
  98.         mov   AH,DELETE_LABEL_FUNCTION
  99.         Call  DOS3Call
  100.         mov   RetVal,AL
  101.      end;
  102.      Result := RetVal;
  103. end;
  104. end.
  105.