sinfilememorystream.pas

SinStream源码

unit SinFileMemoryStream;

interface

uses

  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ZLib;

type
  TFileOpenSty = (fosOpen, fosCreate);

const
  CStr: string[5] = 'TSinM';
  INVALID_VALUE = DWORD(-1);
  D_Size = SizeOf(Dword);
  C_Size = SizeOf(CStr);

type
  TSinFileStream = class(TFileStream)
  private
    procedure GetSpace(BufLen: Dword);
  public
    //.. Dword 有4G的地址空间，完全可以创造一个4G的文件出来
    //.. 我只是 Modify(0,Buf,$100000) ... 汗
    constructor Create(FOS: TFileOpenSty; const AFileName: string); overload;
    //.. 这里不设置指针，所以要提前设置。从前向后操作，结果为指针的相对移动位置
    procedure Delete(OldLen: Dword);                        //.. 删除某一区域
    procedure Modify(OldLen: Dword; const Buf; BufLen: Dword); //.. 修改某一区域
    procedure Insert(const Buf; BufLen: Dword);             //.. 增加

    function CMS(CSize: Dword): DWord;
    function DCMS(DSize: Dword): DWord;

    function InsertFromStream(SM: TStream; BufLen: Dword): Boolean;
    function ModifyFromStream(OldLen: Dword; SM: TStream; BufLen: Dword): Boolean;
  end;

type
  TSinMemoryStream = class(TMemoryStream)
  private
    procedure GetSpace(BufLen: Dword);
  public
    //..完全Copy，虽然重复了，单感觉做成类使用着更好用。。。
    procedure Delete(OldLen: Dword);                        //.. 删除某一区域
    procedure Modify(OldLen: Dword; const Buf; BufLen: Dword); //.. 修改某一区域
    procedure Insert(const Buf; BufLen: Dword);             //.. 增加

    function CMS(CSize: Dword): DWord;
    //.. 从当前位置开始压缩 ... 返回压缩后的大小
    function DCMS(DSize: Dword): DWord;
    //.. 从当前位置开始解压缩... 返回解压缩后的大小

    function InsertFromStream(SM: TStream; BufLen: Dword): Boolean;
    function ModifyFromStream(OldLen: Dword; SM: TStream; BufLen: Dword): Boolean;

  end;

implementation

{ TSinFileStream }

function CMStream(SM: TStream): TCompressionStream;
begin
  Result := TCompressionStream.Create(clDefault, SM);
end;

function DCMSTream(SM: TStream): TDecompressionStream;
begin
  Result := TDecompressionStream.Create(SM);
end;

function TSinFileStream.CMS(CSize: Dword): DWord;
var
  MMS: TMemoryStream;
  IPos: Int64;
begin
  if (CSize = 0) or (CSize > Size - Position) then begin
    Result := 0;
    Exit;
  end;
  MMS := TMemoryStream.Create;
  IPos := Position;
  try
    with CMStream(MMS) do begin
      try
        CopyFrom(Self, CSize);
      finally
        Free;
      end;
    end;
    Position := IPos;                                       //... 回来
    GetSpace(C_Size + D_Size);
    Write(CStr, C_Size);
    Write(CSize, D_Size);
    MMS.Position := 0;
    if ModifyFromStream(CSize, MMS, MMS.Size) then
      Result := MMS.Size + C_Size + D_Size
    else Result := INVALID_VALUE;
  finally
    MMS.Free;
  end;
end;

function TSinFileStream.DCMS(DSize: Dword): DWord;
var
  MMS: TMemoryStream;
  IPos: Int64;
  ICount: Dword;
  Buffer: PChar;
  MStr: string[5];
begin
  if (DSize = 0) or (DSize > Size - Position) or (DSize < C_Size + D_Size) then begin
    Result := 0;
    Exit;
  end;
  IPos := Position;
  Read(MStr, C_Size);
  Read(ICount, D_Size);
  if (MStr <> CStr) then begin
    Result := INVALID_VALUE;
    Position := IPos;
    Exit;
  end;
  MMS := TMemoryStream.Create;
  MMS.CopyFrom(Self, DSize - C_Size - D_Size);
  MMS.Position := 0;
  GetMem(Buffer, ICount);
  try
    with DCMStream(MMS) do begin
      try
        ReadBuffer(Buffer^, ICount);
      finally
        Free;
      end;
    end;
    MMS.Clear;
    MMS.Write(Buffer^, ICount);
    MMS.Position := 0;
    Position := IPos;                                       //... 回来
    if ModifyFromStream(DSize, MMS, MMS.Size) then
      Result := MMS.Size
    else Result := INVALID_VALUE;
  finally
    FreeMem(Buffer);
    MMS.Free;
  end;
end;

constructor TSinFileStream.Create(FOS: TFileOpenSty; const AFileName: string);
const
  FSty: array[0..1] of Dword = (fmOpenReadWrite, fmCreate);
begin
  inherited Create(AFileName, FSty[ord(FOS)]);
end;

procedure TSinFileStream.Delete(OldLen: Dword);
var
  tmpBuf: array[0..$10000 - 1] of Byte;
  I, L, OldPos: Int64;
begin
  if Size < OldLen + Position then begin                    //.. 删除的过长，直接SetSize即可
    Size := Position;
  end else begin                                            // ... 将后面的移动到前面... 然后 SetSize
    I := Position;
    OldPos := Position;
    repeat
      Position := I + OldLen;                               //.. 定位到后面部分
      L := Read(tmpBuf, SizeOf(tmpBuf));                    //.. 读取到Buffer中
      Position := I;                                        //.. 定位到前面部分
      Write(tmpBuf, L);                                     //.. 写入内容
      Inc(I, L);                                            //.. 移动前面部分的位置
    until L < SizeOf(tmpBuf);                               //.. 读取的小于要读取的大小说明已经读取到结尾。
    Size := Size - OldLen;                                  //.. SetSize即可。
    Position := OldPos;
  end;
end;

procedure TSinFileStream.GetSpace(BufLen: Dword);
var
  tmpBuf: array[0..$10000 - 1] of Byte;                     // 64K 大小 这里有个栈的问题..
  I, L, OldPos: Int64;
begin
  if BufLen <= 0 then Exit;                                 //.. 简单判断下了..不然估计出错
  I := Size;                                                //.. 保存原始大小
  OldPos := Position;                                       //.. 保存原始位置
  Size := Size + BufLen;                                    //.. 设置新大小..将前面的后移..倒着读取..
  repeat
    if OldPos + BufLen <= I - SizeOf(tmpBuf) then
      L := SizeOf(tmpBuf)                                   //.. 读取 tmpBuf长度
    else
      L := I - OldPos;                                      //.. 读取剩余长度
    Position := I - L;                                      //.. 定位到要读取的位置
    Read(tmpBuf, L);                                        //.. 读取   L长度
    Position := I - L + BufLen;                             //.. 定位到原来读取的位置
    Write(tmpBuf, L);                                       //.. 写入   L长度
    I := I - L + BufLen;                                    //.. 向前移动..
  until L < SizeOf(tmpBuf);                                 //.. 返回到原始位置，然后写入Buf内容...
  Position := OldPos;
end;

procedure TSinFileStream.Insert(const Buf; BufLen: Dword);
begin
  GetSpace(BufLen);
  Write(Buf, BufLen);
end;

function TSinFileStream.InsertFromStream(SM: TStream; BufLen: Dword): Boolean;
begin                                                       //.. 先定位  SM.Position 然后 BufLen应该<=SM.Size
  Result := BufLen = 0;
  if Result then Exit;                                      //.. 等于0 还有什么意义，退出..
  GetSpace(BufLen);
  SM.Position := 0;                                         //... Delete Later...
  Result := BufLen = CopyFrom(SM, BufLen);
  if not Result then Delete(BufLen);
end;

procedure TSinFileStream.Modify(OldLen: Dword; const Buf; BufLen: Dword);
begin
  if OldLen > BufLen then begin                             //..先删除差额，再写入
    Delete(OldLen - BufLen);
    write(Buf, BufLen);
  end else if OldLen < BufLen then begin                    //..先增加差额，再写入
    if Size > OldLen + Position then begin