home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / VISUAL_B / FERRAMEN / VOL_DLL / VLABEL.ZIP / VOLFUNCS.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-07-02  |  4.6 KB  |  179 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 WinProcs, WinTypes,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.  
  116.   VAR E  : PExFCB;
  117.       DosMem : longint;
  118.   BEGIN
  119.     DosMem := GlobalDosAlloc(Sizeof(ExFCB));
  120.     E := Ptr(LoWord(DosMem),0);
  121.     WITH E^ DO
  122.       BEGIN
  123.         FF        := $FF;
  124.         FillChar(Reserved0, 5, 0);
  125.         Attribute := faVolumeID;
  126.         DriveID   := DriveNum;
  127.         FillChar(FileName, 8, ' ');
  128.         FillChar(Extension, 3, ' ');
  129.         Move(NuLabel[1], Filename, length(NuLabel));
  130.       END;
  131.     with Reg do
  132.       begin
  133.       DS := HiWord(DosMem);
  134.       DX := 0;
  135.       AX := $1600;
  136.       RealModeInt($21,Reg);
  137.       Inc(AL);
  138.       SetLabel := Boolean(AL);
  139.       { Following code added by Pat Ritchey, borland support, thanks Pat }
  140.       if AL=1 then
  141.          begin                    
  142.          DS := HiWord(DosMem);   
  143.          DX := 0;                
  144.          AX := $1000;            
  145.          RealModeInt($21,Reg);   
  146.          end;                    
  147.       end;
  148.     GlobalDosFree(LoWord(DosMem));
  149.   END;
  150.  
  151.   FUNCTION DelLabel(driveNum : Byte) : Boolean;
  152.   VAR E   : PExFCB;
  153.       DosMem : longint;
  154.   BEGIN
  155.     DosMem := GlobalDosAlloc(Sizeof(ExFCB));
  156.     E := Ptr(LoWord(DosMem),0);
  157.     WITH E^ DO
  158.       BEGIN
  159.         FF        := $FF;
  160.         FillChar(Reserved0, 5, 0);
  161.         Attribute := faVolumeID;
  162.         DriveID   := DriveNum;
  163.         FillChar(FileName, 8, '?');
  164.         FillChar(Extension, 3, '?');
  165.       END;
  166.     FillChar(Reg,Sizeof(Reg),0);
  167.     With Reg do
  168.       begin
  169.       DS := HiWord(DosMem);
  170.       DX := 0;
  171.       AX := $1300;
  172.       RealModeInt($21,Reg);
  173.       Inc(AL);
  174.       DelLabel := Boolean(AL);
  175.       end;
  176.     GlobalDosFree(LoWord(DosMem));
  177.   END;
  178. END.
  179.