home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / dossys / vollabel / volfuncs.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-05-22  |  4.3 KB  |  170 lines
  1. UNIT VolFuncs;
  2. (**) INTERFACE (**)
  3.  
  4. {$IFDEF WINDOWS}
  5.   {$DEFINE PMODE}
  6. {$ENDIF}
  7. {$IFDEF DPMI}
  8.   {$DEFINE PMODE}
  9. {$ENDIF}
  10.  
  11. {$IFNDEF PMODE}
  12.   !! Error, this unit is Protected Mode ONLY
  13. {$ENDIF}
  14.  
  15. USES WinAPI,WinDOS,Strings;
  16.  
  17. TYPE
  18.   VolString = String[12];
  19.  
  20.   FUNCTION GetLabel(driveNum : Byte;
  21.                     VAR V : VolString) : Boolean;
  22.   FUNCTION SetLabel(driveNum : Byte;
  23.                     NuLabel : VolString) : Boolean;
  24.   FUNCTION DelLabel(driveNum : Byte) : Boolean;
  25.  
  26. (**) IMPLEMENTATION (**)
  27. TYPE
  28.   PExFCB = ^ExFCB;
  29.   ExFCB = RECORD
  30.             FF        : Byte;              {must be 0FFh}
  31.             Reserved0 : ARRAY[1..5] OF Byte; {must be 0s}
  32.             Attribute : Byte;
  33.             DriveID   : Byte;
  34.             Filename  : ARRAY[1..8] OF Char;
  35.             Extension : ARRAY[1..3] OF Char;
  36.             CurBlock  : Word;
  37.             RecSize   : Word;
  38.             FileSize  : LongInt;
  39.             Date      : Word;
  40.             Time      : Word;
  41.             Reserved  : ARRAY[1..8] OF Byte;
  42.             CurRec    : Byte;
  43.             Relative  : LongInt;
  44.           END;
  45.  
  46. type
  47.   PRealModeRegs = ^TRealModeRegs;
  48.   TRealModeRegs = record
  49.     case Integer of
  50.       0: (
  51.         EDI, ESI, EBP, EXX, EBX, EDX, ECX, EAX: Longint;
  52.         Flags, ES, DS, FS, GS, IP, CS, SP, SS: Word);
  53.       1: (
  54.         DI, DIH, SI, SIH, BP, BPH, XX, XXH: Word;
  55.         case Integer of
  56.           0: (
  57.             BX, BXH, DX, DXH, CX, CXH, AX, AXH: Word);
  58.           1: (
  59.             BL, BH, BLH, BHH, DL, DH, DLH, DHH,
  60.             CL, CH, CLH, CHH, AL, AH, ALH, AHH: Byte));
  61.   end;
  62.  
  63. procedure RealModeInt(Int: Byte; var Regs: TRealModeRegs); assembler;
  64. asm
  65.    MOV   BL,Int
  66.    XOR   BH,BH
  67.    XOR   CX,CX
  68.    LES   DI,Regs
  69.    MOV   AX,0300H
  70.    INT   31H
  71. end;
  72.  
  73. var
  74.   Reg: TRealModeRegs; { Registers Structure used by DPMI Simulate Real mode interrupt }
  75.  
  76.   FUNCTION GetLabel(driveNum : Byte;
  77.                     VAR V : VolString) : Boolean;
  78.   CONST
  79.     Any : String[5] = ':\*.*';
  80.   VAR
  81.     SR   : TSearchRec;
  82.     Mask : array[0..fsPathName] of char;
  83.     P    : Byte;
  84.     SRName : String[12];
  85.   BEGIN
  86.     IF DriveNum > 0 THEN
  87.       Mask[0] := Char(DriveNum + ord('@'))
  88.     ELSE GetCurDir(Mask,0);
  89.     Move(Any[1], Mask[1], 5);
  90.     Mask[6] := #0;
  91.     FindFirst(Mask, faVolumeID, SR);
  92.     WHILE (SR.Attr AND faVolumeID = 0) AND
  93.           (DosError = 0) DO
  94.       FindNext(SR);
  95.     IF DosError = 0 THEN
  96.       BEGIN
  97.         SRName := StrPas(SR.Name);
  98.         FillChar(V[1], 11, ' ');
  99.         V[0] := #11;
  100.         P := Pos('.', SRName);
  101.         IF P = 0 THEN
  102.           Move(SRName[1], V[1], length(SRName))
  103.         ELSE
  104.           BEGIN
  105.             Move(SRName[1], V[1], pred(P));
  106.             Move(SRName[P+1], V[9], length(SRName)-P);
  107.           END;
  108.         GetLabel := TRUE;
  109.       END
  110.     ELSE GetLabel := FALSE;
  111.   END;
  112.  
  113.   FUNCTION SetLabel(driveNum : Byte;
  114.                     NuLabel : VolString) : Boolean;
  115.   VAR E  : PExFCB;
  116.       DosMem : longint;
  117.   BEGIN
  118.     DosMem := GlobalDosAlloc(Sizeof(ExFCB));
  119.     E := Ptr(LoWord(DosMem),0);
  120.     WITH E^ DO
  121.       BEGIN
  122.         FF        := $FF;
  123.         FillChar(Reserved0, 5, 0);
  124.         Attribute := faVolumeID;
  125.         DriveID   := DriveNum;
  126.         FillChar(FileName, 8, ' ');
  127.         FillChar(Extension, 3, ' ');
  128.         Move(NuLabel[1], Filename, length(NuLabel));
  129.       END;
  130.     with Reg do
  131.       begin
  132.       DS := HiWord(DosMem);
  133.       DX := 0;
  134.       AX := $1600;
  135.       RealModeInt($21,Reg);
  136.       Inc(AL);
  137.       SetLabel := Boolean(AL);
  138.       end;
  139.     GlobalDosFree(LoWord(DosMem));
  140.   END;
  141.  
  142.   FUNCTION DelLabel(driveNum : Byte) : Boolean;
  143.   VAR E   : PExFCB;
  144.       DosMem : longint;
  145.   BEGIN
  146.     DosMem := GlobalDosAlloc(Sizeof(ExFCB));
  147.     E := Ptr(LoWord(DosMem),0);
  148.     WITH E^ DO
  149.       BEGIN
  150.         FF        := $FF;
  151.         FillChar(Reserved0, 5, 0);
  152.         Attribute := faVolumeID;
  153.         DriveID   := DriveNum;
  154.         FillChar(FileName, 8, '?');
  155.         FillChar(Extension, 3, '?');
  156.       END;
  157.     FillChar(Reg,Sizeof(Reg),0);
  158.     With Reg do
  159.       begin
  160.       DS := HiWord(DosMem);
  161.       DX := 0;
  162.       AX := $1300;
  163.       RealModeInt($21,Reg);
  164.       Inc(AL);
  165.       DelLabel := Boolean(AL);
  166.       end;
  167.     GlobalDosFree(LoWord(DosMem));
  168.   END;
  169. END.
  170.