home *** CD-ROM | disk | FTP | other *** search
- 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.
-