Delphi/CppBuilder

开发平台：
Delphi

DiskList.PAS：源码内容
							unit DiskList;
interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls,
  Dialogs;
{*****************************************
  磁盘队列说明：
  磁盘队列的前[0..511]字节作为磁盘队列的头信息区，
[0..1]为类型区、[2..5]为头指针、[6..9]为尾指针、
[10..13]为此磁盘队列文件的大小。从512开始为数据区域，
每一个数据区的前四个字节为该数据区的大小。
******************************************}
const divaccount = 100;
type
  //定义磁盘队列
  TcommQueue = class(Tcomponent)
  private
    FFilename: string; //磁盘文件名
    Ffilesize: longint; //文件的大小
    Ffrontpointer, Frearpointer: longint; //文件的前后指针
    Fscroll: char; //是否回绕
    hMutex: THandle; //互斥句柄
    Q: file;
  published
    property Filename: string read FFilename write Ffilename;
    property filesize: longint read FFilesize write Ffilesize;
    property frontpointer: longint read Ffrontpointer write Ffrontpointer;
    property rearpointer: longint read Frearpointer write Frearpointer;
  private
   //获取磁盘文件所剩空间；
    function getleftsize(var leftsize: integer): integer;
     //读取头指针信息；
    function readheadfront: integer;
    //读取尾指针信息；
    function readheadrear: integer;
    //读取文件指定的最大尺寸；
    function readFileSize: integer;
     //读取是否回绕字符值
    function readscroll: integer;
    //写入头指针信息
    function writeheadfront(const frontposition: longint): integer;
    //写入尾指针信息
    function writeheadrear(const rearposition: longint): integer;
    //写入是否回绕字符值
    function writescroll(const myscroll: char): integer;
    //写入对应的一条队列的大小;
    function writebuffersize(const position: longint; const buffersize: longint): integer;
    //从磁盘文件读出队列，保存为流
    function readStream(var aStream: TMemoryStream): integer;
    //将流写入磁盘队列
    function writeStream(aStream: TMemoryStream): integer;
    // 加一处理
    function addone(var position: longint): longint;
  public
    //打开磁盘文件；
    function Open(const Myfilename: string; const MyFileSize: longint): integer;
    //关闭队列
    procedure close;
    //判断磁盘队列是否为空;1代表True ,0代表假
    function empty: integer;
    //读取磁盘队列一条内容
    function readQueue(var buffer; var size: longint): integer;
    //向磁盘队列插入一条内容
    function writequeue(const buffer; const size: integer): integer;
    //读入对应的一条队列的大小;
    function readbuffersize(const position: longint; var buffsize: longint): longint;
  end;
implementation
//根据磁盘名得到磁盘的对应磁盘号
function GetDriveBytebyName(Filename: string): byte;
var
  xdrive: string;
  xdrivechar: char;
  xdrivebyte: byte;
begin
  if length(filename) > 0 then
  begin
    xdrive := copy(filename, 1, 1);
    xdrive := uppercase(xdrive);
    xdrivechar := xdrive[1];
    xdrivebyte := ord('A');
    result := (ord(xdrivechar) - xdrivebyte) + 1;
  end;
end;
//打开磁盘文件,并初始化文件
function TcommQueue.open(const Myfilename: string; const MyFileSize: longint): integer;
{---------
  返回值为-1   打开文件出错或写出错
          -3   磁盘空间不足
          -4  文件只读
}
var
  buffer: array[0..511] of char;
  writeaccount: integer;
  i: integer;
  drive: byte;
  diskfreesize: int64;
  xx: string;
  xxx: char;
begin
  FFilename := MyFilename;
  FFileSize := MyFileSize;
  result := 1;
  Assignfile(Q, FFilename);
  //如果文件存在，打开
  if fileexists(FFilename) then
  begin
    if fileisreadonly(Ffilename) then
    begin
      result := -4; //文件为只读
      exit;
    end;
    try
      Reset(Q, 1);
      //从磁盘队列读取磁盘队列的头、尾指针、文件大小、是否回绕。
      readheadfront;
      readheadrear;
      readFileSize;
      readscroll;
    except
      result := -1; //代表打开文件错误
    end;
  end
  else
  //不存在，创建
  begin
    try
      //判断磁盘队列
      drive := getDriveByteByName(Ffilename);
      diskfreesize := diskfree(drive);
      if diskfreesize <= FFileSize then
      begin
        result := -3; //磁盘空间不足
        exit;
      end;
      //初始化队列
      Ffrontpointer := 512;
      Frearpointer := 512;
      Fscroll := 'N';
      buffer[0] := 'A';
      buffer[1] := 'A';
      move(Ffrontpointer, buffer[2], 4);
      move(Frearpointer, buffer[6], 4);
      move(FFileSize, buffer[10], 4);
      buffer[14] := 'N';
      fillchar(buffer[15], 497, '0');
      rewrite(Q, 1);
      blockwrite(Q, buffer, 512, writeaccount);
      if writeaccount <> 512 then
      begin
        result := -1; //代表写入数据有误
        exit;
      end;
      for i := 1 to FFileSize div 512 do
      begin
        fillchar(buffer[0], 512, '0');
        blockwrite(Q, buffer, 512, writeaccount);
        if writeaccount <> 512 then
        begin
          result := -1; //代表写入数据有误
          exit;
        end;
      end;
      fillchar(buffer[0], FFileSize mod 512, '0');
      blockwrite(Q, buffer, FFileSize mod 512, writeaccount);
      if writeaccount <> FFileSize mod 512 then
      begin
        result := -1; //代表写入数据有误
      end;
    except
      result := -1;
    end;
    reset(Q, 1);
  end;
  //创建互斥句柄
  hMutex := CreateMutex(nil, false, nil);
end;
//关闭队列
procedure TcommQueue.close;
begin
  closefile(Q);
  closeHandle(hMutex);
end;
//判断磁盘队列是否为空
function TcommQueue.empty: integer;
begin
  result := 0;
  if Fscroll = 'N' then
  begin
    if Frearpointer = Ffrontpointer then
      result := 1
    else
      result := 0;
  end;
end;
//获取磁盘文件所剩空间；
function TcommQueue.getleftsize(var leftsize: longint): integer;
begin
  if Fscroll = 'N' then
  begin
    leftsize := (FFileSize - Frearpointer) + (Ffrontpointer - 512);
  end
  else
  begin
    leftsize := Ffrontpointer - frearpointer;
  end;
end;
//读取头指针
function TcommQueue.readheadfront: integer;
var
  readaccount: integer;
  buffer: array[0..3] of char;
begin
  //移动磁盘文件指针到2的位置
  seek(Q, 2);
  blockread(Q, buffer, 4, readaccount);
  move(buffer[0], Ffrontpointer, 4);
  if readaccount <> 4 then
    result := 0
  else
    result := 1
end;
//读取尾指针
function TcommQueue.readheadrear: integer;
var
  readaccount: integer;
  buffer: array[0..3] of char;
begin
  seek(Q, 6);
  blockread(Q, buffer, 4, readaccount);
  move(buffer[0], Frearpointer, 4);
  if readaccount <> 4 then
    result := 0
  else
    result := 1
end;
//读取文件指定的最大尺寸；
function TcommQueue.readFileSize: integer;
var
  readaccount: integer;
  buffer: array[0..3] of char;
begin
  seek(Q, 10);
  blockread(Q, buffer, 4, readaccount);
  move(buffer[0], FFileSize, 4);
  if readaccount <> 4 then
    result := 0
  else
    result := 1
end;
//写入头指针
function TcommQueue.writeheadfront(const frontposition: longint): integer;
var
  buffer: array[0..3] of char;
  writeaccount: integer;
begin
  move(frontposition, buffer[0], 4);
  seek(Q, 2);
  blockwrite(Q, buffer, 4, writeaccount);
  if writeaccount <> 4 then
  begin
    result := -1;
    exit;
  end
  else
    result := 1;
  Ffrontpointer := frontposition;
end;
//写入尾指针
function TcommQueue.writeheadrear(const rearposition: longint): integer;
var
  buffer: array[0..3] of char;
  writeaccount: integer;
begin
  move(rearposition, buffer[0], 4);
  seek(Q, 6);
  blockwrite(Q, buffer, 4, writeaccount);
  if writeaccount <> 4 then
  begin
    result := -1;
    exit;
  end
  else
    result := 1;
  Frearpointer := rearposition;
end;
//读取对应的一条队列的大小;
function TcommQueue.readbuffersize(const position: longint; var buffsize: longint): longint;
var
  buffer: array[0..3] of char;
  I: integer;
  readaccount: integer;
begin
  result := 1;
  seek(Q, position);
  //判断剩余大小是否大于4，如果小于4，则得分开读
  if FFileSize - position < 4 then
  begin
    for i := 0 to (FFileSize - position - 1) do
    begin
      blockread(Q, buffer[i], 1, readaccount);
      if readaccount <> 1 then
      begin
        result := -1;
        exit;
      end;
    end;
    seek(Q, 512);
    for i := (FFileSize - position) to 3 do
    begin
      blockread(Q, buffer[i], 1, readaccount);
      if readaccount <> 1 then
      begin
        result := -1;
        exit;
      end;
    end;
  end
  else
  begin
    seek(Q, position);
    blockread(Q, buffer, 4, readaccount);
    if readaccount <> 4 then
    begin
      result := -1;
      exit;
    end;
  end;
  move(buffer[0], buffsize, 4);
end;
//写入对应的一条队列的大小;
function TcommQueue.writebuffersize(const position: longint; const buffersize: longint): integer;
var
  buffer: array[0..3] of char;
  I: integer;
  writeaccount: longint;
begin
  result := -1;
  seek(Q, position);
  move(buffersize, buffer[0], 4);
  //判断剩余大小是否大于4，如果小于4，则得分开写
  if FFileSize - Frearpointer < 4 then
  begin
    for i := 0 to (FFileSize - Frearpointer - 1) do
    begin
      blockwrite(Q, buffer[i], 1, writeaccount);
      if writeaccount <> 1 then
      begin
        result := -1;
        exit;
      end;
    end;
    seek(Q, 512);
    for i := (FFileSize - Frearpointer) to 3 do
    begin
      blockwrite(Q, buffer[i], 1, writeaccount);
      if writeaccount <> 1 then
      begin
        result := -1;
        exit;
      end;
    end;
  end
  else
  begin
    blockwrite(Q, buffer, 4, writeaccount);
    if writeaccount <> 4 then
    begin
      result := -1;
      exit;
    end;
  end;
end;
//读取是否回绕字符值
function TcommQueue.readscroll: integer; //读取是否回绕字符值
var
  readaccount: integer;
begin
  result := 1;
  seek(Q, 14);
  blockread(Q, Fscroll, 1, readaccount);
  if readaccount <> 1 then
    result := -1;
end;
//写入是否回绕字符值
function TcommQueue.writescroll(const Myscroll: char): integer;
var
  writeaccount: integer;
begin
  result := 1;
  seek(Q, 14);
  blockwrite(Q, myscroll, 1, writeaccount);
  if writeaccount <> 1 then
  begin
    result := -1;
    exit;
  end;
  Fscroll := Myscroll;
end;
//从磁盘文件读出队列，保存为流
function TCommQueue.readStream(var aStream: TMemoryStream): integer;
var
  buffer: array[1..divAccount] of char;
  i: integer;
  ActReadNum: Longint;
  aleft: Longint;
  bufferSize: longint;
begin
  result := 1;
  //进入互斥，阻止其他线程访问
  if waitForSingleObject(hMutex, INFINITE) = WAIT_OBJECT_0 then
  begin
    try
      //判断底部剩余空间是否大于4,以判断是否分开读
      if fFileSize - FfrontPointer - 4 > 0 then
        aLeft := fFileSize - FfrontPointer - 4
      else
        aLeft := fFileSize - (FFrontPointer + 4 - fFileSize);
      readbuffersize(Ffrontpointer, buffersize);
      for i := 0 to buffersize div divAccount - 1 do
      begin
        if aLeft >= divAccount then
        begin
          blockRead(Q, buffer[1], divAccount, ActReadNum);
          aStream.Write(buffer[1], divAccount);
          aLeft := aLeft - divAccount;
          if ActReadNum <> DivAccount then
          begin
            Result := -1;
            exit;
          end;
        end
        else
        begin
          blockRead(Q, buffer[1], aLeft, ActReadNum);
          astream.Write(buffer[1], aLeft);
          aLeft := fFileSize - ffrontPointer;
          if ActReadNum <> aLeft then
          begin
            Result := -1;
            exit;
          end;
          Seek(Q, 512);
          blockRead(Q, buffer[1], divAccount - aLeft, ActReadNum);
          astream.write(buffer[1], divAccount - aLeft);
          aLeft := aLeft - (divAccount - aLeft);
          if ActReadNum <> divAccount - aLeft then
          begin
            Result := -1;
            exit;
          end;
        end;
      end;
    //如果还有剩余
      if bufferSize mod divAccount <> 0 then
      begin
        if aleft >= bufferSize mod divAccount then
        begin
          blockRead(Q, buffer[1], bufferSize mod divAccount, actReadNum);
          aStream.Write(buffer, bufferSize mod divAccount);
          if ActReadNum <> DivAccount then
          begin
            Result := -1;
            exit;
          end;
        end
        else
        begin
          blockRead(Q, buffer[1], aLeft, actReadNum);
          aStream.Write(buffer[1], aLeft);
          if ActReadNum <> DivAccount then
          begin
            Result := -1;
            exit;
          end;
          Seek(Q, 512);
          blockRead(Q, buffer[1], bufferSize mod divAccount - aleft, actReadNum);
          aStream.Write(buffer[1], bufferSize mod divAccount - aleft);
          if ActReadNum <> DivAccount then
          begin
            Result := -1;
            exit;
          end;
        end;
      end;
    finally
      //离开互斥状态
      releaseMutex(hMutex);
    end;
  end;
end;
//读取磁盘队列一条内容
function TcommQueue.readqueue(var buffer; var size: longint): integer;
var
  recvstream: TmemoryStream;
begin
  result := 1;
  if empty = 1 then
  begin
    result := -1; //队列已空
    exit;
  end;
  //创建接收的内存流
  recvStream := TMemoryStream.Create;
  //调用ReadStream，从磁盘队列读出一条内容
  readStream(recvStream);
  recvStream.Seek(0, 0);
  //将流写入Buffer
  recvStream.Read(Buffer, recvStream.Size);
  size := recvStream.Size;
  //指针向后移动一位
  Ffrontpointer := addone(Ffrontpointer);
  writeheadfront(Ffrontpointer);
end;
//将流写入磁盘队列
function TCommQueue.writeStream(aStream: TMemoryStream): integer;
var
  buffer: array[1..divAccount] of char;
  i: integer;
  ActWriteNum: Longint;
  aleft: Longint;
begin
  Result := 1;
  //进入互斥，阻止其他线程访问
  if waitForSingleObject(hMutex, INFINITE) = WAIT_OBJECT_0 then
  begin
    try
      //判断底部剩余空间是否大于4，以判断是否分开写
      if fFileSize - Frearpointer - 4 > 0 then
        aLeft := fFileSize - Frearpointer - 4
      else
        aLeft := fFileSize - (FrearPointer + 4 - fFileSize);
      aStream.Seek(0, 0);
      for i := 0 to aStream.Size div divAccount - 1 do
      begin
        if aLeft >= divAccount then
        begin
          aStream.Read(buffer[1], divAccount);
          blockWrite(Q, buffer[1], divAccount, ActWriteNum);
          aLeft := aLeft - divAccount;
          if ActWriteNum <> DivAccount then
          begin
            Result := -1;
            exit;
          end;
        end
        else
        begin
          astream.Read(buffer[1], aLeft);
          blockWrite(Q, buffer[1], aLeft, ActWriteNum);
          aLeft := fFileSize - ffrontPointer;
          if ActWriteNum <> aLeft then
          begin
            Result := -1;
            exit;
          end;
          Seek(Q, 512);
          astream.Read(buffer[1], divAccount - aLeft);
          blockWrite(Q, buffer[1], divAccount - aLeft, ActWriteNum);
          aLeft := aLeft - (divAccount - aLeft);
          if ActWriteNum <> divAccount - aLeft then
          begin
            Result := -1;
            exit;
          end;
        end;
      end;
    //如果还有剩余
      if aStream.Size mod divAccount <> 0 then
      begin
        if aleft >= aStream.Size mod divAccount then
        begin
          aStream.read(buffer[1], aStream.Size mod divAccount);
          blockWrite(Q, buffer[1], aStream.Size mod divAccount, actWriteNum);
          if ActWriteNum <> DivAccount then
          begin
            Result := -1;
            exit;
          end;
        end
        else
        begin
          aStream.Read(buffer[1], aLeft);
          blockWrite(Q, buffer[1], aLeft, actWriteNum);
          if ActWriteNum <> DivAccount then
          begin
            Result := -1;
            exit;
          end;
          Seek(Q, 512);
          aStream.Read(buffer[1], aStream.Size mod divAccount - aleft);
          blockWrite(Q, buffer[1], aStream.Size mod divAccount - aleft, actWriteNum);
          if ActWriteNum <> DivAccount then
          begin
            Result := -1;
            exit;
          end;
        end;
      end;
    finally
      //离开互斥
      releaseMutex(hMutex);
    end;
  end;
end;
//向磁盘队列插入一条内容
function TcommQueue.writequeue(const Buffer; const size: integer): integer;
var
  SendStream: Tmemorystream;
  leftsize: longint;
begin
  result := 1; //代表写成功
  getleftsize(leftsize);
  if leftsize < size + 4 then //判断剩余空间是否够
  begin
    result := -1; //剩余空间；
    exit;
  end;
  try
    //创建内存流
    sendStream := Tmemorystream.Create;
    //将buffer写入到流中
    sendStream.WriteBuffer(buffer, size);
    sendStream.Seek(0, sofrombeginning);
    //写入数据区大小
    WriteBufferSize(Frearpointer, size);
    //将流写入磁盘队列
    writeStream(sendStream);
    //将尾指针相后移
    Frearpointer := addone(Frearpointer);
    writeheadrear(Frearpointer);
  finally
    sendStream.Free;
  end;
end;
//将指针向下移
function TcommQueue.addone(var position: longint): longint;
var
  buffersize: longint;
  nextposition: longint;
begin
  readFileSize;
  readbuffersize(position, buffersize);
  nextposition := position + 4 + buffersize;
  if nextposition > FFileSize then
  begin
    if Fscroll = 'Y' then
      Fscroll := 'N'
    else
      Fscroll := 'Y';
    writescroll(Fscroll);
    result := (position + 4 + buffersize) mod FFileSize + 512;
  end
  else
    result := position + 4 + buffersize;
end;
end.

						