[Back to DRIVES SWAG index] [Back to Main SWAG index] [Original]

    {$S-,R-,V-,I-,B-,F+,O+,A-,X+}

    unit DDisk;
      {-Read and write absolute sectors using DOS int $25 and $26
        in protected mode under DOS or Windows. Does not support real mode.
        Requires BP7 or TPW 1.5.

        Based on the code in the OPDOS unit from Object Professional.

        Thanks to Maynard Riley and Mark Boler for work done on this unit.

        Notes:
          The calling parameters correspond to those in OPDOS.
          Drive = 0 corresponds to drive A.
          Sectors are typically 512 bytes each. NumSects*SectorSize must be
            less than 64K.
          Buf may be any buffer in a protected mode program. DDISK
            temporarily allocates a DOS real mode buffer, then copies
            the result into or out of Buf.
          If the function returns False, the DosError variable from the
            DOS or WINDOS unit may have a non-zero value with more information
            about the failure.

          Use DPMIWriteDiskSectors with caution!

        Version 1.0 (first public release) 7/19/94

        For more information, contact TurboPower Software
        CompuServe 76004,2611
      }

    interface

    function DPMIReadDiskSectors(Drive : Word;
                                 FirstSect : LongInt; NumSects : Word;
                                 var Buf) : Boolean;
      {-Read sectors using int $25}

    function DPMIWriteDiskSectors(Drive : Word;
                                  FirstSect : LongInt; NumSects : Word;
                                  var Buf) : Boolean;
      {-Write sectors using int $26}

      {====================================================================}

    implementation

    uses
    {$IFDEF DPMI}
      DOS,
    {$ELSE}
      WinDOS,
    {$ENDIF}
      WinAPI;

    type
      DpmiRealBuf =
        object

        private
          Bytes   : LongInt;
          BufBase : LongInt;

        public
          constructor Init(BufBytes : LongInt);
          destructor Done;
          function Size : LongInt;
          function Segment : Word;
          function Selector : Word;
          function RealPtr : Pointer;
          function ProtPtr : Pointer;
        end;

      DPMIRegisters =
        record
          DI : LongInt;
          SI : LongInt;
          BP : LongInt;
          Reserved : LongInt;
          BX : LongInt;
          DX : LongInt;
          CX : LongInt;
          AX : LongInt;
          Flags : Word;
          ES : Word;
          DS : Word;
          FS : Word;
          GS : Word;
          IP : Word;
          CS : Word;
          SP : Word;
          SS : Word;
        end;

      PacketPtr = ^PacketRec;
      PacketRec =
        record
          StartLo : Word;
          StartHi : Word;
          Count : Word;
          BufOfs : Word;
          BufSeg : Word;
        end;

      procedure GetRealModeIntVector(IntNo : Byte; var Vector : Pointer); assembler;
      asm
        mov     ax,0200h
        mov     bl,IntNo
        int     31h
        les     di,Vector
        mov     word ptr es:[di],dx
        mov     word ptr es:[di+2],cx
      end;

      function CallFarRealModeProc(var Regs : DPMIRegisters) : Word; assembler;
      asm
        mov     ax,0301h
        xor     bx,bx
        xor     cx,cx
        les     di,Regs
        int     31h
        jc      @@9
        xor     ax,ax
    @@9:
      end;

      function DpmiRealBuf.Segment : Word;
      begin
        Segment := BufBase shr 16;
      end;

      function DpmiRealBuf.Selector : Word;
      begin
        Selector := BufBase and $FFFF;
      end;

      function DpmiRealBuf.RealPtr : Pointer;
      begin
        RealPtr := Ptr(BufBase shr 16, 0);
      end;

      function DpmiRealBuf.ProtPtr : Pointer;
      begin
        ProtPtr := Ptr(BufBase and $FFFF, 0);
      end;

      function DpmiRealBuf.Size : LongInt;
      begin
        Size := Bytes;
      end;

      constructor DpmiRealBuf.Init(BufBytes : LongInt);
      begin
        BufBase := GlobalDosAlloc(BufBytes);
        if BufBase = 0 then
          Fail;
        Bytes := BufBytes;
      end;

      destructor DpmiRealBuf.Done;
      begin
        GlobalDosFree(Selector);
      end;

    type
      DiskInfoRec =
        object
          DriveNumber : Byte;
          ClustersAvailable : Word;
          TotalClusters : Word;
          BytesPerSector : Word;
          SectorsPerCluster : Word;
          constructor Init(d : Byte);
        end;

      constructor DiskInfoRec.Init(d : Byte);
      var
        Ok : Boolean;
      begin
        DriveNumber := d; { 0 = default ; 1 = 'A' }

        asm
          mov     dl,d
          mov     ah,$36
          int     $21
          cmp     ax,$FFFF
          je      @8

          les     di,Self
          mov     es:[di].SectorsPerCluster,ax
          mov     es:[di].ClustersAvailable,bx
          mov     es:[di].BytesPerSector,cx
          mov     es:[di].TotalClusters,dx
          mov     al,True
          jmp     @9

    @8:   mov     al,False
    @9:   mov     Ok,al
        end;

        if not Ok then
          Fail;
      end;

      function DPMIReadWrite(Drive : Word;
                             FirstSect : LongInt; NumSects : Word;
                             var Buf; Vector : Byte) : Boolean;
      var
        SaveInt : Pointer;
        Status : Word;
        BufBytes : LongInt;
        DiskInfo : DiskInfoRec;
        InterimBuf : DpmiRealBuf;
        PacketBuf : DpmiRealBuf;
        Regs : DPMIRegisters;
      begin
        DosError := 0;
        DPMIReadWrite := False;

        if not DiskInfo.Init(Drive+1) then
          Exit;

        BufBytes := LongInt(NumSects)*DiskInfo.BytesPerSector;
        if BufBytes > 65535 then
          Exit;
        if not InterimBuf.Init(BufBytes) then
          Exit;

        if not PacketBuf.Init(SizeOf(PacketRec)) then begin
          InterimBuf.Done;
          Exit;
        end;

        if Vector = $26 then
          Move(Buf, InterimBuf.ProtPtr^, BufBytes);

        FillChar(Regs, SizeOf(Regs), 0);
        with PacketPtr(PacketBuf.ProtPtr)^ do begin
          StartLo := FirstSect and $FFFF;
          StartHi := FirstSect shr 16;
          Count := NumSects;
          BufOfs := 0;
          BufSeg := InterimBuf.Segment;
        end;

        GetRealModeIntVector(Vector, SaveInt); { returns real mode seg:ofs }
        with Regs do begin
          CX := $FFFF;
          AX := Drive;
          BX := 0;
          DS := PacketBuf.Segment;
          CS := LongInt(SaveInt) shr 16;
          IP := LongInt(SaveInt) and $FFFF;
        end;
        Status := CallFarRealModeProc(Regs);

        if Status = 0 then
          if Odd(Regs.Flags) then
            DosError := Regs.AX
          else begin
            if Vector = $25 then
              Move(InterimBuf.ProtPtr^, Buf, BufBytes);
            DPMIReadWrite := True;
          end;

        PacketBuf.Done;
        InterimBuf.Done;
      end;

      function DPMIReadDiskSectors(Drive : Word;
                                   FirstSect : LongInt; NumSects : Word;
                                   var Buf) : Boolean;
      begin
        DPMIReadDiskSectors := DPMIReadWrite(Drive, FirstSect, NumSects, Buf, $25);
      end;

      function DPMIWriteDiskSectors(Drive : Word;
                                    FirstSect : LongInt; NumSects : Word;
                                    var Buf) : Boolean;
      begin
        DPMIWriteDiskSectors := DPMIReadWrite(Drive, FirstSect, NumSects, Buf, $26);
      end;

    end.

[Back to DRIVES SWAG index] [Back to Main SWAG index] [Original]