home *** CD-ROM | disk | FTP | other *** search
/ Chip 2002 October / Chip_2002-10_cd1.bin / zkuste / delphi / kolekce / d56 / FLEXCEL.ZIP / BiffEdit / UBiffEdit.pas < prev    next >
Pascal/Delphi Source File  |  2002-05-28  |  13KB  |  425 lines
  1. unit UBiffEdit;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   URecordEdit, Menus, ImgList, ActnList, ComCtrls, StdCtrls, ToolWin,
  8.   ExtCtrls,axctrls, activex, ComObj, UBiffData, UBiffEditUtil, UWaitCursor, UEscherEdit;
  9.  
  10. type
  11.   TProcessStreamFunc = procedure (const FullName: Widestring; const DocIN, DocOUT: IStorage) of object;
  12.  
  13.   TMain = class(TRecordEdit)
  14.     ActionOpen: TAction;
  15.     ActionSaveAs: TAction;
  16.     OpenDialog: TOpenDialog;
  17.     SaveDialog: TSaveDialog;
  18.     Panel1: TPanel;
  19.     cbStream: TComboBox;
  20.     Label1: TLabel;
  21.     procedure FormCreate(Sender: TObject);
  22.     procedure ActionOpenExecute(Sender: TObject);
  23.     procedure ActionSaveAsExecute(Sender: TObject);
  24.     procedure ActionSaveAsUpdate(Sender: TObject);
  25.     procedure ActionEditExecute(Sender: TObject);
  26.     procedure ListRecordsGetImageIndex(Sender: TObject; Item: TListItem);
  27.     procedure cbStreamChange(Sender: TObject);
  28.   protected
  29.     function SectionBegins(const aRecord: PRecord): boolean;override;
  30.     function SectionEnds(const aRecord: PRecord): boolean;override;
  31.     function GetIdName(const Id: word): string;override;
  32.   private
  33.     EscherEdit: TEscherEdit;
  34.  
  35.     function ExtractName(const FullName: widestring): widestring;
  36.     procedure OpenFile(const ResetStream: boolean);
  37.     procedure CopyStorage(const DocIN, DocOUT: IStorage);
  38.     procedure CreateNewDocument(const TemplateFileName, OutputFileName: WideString);
  39.     procedure FillStreamBox(const DocIN: IStorage);
  40.     procedure IterateStorage(const DocIN, DocOUT: IStorage; const DoStream, DoStorage: TProcessStreamFunc; const Path: Widestring);
  41.     procedure aCopyStorage(const FullName: Widestring; const DocIN, DocOUT: IStorage);
  42.     procedure aCopyStream(const FullName: Widestring; const DocIN, DocOUT: IStorage);
  43.     function CurrentStream: widestring;
  44.     procedure FillCbStream(const FullName: Widestring; const DocIN,
  45.       DocOUT: IStorage);
  46.     procedure FillCbStorage(const FullName: Widestring; const DocIN,
  47.       DocOUT: IStorage);
  48.     { Private declarations }
  49.   public
  50.     { Public declarations }
  51.   end;
  52.  
  53. var
  54.   Main: TMain;
  55.  
  56. implementation
  57.  
  58. procedure TMain.OpenFile(const ResetStream: boolean);
  59. var
  60.   DocIN: array of IStorage;  //We have to keep them all
  61.   Workbook: IStream;
  62.   RecordHeader: TRecordHeader;
  63.   WFileName: Widestring;
  64.   s:string;
  65.   le: longint;
  66.   Ofs: string;
  67.   StreamPos: Cardinal;
  68.   DataRec: PRecord;
  69.   WaitCursor: IWaitCursor;
  70.   Wc:WideString;
  71. begin
  72.   WaitCursor:=TWaitCursor.Create;
  73.   WFileName:=OpenDialog.FileName;
  74.   StreamPos:=0;
  75.  
  76.   DataRecords.Clear;
  77.   UpdateRecordCount;
  78.   Caption:='Biff Edit';
  79.   Ofs:='';
  80.   SetLength(DocIN, 1);
  81.   OleCheck(StgOpenStorage(PWideChar(WFileName), nil, OptionsRead, nil, 0, DocIN[0]));
  82.   if ResetStream then FillStreamBox(DocIN[0]);
  83.   if CurrentStream='' then exit;
  84.   Wc:=copy(CurrentStream, 2 , MaxInt);
  85.   while Pos('\', Wc)<>0 do
  86.   begin
  87.     SetLength(DocIN, Length(DocIN)+1);
  88.     OleCheck(DocIN[Length(DocIN)-2].OpenStorage(PWideChar(copy(Wc,1,pos('\', Wc)-1)), nil, OptionsRead, nil, 0, DocIN[Length(DocIN)-1]));
  89.     Wc:=copy(Wc, pos('\', Wc) +1, MaxINT);
  90.   end;
  91.  
  92.   OleCheck(DocIN[Length(DocIN)-1].OpenStream(PWideChar(Wc), nil, OptionsRead, 0, Workbook));
  93.   try
  94.     while (Workbook.Read( @RecordHeader, sizeof(RecordHeader), @le)=S_OK) and (le=sizeof(RecordHeader)) do
  95.     begin
  96.       if (RecordHeader.Id=$000A) and (length(Ofs)-1>0) then Delete(Ofs,Length(Ofs)-1,2); //eof;
  97.  
  98.       New(DataRec);
  99.       try
  100.         DataRec.Id:=RecordHeader.Id;
  101.         DataRec.IdName:= Ofs+GetIdName(RecordHeader.Id);
  102.         DataRec.Size:=RecordHeader.Size;
  103.         DataRec.Offset:=StreamPos;
  104.         SetLength(s, RecordHeader.Size);
  105.         if Workbook.Read( @s[1], RecordHeader.Size, nil)<>S_OK then Raise Exception.Create(ErrInvalidRecord);
  106.         DataRec.Data:=SkipZero(s);
  107.         DataRec.HexData:=StrToHex(s);
  108.  
  109.         DataRecords.Add(DataRec);
  110.       except
  111.         Dispose(DataRec);
  112.         DataRecords.Clear;
  113.         raise;
  114.       end; //Except
  115.  
  116.       if RecordHeader.Id=$0809 then Ofs:=Ofs+'  '; //bof;
  117.  
  118.       StreamPos:=StreamPos+SizeOf(RecordHeader)+ RecordHeader.Size;
  119.       if DataRecords.Count=10000 then
  120.       begin
  121.         if MessageDlg(WarFileTooBig, mtWarning, [mbYes,mbNo], 0) = mrNo then break;
  122.       end;
  123.     end;
  124.     UpdateRecordCount;
  125.   finally
  126.     Workbook:=nil;
  127.   end; //finally
  128.   Caption:='Biff Edit: '+OpenDialog.FileName;
  129. end;
  130.  
  131. procedure TMain.FillCbStream(const FullName: Widestring; const DocIN, DocOUT: IStorage);
  132. begin
  133.   cbStream.Items.Add(FullName);
  134. end;
  135.  
  136. procedure TMain.FillCbStorage(const FullName: Widestring; const DocIN, DocOUT: IStorage);
  137. var
  138.   NewDocIN: IStorage;
  139. begin
  140.   OleCheck(DocIN.OpenStorage(PWideChar(ExtractName(FullName)), nil, OptionsRead, nil, 0, NewDocIN));
  141.   try
  142.     IterateStorage(NewDocIN, nil, FillCbStream, FillCbStorage, FullName);
  143.   finally
  144.     NewDocIN := nil;
  145.   end; //finally
  146. end;
  147.  
  148. procedure TMain.FillStreamBox(const DocIN: IStorage);
  149. var
  150.   i:integer;
  151. begin
  152.   cbStream.Items.Clear;
  153.   IterateStorage(DocIN, nil, FillCbStream, FillCbStorage, '');
  154.   for i:=0 to cbStream.Items.Count-1 do
  155.     if cbStream.Items[i]=WorkbookStr then cbStream.ItemIndex:=i;
  156. end;
  157.  
  158. {$R *.DFM}
  159.  
  160. procedure TMain.FormCreate(Sender: TObject);
  161. begin
  162.   inherited;
  163.   //This is because a bug in TToolbar
  164.   btnOpen.Action:=ActionOpen;
  165.   btnSaveAs.Action:=ActionSaveAs;
  166.  
  167.   IsBiff:=true;
  168.   if paramcount>0 then begin; OpenDialog.FileName:=ParamStr(1);OpenFile(true);end;
  169. end;
  170.  
  171. procedure TMain.ActionOpenExecute(Sender: TObject);
  172. begin
  173.   if not OpenDialog.Execute then exit;
  174.   OpenFile(true);
  175. end;
  176.  
  177.  
  178. procedure TMain.ActionSaveAsExecute(Sender: TObject);
  179. var
  180.   WaitCursor: IWaitCursor;
  181. begin
  182.   if not SaveDialog.Execute then exit;
  183.   if OpenDialog.FileName='' then exit;
  184.   if SaveDialog.FileName=OpenDialog.FileName then raise Exception.Create(ErrFileDestSameSource);
  185.   WaitCursor:=TWaitCursor.Create;
  186.   CreateNewDocument(OpenDialog.FileName, SaveDialog.FileName);
  187. end;
  188.  
  189. procedure TMain.ActionSaveAsUpdate(Sender: TObject);
  190. begin
  191.   ActionSaveAs.Enabled:=OpenDialog.FileName<>'';
  192. end;
  193.  
  194.  
  195. procedure TMain.aCopyStream(const FullName: Widestring; const DocIN, DocOUT: IStorage);
  196. var
  197.   StreamIN, StreamOUT: IStream;
  198.   rr, rw: int64;
  199.   i: integer;
  200.   WorkStream: TOleStream;
  201.   RecordHeader: TRecordHeader;
  202.   s:string;
  203. begin
  204.   if FullName = CurrentStream then
  205.     begin
  206.       //Create Workbook stream
  207.       OleCheck(DocOUT.CreateStream(PWidechar(ExtractName(FullName)), OptionsWrite, 0, 0, StreamOUT));
  208.       try
  209.         WorkStream := TOleStream.Create(StreamOUT);
  210.         try
  211.           //fill the new stream
  212.           for i:=0 to DataRecords.Count-1 do
  213.           begin
  214.             RecordHeader.Id:=DataRecords[i].Id;
  215.             RecordHeader.Size:=DataRecords[i].Size;
  216.             WorkStream.Write(RecordHeader, SizeOf(RecordHeader));
  217.             s:=HexToStr(DataRecords[i].HexData,RecordHeader.Size);
  218.             if Length(s)>0 then WorkStream.Write(s[1], length(s));
  219.           end;
  220.           //free objects
  221.         finally
  222.           FreeAndNil(WorkStream);
  223.         end; //finally
  224.       finally
  225.         StreamOUT := nil;
  226.       end; //finally
  227.     end
  228.   else
  229.   begin
  230.     OleCheck(DocIN.OpenStream(PWidechar(ExtractName(FullName)), nil, OptionsRead, 0, StreamIN));
  231.     try
  232.       OleCheck(DocOUT.CreateStream(PWidechar(ExtractName(FullName)), OptionsWrite, 0, 0, StreamOUT));
  233.       try
  234.         OleCheck(StreamIN.CopyTo(StreamOUT, High(int64), rr, rw));
  235.       finally
  236.         StreamOUT := nil;
  237.       end; //finally
  238.     finally
  239.       StreamIN := nil;
  240.     end; //finally
  241.   end;
  242. end;
  243.  
  244. procedure TMain.aCopyStorage(const FullName: WideString; const DocIN, DocOUT: IStorage);
  245. var
  246.   NewDocIN, NewDocOUT: IStorage;
  247. begin
  248.   OleCheck(DocIN.OpenStorage(PWideChar(ExtractName(FullName)), nil, OptionsRead, nil, 0, NewDocIN));
  249.   try
  250.     OleCheck(DocOUT.CreateStorage(PWideChar(ExtractName(FullName)), OptionsWrite, 0, 0, NewDocOUT));
  251.     try
  252.       IterateStorage(NewDocIN, NewDocOUT,aCopyStream, aCopyStorage, FullName);
  253.     finally
  254.       NewDocOUT := nil;
  255.     end; //finally
  256.   finally
  257.     NewDocIN := nil;
  258.   end; //finally
  259. end;
  260.  
  261. procedure TMain.CopyStorage(const DocIN, DocOUT: IStorage);
  262. begin
  263.   IterateStorage(DocIN, DocOUT, aCopyStream, aCopyStorage, '');
  264. end;
  265.  
  266. procedure TMain.IterateStorage(const DocIN, DocOUT: IStorage; const DoStream, DoStorage: TProcessStreamFunc; const Path: Widestring);
  267. var
  268.   Enum: IEnumStatStg;
  269.   NumFetched: integer;
  270.   StatStg: TStatStg;
  271.   Malloc: IMalloc;
  272.  
  273. begin
  274.   OleCheck(CoGetMalloc(1, Malloc));
  275.   try
  276.     if DocIN.EnumElements(0, nil, 0, Enum) <> S_OK then
  277.     begin
  278.       DocIN.Stat(StatStg, 0);
  279.       try
  280.         raise Exception.CreateFmt(ErrCantReadFile, [StatStg.pwcsName]);
  281.       finally
  282.         Malloc.Free(StatStg.pwcsName);
  283.       end; //finally
  284.     end;
  285.  
  286.     while Enum.Next(1, StatStg, @NumFetched) = S_OK do
  287.     begin
  288.       try
  289.         case StatStg.dwType of
  290.           STGTY_STREAM:
  291.             begin
  292.               DoStream( Path+'\'+StatStg.pwcsName, DocIN, DocOUT);
  293.             end;
  294.  
  295.           STGTY_STORAGE:
  296.             begin
  297.               DoStorage( Path+'\'+StatStg.pwcsName, DocIN, DocOUT);
  298.             end;
  299.         end; //case
  300.       finally
  301.          Malloc.Free(StatStg.pwcsName);
  302.       end; //finally
  303.     end; //while
  304.   finally
  305.     Malloc:=nil;
  306.   end;
  307. end;
  308.  
  309. procedure TMain.CreateNewDocument(const TemplateFileName,
  310.   OutputFileName: WideString);
  311. var
  312.   DocIN, DocOUT: IStorage;
  313. begin
  314.   DocIN := nil;
  315.   DocOut := nil;
  316.  
  317.   if StgIsStorageFile(PWideChar(TemplateFileName)) <> S_OK then
  318.     raise Exception.CreateFmt(ErrFileIsNotXLS, [TemplateFileName]);
  319.  
  320.   //Open template
  321.   OleCheck(StgOpenStorage(PWideChar(TemplateFileName), nil, OptionsRead, nil, 0, DocIN));
  322.   try
  323.     //Create output file
  324.     if FileExists(OutPutFileName) then DeleteFile(OutPutFileName);
  325.     OleCheck(StgCreateDocFile(PWideChar(OutputFileName), OptionsWrite, 0, DocOUT));
  326.     try
  327.       //Copy sections from template to output
  328.       CopyStorage(DocIN, DocOUT);
  329.  
  330.     finally
  331.       DocOUT := nil;
  332.     end; //finally
  333.   finally
  334.     DocIN := nil;
  335.   end; //finally
  336. end;
  337.  
  338.  
  339.  
  340. procedure TMain.ActionEditExecute(Sender: TObject);
  341. var
  342.   index, Idx: integer;
  343.   s: string;
  344. begin
  345.   if ListRecords.Selected= nil then exit;
  346.   Index:=ListRecords.Selected.Index;
  347.   if (DataRecords[Index].Id  >= $00EB) and (DataRecords[Index].Id  <= $00ED) then
  348.   begin
  349.     //Escher Record
  350.     if EscherEdit=nil then EscherEdit:=TEscherEdit.Create(Self);
  351.     EscherEdit.Caption:=Format('Editing Escher Record: Offset in Biff file: %x    Id: %s',[DataRecords[Index].Offset, Trim(ListRecords.Selected.Caption)]);
  352.     EscherEdit.PanelVersion.Visible:=false;
  353.  
  354.     //Handle continues
  355.     s:=DataRecords[Index].HexData; Idx:=Index+1;
  356.     while (Idx<DataRecords.Count) and (DataRecords[idx].Id= $3C) do
  357.     begin
  358.       s:=s+DataRecords[idx].HexData;
  359.       inc(idx);
  360.     end;
  361.     if idx>Index+1 then Showmessage(WarEscherBig);
  362.     EscherEdit.ActionOk.Enabled:= idx= Index+1;
  363.  
  364.     EscherEdit.Load(s, DataRecords[Index].Version, DataRecords[Index].Size );
  365.     if EscherEdit.ShowModal = mrOk then
  366.     begin
  367.       s:=HexToStr(EscherEdit.HexData, (Length(EscherEdit.HexData)-1) div 3 +1);
  368.       DataRecords[Index].Size:= Length(s);
  369.       DataRecords[Index].HexData:= EscherEdit.HexData;
  370.       DataRecords[Index].Data:= SkipZero(s);
  371.       ListRecordsSelectItem( Self, ListRecords.Selected, true);
  372.       FixStreamOffsets(ListRecords.Selected.Index-1);
  373.     end;
  374.   end else inherited;
  375.  
  376. end;
  377.  
  378. procedure TMain.ListRecordsGetImageIndex(Sender: TObject; Item: TListItem);
  379. begin
  380.   inherited;
  381.   if (Item<>nil) and (DataRecords[Item.Index].Id  >= $00EB)
  382.   and (DataRecords[Item.Index].Id  <= $00ED) then Item.ImageIndex:=0 else
  383.   if  (DataRecords[Item.Index].Id   = $003C) then Item.ImageIndex:=1 else
  384.   if  (DataRecords[Item.Index].Id   = $0809) then Item.ImageIndex:=2 else
  385.   if  (DataRecords[Item.Index].Id   = $000A) then Item.ImageIndex:=3 else
  386.   Item.ImageIndex:=-1;
  387.  
  388. end;
  389.  
  390. function TMain.SectionEnds(const aRecord: PRecord): boolean;
  391. begin
  392.   SectionEnds:=aRecord.Id=$000A;
  393. end;
  394.  
  395. function TMain.SectionBegins(const aRecord: PRecord): boolean;
  396. begin
  397.   SectionBegins:=aRecord.Id=$0809;
  398. end;
  399.  
  400. function TMain.GetIdName(const Id: word): string;
  401. begin
  402.   Result:= UBiffEditUtil.GetIdName(Id);
  403. end;
  404.  
  405. function TMain.ExtractName(const FullName: widestring): widestring;
  406. var
  407.   I: Integer;
  408. begin
  409.   I := LastDelimiter('\', FullName);
  410.   Result := Copy(FullName, I + 1, MaxInt);
  411. end;
  412.  
  413. function TMain.CurrentStream: widestring;
  414. begin
  415.   Result:=cbStream.Text;
  416. end;
  417.  
  418. procedure TMain.cbStreamChange(Sender: TObject);
  419. begin
  420.   inherited;
  421.   OpenFile(False);
  422. end;
  423.  
  424. end.
  425.