sst2.pas

一个经典的读写Excel的控件

function TSST2.Delete(Value: PXLSString): boolean;
var
  i: integer;
  pFnt: PFontRun;
begin
  Dec(Value.RefCount);
  Result := PXLSString(FSST[Value.Index]).RefCount <= 0;
  if Result then begin
    if Value.Options in [STRID_RICH,STRID_RICH_UNICODE,STRID_FAREAST_RICH,STRID_FAREAST_RICH_UC] then begin
      for i := 0 to GetFormatCount(Value) - 1 do begin
        pFnt := GetFont(Value,i);
        if pFnt.Font.Index >= FFonts.DeleteIndex then begin
          pFnt.Font.UsageCount := pFnt.Font.UsageCount - 1;
          if pFnt.Font.UsageCount <= 0 then
            FFonts.Delete(pFnt.Font.Index);
        end;
      end;
    end;
    if not FIsUpdating then begin
      for i := Value.Index + 1 to FSST.Count - 1 do
        PXLSString(FSST[i]).Index := i - 1;
    end;
    i := Value.Index;
    FreeMem(FSST[i]);
    FSST.Delete(i);
    Dec(FTotalCount);
  end;
end;

function TSST2.GetFont(Value: PXLSString; FormatIndex: integer): PFontRun;
begin
  case Value.Options of
    STRID_RICH:            Result := PFontRun(Integer(@PXLSStringRich(Value).Data) +
                                     PXLSStringRich(Value).Len +
                                     FormatIndex * SizeOf(TFontRun));
    STRID_RICH_UNICODE:    Result := PFontRun(Integer(@PXLSStringRichUC(Value).Data) +
                                     PXLSStringRichUC(Value).Len * 2 +
                                     FormatIndex * SizeOf(TFontRun));
    STRID_FAREAST_RICH:    Result := PFontRun(Integer(@PXLSStringFarEastRich(Value).Data) +
                                     PXLSStringFarEastRich(Value).Len * 2 +
                                     FormatIndex * SizeOf(TFontRun));
    STRID_FAREAST_RICH_UC: Result := PFontRun(Integer(@PXLSStringFarEastRichUC(Value).Data) +
                                     PXLSStringFarEastRichUC(Value).Len * 2 +
                                     FormatIndex * SizeOf(TFontRun));
    else
      raise Exception.Create('String is not formatted');
  end;
  if FormatIndex >= PXLSStringRich(Value).FormatCount then
    raise Exception.Create('FormatIndedx out of range');
end;

function TSST2.GetFormatCount(Value: PXLSString): integer;
begin
  if (Value.Options and $08) = $08 then
    Result := PXLSStringRich(Value).FormatCount
  else
    Result := 0;
end;

function TSST2.GetIsFormatted(Value: PXLSString): boolean;
begin
  Result := (Value.Options and $08) = $08;
end;

function TSST2.GetDataPointer(Value: PXLSString): PByteArray;
begin
  case Value.Options of
    STRID_COMPRESSED     : Result := @PXLSString(Value).Data;
    STRID_UNICODE        : Result := @PXLSStringUC(Value).Data;
    STRID_RICH           : Result := @PXLSStringRich(Value).Data;
    STRID_RICH_UNICODE   : Result := @PXLSStringRichUC(Value).Data;
    STRID_FAREAST        : Result := @PXLSStringFarEast(Value).Data;
    STRID_FAREAST_UC     : Result := @PXLSStringFarEastUC(Value).Data;
    STRID_FAREAST_RICH   : Result := @PXLSStringFarEastRich(Value).Data;
    STRID_FAREAST_RICH_UC: Result := @PXLSStringFarEastRichUC(Value).Data;
    else
      raise Exception.Create('STT: Unhandled string type.');
  end;
end;

function TSST2.GetItemByIndex(Index: integer): WideString;
begin
  if (Index < 0) or (Index >= FSST.Count) then begin
    Result := '';
    Exit;
  end;
  Result := GetItem(FSST[Index]);
end;

function TSST2.GetItem(Value: PXLSString): WideString;
var
  i: integer;
  P: PByteArray;
begin
  P := GetDataPointer(Value);
  SetLength(Result,Value.Len);
  if (Value.Options and $01) = $01 then
    Move(P^,Pointer(Result)^,Value.Len * 2)
  else begin
    for i := 1 to Value.Len do
      Result[i] := WideChar(P[i - 1]);
  end;
end;

function TSST2.HashFind(Hash: longword; S: Pointer; Len: integer; var Index: integer): boolean;
var
  P: Pointer;
  First : Integer;
  Last  : Integer;
begin
  First := 0;
  Last := FSST.Count - 1;
  Index := -1;
  Result := False;

  while (First <= Last) and (not Result) do begin
    Index := (First + Last) div 2;
    if (PXLSString(FSST[Index]).Hash = Hash) and (PXLSString(FSST[Index]).Len = Len) then begin
      P := GetDataPointer(FSST[Index]);
      if CompareMem(P,S,Len) then begin
        Result := True;
        Break;
      end;
    end;
    if PXLSString(FSST[Index]).Hash > Hash then
      Last := Index - 1
    else
      First := Index + 1;
  end;

  if (Index < 0) or (Index > (FSST.Count - 1)) then
    Exit
  else if (Index >= FSST.Count) and (PXLSString(FSST[Index]).Hash > Hash) then
    Inc(Index)
  else if PXLSString(FSST[Index]).Hash < Hash then
    Inc(Index);
end;

function TSST2.ReadCONTINUE(Stream: TXLSStream): word;
var
  Header: TBIFFHeader;
begin
  Stream.Read(Header,SizeOf(TBIFFHeader));
  if Header.RecID <> BIFFRECID_CONTINUE then
    raise Exception.Create('CONTINUE record is missing in SST');
  Result := Header.Length;
end;


procedure TSST2.Read(Stream: TXLSStream; RecSize: word);
var
  i: integer;
  Count: longword;
begin
  Dec(RecSize,Stream.Read(FTotalCount,4));
  Dec(RecSize,Stream.Read(Count,4));
  for i := 1 to Count do begin
    if RecSize = 0 then
      RecSize := ReadCONTINUE(Stream);
    FSST.Add(StreamReadString(Stream,RecSize));
  end;
end;

function TSST2.StreamReadString(Stream: TXLSStream; var RecSize: word): PByteArray;
var
  Len,FmtCount: word;
  Options: byte;
  MemLen,StrMemLen: word;
  FarEastDataSize: longword;

procedure ReadSplittedString(P: PByteArray; Len: word; Unicode: boolean);
type
  PStrPart = ^TStrPart;
  TStrPart = record
  Unicode: byte;
  Len: word;
  PStr: PByteArray;
  end;
var
  i,j: integer;
  Parts: TList;
  SPart: PStrPart;

procedure ReadPart(Opt: byte);
var
  BytesToRead: integer;
begin
  if Opt = $FF then
    Dec(RecSize,Stream.Read(Opt,1));
  if Opt = $01 then begin
    BytesToRead := Len * 2;
    Options := Options or $01;
  end
  else
    BytesToRead := Len;
  if BytesToRead > RecSize then
    BytesToRead := RecSize;
  New(SPart);
  SPart.Unicode := Opt;
  GetMem(SPart.PStr,BytesToRead);
  Dec(RecSize,Stream.Read(SPart.PStr^,BytesToRead));
  if Opt = $01 then
    SPart.Len := BytesToRead div 2
  else
    SPart.Len := BytesToRead;
  Dec(Len,SPart.Len);
  Parts.Add(SPart);
end;

begin
  Parts := TList.Create;
  try
    ReadPart(Byte(Unicode));
    while Len > 0 do begin
      RecSize := ReadCONTINUE(Stream);
      ReadPart($FF);
    end;
    for i := 0 to Parts.Count - 1 do begin
      if (Options and $01) = $01 then begin
        if (PStrPart(Parts[i]).Unicode and $01) = $01 then
          Move(PStrPart(Parts[i]).PStr^,P^,PStrPart(Parts[i]).Len * 2)
        else begin
          for j := 0 to PStrPart(Parts[i]).Len - 1 do
            PWordArray(P)[j] := PStrPart(Parts[i]).PStr[j];
        end;
        P := PByteArray(Integer(P) + PStrPart(Parts[i]).Len * 2);
      end
      else begin
        if (PStrPart(Parts[i]).Unicode and $01) = $01 then
          raise Exception.Create('SST split error: unicode part in compressed string.');
        Move(PStrPart(Parts[i]).PStr^,P^,PStrPart(Parts[i]).Len);
        P := PByteArray(Integer(P) + PStrPart(Parts[i]).Len);
      end;
      FreeMem(PStrPart(Parts[i]).PStr);
      FreeMem(PStrPart(Parts[i]));
    end;
  finally
    Parts.Free;
  end;
end;

procedure ReadString(P: PByteArray; Len: word; Unicode: boolean);
begin
  if MemLen > RecSize then
    ReadSplittedString(P,Len,Unicode)
  else
    Dec(RecSize,Stream.Read(P^,MemLen));
end;

procedure ReadData(P: PByteArray; Len: word);
begin
  if Len > RecSize then begin
    Stream.Read(P^,RecSize);
    Dec(Len,RecSize);
    P := PByteArray(Integer(P) + RecSize);
    RecSize := ReadCONTINUE(Stream);
    ReadData(P,Len);
  end
  else
    Dec(RecSize,Stream.Read(P^,Len));
end;

procedure ConvertFormatRunsToFonts(P: PByteArray; Count: integer);
var
  i: integer;
  pFmt: PFormatRun;
  pFnt: PFontRun;
begin
  if FFonts = Nil then
    Exit;
  // Work backwards trough the memory, as TFontRun always is bigger than
  // TFormatRun.
  for i := Count - 1 downto 0 do begin
    pFmt := PFormatRun(Integer(P) + (i * SizeOf(TFormatRun)));
    pFnt := PFontRun(Integer(P) + (i * SizeOf(TFontRun)));
    pFnt.Index := pFmt.Index;
    pFnt.Font := FFonts[pFmt.FontIndex];
    pFnt.Font.UsageCount := pFnt.Font.UsageCount + 1;
  end;
end;

procedure CheckIfSplittedString;
var
  L: integer;
  AdjOptions: byte;
begin
  L := 0;
  case Options of
    STRID_COMPRESSED,
    STRID_UNICODE:
      L := 0;
    STRID_RICH,
    STRID_RICH_UNICODE:
      L := 2;
    STRID_FAREAST,
    STRID_FAREAST_UC:
      L := 4;
    STRID_FAREAST_RICH,
    STRID_FAREAST_RICH_UC:
      L := 5;
  end;
  if (Options and STRID_UNICODE) = STRID_UNICODE then
    Inc(L,Len * 2)
  else
    Inc(L,Len);
  if L > RecSize then
    AdjOptions := Options or $01
  else
    AdjOptions := Options;
  if (AdjOptions and $01) = $01 then
    MemLen := Len * 2
  else
    MemLen := Len;
end;

begin
  Dec(RecSize,Stream.Read(Len,2));
  Dec(RecSize,Stream.Read(Options,1));
  CheckIfSplittedString;
  if (Options and $01) = $01 then
    StrMemLen := Len * 2
  else
    StrMemLen := Len;
  case Options of
    STRID_COMPRESSED: begin
      GetMem(Result,SizeOf(TXLSString) + MemLen);
      ReadString(PByteArray(@PXLSString(Result).Data),Len,False);
      PXLSString(Result).Hash := GetHashCode(Pointer(@PXLSString(Result).Data)^,StrMemLen);
    end;
    STRID_UNICODE: begin
      GetMem(Result,SizeOf(TXLSStringUC) + MemLen);
      ReadString(@PXLSStringUC(Result).Data,Len,True);
      PXLSString(Result).Hash := GetHashCode(Pointer(@PXLSStringUC(Result).Data)^,StrMemLen);
    end;
    STRID_RICH: begin
      Dec(RecSize,Stream.Read(FmtCount,2));
      GetMem(Result,SizeOf(TXLSStringRich) + MemLen + FmtCount * SizeOf(TFontRun));
      ReadString(PByteArray(@PXLSStringRich(Result).Data),Len,False);
      ReadData(Pointer(Integer(@PXLSStringRich(Result).Data) + StrMemLen),FmtCount * SizeOf(TFormatRun));
      ConvertFormatRunsToFonts(Pointer(Integer(@PXLSStringRich(Result).Data) + StrMemLen),FmtCount);
      PXLSStringRich(Result).FormatCount := FmtCount;
      PXLSStringRich(Result).Hash := GetHashCode(Pointer(@PXLSStringRich(Result).Data)^,StrMemLen);
    end;
    STRID_RICH_UNICODE: begin
      Dec(RecSize,Stream.Read(FmtCount,2));
      GetMem(Result,SizeOf(TXLSStringRichUC) + MemLen + FmtCount * SizeOf(TFontRun));
      ReadString(@PXLSStringRichUC(Result).Data,Len,True);
      ReadData(Pointer(Integer(@PXLSStringRichUC(Result).Data) + StrMemLen),FmtCount * SizeOf(TFormatRun));
      ConvertFormatRunsToFonts(Pointer(Integer(@PXLSStringRichUC(Result).Data) + StrMemLen),FmtCount);
      PXLSStringRich(Result).FormatCount := FmtCount;
      PXLSString(Result).Hash := GetHashCode(PXLSStringRichUC(Result).Data,StrMemLen);
    end;
    STRID_FAREAST: begin
      Dec(RecSize,Stream.Read(FarEastDataSize,4));
      GetMem(Result,SizeOf(TXLSStringFarEast) + MemLen + FarEastDataSize);
      ReadString(@PXLSStringFarEast(Result).Data,Len,False);
      ReadData(Pointer(Integer(@PXLSStringFarEast(Result).Data) + StrMemLen),FarEastDataSize);
      PXLSStringFarEast(Result).FarEastDataSize := FarEastDataSize;
      PXLSString(Result).Hash := GetHashCode(PXLSStringFarEast(Result).Data,StrMemLen);
    end;
    STRID_FAREAST_UC: begin
      Dec(RecSize,Stream.Read(FarEastDataSize,4));
      GetMem(Result,SizeOf(TXLSStringFarEastUC) + MemLen + FarEastDataSize);
      ReadString(@PXLSStringFarEastUC(Result).Data,Len,True);
      ReadData(Pointer(Integer(@PXLSStringFarEastUC(Result).Data) + StrMemLen),FarEastDataSize);
      PXLSStringFarEastUC(Result).FarEastDataSize := FarEastDataSize;
      PXLSString(Result).Hash := GetHashCode(PXLSStringFarEastUC(Result).Data,StrMemLen);
    end;
    STRID_FAREAST_RICH: begin
      Dec(RecSize,Stream.Read(FmtCount,2));
      Dec(RecSize,Stream.Read(FarEastDataSize,4));
      GetMem(Result,SizeOf(TXLSStringFarEastRich) + MemLen + FmtCount * SizeOf(TFontRun) + FarEastDataSize);
      ReadString(@PXLSStringFarEastRich(Result).Data,Len,True);
      ReadData(Pointer(Integer(@PXLSStringFarEastRich(Result).Data) + StrMemLen),FmtCount * SizeOf(TFormatRun));
      ConvertFormatRunsToFonts(Pointer(Integer(@PXLSStringFarEastRich(Result).Data) + StrMemLen),FmtCount);
      ReadData(Pointer(Integer(@PXLSStringFarEastRich(Result).Data) + StrMemLen + FmtCount * SizeOf(TFontRun)),FarEastDataSize);
      PXLSStringFarEastRich(Result).FormatCount := FmtCount;
      PXLSStringFarEastRich(Result).FarEastDataSize := FarEastDataSize;
      PXLSStringFarEastRich(Result).Hash := GetHashCode(PXLSStringFarEastRich(Result).Data,StrMemLen);
    end;
    STRID_FAREAST_RICH_UC: begin
      Dec(RecSize,Stream.Read(FmtCount,2));
      Dec(RecSize,Stream.Read(FarEastDataSize,4));