如何创建自定义结构的文件?(100分)

  • 主题发起人 主题发起人 飞来石
  • 开始时间 开始时间

飞来石

Unregistered / Unconfirmed
GUEST, unregistred user!
我想建立自定义结构的文件。比如:(*.abc)文件,前3个字节用于效验(如“abc”),
第4--7字节用于读取月份和日期。请给我具体例子。100分喔!
 
找了一段以前写的代码, 参考一下吧
unit SafeQueue;

interface
uses
SysUtils, Classes, Windows, SyncObjs;

type
TTransactionMode = LongWord;

const
tmGet = $00000000;
tmPut = $00000001;
tmAll = $00000002;

type
ESafeQueueEmpty = class(Exception);
ESafeQueueFull = class(Exception);

{队列文件头格式定义, 固定长度512字节}
TSafeQueueHeader = packed record
Sign : array[0..1] of Char; //队列文件标识
Size : Integer; //队列文件长度, 不包含文件头长度
HeadPtr : Integer; //队列头指针
RearPtr : Integer; //队列尾指针
dummy : array[0..511-14] of Byte;
end;

{队列文件数据项定义}
TSafeQueueItemHeader = packed record
Sign : Char; //数据项标识
Size : Integer; //数据项长度, 不包含头长度
Priority : ShortInt; //优先级
TTL : SmallInt; //生存时间 TimeToLive
dummy : array[0..7] of Byte; //保留, 未用
end;

{队列类定义}
TSafeQueue = class(TObject)
private
FName : string;
FHandle : file;

FQueueHeader: TSafeQueueHeader;

FActive : Boolean;

FCriticalSection : TCriticalSection;

//向队列文件中写入指定长度(单位KB)的0,用于扩展队列文件长度
procedure FillWithZero(const aKBytes: DWord);
//事务提交(内部用)
procedure InnerCommit(aMode: TTransactionMode);
//事务回滚(内部用)
procedure InnerRollBack(aMode: TTransactionMode);

procedure SetActive(aActive: Boolean);
protected
procedure ReadHeader(var aHeader: TSafeQueueHeader); virtual;
procedure WriteHeader(const aHeader: TSafeQueueHeader); virtual;

procedure ReadItemHeader(var aHeader: TSafeQueueItemHeader); virtual;
procedure WriteItemHeader(const aHeader: TSafeQueueItemHeader); virtual;
procedure ReadItemData(aStream: TStream); virtual;
procedure WriteItemData(aStream: TStream); virtual;

public
constructor Create(const aName: string); virtual;
destructor Destroy; override;

procedure Open; virtual;
procedure Close; virtual;
procedure Clear; virtual;

procedure Get(aStream: TStream; AutoCommit: Boolean = True); virtual;
procedure Put(aStream: TStream; AutoCommit: Boolean = True); virtual;

procedure Commit(aMode: TTransactionMode = tmAll);
procedure RollBack(aMode: TTransactionMode = tmAll);

function isEmpty: Boolean; virtual;
function GetFreeSpace: Integer; virtual;

procedure SetLength(const aKBytes: Integer); virtual;

property Name: string read FName;
property Active: Boolean read FActive write SetActive;
end;

implementation

constructor TSafeQueue.Create(const aName: string);
begin
try
FName := aName;

FillChar(FQueueHeader, SizeOf(FQueueHeader), 0);

//创建临界区对象用于线程间同步
FCriticalSection := TCriticalSection.Create;
Assert(FCriticalSection <> nil);
except
raise;
end;
end;

destructor TSafeQueue.Destroy;
begin
Close;

//释放临界区对象
if FCriticalSection <> nil then
begin
FCriticalSection.Free;
FCriticalSection := nil;
end;

inherited Destroy;
end;

procedure TSafeQueue.ReadHeader(var aHeader: TSafeQueueHeader);
begin
try
Seek(FHandle, 0);
BlockRead(FHandle, aHeader, SizeOf(aHeader));
except
raise;
end;
end;

procedure TSafeQueue.WriteHeader(const aHeader: TSafeQueueHeader);
begin
try
Seek(FHandle, 0);
BlockWrite(FHandle, aHeader, SizeOf(aHeader));
except
raise;
end;
end;

procedure TSafeQueue.ReadItemHeader(var aHeader: TSafeQueueItemHeader);
begin
try
Seek(FHandle, FQueueHeader.HeadPtr);
BlockRead(FHandle, aHeader, SizeOf(aHeader));
except
raise;
end;
end;

procedure TSafeQueue.WriteItemHeader(const aHeader: TSafeQueueItemHeader);
begin
try
Seek(FHandle, FQueueHeader.RearPtr);
BlockWrite(FHandle, aHeader, SizeOf(aHeader));
except
raise;
end;
end;

procedure TSafeQueue.ReadItemData(aStream: TStream);
var
Header : TSafeQueueItemHeader;
Buffer : Pointer;
Count : Integer;
Offset : Integer;
nReads : Integer;
begin
try
ReadItemHeader(Header);

Count := Header.Size;
Buffer := AllocMem(Count);
try
Offset := FQueueHeader.HeadPtr + SizeOf(TSafeQueueItemHeader);

with FQueueHeader do
begin
//如果偏移已经到达文件尾部,则绕回数据区开始位置
if Offset >= SizeOf(TSafeQueueHeader) + Size then Dec(Offset, Size);
end;

Seek(FHandle, Offset);
BlockRead(FHandle, Buffer^, Count, nReads);

//数据部分读入表明已经到达文件尾, 则绕回数据区开始位置读取剩余部分数据
if nReads < Count then
begin
Count := Count - nReads;
Offset := SizeOf(TSafeQueueHeader); //文件头后面紧接着是数据区

Seek(FHandle, Offset); //跳过文件头
BlockRead(FHandle, (Pointer(Longint(Buffer)+nReads))^, Count);
end;

Assert(aStream <> nil); //断言: aStream 应为有效TStream类型参数

aStream.Seek(0, soFromBeginning);
aStream.WriteBuffer(Buffer^, Header.Size);
finally
FreeMem(Buffer);
end;
except
raise;
end
end;

procedure TSafeQueue.WriteItemData(aStream: TStream);
var
Buffer : Pointer;
Count : Integer;
Offset : Integer;
begin
try
Assert(aStream <> nil); //断言: aStream 应为有效TStream类型参数

//对齐16字节边界
Count := ((aStream.Size + 15) div 16) * 16;

Buffer:= AllocMem(Count);
try
aStream.Seek(0, soFromBeginning);
aStream.ReadBuffer(Buffer^, aStream.Size);

with FQueueHeader do
begin
Offset := RearPtr + SizeOf(TSafeQueueItemHeader);
//如果偏移指针已经到达文件尾部,则绕回数据区开始位置
if Offset >= SizeOf(TSafeQueueHeader) + Size then Dec(Offset, Size);
end;

if Offset + Count >= SizeOf(TSafeQueueHeader) + FQueueHeader.Size then
begin
//处理数据分布在文件头尾两端的情况

//写数据直到文件尾
Count := SizeOf(TSafeQueueHeader) + FQueueHeader.Size - Offset;
Seek(FHandle, Offset);
BlockWrite(FHandle, Buffer^, Count);

//绕回数据区开始位置写剩余部分数据
Offset := SizeOf(TSafeQueueHeader);
Seek(FHandle, Offset);
BlockWrite(FHandle, (Pointer(Longint(Buffer)+Count))^, aStream.Size - Count);
end
else
begin
//一般情况直接读取
Seek(FHandle, Offset);
BlockWrite(FHandle, Buffer^, Count);
end;
finally
FreeMem(Buffer);
end;
except
raise;
end;
end;

procedure TSafeQueue.Open;
var
OldFileMode : Byte;
begin
try
if FileExists(FName) then //如果队列文件存在则打开
begin
AssignFile(FHandle, FName);
OldFileMode := FileMode;
FileMode := fmShareExclusive;
Reset(FHandle, 1);
FileMode := OldFileMode;
ReadHeader(FQueueHeader);
end
else //队列文件不存在, 创建
begin
AssignFile(FHandle, FName);
Rewrite(FHandle, 1);
WriteHeader(FQueueHeader);
Self.SetLength(0); //初始化长度为0
end;

FActive := True;

except
raise;
end;
end;

procedure TSafeQueue.Close;
begin
try
//如果文件未关闭则关闭文件
if FActive then
begin
CloseFile(FHandle);
FActive := False;
end;

except
raise;
end;
end;

procedure TSafeQueue.Get(aStream: TStream; AutoCommit: Boolean = True);
var
ItemHeader: TSafeQueueItemHeader;
begin
FCriticalSection.Enter;
try
if not isEmpty then
try
ReadItemHeader(ItemHeader);
ReadItemData(aStream);

//16字节边界调整
ItemHeader.Size := ((ItemHeader.Size + 15) div 16) * 16;

with FQueueHeader do
begin
HeadPtr := HeadPtr + ItemHeader.Size + SizeOf(ItemHeader);
if HeadPtr >= SizeOf(TSafeQueueHeader) + Size then Dec(HeadPtr, Size);
end;

if AutoCommit then InnerCommit(tmGet);
except
raise;
end
else
begin
raise ESafeQueueEmpty.Create('队列空');
end;
finally
FCriticalSection.Leave;
end;
end;

procedure TSafeQueue.Put(aStream: TStream; AutoCommit: Boolean = True);
var
ItemHeader: TSafeQueueItemHeader;
begin
FCriticalSection.Enter;
try
if GetFreeSpace > aStream.Size then
try
with ItemHeader do
begin
Sign := '#';
Size := aStream.Size;
Priority := 0; //保留, 未用
TTL := 0; //保留, 未用
FillChar(dummy, SizeOf(dummy), 0);
end;

WriteItemHeader(ItemHeader);
WriteItemData(aStream);

//16字节边界调整
ItemHeader.Size := ((ItemHeader.Size + 15) div 16) * 16;

with FQueueHeader do
begin
RearPtr := RearPtr + ItemHeader.Size + SizeOf(ItemHeader);
if RearPtr > SizeOf(TSafeQueueHeader) + Size then Dec(RearPtr, Size);
end;

if AutoCommit then InnerCommit(tmPut);
except
raise;
end
else
begin
raise ESafeQueueFull.Create('队列满');
end;
finally
FCriticalSection.Leave;
end;
end;

procedure TSafeQueue.Commit(aMode: TTransactionMode = tmAll);
begin
FCriticalSection.Enter;
try
InnerCommit(aMode);
finally
FCriticalSection.Leave;
end;
end;

procedure TSafeQueue.Rollback(aMode: TTransactionMode = tmAll);
begin
FCriticalSection.Enter;
try
InnerRollback(aMode);
finally
FCriticalSection.Leave;
end;
end;

procedure TSafeQueue.SetLength(const aKBytes: Integer);
var
Header : TSafeQueueHeader;
begin
FCriticalSection.Enter;
try
try
if FQueueHeader.Size > aKBytes * 1024 then
begin
Seek(FHandle, SizeOf(TSafeQueueHeader) + aKBytes * 1024);
Truncate(FHandle); //截断文件
end
else
begin
Seek(FHandle, SizeOf(TSafeQueueHeader));
FillWithZero(aKBytes);
end;

//构造文件头, 将队列头尾指针设为相同值表示队列空
with Header do
begin
Sign := 'ZL';
Size := aKBytes * 1024;
HeadPtr := SizeOf(TSafeQueueHeader);
RearPtr := HeadPtr;
FillChar(dummy, SizeOf(dummy), 0);
end;

WriteHeader(Header);
FQueueHeader := Header;
except
raise;
end;
finally
FCriticalSection.Leave;
end;
end;

procedure TSafeQueue.Clear;
var
Header : TSafeQueueHeader;
begin
try
FCriticalSection.Enter;
try
//将队列头尾指针设为相同值表示队列空
Header := FQueueHeader;
with Header do
begin
HeadPtr := SizeOf(TSafeQueueHeader);
RearPtr := HeadPtr;
end;

WriteHeader(Header);
FQueueHeader := Header;
finally
FCriticalSection.Leave;
end;
except
raise;
end;
end;

procedure TSafeQueue.InnerCommit(aMode: TTransactionMode);
var
Header: TSafeQueueHeader;
begin
try
ReadHeader(Header);

Assert(aMode in [tmGet, tmPut, tmAll]);
case aMode of
tmGet: Header.HeadPtr := FQueueHeader.HeadPtr;
tmPut: Header.RearPtr := FQueueHeader.RearPtr;
tmAll: Header := FQueueHeader;
else
//正常不会执行到这里
end;

WriteHeader(Header);
except
raise;
end;
end;

procedure TSafeQueue.InnerRollBack(aMode: TTransactionMode);
var
Header: TSafeQueueHeader;
begin
try
//根据已提交数据恢复队列指针
ReadHeader(Header);

Assert(aMode in [tmGet, tmPut, tmAll]);
case aMode of
tmGet: FQueueHeader.HeadPtr := Header.HeadPtr;
tmPut: FQueueHeader.RearPtr := Header.RearPtr;
tmAll: FQueueHeader := Header;
else
//正常不会执行到这里
end;

except
raise;
end;
end;

function TSafeQueue.isEmpty: Boolean;
var
Header: TSafeQueueHeader;
begin
//因为可能存在未提交事务, 所以按照读已提交, 写未提交的假设来计算
ReadHeader(Header);
result := (FQueueHeader.HeadPtr = Header.RearPtr);
end;

function TSafeQueue.GetFreeSpace: Integer;
var
Header: TSafeQueueHeader;
begin
//因为可能存在未提交事务, 所以按照读未提交, 写已提交的假设来计算
ReadHeader(Header);
with FQueueHeader do
begin
if RearPtr >= Header.HeadPtr then
begin
result := Size - (RearPtr - Header.HeadPtr);
end
else
begin
//尾指针已经回绕到头部
result := Header.HeadPtr - RearPtr;
end;
end;
Dec(result, 16); //保留16字节用于区分队列满或空
end;

procedure TSafeQueue.FillWithZero(const aKBytes: DWord);
var
Buffer: array[0..1023] of Byte;
I : DWord;
begin
FillChar(Buffer, SizeOf(Buffer), 0);

try
for I := 1 to aKBytes do
begin
BlockWrite(FHandle, Buffer, SizeOf(Buffer));
end;

except
raise;
end;
end;

procedure TSafeQueue.SetActive(aActive: Boolean);
begin
if not FActive then Open;
end;

end.
 
使用流技术.
 
接受答案了.
 

Similar threads

回复
0
查看
1K
不得闲
S
回复
0
查看
3K
SUNSTONE的Delphi笔记
S
S
回复
0
查看
2K
SUNSTONE的Delphi笔记
S
后退
顶部