Chip 2003 January/Chip_2003-01_cd1.bin/zkuste/delphi/kolekce/d567/FLEXCEL.ZIP/BiffEdit/UBiffEdit.pas

Pascal/Delphi Source File | 2002-09-26 | 12.7 KB | 425 lines

unit UBiffEdit;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  URecordEdit, Menus, ImgList, ActnList, ComCtrls, StdCtrls, ToolWin,
  ExtCtrls,axctrls, activex, ComObj, UBiffData, UBiffEditUtil, UWaitCursor, UEscherEdit;

type
  TProcessStreamFunc = procedure (const FullName: Widestring; const DocIN, DocOUT: IStorage) of object;

  TMain = class(TRecordEdit)
    ActionOpen: TAction;
    ActionSaveAs: TAction;
    OpenDialog: TOpenDialog;
    SaveDialog: TSaveDialog;
    Panel1: TPanel;
    cbStream: TComboBox;
    Label1: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure ActionOpenExecute(Sender: TObject);
    procedure ActionSaveAsExecute(Sender: TObject);
    procedure ActionSaveAsUpdate(Sender: TObject);
    procedure ActionEditExecute(Sender: TObject);
    procedure ListRecordsGetImageIndex(Sender: TObject; Item: TListItem);
    procedure cbStreamChange(Sender: TObject);
  protected
    function SectionBegins(const aRecord: PRecord): boolean;override;
    function SectionEnds(const aRecord: PRecord): boolean;override;
    function GetIdName(const Id: word): string;override;
  private
    EscherEdit: TEscherEdit;

    function ExtractName(const FullName: widestring): widestring;
    procedure OpenFile(const ResetStream: boolean);
    procedure CopyStorage(const DocIN, DocOUT: IStorage);
    procedure CreateNewDocument(const TemplateFileName, OutputFileName: WideString);
    procedure FillStreamBox(const DocIN: IStorage);
    procedure IterateStorage(const DocIN, DocOUT: IStorage; const DoStream, DoStorage: TProcessStreamFunc; const Path: Widestring);
    procedure aCopyStorage(const FullName: Widestring; const DocIN, DocOUT: IStorage);
    procedure aCopyStream(const FullName: Widestring; const DocIN, DocOUT: IStorage);
    function CurrentStream: widestring;
    procedure FillCbStream(const FullName: Widestring; const DocIN,
      DocOUT: IStorage);
    procedure FillCbStorage(const FullName: Widestring; const DocIN,
      DocOUT: IStorage);
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Main: TMain;

implementation

procedure TMain.OpenFile(const ResetStream: boolean);
var
  DocIN: array of IStorage;  //We have to keep them all
  Workbook: IStream;
  RecordHeader: TRecordHeader;
  WFileName: Widestring;
  s:string;
  le: longint;
  Ofs: string;
  StreamPos: Cardinal;
  DataRec: PRecord;
  WaitCursor: IWaitCursor;
  Wc:WideString;
begin
  WaitCursor:=TWaitCursor.Create;
  WFileName:=OpenDialog.FileName;
  StreamPos:=0;

  DataRecords.Clear;
  UpdateRecordCount;
  Caption:='Biff Edit';
  Ofs:='';
  SetLength(DocIN, 1);
  OleCheck(StgOpenStorage(PWideChar(WFileName), nil, OptionsRead, nil, 0, DocIN[0]));
  if ResetStream then FillStreamBox(DocIN[0]);
  if CurrentStream='' then exit;
  Wc:=copy(CurrentStream, 2 , MaxInt);
  while Pos('\', Wc)<>0 do
  begin
    SetLength(DocIN, Length(DocIN)+1);
    OleCheck(DocIN[Length(DocIN)-2].OpenStorage(PWideChar(copy(Wc,1,pos('\', Wc)-1)), nil, OptionsRead, nil, 0, DocIN[Length(DocIN)-1]));
    Wc:=copy(Wc, pos('\', Wc) +1, MaxINT);
  end;

  OleCheck(DocIN[Length(DocIN)-1].OpenStream(PWideChar(Wc), nil, OptionsRead, 0, Workbook));
  try
    while (Workbook.Read( @RecordHeader, sizeof(RecordHeader), @le)=S_OK) and (le=sizeof(RecordHeader)) do
    begin
      if (RecordHeader.Id=$000A) and (length(Ofs)-1>0) then Delete(Ofs,Length(Ofs)-1,2); //eof;

      New(DataRec);
      try
        DataRec.Id:=RecordHeader.Id;
        DataRec.IdName:= Ofs+GetIdName(RecordHeader.Id);
        DataRec.Size:=RecordHeader.Size;
        DataRec.Offset:=StreamPos;
        SetLength(s, RecordHeader.Size);
        if Workbook.Read( @s[1], RecordHeader.Size, nil)<>S_OK then Raise Exception.Create(ErrInvalidRecord);
        DataRec.Data:=SkipZero(s);
        DataRec.HexData:=StrToHex(s);

        DataRecords.Add(DataRec);
      except
        Dispose(DataRec);
        DataRecords.Clear;
        raise;
      end; //Except

      if RecordHeader.Id=$0809 then Ofs:=Ofs+'  '; //bof;

      StreamPos:=StreamPos+SizeOf(RecordHeader)+ RecordHeader.Size;
      if DataRecords.Count=10000 then
      begin
        if MessageDlg(WarFileTooBig, mtWarning, [mbYes,mbNo], 0) = mrNo then break;
      end;
    end;
    UpdateRecordCount;
  finally
    Workbook:=nil;
  end; //finally
  Caption:='Biff Edit: '+OpenDialog.FileName;
end;

procedure TMain.FillCbStream(const FullName: Widestring; const DocIN, DocOUT: IStorage);
begin
  cbStream.Items.Add(FullName);
end;

procedure TMain.FillCbStorage(const FullName: Widestring; const DocIN, DocOUT: IStorage);
var
  NewDocIN: IStorage;
begin
  OleCheck(DocIN.OpenStorage(PWideChar(ExtractName(FullName)), nil, OptionsRead, nil, 0, NewDocIN));
  try
    IterateStorage(NewDocIN, nil, FillCbStream, FillCbStorage, FullName);
  finally
    NewDocIN := nil;
  end; //finally
end;

procedure TMain.FillStreamBox(const DocIN: IStorage);
var
  i:integer;
begin
  cbStream.Items.Clear;
  IterateStorage(DocIN, nil, FillCbStream, FillCbStorage, '');
  for i:=0 to cbStream.Items.Count-1 do
    if cbStream.Items[i]=WorkbookStr then cbStream.ItemIndex:=i;
end;

{$R *.DFM}

procedure TMain.FormCreate(Sender: TObject);
begin
  inherited;
  //This is because a bug in TToolbar
  btnOpen.Action:=ActionOpen;
  btnSaveAs.Action:=ActionSaveAs;

  IsBiff:=true;
  if paramcount>0 then begin; OpenDialog.FileName:=ParamStr(1);OpenFile(true);end;
end;

procedure TMain.ActionOpenExecute(Sender: TObject);
begin
  if not OpenDialog.Execute then exit;
  OpenFile(true);
end;


procedure TMain.ActionSaveAsExecute(Sender: TObject);
var
  WaitCursor: IWaitCursor;
begin
  if not SaveDialog.Execute then exit;
  if OpenDialog.FileName='' then exit;
  if SaveDialog.FileName=OpenDialog.FileName then raise Exception.Create(ErrFileDestSameSource);
  WaitCursor:=TWaitCursor.Create;
  CreateNewDocument(OpenDialog.FileName, SaveDialog.FileName);
end;

procedure TMain.ActionSaveAsUpdate(Sender: TObject);
begin
  ActionSaveAs.Enabled:=OpenDialog.FileName<>'';
end;


procedure TMain.aCopyStream(const FullName: Widestring; const DocIN, DocOUT: IStorage);
var
  StreamIN, StreamOUT: IStream;
  rr, rw: int64;
  i: integer;
  WorkStream: TOleStream;
  RecordHeader: TRecordHeader;
  s:string;
begin
  if FullName = CurrentStream then
    begin
      //Create Workbook stream
      OleCheck(DocOUT.CreateStream(PWidechar(ExtractName(FullName)), OptionsWrite, 0, 0, StreamOUT));
      try
        WorkStream := TOleStream.Create(StreamOUT);
        try
          //fill the new stream
          for i:=0 to DataRecords.Count-1 do
          begin
            RecordHeader.Id:=DataRecords[i].Id;
            RecordHeader.Size:=DataRecords[i].Size;
            WorkStream.Write(RecordHeader, SizeOf(RecordHeader));
            s:=HexToStr(DataRecords[i].HexData,RecordHeader.Size);
            if Length(s)>0 then WorkStream.Write(s[1], length(s));
          end;
          //free objects
        finally
          FreeAndNil(WorkStream);
        end; //finally
      finally
        StreamOUT := nil;
      end; //finally
    end
  else
  begin
    OleCheck(DocIN.OpenStream(PWidechar(ExtractName(FullName)), nil, OptionsRead, 0, StreamIN));
    try
      OleCheck(DocOUT.CreateStream(PWidechar(ExtractName(FullName)), OptionsWrite, 0, 0, StreamOUT));
      try
        OleCheck(StreamIN.CopyTo(StreamOUT, High(int64), rr, rw));
      finally
        StreamOUT := nil;
      end; //finally
    finally
      StreamIN := nil;
    end; //finally
  end;
end;

procedure TMain.aCopyStorage(const FullName: WideString; const DocIN, DocOUT: IStorage);
var
  NewDocIN, NewDocOUT: IStorage;
begin
  OleCheck(DocIN.OpenStorage(PWideChar(ExtractName(FullName)), nil, OptionsRead, nil, 0, NewDocIN));
  try
    OleCheck(DocOUT.CreateStorage(PWideChar(ExtractName(FullName)), OptionsWrite, 0, 0, NewDocOUT));
    try
      IterateStorage(NewDocIN, NewDocOUT,aCopyStream, aCopyStorage, FullName);
    finally
      NewDocOUT := nil;
    end; //finally
  finally
    NewDocIN := nil;
  end; //finally
end;

procedure TMain.CopyStorage(const DocIN, DocOUT: IStorage);
begin
  IterateStorage(DocIN, DocOUT, aCopyStream, aCopyStorage, '');
end;

procedure TMain.IterateStorage(const DocIN, DocOUT: IStorage; const DoStream, DoStorage: TProcessStreamFunc; const Path: Widestring);
var
  Enum: IEnumStatStg;
  NumFetched: integer;
  StatStg: TStatStg;
  Malloc: IMalloc;

begin
  OleCheck(CoGetMalloc(1, Malloc));
  try
    if DocIN.EnumElements(0, nil, 0, Enum) <> S_OK then
    begin
      DocIN.Stat(StatStg, 0);
      try
        raise Exception.CreateFmt(ErrCantReadFile, [StatStg.pwcsName]);
      finally
        Malloc.Free(StatStg.pwcsName);
      end; //finally
    end;

    while Enum.Next(1, StatStg, @NumFetched) = S_OK do
    begin
      try
        case StatStg.dwType of
          STGTY_STREAM:
            begin
              DoStream( Path+'\'+StatStg.pwcsName, DocIN, DocOUT);
            end;

          STGTY_STORAGE:
            begin
              DoStorage( Path+'\'+StatStg.pwcsName, DocIN, DocOUT);
            end;
        end; //case
      finally
         Malloc.Free(StatStg.pwcsName);
      end; //finally
    end; //while
  finally
    Malloc:=nil;
  end;
end;

procedure TMain.CreateNewDocument(const TemplateFileName,
  OutputFileName: WideString);
var
  DocIN, DocOUT: IStorage;
begin
  DocIN := nil;
  DocOut := nil;

  if StgIsStorageFile(PWideChar(TemplateFileName)) <> S_OK then
    raise Exception.CreateFmt(ErrFileIsNotXLS, [TemplateFileName]);

  //Open template
  OleCheck(StgOpenStorage(PWideChar(TemplateFileName), nil, OptionsRead, nil, 0, DocIN));
  try
    //Create output file
    if FileExists(OutPutFileName) then DeleteFile(OutPutFileName);
    OleCheck(StgCreateDocFile(PWideChar(OutputFileName), OptionsWrite, 0, DocOUT));
    try
      //Copy sections from template to output
      CopyStorage(DocIN, DocOUT);

    finally
      DocOUT := nil;
    end; //finally
  finally
    DocIN := nil;
  end; //finally
end;



procedure TMain.ActionEditExecute(Sender: TObject);
var
  index, Idx: integer;
  s: string;
begin
  if ListRecords.Selected= nil then exit;
  Index:=ListRecords.Selected.Index;
  if (DataRecords[Index].Id  >= $00EB) and (DataRecords[Index].Id  <= $00ED) then
  begin
    //Escher Record
    if EscherEdit=nil then EscherEdit:=TEscherEdit.Create(Self);
    EscherEdit.Caption:=Format('Editing Escher Record: Offset in Biff file: %x    Id: %s',[DataRecords[Index].Offset, Trim(ListRecords.Selected.Caption)]);
    EscherEdit.PanelVersion.Visible:=false;

    //Handle continues
    s:=DataRecords[Index].HexData; Idx:=Index+1;
    while (Idx<DataRecords.Count) and (DataRecords[idx].Id= $3C) do
    begin
      s:=s+DataRecords[idx].HexData;
      inc(idx);
    end;
    if idx>Index+1 then Showmessage(WarEscherBig);
    EscherEdit.ActionOk.Enabled:= idx= Index+1;

    EscherEdit.Load(s, DataRecords[Index].Version, DataRecords[Index].Size );
    if EscherEdit.ShowModal = mrOk then
    begin
      s:=HexToStr(EscherEdit.HexData, (Length(EscherEdit.HexData)-1) div 3 +1);
      DataRecords[Index].Size:= Length(s);
      DataRecords[Index].HexData:= EscherEdit.HexData;
      DataRecords[Index].Data:= SkipZero(s);
      ListRecordsSelectItem( Self, ListRecords.Selected, true);
      FixStreamOffsets(ListRecords.Selected.Index-1);
    end;
  end else inherited;

end;

procedure TMain.ListRecordsGetImageIndex(Sender: TObject; Item: TListItem);
begin
  inherited;
  if (Item<>nil) and (DataRecords[Item.Index].Id  >= $00EB)
  and (DataRecords[Item.Index].Id  <= $00ED) then Item.ImageIndex:=0 else
  if  (DataRecords[Item.Index].Id   = $003C) then Item.ImageIndex:=1 else
  if  (DataRecords[Item.Index].Id   = $0809) then Item.ImageIndex:=2 else
  if  (DataRecords[Item.Index].Id   = $000A) then Item.ImageIndex:=3 else
  Item.ImageIndex:=-1;

end;

function TMain.SectionEnds(const aRecord: PRecord): boolean;
begin
  SectionEnds:=aRecord.Id=$000A;
end;

function TMain.SectionBegins(const aRecord: PRecord): boolean;
begin
  SectionBegins:=aRecord.Id=$0809;
end;

function TMain.GetIdName(const Id: word): string;
begin
  Result:= UBiffEditUtil.GetIdName(Id);
end;

function TMain.ExtractName(const FullName: widestring): widestring;
var
  I: Integer;
begin
  I := LastDelimiter('\', FullName);
  Result := Copy(FullName, I + 1, MaxInt);
end;

function TMain.CurrentStream: widestring;
begin
  Result:=cbStream.Text;
end;

procedure TMain.cbStreamChange(Sender: TObject);
begin
  inherited;
  OpenFile(False);
end;

end.