呵呵.冰力不足笑话我.
我是个业余玩票的.
to zuoc
不好意思,我仔细的看了一下,是我的那类有问题.当时反复修改,版本多到自己都晕了,结果发出来的竟然是有问题的.
下面的这个是我从硬盘里找的,带DEMO.如果需要DEMO,留个妹儿,我发给你.要说明的是,有个MyUnit的单元是坏的,因为D盘曾不小心被格了,用恢复工具恢复后,这个单元损坏了.好在它的dcu没问题,照样可以编译.
------------------------------------------------------------------------------
//------------------------------------------------------------------------------
//功 能：将若干个流合并成一个流，可以对其进行读出添加删除操作以及输出为文件
// 或流。
//作 者：iseek
//开始时间：2005.07.25
//最后修改：2005.07.30
//E-mail : iatgog@gmail.com
//------------------------------------------------------------------------------
unit StreamPack;
interface
uses classes, Sysutils, windows, Gauges, Dialogs;
type
TFileHead = record
FileMark: array[0..5] of char;
StreamLen: longint;
StreamNum: word;
end;
PDataHead = ^TDataHead;
TDataHead = record
DataName: array[0..39] of char;
DataType: array[0..7] of char;
DataPass: array[0..7] of char;
DataSize: longint;
DataPos: longint;
end;
TStreamPack = class
private
FDataList: TList;
FFileHead: TFileHead;
FDataHead: TDataHead;
FStream: TMemoryStream;
FFileName: string
//文件名
FStreamName: string
//流名
FValidSize: longint;
FTempName: string
//临时文件名
FTempIndex: string
//临时索引名
FModified: boolean;
FFHModified: boolean
//文件头变动标志
FTempData: boolean;
FTempDataHead: boolean;
procedure SetModified(Value: boolean);
procedure SetStreamName(Value: string);
function GetValidSize: longint;
function LoadList: boolean;
procedure BindList(ds: TMemoryStream);
procedure SaveFileHead;
procedure SaveListToStream(ms: TMemoryStream);
procedure ClearList;
procedure ChangeDataPos(idx: integer);
procedure StreamDelete(AStream: TStream
Index: Longint
Count: Longint);
public
property FileHead: TFileHead read FFileHead write FFileHead;
property DataHead: TDataHead read FDataHead write FDataHead;
property DataList: TList read FDataList;
property FileName: string read FFileName;
property Modified: boolean read FModified write SetModified default false;
property StreamName: string read FStreamName write SetStreamName;
property ValidSize: longint read GetValidSize default 0;
constructor Create;
destructor Destroy
override;
procedure CreateStreamPack(const fn: string
OnlyStream: boolean);
procedure Clear;
function LoadFromFile(const fn: string): boolean;
function LoadFromStream(ms: TMemoryStream
dn: string): boolean;
procedure Save;
procedure SaveToFile(const fn: string);
procedure SaveToStream(ms: TMemoryStream);
procedure TempSaveData;
procedure TempSaveHead;
function ReadAData(idx: integer
ds: TMemoryStream): boolean;
procedure DeleteAData(idx: integer);
procedure DelADataAtOnce(idx: integer);
function AddAData(const ID, Ext: string
src: TMemoryStream): boolean;
procedure ReNameAData(idx: integer
NewID: string);
function IDExists(ID: string): integer;
procedure CompressData(g: TGauge);
procedure SetStreamSize(size: longint);
function ItemsStrForOuter: string;
procedure ExportAllItems(g: TGauge
path: string);
procedure SaveListToFile(fn: string);
end;
implementation
const
iExt = '.pac';
sLoadError = '不正确的文件格式或文件已损坏。';
sDefaultPS = 'wuping';
function TStreamPack.AddAData(const ID, Ext: string
src: TMemoryStream): boolean;
var pd: PDataHead;
sz: longint;
num: word;
begin
Result := true;
try
New(pd);
StrPCopy(pd^.DataName, ID);
StrPCopy(pd^.DataType, Ext);
pd^.DataPass[0] := #0;
pd^.DataSize := src.Size;
pd^.DataPos := FStream.Size;
FDataList.Add(pd);
if FTempData then
begin
FStream.LoadFromFile(FTempName);
FTempData := false;
end;
FStream.Seek(0, soFromEnd);
FStream.CopyFrom(src, 0);
sz := FFileHead.StreamLen;
sz := sz + src.Size;
FFileHead.StreamLen := sz;
num := FFileHead.StreamNum;
inc(num);
FFileHead.StreamNum := num;
FModified := true;
FFHModified := true;
except
Result := false;
end;
end;
procedure TStreamPack.BindList(ds: TMemoryStream);
var ms: TMemoryStream;
begin
SaveFileHead;
ms := TMemoryStream.Create;
try
SaveListToStream(ms);
ds.SetSize(FStream.Size + ms.Size);
ds.CopyFrom(FStream, 0);
//ds.Seek(0,soFromEnd);
ds.CopyFrom(ms, 0);
finally
ms.Free;
end;
end;
procedure TStreamPack.Clear;
begin
if (FModified) or (FFHModified) then Save;
FFileName := '';
FStreamName := '';
FModified := false;
FFHModified := false;
FTempData := false;
FTempDataHead := false;
if FileExists(FTempName) then DeleteFile(PChar(FTempName));
FTempName := '';
if FileExists(FTempIndex) then DeleteFile(PChar(FTempIndex));
FTempIndex := '';
ClearList;
FFileHead.StreamLen := 0;
FFileHead.StreamNum := 0;
end;
procedure TStreamPack.CompressData(g: TGauge);
var pd: PDataHead;
i: integer;
size: longint;
ms: TMemoryStream;
begin
if FDataList.Count = 0 then exit;
if FFileHead.StreamNum = FDataList.Count then exit;
if FTempData then
begin
FStream.LoadFromFile(FTempName);
FTempData := false;
end;
g.MinValue := 0;
g.MaxValue := FDataList.Count - 1;
ms := TMemoryStream.Create;
try
FFileHead.StreamLen := SizeOf(TFileHead) + FValidSize;
FFileHead.StreamNum := FDataList.Count;
ms.SetSize(FValidSize);
for i := 0 to FDataList.Count - 1 do
begin
g.Progress := i;
pd := FDataList.Items;
FStream.Position := pd^.DataPos;
ms.CopyFrom(FStream, pd^.DataSize);
end;
ChangeDataPos(0);
FStream.Clear;
FStream.SetSize(SizeOf(TFileHead) + ms.Size + SizeOf(TDataHead) * FDataList.Count);
FStream.Position := 0;
FStream.Write(FFileHead, SizeOf(TFileHead));
FStream.CopyFrom(ms, 0);
size := FStream.Size;
ms.Clear;
SaveListToStream(ms);
if FFileName <> '' then
begin
FStream.CopyFrom(ms, 0);
FStream.SaveToFile(FFileName);
FStream.SetSize(size);
FModified := false;
FFHModified := false;
end else
begin
FModified := true;
FFHModified := true;
end;
finally
ms.Free;
end;
end;
constructor TStreamPack.Create;
begin
inherited Create;
FStream := TMemoryStream.Create;
FDataList := TList.create;
FTempData := false;
FTempDataHead := false;
FFHModified := false;
end;
procedure TStreamPack.CreateStreamPack(const fn: string
OnlyStream: boolean);
begin
if FDataList.Count > 0 then clear;
StrPCopy(FFileHead.FileMark, sDefaultPS);
FFileHead.StreamLen := SizeOf(TFileHead);
FFileHead.StreamNum := 0;
FStream.Write(FFileHead, SizeOf(TFileHead));
if not OnlyStream then
begin
FStream.SaveToFile(fn);
FFileName := fn;
end;
end;
procedure TStreamPack.DeleteAData(idx: integer);
var pd: PDataHead;
begin
pd := FDataList.Items[idx];
Dispose(pd);
FDataList.Delete(idx);
FModified := true;
end;
destructor TStreamPack.Destroy;
begin
Clear;
FDataList.Free;
FStream.Free;
inherited;
end;
procedure TStreamPack.ExportAllItems(g: TGauge
path: string);
var i: integer;
pd: PDataHead;
fn: string;
ms: TMemoryStream;
begin
if FDataList.Count = 0 then exit;
g.MinValue := 0;
g.MaxValue := FDataList.Count - 1;
ms := TMemoryStream.Create;
try
for i := 0 to FDataList.Count - 1 do
begin
g.Progress := i;
pd := FDataList.Items;
fn := path + pd^.DataName + pd^.DataType;
FStream.Seek(pd^.DataPos, soFromBeginning);
ms.CopyFrom(FStream, pd^.DataSize);
ms.SaveToFile(fn);
ms.Clear;
end;
finally
ms.Free;
end;
end;
function TStreamPack.GetValidSize: longint;
var i: integer;
pd: PDataHead;
begin
Result := 0;
if FDataList.Count = 0 then exit;
for i := 0 to FDataList.Count - 1 do
begin
pd := FDataList.Items;
Result := Result + pd^.DataSize;
end;
end;
function TStreamPack.IDExists(ID: string): integer;
var i: integer;
pd: PDataHead;
begin
Result := -1;
if FDataList.Count = 0 then exit;
for i := 0 to FDataList.Count - 1 do
begin
pd := FDataList.Items;
if pd^.DataName = ID then
begin
Result := i;
break;
end;
end;
end;
function TStreamPack.ItemsStrForOuter: string;
var i, count: integer;
pd: PDataHead;
begin
count := FDataList.Count;
if count = 0 then exit;
for i := 0 to count - 1 do
begin
pd := FDataList.Items;
Result := Result + pd^.DataName;
if i < count - 1 then Result := Result + #13#10;
end;
end;
function TStreamPack.LoadFromFile(const fn: string): boolean;
begin
Result := false;
if not FileExists(fn) then exit;
if FDataList.Count > 0 then clear;
FStream.LoadFromFile(fn);
if LoadList then
begin
FFileName := fn;
Result := true;
end;
end;
function TStreamPack.LoadFromStream(ms: TMemoryStream;
dn: string): boolean;
begin
Result := false;
if assigned(ms) then
begin
if FDataList.Count > 0 then clear;
FStream.LoadFromStream(ms);
if LoadList then
begin
FStreamName := dn;
Result := true;
end;
end;
end;
function TStreamPack.LoadList: boolean;
var pd: PDataHead;
i: integer;
count: word;
size: longint;
ds: TMemoryStream;
begin
Result := true;
try
FStream.Seek(0, soFromBeginning);
FStream.Read(FFileHead, SizeOf(TFileHead));
if FFileHead.StreamLen = SizeOf(TFileHead) then exit;
FStream.Seek(-SizeOf(size), soFromEnd);
Fstream.Read(size, SizeOf(size));
FStream.Seek(-(size + SizeOf(size)), soFromEnd);
ds := TMemoryStream.Create;
try
ds.CopyFrom(FStream, size);
ds.Seek(0, soFromBeginning);
ds.Read(count, SizeOf(count));
FDataList.Count := count;
for i := 0 to count - 1 do
begin
New(pd);
ds.Read(pd^, SizeOf(TDataHead));
FDataList.Items := pd;
end;
FStream.SetSize(FStream.Size - size - SizeOf(size));
finally
ds.Free;
end;
except
Result := false;
ShowMessage(sLoadError);
end;
end;
function TStreamPack.ReadAData(idx: integer
ds: TMemoryStream): boolean;
var pd: PDataHead;
begin
Result := true;
if FDataList.Count = 0 then exit;
pd := FDataList.Items[idx];
if FTempData then FStream.LoadFromFile(FTempName);
FStream.Position := pd^.DataPos;
ds.CopyFrom(FStream, pd^.DataSize);
end;
procedure TStreamPack.ReNameAData(idx: integer
NewID: string);
var pd: PDataHead;
begin
if FDataList.Count = 0 then exit;
pd := FDataList.Items[idx];
StrPCopy(pd^.DataName, NewID);
FModified := true;
end;
procedure TStreamPack.Save;
var ms: TMemoryStream;
begin
if FFileName = '' then exit;
ms := TMemoryStream.Create;
try
BindList(ms);
ms.SaveToFile(FFileName);
FModified := false;
FFHModified := false;
finally
ms.Free;
end;
end;
procedure TStreamPack.SaveToFile(const fn: string);
var ms: TMemoryStream;
begin
if FDataList.Count = 0 then exit;
ms := TMemoryStream.Create;
try
BindList(ms);
ms.SaveToFile(fn);
FModified := false;
FFHModified := false;
finally
ms.Free;
end;
end;
procedure TStreamPack.SaveToStream(ms: TMemoryStream);
begin
if FDataList.Count = 0 then exit;
BindList(ms);
ms.Position := 0;
end;
procedure TStreamPack.SetModified(Value: boolean);
begin
FModified := Value;
end;
procedure TStreamPack.SetStreamName(Value: string);
begin
FStreamName := Value;
end;
procedure TStreamPack.TempSaveData;
begin
if FStream.Size > SizeOf(TFileHead) then
begin
FStream.SaveToFile(FTempName);
FTempData := true;
FStream.Clear;
end;
end;
procedure TStreamPack.SaveListToStream(ms: TMemoryStream);
var i: integer;
n: word;
size: longint;
begin
n := FDataList.Count;
ms.Write(n, SizeOf(word));
for i := 0 to FDataList.Count - 1 do
ms.Write(PDataHead(FDataList.Items)^, SizeOf(TDataHead));
size := ms.Size;
ms.Write(size, SizeOf(size));
end;
procedure TStreamPack.TempSaveHead;
var ms: TMemoryStream;
begin
if FDataList.Count = 0 then exit;
ms := TMemoryStream.Create;
try
SaveListToStream(ms);
ms.SaveToFile(FTempIndex);
finally
ms.Free;
end;
end;
procedure TStreamPack.SaveFileHead;
begin
if FFHModified then
begin
FStream.Seek(0, soFromBeginning);
FStream.Write(FFileHead, SizeOf(TFileHead));
end;
end;
procedure TStreamPack.ClearList;
var pd: PDataHead;
i: integer;
begin
if FDataList.Count = 0 then exit;
for i := 0 to FDataList.Count - 1 do
begin
pd := FDataList.Items;
Dispose(pd);
end;
FDataList.Clear;
end;
procedure TStreamPack.SaveListToFile(fn: string);
var i: integer;
pd: PDataHead;
ts: TStringList;
begin
if FDataList.Count = 0 then exit;
ts := TStringList.Create;
try
for i := 0 to FDataList.Count - 1 do
begin
ts.Add('Data' + inttostr(i));
pd := FDataList.Items;
ts.Add('DataName:' + string(pd^.DataName));
ts.Add('DataExt:' + string(pd^.DataType));
ts.Add('DataPass:' + string(pd^.DataPass));
ts.Add('DataSize:' + inttostr(pd^.DataSize));
ts.Add('DataPos:' + inttostr(pd^.DataPos));
ts.Add('');
end;
ts.SaveToFile(fn);
finally
ts.Free;
end;
end;
procedure TStreamPack.ChangeDataPos(idx: integer);
var i: integer;
ipos: longint;
pd: PDataHead;
begin
if idx = 0 then ipos := SizeOf(TFileHead) else
begin
pd := FDataList.Items[idx - 1];
ipos := pd^.DataPos + pd^.DataSize;
end;
for i := idx to FDataList.Count - 1 do
begin
pd := FDataList.Items;
pd^.DataPos := ipos;
FDataList.Items := pd;
ipos := ipos + pd^.DataSize;
end;
end;
procedure TStreamPack.SetStreamSize(size: longint);
begin
FStream.SetSize(FValidSize + size);
end;
procedure TStreamPack.StreamDelete(AStream: TStream
Index, Count: Longint);
var
SavedPos: Longint;
ASize: Longint;
BufferStream: TMemoryStream;
begin
if not Assigned(AStream) then
exit;
ASize := AStream.Size;
if (Index >= ASize) or (Count = 0) then
exit;
if (Index + Count) >= ASize then
begin
AStream.Size := Index;
exit;
end
else begin
SavedPos := AStream.Position;
try
AStream.Seek(Index + Count, soFromBeginning);
BufferStream := TMemoryStream.Create;
try
ASize := ASize - (Index + Count);
BufferStream.SetSize(ASize);
BufferStream.Seek(0, soFromBeginning);
BufferStream.CopyFrom(AStream, ASize);
AStream.Size := Index + ASize;
AStream.Seek(Index, soFromBeginning);
AStream.Write(BufferStream.Memory^, ASize);
finally
BufferStream.Free;
end;
finally
AStream.Position := SavedPos;
end;
end;
end;
procedure TStreamPack.DelADataAtOnce(idx: integer);
var pd: PDataHead;
begin
pd := FDataList.Items[idx];
StreamDelete(FStream, pd^.DataPos, pd^.DataSize);
Dispose(pd);
FDataList.Delete(idx);
ChangeDataPos(idx);
FModified := true;
end;
