CDBufferedStream.pas
上传用户:wanyu_2000
上传日期:2021-02-21
资源大小:527k
文件大小:10k
源码类别:

DVD

开发平台:

Delphi

  1. {-----------------------------------------------------------------------------
  2.  Unit Name: CDBufferedStream
  3.  Author:    Dancemammal
  4.  Purpose:   create a buffer for the file stream, Buffered Read No buffer for write
  5.  History:   First code release
  6. -----------------------------------------------------------------------------}
  7. unit CDBufferedStream;
  8. interface
  9. uses Classes, Types, sysutils, windows, Messages;
  10. const
  11.    BufferMax = 1000; // 1000 * sectorsize = about 2 meg buffer
  12.    DefSectorSize = 2048;
  13.    HFILE_ERROR = -1;
  14.    FILE_BEGIN = 0;
  15.    FILE_CURRENT = 1;
  16.    FILE_END = 2;
  17. type
  18.    TCDBufferedStream = class
  19.    private
  20.       FBuffer: PChar;
  21.       FBufferSize: Integer;
  22.       FBufEnd: longint;
  23.       FBufPos: longint;
  24.       FBytesRead: Longint;
  25.       //BytesInMem   : LongInt;
  26.       FSize: longint;
  27.       FFileHandle: file;
  28.       FSectorSize: Integer;
  29.       FSectorCount: Integer;
  30.       ISOSizeOK: Boolean;
  31.       FBytesLeft: Integer;
  32.       FSectorsLeft: Integer;
  33.       FFileName: string;
  34.       FPosition: Int64;
  35.       FileMode: Word;
  36.       function GetSize: Int64;
  37.       function GetFilePosition: Int64;
  38.    protected
  39.       function ReadBufferFromFile: boolean;
  40.       procedure SetSectorSize(Sector: Integer);
  41.       procedure ResetBufferSize(SectorSize: integer);
  42.       function GetSectorsleft: Integer;
  43.       function SeekFile(Offset: LongInt; Origin: Word): LongInt;
  44.    public
  45.       constructor Create(const FileName: string; Mode: Word);
  46.       destructor Destroy; override;
  47.       procedure FlushBuffer;
  48.       function ReadBuffer(var Buffer; Count: longint): longint;
  49.       function Read(var Buffer; Count: longint): longint;
  50.       function WriteBuffer(const Buffer; Count: LongInt): LongInt;
  51.       function Write(const Buffer; Count: longint): longint;
  52.       function CopyFrom(Source: TStream; Count: Int64): Int64;
  53.       function Seek(Offset: longint; Origin: word): longint;
  54.       function BufferPercentFull: Integer;
  55.       property Position: int64 read GetFilePosition;
  56.       property Size: int64 read GetSize;
  57.       property SectorCount: integer read FSectorCount;
  58.       property SectorSize: integer write SetSectorSize;
  59.       property SectorsLeft: integer read GetSectorsleft;
  60.       property BytesLeft: integer read FBytesLeft;
  61.       property ISOSectorSizeOK: Boolean read ISOSizeOK;
  62.    end;
  63. implementation
  64. function GetFileSize(const FileName: string): LongInt;
  65. var
  66.   SearchRec: TSearchRec;
  67. begin
  68.   try
  69.     if FindFirst(ExpandFileName(FileName), faAnyFile, SearchRec) = 0 then
  70.     begin
  71.       Result := SearchRec.Size;
  72.     end
  73.     else
  74.       Result := -1;
  75.   finally
  76.     SysUtils.FindClose(SearchRec);
  77.   end;
  78. end;
  79. function TCDBufferedStream.GetSize: Int64;
  80. begin
  81.    if (FSize = 0) and FileExists(FFileName) then
  82.       FSize := GetFileSize(FFilename);
  83.    result := FSize;
  84. end;
  85. function TCDBufferedStream.GetFilePosition: Int64;
  86. begin
  87.    FPosition := (FilePos(FFileHandle) - FBufEnd) + FBufPos; //Result := PositionOfFile - End of Buffer + PositionOfBuffer
  88.    Result := FPosition;
  89. end;
  90. procedure TCDBufferedStream.ResetBufferSize(SectorSize: integer);
  91. begin
  92.    if (FBuffer <> nil) then FreeMem(FBuffer, FBufferSize);
  93.    FBufferSize := (BufferMax * SectorSize) - 1;
  94.    GetMem(FBuffer, FBufferSize);
  95.    FillChar(FBuffer^, FBufferSize, 0);
  96. end;
  97. {
  98. fmCreate Create a file with the given name. If a file with the given name exists, open the file in write mode.
  99. fmOpenRead Open the file for reading only.
  100. fmOpenWrite Open the file for writing only. Writing to the file completely replaces the current contents.
  101. fmOpenReadWrite Open the file to modify the current contents rather than replace them.
  102. }
  103. constructor TCDBufferedStream.Create(const FileName: string; Mode: Word);
  104. begin
  105.    AssignFile(FFileHandle, Filename);
  106.    if ((Mode = fmOpenRead) or (Mode = fmOpenReadWrite)) and FileExists(Filename) then
  107.       Reset(FFileHandle, 1)
  108.    else
  109.       if ((Mode = fmOpenWrite) or (Mode = fmCreate)) and (not FileExists(Filename)) then
  110.          ReWrite(FFileHandle, 1)
  111.       else //error --> readonly and not fileexists
  112.          raise Exception.Create('Could not open file.');
  113.    FileMode := Mode;
  114.    ResetBufferSize(DefSectorSize); // align buffer to sector size
  115.    FFileName := FileName;
  116.    ISOSizeOK := False;
  117.    FPosition := 0;
  118.    FSize := 0;
  119.    FBytesLeft := Size;
  120. end;
  121. destructor TCDBufferedStream.Destroy;
  122. begin
  123.    if (FileMode <> fmOpenRead) then FlushBuffer;
  124.    CloseFile(FFileHandle);
  125.    if (FBuffer <> nil) then FreeMem(FBuffer, FBufferSize);
  126. end;
  127. procedure TCDBufferedStream.SetSectorSize(Sector: Integer);
  128. begin
  129.    FSectorSize := Sector;
  130.    ResetBufferSize(FSectorSize); // reset buff to align to new sector size
  131.    FSectorCount := (Size div FSectorSize);
  132.   {work out if ISO image is the right size}
  133.    ISOSizeOK := (Size mod FSectorSize) = 0;
  134.    FSectorsLeft := FSectorCount;
  135. end;
  136. function TCDBufferedStream.GetSectorsleft: Integer;
  137. var
  138.    BytesToGo: Integer;
  139. begin
  140.    BytesToGo := (size - Position);
  141.    FSectorsLeft := (BytesToGo div FSectorSize);
  142.    FBytesLeft := BytesToGo;
  143.    Result := FSectorsLeft;
  144. end;
  145. function TCDBufferedStream.BufferPercentFull: Integer;
  146. var
  147.    Percent, Divisor: Integer;
  148. begin
  149.    Divisor := (FBufferSize div 100);
  150.    Percent := ((FBufferSize - FBufPos) div Divisor);
  151.    if (Percent < 0) then Percent := 0;
  152.    if (Percent > 100) then Percent := 100;
  153.    Result := Percent;
  154. end;
  155. procedure TCDBufferedStream.FlushBuffer;
  156. begin
  157.    if FBufPos > 0 then //if there's anyting in the buffer lets clean it
  158.       BlockWrite(FFileHandle, FBuffer^, FBufPos);
  159.    FBufPos := 0;
  160.    FBytesRead := 0;
  161. end;
  162. function TCDBufferedStream.ReadBufferFromFile: boolean;
  163. begin
  164.   {read the next bufferful from the stream}
  165.    BlockRead(FFileHandle, FBuffer^, FBufferSize, FBufEnd);
  166.    FBufPos := 0;
  167.   {return true if at least one byte read, false otherwise}
  168.    Result := FBufEnd <> FBufPos;
  169. end;
  170. function TCDBufferedStream.ReadBuffer(var Buffer; Count: longint): longint;
  171. var
  172.    UserBuf: PChar;
  173.    BytesToGo: longint;
  174.    BytesToRead: longint;
  175. begin
  176.    UserBuf := @Buffer; {reference the buffer as a PChar}
  177.    Result := 0; {start the counter for the number of bytes read}
  178.    if (FBufPos = FBufEnd) then {if needed, fill internal buffer from underlying stream}
  179.       if not ReadBufferFromFile then Exit;
  180.    BytesToGo := Count; {calculate number of bytes to copy from internal buffer}
  181.    BytesToRead := FBufEnd - FBufPos;
  182.    if (BytesToRead > BytesToGo) then BytesToRead := BytesToGo;
  183.    Move(FBuffer[FBufPos], UserBuf^, BytesToRead); {copy bytes from internal buffer to user buffer}
  184.    inc(FBufPos, BytesToRead); {adjust the counters}
  185.    dec(BytesToGo, BytesToRead);
  186.    inc(Result, BytesToRead);
  187.    while (BytesToGo <> 0) do
  188.    begin {while there are more bytes to copy, do so}
  189.       inc(UserBuf, BytesToRead);
  190.       if not ReadBufferFromFile then Exit; {fill the internal buffer from the underlying stream}
  191.       BytesToRead := FBufEnd - FBufPos; {calculate number of bytes to copy from internal buffer}
  192.       if (BytesToRead > BytesToGo) then BytesToRead := BytesToGo;
  193.       Move(FBuffer^, UserBuf^, BytesToRead); {copy bytes from internal buffer to user buffer}
  194.       inc(FBufPos, BytesToRead);
  195.       dec(BytesToGo, BytesToRead);
  196.       inc(Result, BytesToRead);
  197.    end;
  198. end;
  199. function TCDBufferedStream.Read(var Buffer; Count: longint): longint;
  200. begin
  201.    Result := ReadBuffer(Buffer, Count);
  202. end;
  203. function TCDBufferedStream.SeekFile(Offset: LongInt; Origin: Word): LongInt;
  204. var
  205.    StartPosition, FinishPosition: Longint;
  206. begin
  207.    StartPosition := Position;
  208.    case Origin of
  209.       soFromCurrent: StartPosition := Position;
  210.       soFromEnd: StartPosition := FileSize(FFileHandle); { get file size }
  211.       soFromBeginning: StartPosition := 0;
  212.    end;
  213.    Result := Position; //just in case the user wants a offset that doesnt exist we stay where we are
  214.      //FlushBuffer;
  215.    FinishPosition := StartPosition + Offset;
  216.    if FinishPosition > FileSize(FFileHandle) then exit; //if the user wants to go to a aofsset that doesn't exist get out
  217.    System.Seek(FFileHandle, FinishPosition);
  218.    ReadBufferFromFile;
  219.    Result := FinishPosition;
  220. end;
  221. function TCDBufferedStream.WriteBuffer(const Buffer; Count: LongInt): LongInt;
  222. var
  223.    BytesWritten: longint;
  224.    UserBuf: PChar;
  225. begin
  226.    UserBuf := @Buffer; {reference the buffer as a PChar}
  227.    BlockWrite(FFileHandle, UserBuf^, Count, BytesWritten);
  228.    Result := BytesWritten;
  229. end;
  230. function TCDBufferedStream.Write(const Buffer; Count: LongInt): LongInt;
  231. begin
  232.    Result := WriteBuffer(Buffer, Count);
  233. end;
  234. function TCDBufferedStream.Seek(Offset: longint; Origin: word): longint;
  235. begin
  236.    Result := SeekFile(Offset, Origin);
  237. end;
  238. function TCDBufferedStream.CopyFrom(Source: TStream; Count: Int64): Int64;
  239. const
  240.    MaxBufferSize = 1024; // 1 meg buffer
  241. var
  242.    BytesWritten,BufWrite: longint;
  243.    UserBuf: PChar;
  244.    BufferCount: Integer;
  245. begin
  246.     GetMem(Userbuf, MaxBufferSize);
  247.     FillChar(Userbuf^, MaxBufferSize, 0);
  248.    try
  249.       BufferCount := MaxBufferSize;
  250.       BytesWritten := 0;
  251.       BufWrite := 0;
  252.       if BufferCount > Count then BufferCount := Count;
  253.       repeat
  254.          if ((BytesWritten + BufferCount) > Count) then
  255.                   BufferCount := (Count - (BytesWritten));
  256.          Source.Read(UserBuf^, BufferCount);
  257.          BlockWrite(FFileHandle, UserBuf^, BufferCount, BufWrite);
  258.          inc(BytesWritten,BufWrite);
  259.       until (BytesWritten >= Count);
  260.    finally
  261.       FreeMem(Userbuf);
  262.    end;
  263.    Result := BytesWritten;
  264. end;
  265. end.