qexport4xlsutils.pas

Advanced.Export.Component.v4.01.rar,delphi 第三方控件

unit QExport4XLSUtils;

{$I VerCtrl.inc}

interface

uses Classes, SysUtils, QExport4XLSCommon, QExport4XLSFile
  {$IFDEF WIN32}, ActiveX{$ENDIF};

//type
//  TGetSheet = function(SheetRef: word): integer of object;
function GetByte(const Data: PByteArray; Offset: integer): byte;
procedure SetByte(const Data: PByteArray; Offset: integer; Value: byte);
function GetWord(const Data: PByteArray; Offset: integer): word;
procedure SetWord(const Data: PByteArray; Offset: integer; Value: word);
function GetInteger(const Data: PByteArray; Offset: integer): integer;
procedure SetInteger(const Data: PByteArray; const Offset: integer; Value: integer);

function StringToWideStringNoCodePage(const Str: string): WideString;
function WideStringToStringNoCodePage(const WStr: WideString): string;
function IsWide(const WStr: WideString): boolean;
function CompareWideStr(const S1, S2: WideString): integer;
function ByteArrayToStr(Buffer: PByteArray; Length: integer): WideString;

procedure ReadMem(var ARecord: TbiffRecord; var Position: integer;
  const Size: integer; const ResPtr: Pointer);
procedure ReadStr(var ARecord: TbiffRecord; var Position: integer;
  var ShortData: string; var WideData: WideString;
  var OptionFlags, RealOptionFlags: byte; var DestPos: integer;
  const StrLen: integer);

function EncodeRK(Value: double; var RK: longint): boolean;

function GetStrLen(IsWide: boolean; Data: PByteArray; Position: integer;
  UseExtStrLen: boolean; ExtStrLen: integer{longword}): integer{int64};

function ErrCodeToString(ErrCode: integer): WideString;
function StringToErrCode(const ErrStr: WideString): integer;

function Col2Letter(Col: integer): string;    // needs 1 based col number
function Row2Number(Row: integer): string;    // needs 1 based row number
function Letter2Col(Letter: string): integer; // returns 1 based col number
function Number2Row(Number: string): integer; // returns 1 based row number

function LoadRecord(Section: TxlsSection; Stream: TStream;
  Header: TBIFF_Header): TbiffRecord;

procedure WriteMSOHeader(FBT, Version, Instance: word; Length: integer;
  Stream: TStream);
procedure WriteMSOHeaderToByteArray(FBT, Version, Instance: word;
  Length: integer; ByteArray: PByteArray; var Position: integer);

function CreateXLSStream(const FileName: string; var Storage: IStorage;
  var Stream: IStream): TStream;

const
  LETTERS = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ';
  NUMBERS = '0123456789';

implementation

uses QExport4XLSConsts, Math
  {$IFDEF WIN32}, ComObj, AxCtrls{$ENDIF};

function GetByte(const Data: PByteArray; Offset: integer): byte;
type
  PByte = ^Byte;
begin
  Result := PByte(PChar(Data) + Offset)^;
end;

procedure SetByte(const Data: PByteArray; Offset: integer; Value: byte);
begin
  Move(Value, Data^[Offset], SizeOf(Byte));
end;

function GetWord(const Data: PByteArray; Offset: integer): word;
type
  PWord = ^Word;
begin
  Result := PWord(PChar(Data) + Offset)^;
end;

procedure SetWord(const Data: PByteArray; Offset: integer; Value: word);
begin
  Move(Value, Data^[Offset], SizeOf(Word));
end;

function GetInteger(const Data: PByteArray; Offset: integer): integer;
type
  PInteger = ^Integer;
begin
  Result := PInteger(PChar(Data) + Offset)^;
end;

procedure SetInteger(const Data: PByteArray; const Offset: integer; Value: integer);
begin
  Move(Value, Data^[Offset], SizeOf(Integer))
end;

function StringToWideStringNoCodePage(const Str: string): WideString;
var
  i: integer;
begin
  SetLength(Result, Length(Str));
  for i := 1 to Length(Str) do
    Result[i] := WideChar(Ord(Str[i]));
end;

function WideStringToStringNoCodePage(const WStr: WideString): string;
var
  i: integer;
begin
  SetLength(Result, Length(WStr));
  for i := 1 to Length(WStr) do
    Result[i] := Chr(Ord(WStr[i]) and $FF);
end;

function IsWide(const WStr: WideString): boolean;
var
  i: integer;
begin
  Result := false;
  for i := 1 to Length(WStr) do
    if Ord(WStr[i]) > $FF then begin
      Result := true;
      Exit;
    end;
end;

function CompareWideStr(const S1, S2: WideString): integer;
var
  i: integer;
begin
  Result := 0;
  if Length(S1) < Length(S2) then
    Result := -1
  else if Length(S1) > Length(S2) then
    Result := 1
  else
    for i := 1 to Length(S1) do begin
      if S1[i] = S2[i] then
        Continue
      else if S1[i] < S2[i] then
        Result := -1
      else Result := 1;
      Exit;
    end;
end;

function ByteArrayToStr(Buffer: PByteArray; Length: integer): WideString;
var
  Str: string;
begin
  if Buffer[0] = 0 then begin
    SetLength(Str, Length);
    Move(Pointer(Integer(Buffer) + 1)^, Str[1], Length);
    Result := StringToWideStringNoCodePage(Str);
  end
  else Result := WideCharLenToString(PWideChar(Integer(Buffer) + 1), Length);
end;

procedure ReadMem(var ARecord: TbiffRecord; var Position: integer;
  const Size: integer; const ResPtr: Pointer);
var
  l: integer;
begin
  if not Assigned(ARecord) then
    raise ExlsFileError.Create(sErrorReadingRecord);

  l := ARecord.DataSize - Position;

  if l < 0 then
    raise ExlsFileError.Create(sErrorReadingRecord);

  if (l = 0) and (Size > 0) then
  begin
    Position := 0;
    ARecord := ARecord.Continue;
  end;

  if not Assigned(ARecord) then
    raise ExlsFileError.Create(sErrorReadingRecord);

  l := ARecord.DataSize - Position;

  if Size <= l then begin
    if Assigned(ResPtr) then Move(ARecord.Data^[Position], ResPtr^, Size);
    Inc(Position, Size);
  end
  else begin
    ReadMem(ARecord, Position, l, ResPtr);
    if Assigned(ResPtr)
      then ReadMem(ARecord, Position, Size - l, PChar(ResPtr) + l)
      else ReadMem(ARecord, Position, Size - l, nil);
  end
end;

procedure ReadStr(var ARecord: TbiffRecord; var Position: integer;
  var ShortData: string; var WideData: WideString;
  var OptionFlags, RealOptionFlags: byte; var DestPos: integer;
  const StrLen: integer);
var
  l, i: integer;
  ResPtr: Pointer;
  Size, CharSize: integer;
begin
  l := ARecord.DataSize - Position;

  if l < 0 then raise ExlsFileError.Create(sErrorReadingRecord);
  if (l = 0) and (StrLen > 0) then
    if DestPos = 0 then begin
      Position := 0;
      if not Assigned(ARecord.Continue) then
        raise ExlsFileError.Create(sErrorReadingRecord);
      ARecord := ARecord.Continue;
    end
    else begin
      Position := 1;
      if not Assigned(aRecord.Continue) then
        raise ExlsFileError.Create(sErrorReadingRecord);
      ARecord := ARecord.Continue;
      RealOptionFlags := ARecord.Data[0];
      if (RealOptionFlags = 1) and ((OptionFlags and 1) = 0) then begin
        WideData := StringToWideStringNoCodePage(ShortData);
        OptionFlags := OptionFlags or 1;
      end;
    end;

  l := ARecord.DataSize - Position;

  if (RealOptionFlags and 1) = 0 then begin
    Size := StrLen - DestPos;
    ResPtr := @ShortData[DestPos + 1];
    CharSize := 1;
  end
  else begin
    Size:= (StrLen - DestPos) * 2;
    ResPtr := @WideData[DestPos + 1];
    CharSize := 2;
  end;

  if Size <= l then begin
    if (RealOptionFlags and 1 = 0) and (OptionFlags and 1 = 1) then
      for i := 0 to Size div CharSize - 1 do
        WideData[DestPos + 1 + i] := WideChar(ARecord.Data^[Position + i])
    else Move(ARecord.Data^[Position], ResPtr^, Size);

    Inc(Position, Size);
    Inc(DestPos, Size div CharSize);
  end
  else begin
    if (RealOptionFlags and 1 = 0) and (OptionFlags and 1 = 1) then
      for i := 0 to l div CharSize - 1 do
        WideData[DestPos + 1 + i] := WideChar(ARecord.Data^[Position + i])
    else Move(ARecord.Data^[Position], ResPtr^, l);
    Inc(Position, l);
    Inc(DestPos, l div CharSize);
    ReadStr(ARecord, Position, ShortData, WideData, OptionFlags,
      RealOptionFlags, DestPos, StrLen);
  end
end;

function EncodeRK(Value: double; var RK: longint): boolean;
var
  d: double;
  pd, pd1: ^longint;
  mask: integer{int64};
  i: integer;
begin
  Result := true;
  for i := 0 to 1 do begin
    d := Value * (1 + 99 * i);
    pd := @d;
    pd1 := pd;
    Inc(pd1);
    if (pd^ = 0) and (pd1^ and 3 = 0) then  begin  //Type 0-2   30 bits IEEE float
      RK := pd1^ + i;
      Exit;
    end;

    mask := $1FFFFFFF;  //29 bits