disklist.pas

《delphi深度编程及其项目开发》

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;