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的地址空間，完全可以創(chuàng)造一個4G的文件出來
    //.. 我只是 Modify(0,Buf,$100000) ... 汗
    constructor Create(FOS: TFileOpenSty; const AFileName: string); overload;
    //.. 這里不設(shè)置指針，所以要提前設(shè)置。從前向后操作，結(jié)果為指針的相對移動位置
    procedure Delete(OldLen: Dword);                        //.. 刪除某一區(qū)域
    procedure Modify(OldLen: Dword; const Buf; BufLen: Dword); //.. 修改某一區(qū)域
    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，雖然重復(fù)了，單感覺做成類使用著更好用。。。
    procedure Delete(OldLen: Dword);                        //.. 刪除某一區(qū)域
    procedure Modify(OldLen: Dword; const Buf; BufLen: Dword); //.. 修改某一區(qū)域
    procedure Insert(const Buf; BufLen: Dword);             //.. 增加

    function CMS(CSize: Dword): DWord;
    //.. 從當(dāng)前位置開始壓縮 ... 返回壓縮后的大小
    function DCMS(DSize: Dword): DWord;
    //.. 從當(dāng)前位置開始解壓縮... 返回解壓縮后的大小

    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);                                     //.. 寫入內(nèi)容
      Inc(I, L);                                            //.. 移動前面部分的位置
    until L < SizeOf(tmpBuf);                               //.. 讀取的小于要讀取的大小說明已經(jīng)讀取到結(jié)尾。
    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;                                    //.. 設(shè)置新大小..將前面的后移..倒著讀取..
  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內(nèi)容...
  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應(yīng)該<=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