xlsfile3.pas

Advanced Data Import Component Suite for Borland Delphi and C++ Builder allows you to import your da

      ptgArea3d,
      ptgArea3dV, ptgArea3dA,
      ptgAreaErr3d,
      ptgAreaErr3dV, ptgAreaErr3dA: begin
        AbsRef := GetWord(Data, S + 4) and $8000 <> $8000;
        if not AbsRef then Data[S] := Data[S] + Row;
        AbsRef:= GetWord(Data, S + 4) and $4000 <> $4000;
        if not AbsRef then Data[S + 4] := Data[S + 4] + Col;

        AbsRef:= GetWord(Data, S + 6) and $8000 <> $8000;
        if not AbsRef then Data[S + 2] := Data[S + 2] + Row;;
        AbsRef:= GetWord(Data, S + 6) and $4000 <> $4000;
        if not AbsRef then Data[S + 6] := Data[S + 6] + Col;

        Inc(S, 8);
      end;

      ptgAreaN,
      ptgAreaNV, ptgAreaNA: Inc(S, 8);

      else raise ETokenException.Create(Token);
    end;
  end;

  procedure ArrangeTable;
  begin
  end;

begin
  S := 22;
  F := S + GetWord(Data, 20);
  while S < F do begin
    Token := Data[S];
    case Token of
      ptgUplus..ptgParen,
      ptgAdd..ptgRange,
      ptgMissArg: Inc(S);

      ptgStr: Inc(S, 1 + GetStrLen(false, Data, S + 1, false, 0));

      ptgErr, ptgBool: Inc(S, 1 + 1);

      ptgInt, ptgFunc,
      ptgFuncV, ptgFuncA: Inc(S, 1 + 2);

      ptgFuncVar,
      ptgFuncVarV, ptgFuncVarA: Inc(S, 1 + 3);

      ptgNum: Inc(S, 1 + 8);

      ptgAttr: begin
        if (Data[S + 1] and $04) = $04 then
          Inc(S, (GetWord(Data, S + 2) + 1) * 2);
        Inc(S, 1 + 3);
      end;

      ptgArray,
      ptgName..ptgArea,
      ptgRefErr..ptgAreaN,
      ptgNameX..ptgAreaErr3d,
      ptgArrayV,
      ptgNameV..ptgAreaV,
      ptgRefErrV..ptgAreaNV,
      ptgNameXV..ptgAreaErr3dV,
      ptgNameA..ptgAreaA,
      ptgRefErrA..ptgAreaNA,
      ptgNameXA..ptgAreaErr3dA: ArrangeOperand;

      ptgTbl: ArrangeTable;
      else raise ETokenException.Create(Token);
    end;
  end;
end;

{ TbiffShrFmla }

function TbiffShrFmla.GetFirstRow: word;
begin
  Result := GetWord(Data, 0);
end;

function TbiffShrFmla.GetLastRow: word;
begin
  Result := GetWord(Data, 2);
end;

function TbiffShrFmla.GetFirstCol: word;
begin
  Result := Data[4];
end;

function TbiffShrFmla.GetLastCol: word;
begin
  Result := Data[5];
end;

function TbiffShrFmla.GetKey: integer{longword};
begin
  Result := GetWord(Data, 0) or Data[4] shl 16;
end;

{ TbiffName }

function TbiffName.GetName: WideString;
var
  Str: AnsiString;
begin
  if (GetOptionFlags and $01) = 1 then begin
    SetLength(Result, GetNameLength);
    Move(Data[15], Result[1], GetNameLength * 2);
  end else begin
    SetLength(Str, GetNameLength);
    Move(Data[15], Str[1], GetNameLength);
    Result := WideString(Str);
  end;
end;

function TbiffName.GetNameLength: byte;
begin
  Result := Data[3];
end;

function TbiffName.GetNameSize: integer;
begin
  Result := GetStrLen(false , Data, 14, true, NameLength);
end;

function TbiffName.GetOptionFlags: byte;
begin
  Result := Data[14];
end;

function TbiffName.GetRow1: integer;
begin
  if Data[14 + NameSize] in tkArea3d
    then Result := GetWord(Data, 15 + 2 + NameSize)
    else Result := -1;
end;

function TbiffName.GetRow2: integer;
begin
  if Data[14 + NameSize] in tkArea3d
    then Result := GetWord(Data, 15 + 4 + NameSize)
    else Result := -1;
end;

function TbiffName.GetCol1: integer;
begin
  if Data[14 + NameSize] in tkArea3d
    then Result := GetWord(Data, 15 + 6 + NameSize)
    else Result := -1;
end;

function TbiffName.GetCol2: integer;
begin
  if Data[14 + NameSize] in tkArea3d
    then Result := GetWord(Data, 15 + 8 + NameSize)
    else Result := -1;
end;

{ TbiffMultiple }

constructor TbiffMultiple.Create(Section: TxlsSection; ID, DataSize: word;
  Data: PByteArray);
begin
  inherited;
  FCol := 0;
end;

{ TbiffMulBlank }

function TbiffMulBlank.GetEOF: boolean;
begin
  Result := 4 + (FCol + 1) * SizeOf(Word) >= DataSize;
end;

function TbiffMulBlank.GetCell: TbiffCell;
var
  NewData: PByteArray;
  NewDataSize: integer;
begin
  NewDataSize := 6;
  GetMem(NewData, NewDataSize);
  try
    SetWord(NewData, 0, GetWord(Data, 0));
    SetWord(NewData, 2, GetWord(Data, 2) + FCol);
    SetWord(NewData, 4, GetWord(Data, 4 + FCol * SizeOf(Word)));

    Result := TbiffBlank.Create(Section, BIFF_BLANK, NewDataSize, NewData);
    Inc(FCol);
  except
    FreeMem(NewData);
    raise;
  end;
end;

{ TbiffMulRK }

type
  P_RK = ^T_RK;
  T_RK = packed record
    XF: word;
    RK: longint;
  end;

function TbiffMulRK.GetEOF: boolean;
begin
  Result := 4 + (FCol + 1) * SizeOf(T_RK) >= DataSize;
end;

function TbiffMulRK.GetCell: TbiffCell;
var
  NewData: PByteArray;
  NewDataSize: integer;
  RK1, RK2: P_RK;
begin
  NewDataSize := 10;
  GetMem(NewData, NewDataSize);
  try
    SetWord(NewData, 0, GetWord(Data, 0));
    SetWord(NewData, 2, GetWord(Data, 2) + FCol);
    RK1 := P_RK(@(Data[4 + FCol * SizeOf(T_RK)]));
    RK2 := P_RK(@(NewData[4]));
    RK2^ := RK1^;

    Result := TbiffRK.Create(Section, BIFF_RK, NewDataSize, NewData);
    Inc(FCol);
  except
    FreeMem(NewData);
    raise;
  end;
end;

{ TbiffXF }

function TbiffXF.GetFormatIndex: word;
begin
  Result := PBIFF_XF(Data).FormatIndex;
end;

procedure TbiffXF.SetFormatIndex(Value: word);
begin
  PBIFF_XF(Data).FormatIndex := Value;
end;

{ TbiffFormat }

constructor TbiffFormat.Create(Section: TxlsSection; ID, DataSize: word;
  Data: PByteArray);
var
  MySelf: TbiffRecord;
  TempPos, StrLen: integer;
//dee  Str: string;
  Str: AnsiString;
  WStr: WideString;
  OptionFlags, RealOptionFlags: byte;
  DestPos: integer;
begin
  inherited;
  FID := GetWord(Data, 0);

  TempPos := 5;
  MySelf := Self;
  DestPos := 0;
  OptionFlags := Data[4];
  RealOptionFlags := OptionFlags;
  StrLen := GetWord(Data, 2);
  SetLength(Str, StrLen);
  SetLength(WStr, StrLen);
  ReadStr(MySelf, TempPos, Str, WStr, OptionFlags, RealOptionFlags, DestPos,
    StrLen);
  if (OptionFlags and $1) = 0
    then FValue := StringToWideStringNoCodePage(Str)
    else FValue := WStr;
end;

{ TbiffSST }

constructor TbiffSST.Create(Section: TxlsSection; ID, DataSize: word;
  Data: PByteArray);
begin
  inherited;
  FCount := GetInteger(Data, 4);
end;

{ TxlsList }

function TxlsList.GetItems(Index: integer): TObject;
begin
  Result := TObject(inherited Items[Index]);
end;

procedure TxlsList.SetItems(Index: integer; Value: TObject);
begin
  Items[Index] := Value;
end;

function TxlsList.Add(Item: TObject): integer;
begin
  Result := inherited Add(Item);
end;

constructor TxlsList.Create(Workbook: TxlsWorkbook);
begin
  inherited Create;
  FWorkbook := Workbook;
end;

procedure TxlsList.Delete(Index: integer);
begin
  if Assigned(Items[Index]) then
    TObject(Items[Index]).Free;
  inherited Delete(Index);
end;

{$IFDEF VCL5}
function TxlsList.Extract(Item: TObject): TObject;
begin
  Result := TObject(inherited Extract(Item));
end;
{$ENDIF}

function TxlsList.First: TObject;
begin
  Result := TObject(inherited First);
end;

function TxlsList.IndexOf(Item: TObject): integer;
begin
  Result := inherited IndexOf(Item);
end;

procedure TxlsList.Insert(Index: integer; Item: TObject);
begin
  inherited Insert(Index, Item);
end;

function TxlsList.Last: TObject;
begin
  Result := TObject(inherited Last);
end;

function TxlsList.Remove(Item: TObject): integer;
begin
  Result := inherited Remove(Item);
end;

{ TbiffRecordList }

function TbiffRecordList.Add(Item: TbiffRecord): integer;
begin
  Result := inherited Add(Item);
end;

procedure TbiffRecordList.Insert(Index: integer; Item: TbiffRecord);
begin
  inherited Insert(Index, Item);
end;

procedure TbiffRecordList.CorrectSize(Delta: integer);
begin
  Inc(FTotalSize, Delta);
end;

procedure TbiffRecordList.RecalculateTotalSize;
var
  i: integer;
begin
  FTotalSize := 0;
  for i := 0 to Count - 1 do
    Inc(FTotalSize, Items[i].FDataSize);
end;

function TbiffRecordList.GetItems(Index: integer): TbiffRecord;
begin
  Result := TbiffRecord(inherited GetItems(Index));
end;

procedure TbiffRecordList.SetItems(Index: integer; Value: TbiffRecord);
begin
  inherited SetItems(Index, Value);
end;

{ TxlsRowList }

constructor TxlsRowList.Create(Workbook: TxlsWorkbook);
begin
  FSorted := false;
end;

function TxlsRowList.GetItems(Index: integer): TxlsRow;
begin
  Result := TxlsRow(inherited Items[Index]);
end;

procedure TxlsRowList.SetItems(Index: integer; Value: TxlsRow);
begin
  inherited Items[Index] := Value;
end;

function TxlsRowList.Add(Row: TxlsRow): integer;
begin
  Result := inherited Add(Row);
  FSorted := false;
end;

procedure TxlsRowList.Insert(Index: integer; Row: TxlsRow);
begin
  inherited Insert(Index, Row);
end;

function TxlsRowList.Find(Row: integer; var Index: integer): boolean;
var
 L, H, I, C: Integer;
begin
  if not FSorted then Sort;
  Result := false;
  L := 0;
  H := Count - 1;
  while L <= H do begin
    I := (L + H) shr 1;
    if Items[i].RowNumber < Row then
      C := -1
    else if Items[i].RowNumber > Row then
      C := 1
    else C := 0;
    if C < 0 then L := I + 1
    else begin
      H := I - 1;
      if C = 0 then begin
        Result := true;
        L := I;
      end;
    end;
  end;
  Index := L;
end;

function CompareRowNumber(Item1, Item2: Pointer): integer;
begin
  if TxlsRow(Item1).RowNumber < TxlsRow(Item2).RowNumber then
    Result := -1
  else if TxlsRow(Item1).RowNumber > TxlsRow(Item2).RowNumber then
    Result := 1
  else Result := 0;
end;

procedure TxlsRowList.Sort;
begin
  inherited Sort(CompareRowNumber);
  FSorted := true;
end;

{ TxlsColList }

constructor TxlsColList.Create(Workbook: TxlsWorkbook);
begin
  inherited;
  FSorted := false;
end;

function TxlsColList.GetItems(Index: integer): TxlsCol;
begin
  Result := TxlsCol(inherited Items[Index]);
end;

procedure TxlsColList.SetItems(Index: integer; Value: TxlsCol);
begin
  inherited Items[Index] := Value;
end;

function TxlsColList.Add(Col: TxlsCol): integer;
begin
  Result := inherited Add(Col);
  FSorted := false;
end;

procedure TxlsColList.Insert(Index: integer; Col: TxlsCol);
begin
  inherited Insert(Index, Col);
end;

function TxlsColList.Find(Col: integer; var Index: integer): boolean;
var
 L, H, I, C: Integer;
begin
  if not FSorted then Sort;
  Result := false;
  L := 0;
  H := Count - 1;
  while L <= H do begin
    I := (L + H) shr 1;
    if Items[i].ColNumber < Col then
      C := -1
    else if Items[i].ColNumber > Col then
      C := 1
    else C := 0;
    if C < 0 then L := I + 1
    else begin
      H := I - 1;
      if C = 0 then begin
        Result := true;
        L := I;
      end;
    end;
  end;
  Index := L;
end;

function CompareColNumber(Item1, Item2: Pointer): integer;
begin
  if TxlsCol(Item1).ColNumber < TxlsCol(Item2).ColNumber then
    Result := -1
  else if TxlsCol(Item1).ColNumber > TxlsCol(Item2).ColNumber then
    Result := 1
  else Result := 0;
end;

procedure TxlsColList.Sort;
begin
  inherited Sort(CompareColNumber);
  FSorted := true;
end;

{ TbiffColRowList }

function TbiffColRowList.GetItems(Index: integer): TbiffColRow;
begin
  Result := TbiffColRow(inherited Items[Index]);
end;

procedure TbiffColRowList.SetItems(Index: integer; Value: TbiffColRow);
begin