⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 mbcache.pas

📁 刻录机源码
💻 PAS
字号:
{*******************************************************************************
  Unit        : mbCache.pas
  Date        : Jul 2001 - Nov 2002
  Author      : Ehsan Khan  
  Description :
  Copyright   : 2001-02 Binary Magic, All rights reserved.
{******************************************************************************}
unit mbCache;
{$I DEFINES.INC}
interface

uses
  Windows, SysUtils, Classes, SyncObjs, mbISOLib, mbConst, mbStreamEx;

type
  PPacket = ^TPacket;
  TPacket = record
    Data: array[0..32*2048] of char;
    Size: Integer;
  end;

  TCacheThread = class(TThread)
  private
    Index: TList;
    PostGap: Boolean;
    BootImageSize: Integer;
    CacheSize: Integer;
    IndexCapacity: Integer;
    LastBlockWas: Integer;
    fCriticalSection: TCriticalSection;
    vPriority : TThreadPriority;
    Busy1, Busy2: Boolean;
  protected
    procedure Execute; override;
    procedure On_Terminate(Sender: TObject);
  public
    Aborted,
    Finished: Boolean;
    ISOFileName: String;
    BytesAvailable: Int64;
    TotalImageSize: Int64;
    BufferSize: Int64;
    CanStart: Boolean;
    MaxPacketSize: Integer;
    FileName: String;
    Error: String;
    RemainingBytes: Int64;
    ISOHeader: TMemoryStream;
    BootImagePath: String;
    tmpbuf: array[0..32*2048] of char;
    procedure Abort;
    procedure Lock;
    procedure unLock;
    function GetFirst(Buf: PChar): Integer;
    constructor Create(Size: Integer; RootDir: PDirEntry; fISOHeader: TMemoryStream; ImageSize: Int64; BISize: Integer; bi: String; WritePostGap: Boolean; MaxPacketSize: Integer; CriticalSection: TCriticalSection);
  end;

implementation
var
  PacketSize: Integer = 32 * 2048;

{$WARNINGS OFF}

{*******************************************************************************
                                     Create
*******************************************************************************}
constructor TCacheThread.Create(Size: Integer; RootDir: PDirEntry; fISOHeader: TMemoryStream; ImageSize: Int64; BISize: Integer; bi: String; WritePostGap: Boolean; MaxPacketSize: Integer; CriticalSection: TCriticalSection);
begin

  inherited Create(True);
  Index := TList.Create;
  PacketSize := MaxPacketSize;
  IndexCapacity := Size div (PacketSize);
  CacheSize := Size;
  ISOHeader := fISOHeader;
  LastBlockWas := -1;
  Error := ERR_NONE;
  Priority := tpLower;
  vPriority := tpLower;
  CanStart := False;
  BootImageSize := BISize;
  OnTerminate := On_Terminate;
  RemainingBytes := ImageSize;
  TotalImageSize := ImageSize;
  BootImagePath := bi;
  fCriticalSection := CriticalSection;
  if (ISOFileName = '') then
  begin
    if WritePostGap and (ImageSize < 614400) then
      PostGap := True
    else
      PostGap := False;
  end;
  Resume;
end;
{*******************************************************************************
                               On termiate thread  
*******************************************************************************}
procedure TCacheThread.On_Terminate;
begin
  Index.Destroy;
end;
{*******************************************************************************
                                     Abort
*******************************************************************************}
procedure TCacheThread.Abort;
begin
  Aborted := True;
end;
{*******************************************************************************
                              Enter Critical Section
*******************************************************************************}
var
  xcount: Integer = 0;
procedure TCacheThread.Lock;
begin
  Inc(xCount);
  fCriticalSection.Enter;
end;
{*******************************************************************************
                              Leave Critical Section
*******************************************************************************}
procedure TCacheThread.Unlock;
begin
  fCriticalSection.Leave;
  Dec(xCount);
end;
{*******************************************************************************
                                 Execute thread
*******************************************************************************}
procedure TCacheThread.Execute;
var
  fs: TFileStreamEx;
  f: PFileEntry;
  bf: TFEntry;
  Packet: PPacket;
  Count, BytesToRead: Integer;
  BytesLeft: Int64;
  i: Integer;
  Position,
  FileSize: Int64;
  AvailableBytesInPacket: Integer;
  src: String;
  NoOfFiles: Integer;
label fillagain;
begin

  BytesAvailable := 0;
  Aborted := False;
  Finished := False;
  Error := ERR_NONE;  fs := nil;
  BytesLeft := ISOHeader.Size;
  ISOHeader.Seek(0, soFromBeginning);
  Position := 0; AvailableBytesInPacket := 0;
  if (ISOFileName = '') then
  begin
    NoOfFiles := FileCounter-1;
    while BytesLeft > 0 do
    begin
      if BytesLeft < PacketSize then
        BytesToRead := BytesLeft
      else
        BytesToRead := PacketSize;
      New(Packet);
      ISOHeader.Read(Packet.Data[0], BytesToRead);
      AvailableBytesInPacket := PacketSize - BytesToRead;
      if BytesToRead = PacketSize then
      begin
        Packet.Size := BytesToRead;
        Index.Add(Packet);
        Position := 0;
      end
      else
      begin
        Position := BytesToRead;
        move(Packet.Data[0], tmpbuf[0], BytesToRead);
      end;
      BytesLeft := BytesLeft - BytesToRead;
      BytesAvailable := BytesAvailable + BytesToRead;
      Count := Index.Count;
      while Count >= IndexCapacity-1 do
      begin
        CanStart := True;
        Sleep(1);
        Lock;
        Count := Index.Count;
        Unlock;
      end;

    end;

    ISOHeader.Clear;
    while Index.Count >= IndexCapacity-1 do
    begin
      CanStart := True;
      while Busy2 do
        Sleep(10);
      Busy1 := True;

      Sleep(1);
      if Aborted then
      begin
        Lock;
        while Index.Count <> 0 do
        begin
          Packet := PPacket(Index.Items[0]);
          Dispose(Packet);
          Index.Delete(0);
        end;
        if Error = ERR_NONE then
          Error := ERR_ABORTED;
        Finished := True;
        Unlock;
        Terminate;
        exit;
      end;
    end;
  end
  else
    NoOfFiles := -1;

  //*****************************************************************************************************
  for i:=-1 to NoOfFiles do
  begin
    if (i <> -1) then
    begin
      try
        f := Files[i];
      except
        Lock;
        Error := Format(ERR_5, [src]);
        Finished := True;
        Unlock;
        Terminate;
        exit;
      end;
    end
    else
    begin
      f := @bf;
      if ISOFileName = '' then
      begin

        if (BootImagePath <> '') then
        begin
          bf.Path := BootImagePath;
          bf.FileSize := BootImageSize * 2048;
          bf.Attr := 0;
        end
        else
        begin
          bf.Attr := faDirectory;
        end;
      end
      else
      begin
        f.Path := ISOFileName;
        bf.FileSize := RemainingBytes;
        bf.Attr := 0;

      end;

    end;
    begin
      src := f.Path;
      if ((f.Attr and faDirectory) <> faDirectory) and (Src <> '') and (f.FileSize <> 0) then
      begin
        FileName := src;
        if fs <> nil then fs.Destroy;
        try
          fs := TFileStreamEx.Create(src, fmOpenRead+fmShareDenyNone);
        except
          Lock;
          Error := Format(ERR_FILEINUSE, [src]);
          Finished := True;
          Unlock;
          Terminate;
          exit;
        end;
        FileSize := f.FileSize;
        BytesLeft := FileSize;
        repeat
          if AvailableBytesInPacket = 0 then
          begin
            New(Packet); Packet.Size := 0; Position := 0; AvailableBytesInPacket := PacketSize;
          end;
          if BytesLeft < AvailableBytesInPacket then
            BytesToRead := BytesLeft
          else
            BytesToRead := AvailableBytesInPacket;
          fs.Read(tmpbuf[Position], BytesToRead);
          Inc(Position, (Sectors(BytesToRead) * DefaultSectorSize));
          AvailableBytesInPacket := AvailableBytesInPacket - (Sectors(BytesToRead) * DefaultSectorSize);
          if Aborted then
          begin
            while Busy2 do
              Sleep(10);
            Busy1 := True;
            Lock;
            while Index.Count <> 0 do
            begin
              Packet := PPacket(Index.Items[0]);
              Dispose(Packet);
              Index.Delete(0);
            end;
            if Error = ERR_NONE then
              Error := ERR_ABORTED;
            Finished := True;
            fs.Destroy;
            Unlock;
            Terminate;
            exit;
          end;
          Lock; Busy1 := False; 
          if (i = FileCounter - 1) or (AvailableBytesInPacket = 0) then
          begin
            move(tmpbuf, Packet.Data[0], Position);
            Packet.Size := Position;
            Index.Add(Packet);
            Position := 0;
            //BytesAvailable := BytesAvailable + Packet.Size;
          end;
          Count := Index.Count;
          BytesAvailable := BytesAvailable + Sectors(BytesToRead) * DefaultSectorSize;
          BytesLeft := BytesLeft - BytesToRead;
          Unlock;

          if (Count < IndexCapacity div 4) and (vPriority <> tpNormal) then
          begin
            vPriority := tpNormal;
            Priority := tpNormal;
          end
          else if (Count < IndexCapacity div 2) and (vPriority <> tpLower) then
          begin
            vPriority := tpLower;
            Priority := tpLower;
          end
          else if vPriority <> tpLowest then
          begin
            vPriority := tpLowest;
            Priority := tpLowest;
          end;

          while Count >= IndexCapacity-1 do
          begin
            if vPriority <> tpIdle then
            begin
              vPriority := tpIdle;
              Priority := tpIdle;
            end;
            if Aborted then
            begin
              while Busy2 do
                Sleep(10);
              Busy1 := True;

              Lock;
              while Index.Count <> 0 do
              begin
                Packet := PPacket(Index.Items[0]);
                Dispose(Packet);
                Index.Delete(0);
              end;
              if Error = ERR_NONE then
                Error := ERR_ABORTED;
              Finished := True;
              fs.Destroy;
              Unlock;
              Busy1 := False;
              Terminate;
              exit;
            end;
            CanStart := True;
            Sleep(1);
            Lock;
            Count := Index.Count;
            Unlock;
          end;
        until (BytesLeft = 0);
      end;
    end;
  end;
  if Position <> 0 then
  begin
    move(tmpbuf, Packet.Data[0], Position);
    Packet.Size := Position;
    Index.Add(Packet);
    BytesAvailable := BytesAvailable + Position;
  end;
  if fs <> nil then
    fs.Destroy;

  if (PostGap) and (ISOFileName = '') then
  begin
    Lock;
    if TotalImageSize < 614400 then
      TotalImageSize := 614400 - TotalImageSize;
    RemainingBytes := RemainingBytes + TotalImageSize;
fillagain:
    if TotalImageSize > PacketSize then
      BytesToRead := PacketSize
    else
      BytesToRead := TotalImageSize;
    New(Packet);   //
    fillchar(Packet.Data[0], BytesToRead, $00);
    Packet.Size := BytesToRead;
    Index.Add(Packet);
    TotalImageSize := TotalImageSize - BytesToRead;
    if TotalImageSize <> 0 then goto fillagain;
    Unlock;
  end;
  CanStart := True;
  while (RemainingBytes > 0) do
  begin
    if Aborted then
    begin
      while Busy2 do
        Sleep(10);
      Busy1 := True;
      Finished := True;
      exit;
    end;
    Sleep(10);
  end;

  Finished := True;
  Sleep(1000);
end;
//******************************************************************************
function TCacheThread.GetFirst(Buf: PChar): Integer;
var
  p: PPacket;
  Count: Integer;
begin
  if (RemainingBytes = 0) and Finished then
  begin
    Result := 0;
    exit;
  end;
  Count := Index.Count;
  if Count > 0 then
  begin
    while Busy1 do
    begin
      Sleep(1);
      if Aborted then
      begin
        result := 0;
        exit;
      end;
    end;
    Lock;
    Busy2 := True;
    if Count <> 0 then
    begin
      p := PPacket(Index.Items[0]);
      result := p.Size;
      move(p.Data[0], buf[0], result);
      Dispose(p);
      Index.Delete(0);
      BytesAvailable := BytesAvailable - result;
      RemainingBytes := RemainingBytes - result;
    end
    else
    begin
      if Finished then
        Result := 0
      else
        Result := -1;
    end;
    Busy2 := False;
    Unlock;
  end
  else
  begin
    if Finished then
      result := 0
    else
      result := -1;
  end;
end;
end.


⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -