From 933d8a5b444c964a01c6b1867591b4c9a44ce4aa Mon Sep 17 00:00:00 2001 From: sekelsenmat Date: Mon, 2 Feb 2009 09:58:51 +0000 Subject: [PATCH] fpspreadsheet: Improves OpenDocument support git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@692 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- .../examples/excel5demo/excel5write.lpi | 132 +- .../examples/excel5demo/excel5write.lpr | 15 +- .../examples/ooxmldemo/ooxmlwrite.lpi | 132 +- .../examples/ooxmldemo/ooxmlwrite.lpr | 14 +- .../examples/opendocdemo/oocreated.ods | Bin 7055 -> 7246 bytes .../examples/opendocdemo/opendocwrite.lpi | 252 +-- .../examples/opendocdemo/opendocwrite.lpr | 39 +- components/fpspreadsheet/fpsopendocument.pas | 126 +- components/fpspreadsheet/fpspreadsheet.pas | 111 +- components/fpspreadsheet/fpszipper.pp | 1687 +++++++++++++++++ .../fpspreadsheet/laz_fpspreadsheet.lpk | 8 +- .../fpspreadsheet/laz_fpspreadsheet.pas | 2 +- components/fpspreadsheet/xlsbiff2.pas | 108 +- components/fpspreadsheet/xlsbiff5.pas | 12 +- components/fpspreadsheet/xlsbiff8.pas | 12 +- components/fpspreadsheet/xlsxooxml.pas | 316 +-- 16 files changed, 2386 insertions(+), 580 deletions(-) create mode 100644 components/fpspreadsheet/fpszipper.pp diff --git a/components/fpspreadsheet/examples/excel5demo/excel5write.lpi b/components/fpspreadsheet/examples/excel5demo/excel5write.lpi index 96adb0ca9..9ef7a1dfe 100644 --- a/components/fpspreadsheet/examples/excel5demo/excel5write.lpi +++ b/components/fpspreadsheet/examples/excel5demo/excel5write.lpi @@ -33,13 +33,13 @@ - + - - + + @@ -68,8 +68,8 @@ - - + + @@ -86,9 +86,9 @@ - - - + + + @@ -97,7 +97,7 @@ - + @@ -116,8 +116,8 @@ - - + + @@ -128,108 +128,146 @@ + + + + + + + + + + + + + + + + + + - + - + - + - + - + - + - + - + - - - - - - - - - - + + + + + + + + + + - + - + - + - - + + - + - - + + - + - + - + - + - + - + - - + + - - + + + + + + + + + + + + + + + + + + + + + + diff --git a/components/fpspreadsheet/examples/excel5demo/excel5write.lpr b/components/fpspreadsheet/examples/excel5demo/excel5write.lpr index accb4d33f..df379ecc6 100644 --- a/components/fpspreadsheet/examples/excel5demo/excel5write.lpr +++ b/components/fpspreadsheet/examples/excel5demo/excel5write.lpr @@ -15,10 +15,9 @@ uses var MyWorkbook: TsWorkbook; MyWorksheet: TsWorksheet; - MyFormula: TRPNFormula; + MyFormula: TsFormula; MyDir: string; i: Integer; - a: TStringList; begin // Open the output file MyDir := ExtractFilePath(ParamStr(0)); @@ -44,16 +43,8 @@ begin } // Write the formula E1 = A1 + B1 - // or, in RPN: A1, B1, + - SetLength(MyFormula, 3); - MyFormula[0].TokenID := INT_EXCEL_TOKEN_TREFV; {A1} - MyFormula[0].Col := 0; - MyFormula[0].Row := 0; - MyFormula[1].TokenID := INT_EXCEL_TOKEN_TREFV; {B1} - MyFormula[1].Col := 1; - MyFormula[1].Row := 0; - MyFormula[2].TokenID := INT_EXCEL_TOKEN_TADD; {+} - MyWorksheet.WriteRPNFormula(0, 4, MyFormula); +// MyFormula.FormulaStr := ''; +// MyWorksheet.WriteFormula(0, 4, MyFormula); // Creates a new worksheet MyWorksheet := MyWorkbook.AddWorksheet('My Worksheet 2'); diff --git a/components/fpspreadsheet/examples/ooxmldemo/ooxmlwrite.lpi b/components/fpspreadsheet/examples/ooxmldemo/ooxmlwrite.lpi index 977c26743..ff2ab33cd 100644 --- a/components/fpspreadsheet/examples/ooxmldemo/ooxmlwrite.lpi +++ b/components/fpspreadsheet/examples/ooxmldemo/ooxmlwrite.lpi @@ -11,7 +11,7 @@ <UseAppBundle Value="False"/> - <ActiveEditorIndexAtStart Value="2"/> + <ActiveEditorIndexAtStart Value="1"/> </General> <VersionInfo> <ProjectVersion Value=""/> @@ -38,8 +38,8 @@ <Filename Value="ooxmlwrite.lpr"/> <IsPartOfProject Value="True"/> <UnitName Value="ooxmlwrite"/> - <CursorPos X="19" Y="46"/> - <TopLine Value="33"/> + <CursorPos X="81" Y="57"/> + <TopLine Value="46"/> <EditorIndex Value="0"/> <UsageCount Value="309"/> <Loaded Value="True"/> @@ -131,8 +131,8 @@ <Unit12> <Filename Value="..\..\fpsopendocument.pas"/> <UnitName Value="fpsopendocument"/> - <CursorPos X="15" Y="1"/> - <TopLine Value="1"/> + <CursorPos X="3" Y="296"/> + <TopLine Value="285"/> <EditorIndex Value="1"/> <UsageCount Value="13"/> <Loaded Value="True"/> @@ -140,8 +140,8 @@ <Unit13> <Filename Value="..\..\xlsxooxml.pas"/> <UnitName Value="xlsxooxml"/> - <CursorPos X="1" Y="89"/> - <TopLine Value="79"/> + <CursorPos X="1" Y="248"/> + <TopLine Value="244"/> <EditorIndex Value="2"/> <UsageCount Value="13"/> <Loaded Value="True"/> @@ -150,123 +150,123 @@ <JumpHistory Count="30" HistoryIndex="29"> <Position1> <Filename Value="..\..\fpolestorage.pas"/> - <Caret Line="77" Column="7" TopLine="76"/> + <Caret Line="567" Column="5" TopLine="548"/> </Position1> <Position2> - <Filename Value="..\..\fpspreadsheet.pas"/> - <Caret Line="137" Column="40" TopLine="129"/> + <Filename Value="..\..\fpolestorage.pas"/> + <Caret Line="622" Column="1" TopLine="618"/> </Position2> <Position3> <Filename Value="..\..\fpolestorage.pas"/> - <Caret Line="563" Column="5" TopLine="544"/> + <Caret Line="621" Column="29" TopLine="611"/> </Position3> <Position4> - <Filename Value="..\..\fpolestorage.pas"/> - <Caret Line="486" Column="5" TopLine="467"/> + <Filename Value="..\..\fpspreadsheet.pas"/> + <Caret Line="428" Column="5" TopLine="403"/> </Position4> <Position5> - <Filename Value="..\..\fpolestorage.pas"/> - <Caret Line="510" Column="5" TopLine="491"/> + <Filename Value="..\..\fpspreadsheet.pas"/> + <Caret Line="458" Column="15" TopLine="434"/> </Position5> <Position6> - <Filename Value="..\..\fpolestorage.pas"/> - <Caret Line="94" Column="46" TopLine="84"/> + <Filename Value="..\..\fpspreadsheet.pas"/> + <Caret Line="386" Column="1" TopLine="372"/> </Position6> <Position7> - <Filename Value="..\..\fpolestorage.pas"/> - <Caret Line="686" Column="5" TopLine="667"/> + <Filename Value="..\..\fpspreadsheet.pas"/> + <Caret Line="390" Column="26" TopLine="377"/> </Position7> <Position8> - <Filename Value="..\..\fpolestorage.pas"/> - <Caret Line="567" Column="5" TopLine="548"/> + <Filename Value="..\..\fpspreadsheet.pas"/> + <Caret Line="420" Column="32" TopLine="407"/> </Position8> <Position9> - <Filename Value="..\..\fpolestorage.pas"/> - <Caret Line="622" Column="1" TopLine="618"/> + <Filename Value="..\..\fpspreadsheet.pas"/> + <Caret Line="421" Column="14" TopLine="408"/> </Position9> <Position10> - <Filename Value="..\..\fpolestorage.pas"/> - <Caret Line="621" Column="29" TopLine="611"/> + <Filename Value="..\..\fpspreadsheet.pas"/> + <Caret Line="460" Column="33" TopLine="440"/> </Position10> <Position11> <Filename Value="..\..\fpspreadsheet.pas"/> - <Caret Line="428" Column="5" TopLine="403"/> + <Caret Line="181" Column="91" TopLine="160"/> </Position11> <Position12> <Filename Value="..\..\fpspreadsheet.pas"/> - <Caret Line="458" Column="15" TopLine="434"/> + <Caret Line="769" Column="83" TopLine="754"/> </Position12> <Position13> <Filename Value="..\..\fpspreadsheet.pas"/> - <Caret Line="386" Column="1" TopLine="372"/> + <Caret Line="102" Column="15" TopLine="89"/> </Position13> <Position14> <Filename Value="..\..\fpspreadsheet.pas"/> - <Caret Line="390" Column="26" TopLine="377"/> + <Caret Line="103" Column="15" TopLine="90"/> </Position14> <Position15> <Filename Value="..\..\fpspreadsheet.pas"/> - <Caret Line="420" Column="32" TopLine="407"/> + <Caret Line="404" Column="5" TopLine="379"/> </Position15> <Position16> <Filename Value="..\..\fpspreadsheet.pas"/> - <Caret Line="421" Column="14" TopLine="408"/> + <Caret Line="187" Column="1" TopLine="172"/> </Position16> <Position17> <Filename Value="..\..\fpspreadsheet.pas"/> - <Caret Line="460" Column="33" TopLine="440"/> + <Caret Line="380" Column="17" TopLine="362"/> </Position17> <Position18> <Filename Value="..\..\fpspreadsheet.pas"/> - <Caret Line="181" Column="91" TopLine="160"/> + <Caret Line="412" Column="1" TopLine="404"/> </Position18> <Position19> <Filename Value="..\..\fpspreadsheet.pas"/> - <Caret Line="769" Column="83" TopLine="754"/> + <Caret Line="716" Column="1" TopLine="702"/> </Position19> <Position20> <Filename Value="..\..\fpspreadsheet.pas"/> - <Caret Line="102" Column="15" TopLine="89"/> + <Caret Line="167" Column="17" TopLine="154"/> </Position20> <Position21> - <Filename Value="..\..\fpspreadsheet.pas"/> - <Caret Line="103" Column="15" TopLine="90"/> - </Position21> - <Position22> - <Filename Value="..\..\fpspreadsheet.pas"/> - <Caret Line="404" Column="5" TopLine="379"/> - </Position22> - <Position23> - <Filename Value="..\..\fpspreadsheet.pas"/> - <Caret Line="187" Column="1" TopLine="172"/> - </Position23> - <Position24> - <Filename Value="..\..\fpspreadsheet.pas"/> - <Caret Line="380" Column="17" TopLine="362"/> - </Position24> - <Position25> - <Filename Value="..\..\fpspreadsheet.pas"/> - <Caret Line="412" Column="1" TopLine="404"/> - </Position25> - <Position26> - <Filename Value="..\..\fpspreadsheet.pas"/> - <Caret Line="716" Column="1" TopLine="702"/> - </Position26> - <Position27> - <Filename Value="..\..\fpspreadsheet.pas"/> - <Caret Line="167" Column="17" TopLine="154"/> - </Position27> - <Position28> <Filename Value="..\..\xlsbiff2.pas"/> <Caret Line="69" Column="1" TopLine="57"/> - </Position28> - <Position29> + </Position21> + <Position22> <Filename Value="ooxmlwrite.lpr"/> <Caret Line="68" Column="57" TopLine="46"/> + </Position22> + <Position23> + <Filename Value="..\..\xlsxooxml.pas"/> + <Caret Line="102" Column="1" TopLine="77"/> + </Position23> + <Position24> + <Filename Value="..\..\xlsxooxml.pas"/> + <Caret Line="89" Column="1" TopLine="79"/> + </Position24> + <Position25> + <Filename Value="..\..\xlsxooxml.pas"/> + <Caret Line="50" Column="30" TopLine="37"/> + </Position25> + <Position26> + <Filename Value="..\..\xlsxooxml.pas"/> + <Caret Line="51" Column="58" TopLine="35"/> + </Position26> + <Position27> + <Filename Value="..\..\xlsxooxml.pas"/> + <Caret Line="80" Column="70" TopLine="67"/> + </Position27> + <Position28> + <Filename Value="..\..\xlsxooxml.pas"/> + <Caret Line="194" Column="17" TopLine="181"/> + </Position28> + <Position29> + <Filename Value="..\..\xlsxooxml.pas"/> + <Caret Line="324" Column="46" TopLine="306"/> </Position29> <Position30> <Filename Value="..\..\xlsxooxml.pas"/> - <Caret Line="102" Column="1" TopLine="77"/> + <Caret Line="211" Column="20" TopLine="188"/> </Position30> </JumpHistory> </ProjectOptions> diff --git a/components/fpspreadsheet/examples/ooxmldemo/ooxmlwrite.lpr b/components/fpspreadsheet/examples/ooxmldemo/ooxmlwrite.lpr index 7e4d67dec..a05dfc6e2 100644 --- a/components/fpspreadsheet/examples/ooxmldemo/ooxmlwrite.lpr +++ b/components/fpspreadsheet/examples/ooxmldemo/ooxmlwrite.lpr @@ -43,18 +43,6 @@ begin end; } - // Write the formula E1 = A1 + B1 - // or, in RPN: A1, B1, + - SetLength(MyFormula, 3); - MyFormula[0].TokenID := INT_EXCEL_TOKEN_TREFV; {A1} - MyFormula[0].Col := 0; - MyFormula[0].Row := 0; - MyFormula[1].TokenID := INT_EXCEL_TOKEN_TREFV; {B1} - MyFormula[1].Col := 1; - MyFormula[1].Row := 0; - MyFormula[2].TokenID := INT_EXCEL_TOKEN_TADD; {+} - MyWorksheet.WriteRPNFormula(0, 4, MyFormula); - // Creates a new worksheet MyWorksheet := MyWorkbook.AddWorksheet('My Worksheet 2'); @@ -65,7 +53,7 @@ begin MyWorksheet.WriteUTF8Text(0, 3, 'Fourth'); // Save the spreadsheet to a file - MyWorkbook.WriteToFile(MyDir + 'test' + STR_OOXML_EXCEL_EXTENSION, sfOOXML); + MyWorkbook.WriteToFile(MyDir + 'test.xlsx', sfOOXML); MyWorkbook.Free; end. diff --git a/components/fpspreadsheet/examples/opendocdemo/oocreated.ods b/components/fpspreadsheet/examples/opendocdemo/oocreated.ods index bfe2e21bdf579a7004c4673aa7c6b4d059d8e24d..9208462700a3b84e818af17d2f9e2cbd70a6cbef 100644 GIT binary patch delta 4665 zcmZ8l2Q*w=*B+uKTJ%AP9=!~~AfiQ-1fvBph~7nsJ~t7f*HNNJhzWv--ev?L(HXs$ z7!o~t{}S)}e*gFWcddJ$=k9a%S^M6#&fd>HaZ<g~<T{#H2xvinE~;F`1ajRgf51}m z64LZ9VGHt?ksYaqNBf5&;doMijj$u@@TmWxn}1Ox0Y3C{mLfhI;5m7l3VmQ?@4Hfo z#dAn3a;iua|KaNqsqG5Q+CBum&?F_l?+()WbRI+>NUF~j>X9kIVEj0+;ba{dZ|9cn zDK`Fm@G-ro$ZlC9DXmsP<D;G?N&v$tHIwm08<J*|shFr?xTM3_Vr{v#Nl<kyO9JIt z22<rI#6kJ&DWGD2U;;O7mf^x%<b)CDfGzL6;!z8u$>s`hv2*zqvwD`zI--V&!nc#< zo%B)a-op?X!z1HsiR#_{a9AtlBe`qvz{~(At4=PG>d6vJOi-brqHjO|^AJkja%8bn zBZ4XU6NuoE9hBrubmgNABQz!FOMOx#zj-iI7L((Ooq-TQXCGowTP@ZB_V6Y;t1^z+ zDDC;Fl0KeZG!SI?GOUCewP?!y&}=$0eJ|p8hTy>W5io_BJxK2CIQ}%ISoC^fX+@N| zvRLHZTA@j(?U+;j!0@nyefEvreZj!uTD+y^abxMc;5~5aQF%VQFd3Dig_S9qjU$63 zNQwPw`XVdv0gEiSXaX*pN8+*auK}=@Z!WpeewuDI2`}fFypE2B&2gLcVycLtz%QP4 z>Swos??UyGvq=WTO*dP;wZ%K1=QoGIyVIYpe?j8Lq1gd$bf}h$IWF(#nNid5jiL#f zPr>-K9i2agM*W}Ps<RwBVUDbqj)RM~cpr+-%DMnIFPN5nw%E>4>2m!_Y?fOPp?Bxl z&l15#bF`WKFacC@LamZCXH^#3e{cCFK2Ph6v1S8edHx=)0o*sMK!EFA%Wb_^FSD)1 zjrrfOeWP}V_rLL;Hg=vj&7N?fKN{F$6D&KD^?K;3hpOePlfU_jI@Q3_I@D>dSh9CG zS%DlV8#wZ7NhadZZ1v<1FLu!<T=Zl1&-CH#-X127O!6YkU(Jg)Y+)f-A{d%dhLvh6 z`UvHWq)(^%cHOMg8c5V>6I4JkWjaUiTkv705#Tw~<N|+k3;K$7@3ZkidufF+E3(Rj zVO%&3z$r{8A_{=%nB?qg=4`WuHgn~3$$*-ajW_F-#tY8*Z;p!W7oB2X;+0ej#fcU+ zG;o{EYMZ?0snvSH)co$wI+cSSLCal|1(P2|o^y1}-@`R0D~Z?o;h4a}_s?IOIVfLG zWO8#CKX7d|nVvE3BD~Wbyf2H8`RLcy#h?_k+AbYFzodA>aQ>}y-q#37BwVt0#d{H8 zS=v}i3%BB>c^at8gLcZ?9{nPd1%3JuWw#jk<xT7smS}X)u@85H1l|${aa3LmXMQ%h z<XkX|*kXQRHksVamf-s%Q{mXH6*bFxhIz~D=9Lj5wIMf#V)K)X?rv)hJ27WHYmnaF zEYQZpYPYLGcFgpiR;!j>T+pAjHwa2KKD+i(o52-g^a+zizG3!x&UQrp#<{HPHmQy# zF-baP<sKaY2-HUd0{xYUNI)ci5)o33hzGb&#|@LQ5OHvmstItUQ$6d~AJ|)J=wlp- zDNk_O=f<F|m@7Uuvp#^m>rw3t-G+!DY}deF*Qax>KgZrzB{UEFVL(k3VwIo^|In&{ z0BEK|d@|fzRkQW94AYvu)oWvu?ufs|*TFe1(T`dR9ckQD9gfUPe4pGdpnH8I*$^<> z?X35pc5*JQC-kY3lv%0kB$~vkQtrr`x*N$N?G=p1EnZ+t{e^M-Y_w4x*DZAo?_(=& zQAGbbSamP<u8LedLjYA6H1(%&?2-p~a`?8z)IyPocvPpm7Nc0NekS}~c}I#$Ufnj> zS&9puN~zLYK;$6t)sZ^_pTv1|2w0L+Hp_wstw)XzR|)Xgx0`a=jiwPEXf8oB%=t%+ zjcQc<WfNvI4uu3KFf->KMFPgXdo~~Ci$3NLuem_IjLb;}UOCcES=P)8Cw^C5%a&a^ zQ$2*k9#|8{inNG5skM2WWR;I69D{c~A&bv1F2xp$Ofhdy)K~g>J3jE-1|VJ&Y<W|+ z3uRd6m^w6-WN^>JksxnzzAo%3ktHvYcJFKNgP!Wb+FC$Yhp%XK#`5|Z4S!G}oL7O} ze7If+lUGrdd^I@1-XH2gxd<-B#_a^@rzhnsoJt;DJ2NK6u$SKB@Qvipg?o!W+yXy| zL?sS=HRIhax8qWibUMzf0jApQPt-z4t#ZS1RCKv>1M>^|4Vw70GzqSeWfpnYN{i{U zM_i34TGzQI80@L53N~PRicQHKfiL{ZcS)bq8Q3T@dQ$gDtSyR(?q+c%orSKakR?Q6 zI&3-edL~g@AH+s%CN?Zkn&lK`HBjdM`CI>|x<s&ym&Ql8YBM&mDWKFC%ag}hI5Ab9 zJzQA|KWE{?@XUj6*=K8Xa&}7c-4)3r9FG4m1Z658pJ=X15_P!I@%Y`hD4&Sgj)$Tv z_iVKWKJm<lzpy&G`8uv3M?7vl-^KI7g?T(JW~7=g;X!}P+TtND%)md59%FJ}*XY^T z%7&jGhk0#<&FA&KC*J}#_yq~Pe%Z}&+r!gF66l_?7<k9Sh@ySpt?2q6j$w};WXl64 zD@Lo;YdQwyuh!lhr7*yjB*IAj*JDkjgV@`#od+srBjgjB<w1~$V}!`it0t>-2CAa# zd1I3mbLn;}EhG=*?vdWBApM$cYYS7ZqNfQjpf1rn+58w|scjFGhq4p=<XWAA#fh$d zH4dbe4SLc;d*}YayT((kct6ckxrn-cVxiFZ*THHULxWzGnbkFNWVQrg@%dZsZ$#9z z64apFItcN43b9))@iOCVll-}CT2g0dhfu5J9fxnuj1LqdVL7ofNgDI;M2^~St-~&B zM(e=avl4Lywez7s$ijPtL;V7Bh!<_u#(E(?)|~(n{Vn>K3eb-v8+skR+semnIyP1K za^Jd+D!!>AFs<w9<oBC($MZH<cjA&cjhm@C>x@^f*<9JwWD6O=J>YN%d+!U)=SdNv z;?WA^6x&~nAU5`u^NT9u^Rr!2{MsFue!ny^gZVMh{vFC}fNQ^lgFmUR%p9cd*2vVd z`9OOq4bz%4*LLb~^yB6mD+X&FzL!nslo~%UonwokH?(JrdXyscos_cLIRzwAgvmvx zD?}S{k9RXnPs+<35ye966peKa4Gl4Up)vW;#W}$}o*1;b9-;F5)BbH1$&v#fTY;XJ z5fcwwGlou9fv-gDzIyV#BCn_@?E|C7PjIcB66H~N<>(!Tg3vVIbN12CkT9%%g>aj^ z0^3&q&JfKwjTi0)5udn>-sk+0U=CTIR;?Vau3N?`q)9r7?cZ7gJxp%vGS1-|nu*B< zL<S8!D(c~tig5<o3TP2SnBo-S#Atqx$2cK$9HZ|qxP53G*Kr|bwIlT>SD)jGRU-*O zAad|Ox%zL>2%S;+I8s4LMvPA`E+i_ZFD?cZm4-sZk(?A}_z*E<FoiIl6tbM69#0zS zOnLuO8rD#%1K@=p3yd(a<@M<(zbF<)7U6XC=>>pwZMfzcY8XOPj;`1xbHzOSU>3lG zOgP;eH9uOOl1Iy)H;<!K6`ZOsN)Rjof<7l5Yzoe!+K&P!_d@-Cy<G25V3T(3bw=8t z;{$MKLemVfPS5Tferw2B+!V`@IjHGIi)N`K0=Rd8S9yL9*AEOdLQGE6g<to*zIc-A zH$6HUx6Xje7&DjXnRYvOcIrY$rCwd-MQ>s(SS`JE_w-8oMWi-Y<N5+GzK>S>oD=T6 zeKSgZb2=N}fZff8Nth-3S?qTAg;E2yFg5G2q$zGp0AXC74Ak^3If&!{=Zs$+GLW)P z$h0hApk=?J`=tBDt~Fu!UW#7zRW*b;FSp~ct26M_X?%o%Rm8eiJ@C^}^`6>lU8s|z zTR!^iY^esj6YPNCgD^0d1_1|-84<7PP{?EDMUl-t)<^I=j!v)u&+>EggIS-P-fuH~ z@H6ARu90!J09LoX9I55`4?~{gp=T!=hWS9#(&p=u)0e2~QpBKP4-&H1CqGLwg3(;w zh~Dkye;14<zDDUI;$N-QZZ^FgdbQ&*eJzbV;oa(an##Vhoe41?oSMzNdCy5L&?Ga> zsX)W%uA30k>~0nCIHN`cx)w*FQpvHDGKkt#!i1ojG>@N+Z#8j9F!6V)AQw-~?*o&r z8{&`4&fodKzYl;%LxJ)v^HeXKq}}?$u4t>B`HO)kjV248bcp4Cvn|{RRyzvU`K1hl z@K<v!eNejl6t%nALI3?=xr2DtPcW<2A!;*9>LB=;Al&ifB<`Kw@t$2OZ*Pq{#&hzb zv37W4oo8()plByb^U%Xvq5I;X1L`8`=kk^G+|mULv+kE#-6f`nkY$%5gjX}E(|@ZG zVv?lB8??3fAW+P2h4OE8B2O&>=t9~b7N4bEM^^jES`KHh)O1g?mjgkR@zLz@RH3P{ z+Obp9cBwX-4K@9k+Ji?{SCnAiujB=dh%+_c@ZvKkk6t}O;fNQX92UfNaeFs=43Nsr z74a$Z$*bPp^$;$x_O&1gHoec4OwY@DUsHzuxEX6Ra_%f}JLPemUD7N$5M2dB+oW4E zW`|BgXay>Q5D3@yydV0+M~S7K=^D118A@%$$^*e|X=9I2!~RY@7cuR<-<tZpqAi)i zcK5^1vR-^gsnhxDIx{tNB{*GC&ZxXi+Y<I3?6=BVR+pP7%ot4&FLQhk`o0>?n*SKw zYB(Es)sOCwS<pcKyZMj-uqwCfS3D_`eh07KWZ8da)q6Jii<JC=6rayL>(mE6lARpg z#(Q?DV<}G=TM9F_Vf?u?&5ZY6t{eF=DMApv5fooFWADJ9l;P<&sGP@KVb^_}o3DYo z*le^&-M^6el`|zM6D_Bxc)?*5GJYrTr)+&Z`32LL>!cJ)x+r1)cHl(fu7PWR(1p`n z9E++H71l1K>}reW+`0By$)ifx+K2nF*zbk{Gkkm0$x3BPTS9N8Mw2uk(BK&=dh5an z|4ND&JYz+!oW8*T!mZ4xlXSQQOO)F<IaQa(iw)l6fXchl_+V2i-A8t^o7xdu&K!*d zHKUC8h=lk27B@8RdI5;8ErxJ15~)|3EnF<FIC_Hi^Dd4n8U$)vz?-7q0;hkC6ov1h za)VPjK@k#Nt<!*AeFok1r;{6HdMnNjYhd*ad^JxHUOX9Q65XcsHo1W4SpS?X$+fO| z#{Zi2;45d#4{hN+5egmPgsYz@>m#$0pQAiRrG{)RiC_ww3xKl6s*YdRf~R(8$HKbB z{2+NUUCwq+^G=q6gg5o+O14HoS60>ChZik)N?vmg7NZh4?S6U0Q4RjL(7W*~co^JX zbD`_0o%bU1lFukwla^L0Wm-=inw+nveq5$GsF`x_MT?l_!{$nT{W#2^OA$Jb?N}Q@ z?37}=BF|(!3j_&<hs;cBc1Db)D8>ZlxRh~+$EhUz+<ex^6D&P3D&~&{f#0bv^=#@R z2tTVOQX}Zx)d;zkt4z6@xW=0w{Hj~vWrHMn-_nBR-67q@%^mG=&4-JbIp+x;2S<s` zQ+#B)DopKDP|WU8UBdoQ@960Pcjt(@;Rk}g*SF-%(s{MfN@=RI%dajj_v*F`*HZEo z5NMwH|LxTZGWsaI%bJtUaCwe_>}OEDd}m~YU7`!4@+I~&Fe7^z`7ikiquSqN%t#CH zt^e|Zzxe=IgW`9a0{y=R2Fb@H0Q@oiZ=Jk)d9d=&BbW#T^7Qg^w(%79b#d0w#KWfr z{rBkQvWkZN{(?U@$v-Zas6qw;x!8DF{;${HeG>G4a}*=RzudNw^Gv)Xe?t26bC6Wb w^m3cjzay~m@^Wys`&SJAtfr`cqO6Vw0@)LTKy?3F3{8)G!puvg!T87eA0d^iLI3~& delta 4489 zcmZ8l1z1#D*B-h<B&DU1k`4(O5DDo<X9#JA5CsL{Akqy(DBTFiARr($TtMj#>69Tv zBn5^U;1}+_-@W(W&vW*A&)R40v(9<;e%D%iP&QtMLSGvXpB8l43>_5{DGcx~g^kpe zcx!wmb|wB)a>6xmXfGigf+O?i2q(M&hvsj%^CyJk<H}z>br+W%h@X|FMjo3H%OBnw zOPYt7*0R#_Kk3b`6ZR`AO&kcJAxNtJdVvJD=*WG&hfzt0{+f<<Sj!*^Z+BNxLW#@1 zl2)ag6|)rT0FfdL4Or@yl>y);dwYBnR9dhPKb+g7xi{}aNO}9pBB+84{&5CozIoH2 zpBPRnL<Bd_en$gDEeP(7XkIT*Vf0U}8DRe40bA}Fl=7KM6rLT5p9>1uGOqDMRCU-I z1RUrLNCk=~Jti&BPV0}lMXzT_3$0%snGw(Xh}cqZvE&cP9XUHwgnh)bQCjNN>LW~f zLQ3;c3|yeD=I=(CI)GaLpj4FKdz|Z-7G`nuz)YKhkn;_IVD5hr_cCMTWfo;k$=1_1 z{1VFIivEK)cAp!YZek5Aijc6uA71&b>>GH38C@OgeGfNZx(kJ~rbM|K4C>aXV~(^+ zUzJHXQTc;qAR?0=1CED()$Cf5k<Gk5a9qyRR5E^us*ei$6mc{7kDgepXT(F!{*b#m zR=+^fn}u5!0GpEXKG*6GT>3?#>jsQ{QQGz&UE3cQw;E6sjr#EGNCRlw`W3N_)DQLO zZ=REt=(>t9%3$(I#U4hYB-}KIdgu5p4$2u{hUd)Zr37%BAih$fRn=_KCyV3G-8iJf zxC*W=HvPl~q<vmTdgQRZJ7G`nZEQTN8tPO%PhA4q0EQzEx;xeFbJn}JZl$0*Iz9&b zE~%BIkM~&E(;=waG`~4+Kn_^!|1gon-*S@iWph`vK&ekzovIqTut>lN-f$T8K=3eH zM?vcZtc}AhU6hdMaahgsYl~-t2Vt!mj_DcME5#-O>f}61<))|*4eD^N>~fSX>%7hG zI*Az}5FuF6{gxY9J3-gK4x5H8w1{<;Q%MR;<J?!)U@9+c(dyNHcSflhD!`-Q`%>P+ z9lByh*kclvUC8TmA#5Tq$CzbXIeK8vv{cb+=#BrO=>c=&3m-|#!Fb)+$hzuI*1dg? zFGchOUq$UkRW`Qi=icA-rg}td|EX4oYCG9J5^&@q;G$GdgO(R_S<ag;SdZ%XYBZvi zHgm(4#0ea5(oP#S3SrlYi3B2digpG~j9C(xIp>EVRbZfF-@Y2xcBn{OUC^N;(SdnE zBentKAnbcmoj31+^+FxoOWrALbRqmE7(U7OY(A6$#nc7K_QE1wbnaxVzxS-H{Op1P zOl)iY40r;avdimH4G{kqh{>Tfbe!h=lA{o!s3UZMFCjl9XZ>Al7T4f0i!gMg@mIX! zHIK~XjX`$0m;TG|Pm=oPWf~_oHWmu5U;LOlqte$VB3{LN;x>Q>0tsIOf&SzVVi55q zf5=}E$zL7mZwb#Oqys()Y85{D10pg%Klj9i&g5*^c;pwVX^8P_Y*ixch^G~4_u9hT zI-a+5bnPap{p2l!vcwVj>d$k1F%ONx{9q64iTu7|d)0k`A(?ab)(cvpGt6p+LZUq_ z{F$Jq2{i(*C_aXtD!IXOGMc$H>7{T&zRQ5Y-EqrrwfrQ$T3djKAMDWtjjJ1?k-)cB zN^YZ}mvDAWJ^nz^%F|3C#Yx$0+WOTP!jE@Nke!xH{F=2v^8K+Ie#)5rV`iZISp#Lq zSs>8T+CVQ(^=-n1Ze~K-dTymxOFUZ3>ptV{L1RW}S6&CbT0z4elbZ}Tgf3ofu$a(U zvfD)<5|`L*avVV20YA!u1Z?k5Pt^ADIdxibJ5IhOIMzn-W<dpIoXzT0{1g%w?N8|G zx1k<@+(e4d+Nt;yn~C}8lOt)@r)E&%kuVq9?;Y+PkJLu`J_P>EJ!V+;*OW?Rl|>SF zMJ%U!8N?(Kev-vkQ}HQYWwlIypl6As;1LKNhjC0}`vA%*ixY_V<};C*(40?JQrA5T z9Ejl@Ja0-@5lR#lQ{_3aIk6Y73nS2Mv}Jg-$*g+&h%yV3C+(4iDw#7zMSc-UF62eE z;9N4)&v1!{UF_?acaj21U(n3^45u~wf#8R+YP;kqsx3dQUD_NY1TwV@xhfU%q7`|V z%FM^uvj7zDy;)^k9mWGzEH|kZ35rW96!Bfh#*)L_ddV1u{Sui+qnWI2>>h4ueJwLu z{C??ZL`EHXtxt3`yv{iotlrcLiL|#JpdPxF{QCX4X^{Gt+K>V4$x_ZOLeCr2%0tOt zWECj)mpwhTW7X^13HZQ$Yg!Jg!vbx{X`g`4o<NhsgN&HCLcxY|f77u>KXkb!T55kt z1#)1l&!&&ir1TRQC=Gl3<?Beqz*j;<VTk6I?3!R41Q|W2<P&^XM%*qcm2OXioF!VL z?V;pZvYZ<qtf!+M_SjL{a<*8FrZRN8Yj1$6{7_ujT`DbKa67@-cfzJzum2$uTl&3D z9q7Z?;WD$JZ;RiXm^Twc4phc2q-Wu#Z0{`zRFssn+S0u^U$H<yJ!Y!G_B}VMUqdV) z_f0C~bcQod-=W7CY-KC3D&zK#DqCo0W#G9x$EvU?h2j@Dc{grHWhs&&o@;T(41cys zwwBBa`r+)tD`o6_`<0X6h<xqE(JbRp2(V_wsG6%gIw<@LzeY+fI^MQK@BQ0$qD^FS zS`LZ0M`RA)ZHCj_B5E4=fl8!SdR*$rQEGTw3<sE(g@E$VK0;t$tpvYU@1Bejp*o{D zAI8p#=kWDrab>!xtf^d1YJb?sNdf<}%{Smu+F#m+ptQFn03F3^@}aeiwGmpGW*|YI z<&Y?6^rKB!T>fZ_Vv72Yc<Zp+Zw=U2s7MooZ@^y#-YI%amZ9)$I9upCZnbZ!sJEPZ z28-I{;$o-Rg}GdkoY3v0x1mUV>0RWZffH<jJKraQv;^#8i^jES|13jer=0DX5LyDS zKS@t=G-V6b87PU|khc`^TAs$tH33mS;?<M+D_R3_xFPaVA&VK=y+*#_(B*EdGkTLF z*KYl>zQF62b1JRP*50YHP*&XqvjNpt#;&Saom{shQ$;Am=4-^7*S>GS6);s*Zh_^( zoKmt4t*xzOL!q&ScfKtN{o;*9K#d5%%U;8KE-sckJN>5VMAx4wHt<v(Oah4%s-DGu znNV_0mf;iH8mfWt6lYroJljX>Ll4L#_OM_?%es`V(LiIuDf&xLcy>v4cXqDCj@bRg zp0}jDwe+-84a^Rw{FVd;EJCJ%)#jlFZc1_$>HOqk=s|BB@ZsLTsZRs)#RQ?Esp8oQ z(p>X}4TBRDo-|QL_TK)&P<S)+o1-Gj#bV5=$0d8)zSND4CIEpbnEqz(OTxZn?`h*# zBQ>VvM7R{Ug~jEJZ%fEa$;wMe!(AvJ;fhJZdniS4q~Rx&jlcUEs{2<t-Z_;f(6hR^ z!f1GVeLE{UFq)N-MWiec3vKoG-Nu=QlN2NK6|&1&zC}0A4GPOi90V>L&F(Asz*?bQ z=7D}=+31Fgv!lY9<euZ>No59MLD%(@jIM)qXy{=)X#pOp+Jz@7r)5UYWnE|G4TJmg zem-`(LotmeYprIchfX43Lv9XeuZI+=z57zR*^Z^C5-rm?Z)px}UMM{`oNjlU1(+NM z$<ER<kIpJxvto_T@-jmg^y1228YpA7y#`P9Y{R$Kpl@<$PAmxvXN__Nxzi?>)mI$G z!s?IK+da}Z1E)XCpyJ;dT~vG@D5-eDwRPMxnB%v+TW_B}5g!{`?*0Z)^duTJ&D8xK zCu%IaMz|QGWKheau=*v_TczoszI7K=&8_q{U=~yGYpz$u-=i3Lakf=Ic910bv)fVB zc2M|8G;4mAw7MbqV#fiJv1{d<DO&G(;b#YIVe3|W0o3EcI_Qb}BwXYmaA%$G;l!8^ z!e7ABs!o1e5$JOJMhcwIEGnCnz2<XX&+$i=|2RWP_(+TnxDg1CD!*@;Z`qhmSNKWo zSS6JC9z?>fhx5rQJl+~3oi)}_E7i24i+TPH5?Wya-D(JLi91H^?6lT>`{bElT5CxH zMNT!vRF7kPeu_SJPq7F{KW*m29#7`z4k;J@4(pbC6a8oCl)D}}7tky~ng6AvF#**V zXx)!<q`Iaqr8&RY^TyML_ug7gxWCf`B4W9v0tyve5J&<4?}hhQ+5pGWhysxgF<GV< z2`*mPflqsxjGX)1Ca~?rDH{h9PXcvlTAW@S%ki|m$4*ndrx$vus`ExjVK?R;=DodS zkiv!`@&~g_jotuNCu(VcK!koAr%#=4H>kWAzvxi7I<LgrnWrOwi+WD=X6Z-SJr&E| zs$rsR-5Q^rI$OJ*6ry|R0ASHv0A*Fo6t-+Jr3kK)oLygEces<j@SOuXY;R%IGv8E9 zy*HvS$?3%_{nfd4A-xAEsCxE<Pm<Lxp_4NJ+xF$F%Klg(X*0ic>^7>q7Mb_J(v@`C zZak*>1;*RGw9uOnjPp1QnMhd{TS+8f)|vavMk%zJ6iY#0#<nl|9VjzlJ8hoWW_iGl z_XzPsapza#PVY(v+g?U;(=N#UD{Tncm3C-knn&86CCqchp*dM=17D1A#2RCgeQ!7> zM<O3@KdAs?^n)(QC9S*FfP*{AHQ9Lc@Zyn8`VaWUYNB@KveJu~;B$2ZaZSLz3E!uj z%;$7bTr?~p`MQq|V}N7lpt8B#rt`@^*yW=ToW*)1Q2LPdKhAPat*V@grkoQCS$Zl= zn~lEH35G&KmlV`IiUm>}p5nLg2z49UY0OrD?Nm~!d)8|XAvkx|R}jSv6kRJ;K6sz2 zALe2r&)I~j<5W7=)M&p>4`PgN-pL>qZQG^`OMG=JVBu3MJvETED2|o8iPs+67A!^* zp3#8!s_LS;JBX(38kYUtcU6F1(!aelh{ZsoTmSJed4cfw&%?&7!6pd7mL=G@Q_W=( zFJA993!c|AjDB>Y`TdWh<0?7bIj=^A8K#&$;&f&bgkw?|tK{|^WqAzm`s9^QS&%%x zSsws~(HC?4@?!wll4=`S->F!<{HcjHZ)WX()L2|Sd=|BY9%N6KCkZ@JDQa0B)Z!=s zmO-5IyOJMZHx4|86$8=rxILjN2~Mw|2YyS&GUqjod$Ic%=0zUTDCWMOrQBIsqov$u zlRTR|+8rv(5n_DSmV#wn&@E{b<u0l-zSh@L+7gFs6xG0v(wds;&NdxN&8;^#3^^n% zL-Sc9|NbvM1<Px9S+=)`6`?^fqxt)5zBgNgm%y4Nt(2b%aFY&ZDv}^c@0X>~5BK2l zjJ@)-yrl*?_<j<*SidCC?l&TJ2J``K=m<|Da|!~6NQH?BYPs2Q>XJz8r!yM+E$&;U z!Hzn#*&=)ce9*l9{2lMtz~x@m`;d2$@;k*}X8wPBwWg0g8t01oEf}xP1%AI&{px;_ z(eO$NF@djSJR>tamPzmmH!^AbHO35Qzrp`MZ2uQdxS>UP8G-((EZ`eAZUL97e}}8f zlH#8xPY42eKYih5?=A8i=BBTWgG&qg-%-X@Fbn_v1(z4`KSsaN85sx!vwv#yZ>zrx zn16E=Bjtb0%HX-oe8iV7UH%;S5HtN9F`C~V*gt*h?C$s<AO4>0t}zCzi30*T5rIH- S|C#K94$jHKM;Og;sr^6BLRI(x diff --git a/components/fpspreadsheet/examples/opendocdemo/opendocwrite.lpi b/components/fpspreadsheet/examples/opendocdemo/opendocwrite.lpi index 02464e3f1..b22b7046f 100644 --- a/components/fpspreadsheet/examples/opendocdemo/opendocwrite.lpi +++ b/components/fpspreadsheet/examples/opendocdemo/opendocwrite.lpi @@ -11,7 +11,7 @@ <TargetFileExt Value=".exe"/> <Title Value="opendocwrite"/> <UseAppBundle Value="False"/> - <ActiveEditorIndexAtStart Value="0"/> + <ActiveEditorIndexAtStart Value="4"/> </General> <VersionInfo> <ProjectVersion Value=""/> @@ -33,13 +33,13 @@ <PackageName Value="laz_fpspreadsheet"/> </Item1> </RequiredPackages> - <Units Count="16"> + <Units Count="20"> <Unit0> <Filename Value="opendocwrite.lpr"/> <IsPartOfProject Value="True"/> <UnitName Value="opendocwrite"/> - <CursorPos X="1" Y="70"/> - <TopLine Value="45"/> + <CursorPos X="1" Y="34"/> + <TopLine Value="20"/> <EditorIndex Value="0"/> <UsageCount Value="309"/> <Loaded Value="True"/> @@ -116,10 +116,10 @@ <Unit10> <Filename Value="..\..\fpspreadsheet.pas"/> <UnitName Value="fpspreadsheet"/> - <CursorPos X="1" Y="366"/> - <TopLine Value="349"/> - <EditorIndex Value="5"/> - <UsageCount Value="98"/> + <CursorPos X="1" Y="794"/> + <TopLine Value="792"/> + <EditorIndex Value="4"/> + <UsageCount Value="100"/> <Loaded Value="True"/> </Unit10> <Unit11> @@ -131,28 +131,26 @@ <Unit12> <Filename Value="..\..\fpsopendocument.pas"/> <UnitName Value="fpsopendocument"/> - <CursorPos X="1" Y="118"/> - <TopLine Value="107"/> + <CursorPos X="1" Y="384"/> + <TopLine Value="373"/> <EditorIndex Value="2"/> - <UsageCount Value="16"/> + <UsageCount Value="21"/> <Loaded Value="True"/> </Unit12> <Unit13> <Filename Value="..\..\xlsxooxml.pas"/> <UnitName Value="xlsxooxml"/> - <CursorPos X="1" Y="268"/> - <TopLine Value="253"/> - <EditorIndex Value="4"/> - <UsageCount Value="16"/> + <CursorPos X="1" Y="35"/> + <TopLine Value="16"/> + <EditorIndex Value="3"/> + <UsageCount Value="21"/> <Loaded Value="True"/> </Unit13> <Unit14> <Filename Value="..\..\..\..\..\..\..\..\usr\local\share\fpcsrc\rtl\objpas\sysutils\sysstrh.inc"/> - <CursorPos X="10" Y="154"/> + <CursorPos X="38" Y="145"/> <TopLine Value="141"/> - <EditorIndex Value="3"/> - <UsageCount Value="13"/> - <Loaded Value="True"/> + <UsageCount Value="15"/> </Unit14> <Unit15> <Filename Value="..\..\fpsallformats.pas"/> @@ -160,127 +158,159 @@ <CursorPos X="44" Y="13"/> <TopLine Value="1"/> <EditorIndex Value="1"/> - <UsageCount Value="11"/> + <UsageCount Value="16"/> <Loaded Value="True"/> </Unit15> + <Unit16> + <Filename Value="..\..\..\..\..\..\..\..\usr\local\share\fpcsrc\packages\paszlib\src\zipper.pp"/> + <UnitName Value="zipper"/> + <CursorPos X="24" Y="7"/> + <TopLine Value="1"/> + <UsageCount Value="12"/> + </Unit16> + <Unit17> + <Filename Value="..\..\..\..\..\..\..\..\usr\local\share\fpcsrc\rtl\objpas\sysutils\finah.inc"/> + <CursorPos X="27" Y="25"/> + <TopLine Value="17"/> + <UsageCount Value="10"/> + </Unit17> + <Unit18> + <Filename Value="..\..\..\..\..\..\..\..\usr\local\share\fpcsrc\rtl\objpas\sysutils\fina.inc"/> + <CursorPos X="28" Y="258"/> + <TopLine Value="249"/> + <UsageCount Value="10"/> + </Unit18> + <Unit19> + <Filename Value="..\..\fpszipper.pp"/> + <UnitName Value="fpszipper"/> + <CursorPos X="36" Y="9"/> + <TopLine Value="1"/> + <EditorIndex Value="5"/> + <UsageCount Value="13"/> + <Loaded Value="True"/> + </Unit19> </Units> - <JumpHistory Count="29" HistoryIndex="28"> + <JumpHistory Count="30" HistoryIndex="29"> <Position1> - <Filename Value="..\..\fpspreadsheet.pas"/> - <Caret Line="754" Column="1" TopLine="741"/> + <Filename Value="..\..\xlsbiff2.pas"/> + <Caret Line="153" Column="72" TopLine="137"/> </Position1> <Position2> - <Filename Value="..\..\fpspreadsheet.pas"/> - <Caret Line="755" Column="1" TopLine="742"/> + <Filename Value="..\..\xlsbiff2.pas"/> + <Caret Line="159" Column="13" TopLine="137"/> </Position2> <Position3> - <Filename Value="..\..\fpspreadsheet.pas"/> - <Caret Line="757" Column="1" TopLine="744"/> + <Filename Value="..\..\xlsbiff2.pas"/> + <Caret Line="187" Column="32" TopLine="174"/> </Position3> <Position4> - <Filename Value="..\..\fpspreadsheet.pas"/> - <Caret Line="759" Column="1" TopLine="746"/> + <Filename Value="..\..\xlsbiff2.pas"/> + <Caret Line="190" Column="13" TopLine="174"/> </Position4> <Position5> - <Filename Value="..\..\fpsopendocument.pas"/> - <Caret Line="392" Column="1" TopLine="379"/> + <Filename Value="..\..\xlsbiff2.pas"/> + <Caret Line="193" Column="34" TopLine="174"/> </Position5> <Position6> <Filename Value="..\..\xlsbiff2.pas"/> - <Caret Line="87" Column="1" TopLine="79"/> + <Caret Line="226" Column="33" TopLine="213"/> </Position6> <Position7> <Filename Value="..\..\xlsbiff2.pas"/> - <Caret Line="211" Column="34" TopLine="196"/> + <Caret Line="97" Column="16" TopLine="85"/> </Position7> <Position8> - <Filename Value="..\..\xlsbiff2.pas"/> - <Caret Line="22" Column="40" TopLine="8"/> - </Position8> - <Position9> - <Filename Value="..\..\xlsbiff2.pas"/> - <Caret Line="48" Column="22" TopLine="35"/> - </Position9> - <Position10> - <Filename Value="..\..\xlsbiff2.pas"/> - <Caret Line="194" Column="7" TopLine="181"/> - </Position10> - <Position11> - <Filename Value="..\..\xlsbiff2.pas"/> - <Caret Line="329" Column="51" TopLine="316"/> - </Position11> - <Position12> - <Filename Value="..\..\xlsbiff2.pas"/> - <Caret Line="257" Column="34" TopLine="242"/> - </Position12> - <Position13> - <Filename Value="..\..\xlsbiff2.pas"/> - <Caret Line="286" Column="34" TopLine="271"/> - </Position13> - <Position14> - <Filename Value="..\..\xlsbiff2.pas"/> - <Caret Line="350" Column="38" TopLine="336"/> - </Position14> - <Position15> - <Filename Value="..\..\xlsbiff5.pas"/> - <Caret Line="207" Column="1" TopLine="196"/> - </Position15> - <Position16> - <Filename Value="..\..\xlsbiff5.pas"/> - <Caret Line="556" Column="34" TopLine="542"/> - </Position16> - <Position17> - <Filename Value="..\..\xlsbiff2.pas"/> - <Caret Line="50" Column="19" TopLine="37"/> - </Position17> - <Position18> - <Filename Value="..\..\xlsbiff2.pas"/> - <Caret Line="150" Column="34" TopLine="137"/> - </Position18> - <Position19> - <Filename Value="..\..\xlsbiff2.pas"/> - <Caret Line="153" Column="72" TopLine="137"/> - </Position19> - <Position20> - <Filename Value="..\..\xlsbiff2.pas"/> - <Caret Line="159" Column="13" TopLine="137"/> - </Position20> - <Position21> - <Filename Value="..\..\xlsbiff2.pas"/> - <Caret Line="187" Column="32" TopLine="174"/> - </Position21> - <Position22> - <Filename Value="..\..\xlsbiff2.pas"/> - <Caret Line="190" Column="13" TopLine="174"/> - </Position22> - <Position23> - <Filename Value="..\..\xlsbiff2.pas"/> - <Caret Line="193" Column="34" TopLine="174"/> - </Position23> - <Position24> - <Filename Value="..\..\xlsbiff2.pas"/> - <Caret Line="226" Column="33" TopLine="213"/> - </Position24> - <Position25> - <Filename Value="..\..\xlsbiff2.pas"/> - <Caret Line="97" Column="16" TopLine="85"/> - </Position25> - <Position26> <Filename Value="..\..\xlsbiff5.pas"/> <Caret Line="601" Column="25" TopLine="588"/> - </Position26> - <Position27> + </Position8> + <Position9> <Filename Value="..\..\xlsbiff5.pas"/> <Caret Line="673" Column="34" TopLine="659"/> - </Position27> - <Position28> + </Position9> + <Position10> <Filename Value="..\..\xlsbiff5.pas"/> <Caret Line="700" Column="34" TopLine="686"/> - </Position28> - <Position29> + </Position10> + <Position11> <Filename Value="opendocwrite.lpr"/> <Caret Line="13" Column="45" TopLine="5"/> + </Position11> + <Position12> + <Filename Value="..\..\fpsopendocument.pas"/> + <Caret Line="40" Column="17" TopLine="28"/> + </Position12> + <Position13> + <Filename Value="..\..\fpsopendocument.pas"/> + <Caret Line="350" Column="29" TopLine="339"/> + </Position13> + <Position14> + <Filename Value="..\..\xlsxooxml.pas"/> + <Caret Line="51" Column="25" TopLine="39"/> + </Position14> + <Position15> + <Filename Value="..\..\xlsxooxml.pas"/> + <Caret Line="103" Column="31" TopLine="103"/> + </Position15> + <Position16> + <Filename Value="..\..\xlsxooxml.pas"/> + <Caret Line="51" Column="15" TopLine="50"/> + </Position16> + <Position17> + <Filename Value="..\..\xlsxooxml.pas"/> + <Caret Line="249" Column="5" TopLine="224"/> + </Position17> + <Position18> + <Filename Value="..\..\xlsxooxml.pas"/> + <Caret Line="242" Column="1" TopLine="238"/> + </Position18> + <Position19> + <Filename Value="opendocwrite.lpr"/> + <Caret Line="30" Column="5" TopLine="10"/> + </Position19> + <Position20> + <Filename Value="..\..\fpsopendocument.pas"/> + <Caret Line="51" Column="22" TopLine="39"/> + </Position20> + <Position21> + <Filename Value="..\..\fpsopendocument.pas"/> + <Caret Line="68" Column="10" TopLine="55"/> + </Position21> + <Position22> + <Filename Value="..\..\xlsxooxml.pas"/> + <Caret Line="268" Column="5" TopLine="244"/> + </Position22> + <Position23> + <Filename Value="..\..\fpsopendocument.pas"/> + <Caret Line="38" Column="36" TopLine="32"/> + </Position23> + <Position24> + <Filename Value="..\..\fpspreadsheet.pas"/> + <Caret Line="62" Column="4" TopLine="52"/> + </Position24> + <Position25> + <Filename Value="..\..\fpspreadsheet.pas"/> + <Caret Line="66" Column="21" TopLine="53"/> + </Position25> + <Position26> + <Filename Value="..\..\fpspreadsheet.pas"/> + <Caret Line="102" Column="20" TopLine="89"/> + </Position26> + <Position27> + <Filename Value="..\..\fpspreadsheet.pas"/> + <Caret Line="105" Column="20" TopLine="94"/> + </Position27> + <Position28> + <Filename Value="..\..\fpspreadsheet.pas"/> + <Caret Line="764" Column="1" TopLine="739"/> + </Position28> + <Position29> + <Filename Value="..\..\fpspreadsheet.pas"/> + <Caret Line="777" Column="36" TopLine="767"/> </Position29> + <Position30> + <Filename Value="..\..\fpspreadsheet.pas"/> + <Caret Line="785" Column="10" TopLine="762"/> + </Position30> </JumpHistory> </ProjectOptions> <CompilerOptions> diff --git a/components/fpspreadsheet/examples/opendocdemo/opendocwrite.lpr b/components/fpspreadsheet/examples/opendocdemo/opendocwrite.lpr index 16fa55b95..180420f77 100644 --- a/components/fpspreadsheet/examples/opendocdemo/opendocwrite.lpr +++ b/components/fpspreadsheet/examples/opendocdemo/opendocwrite.lpr @@ -10,17 +10,14 @@ program opendocwrite; {$mode delphi}{$H+} uses - Classes, SysUtils, fpspreadsheet, fpsallformats, laz_fpspreadsheet; + Classes, SysUtils, fpspreadsheet, fpsallformats, + laz_fpspreadsheet; var MyWorkbook: TsWorkbook; MyWorksheet: TsWorksheet; - MyFormula: TRPNFormula; MyDir: string; - i: Integer; - a: TStringList; begin - // Open the output file MyDir := ExtractFilePath(ParamStr(0)); // Create the spreadsheet @@ -33,38 +30,16 @@ begin MyWorksheet.WriteNumber(0, 2, 3.0); MyWorksheet.WriteNumber(0, 3, 4.0); -{ Uncommend this to test large XLS files - for i := 2 to 20 do - begin - MyWorksheet.WriteAnsiText(i, 0, ParamStr(0)); - MyWorksheet.WriteAnsiText(i, 1, ParamStr(0)); - MyWorksheet.WriteAnsiText(i, 2, ParamStr(0)); - MyWorksheet.WriteAnsiText(i, 3, ParamStr(0)); - end; -} - - // Write the formula E1 = A1 + B1 - // or, in RPN: A1, B1, + -(* SetLength(MyFormula, 3); - MyFormula[0].TokenID := INT_EXCEL_TOKEN_TREFV; {A1} - MyFormula[0].Col := 0; - MyFormula[0].Row := 0; - MyFormula[1].TokenID := INT_EXCEL_TOKEN_TREFV; {B1} - MyFormula[1].Col := 1; - MyFormula[1].Row := 0; - MyFormula[2].TokenID := INT_EXCEL_TOKEN_TADD; {+} - MyWorksheet.WriteRPNFormula(0, 4, MyFormula); - - // Creates a new worksheet - MyWorksheet := MyWorkbook.AddWorksheet('My Worksheet 2'); - *) - // Write some string cells MyWorksheet.WriteUTF8Text(4, 2, 'Total:'); MyWorksheet.WriteNumber(4, 3, 10.0); + // Creates a new worksheet + MyWorksheet := MyWorkbook.AddWorksheet('My Worksheet 2'); + // Save the spreadsheet to a file - MyWorkbook.WriteToFile(MyDir + 'test', sfOpenDocument); + MyWorkbook.WriteToFile(MyDir + 'test.ods', + sfOpenDocument); MyWorkbook.Free; end. diff --git a/components/fpspreadsheet/fpsopendocument.pas b/components/fpspreadsheet/fpsopendocument.pas index 0a9eea3f2..7c2e28cc6 100755 --- a/components/fpspreadsheet/fpsopendocument.pas +++ b/components/fpspreadsheet/fpsopendocument.pas @@ -10,8 +10,7 @@ meta.xml - Authoring data settings.xml - User persistent viewing information, such as zoom, cursor position, etc. styles.xml - Styles, which are the only way to do formatting mimetype - application/vnd.oasis.opendocument.spreadsheet -META-INF - manifest.xml - +META-INF\manifest.xml - Describes the other files in the archive Specifications obtained from: @@ -28,7 +27,8 @@ unit fpsopendocument; interface uses - Classes, SysUtils, zipper, + Classes, SysUtils, + fpszipper, {NOTE: fpszipper is the latest zipper.pp Change to standard zipper when FPC 2.4 is released } fpspreadsheet; type @@ -37,25 +37,23 @@ type TsSpreadOpenDocWriter = class(TsCustomSpreadWriter) protected - FZip: TZipper; // Strings with the contents of files - // filename\ - FMeta, FSettings, FStyles: string; - FContent: string; - FMimetype: string; - // filename\META-INF + FMeta, FSettings, FStyles, FContent, FMimetype: string; FMetaInfManifest: string; + // Streams with the contents of files + FSMeta, FSSettings, FSStyles, FSContent, FSMimetype: TStringStream; + FSMetaInfManifest: TStringStream; // Routines to write those files procedure WriteGlobalFiles; procedure WriteContent(AData: TsWorkbook); procedure WriteWorksheet(CurSheet: TsWorksheet); public { General writing methods } - procedure WriteStringToFile(AFileName, AString: string); + procedure WriteStringToFile(AString, AFileName: string); procedure WriteToFile(AFileName: string; AData: TsWorkbook); override; procedure WriteToStream(AStream: TStream; AData: TsWorkbook); override; { Record writing methods } - procedure WriteFormula(AStream: TStream; const ARow, ACol: Word; const AFormula: TRPNFormula); override; + procedure WriteFormula(AStream: TStream; const ARow, ACol: Word; const AFormula: TsFormula); override; procedure WriteLabel(AStream: TStream; const ARow, ACol: Word; const AValue: string); override; procedure WriteNumber(AStream: TStream; const ARow, ACol: Cardinal; const AValue: double); override; end; @@ -67,11 +65,11 @@ const XML_HEADER = '<?xml version="1.0" encoding="utf-8" ?>'; { OpenDocument Directory structure constants } - OOXML_PATH_CONTENT = 'content.xml'; - OOXML_PATH_META = 'meta.xml'; - OOXML_PATH_SETTINGS = 'settings.xml'; - OOXML_PATH_STYLES = 'styles.xml'; - OOXML_PATH_MIMETYPE = 'mimetype'; + OPENDOC_PATH_CONTENT = 'content.xml'; + OPENDOC_PATH_META = 'meta.xml'; + OPENDOC_PATH_SETTINGS = 'settings.xml'; + OPENDOC_PATH_STYLES = 'styles.xml'; + OPENDOC_PATH_MIMETYPE = 'mimetype'; OPENDOC_PATH_METAINF = 'META-INF' + PathDelim; OPENDOC_PATH_METAINF_MANIFEST = 'META-INF' + PathDelim + 'manifest.xml'; @@ -246,6 +244,7 @@ begin ' <office:body>' + LineEnding + ' <office:spreadsheet>' + LineEnding; + // Write all worksheets for i := 0 to AData.GetWorksheetCount - 1 do begin WriteWorksheet(Adata.GetWorksheetByIndex(i)); @@ -312,13 +311,10 @@ begin ' </table:table>' + LineEnding; end; -{******************************************************************* -* TsSpreadOOXMLWriter.WriteStringToFile () -* -* DESCRIPTION: Writes a string to a file. Helper convenience method. -* -*******************************************************************} -procedure TsSpreadOpenDocWriter.WriteStringToFile(AFileName, AString: string); +{ + Writes a string to a file. Helper convenience method. +} +procedure TsSpreadOpenDocWriter.WriteStringToFile(AString, AFileName: string); var TheStream : TFileStream; S : String; @@ -329,57 +325,70 @@ begin TheStream.Free; end; -{******************************************************************* -* TsSpreadOOXMLWriter.WriteToFile () -* -* DESCRIPTION: Writes an OOXML document to the disc -* -*******************************************************************} +{ + Writes an OOXML document to the disc. +} procedure TsSpreadOpenDocWriter.WriteToFile(AFileName: string; AData: TsWorkbook); var - TempDir: string; + FZip: TZipper; begin - {FZip := TZipper.Create; - FZip.ZipFiles(AFileName, x); - FZip.Free;} - -// WriteToStream(nil, AData); + { Fill the strings with the contents of the files } WriteGlobalFiles(); WriteContent(AData); - TempDir := IncludeTrailingBackslash(AFileName); + { Write the data to streams } - { files on the root path } + FSMeta := TStringStream.Create(FMeta); + FSSettings := TStringStream.Create(FSettings); + FSStyles := TStringStream.Create(FStyles); + FSContent := TStringStream.Create(FContent); + FSMimetype := TStringStream.Create(FMimetype); + FSMetaInfManifest := TStringStream.Create(FMetaInfManifest); - ForceDirectories(TempDir); + { Now compress the files } - WriteStringToFile(TempDir + OOXML_PATH_CONTENT, FContent); - - WriteStringToFile(TempDir + OOXML_PATH_META, FMeta); + FZip := TZipper.Create; + try + FZip.FileName := AFileName; - WriteStringToFile(TempDir + OOXML_PATH_SETTINGS, FSettings); + FZip.Entries.AddFileEntry(FSMeta, OPENDOC_PATH_META); + FZip.Entries.AddFileEntry(FSSettings, OPENDOC_PATH_SETTINGS); + FZip.Entries.AddFileEntry(FSStyles, OPENDOC_PATH_STYLES); + FZip.Entries.AddFileEntry(FSContent, OPENDOC_PATH_CONTENT); + FZip.Entries.AddFileEntry(FSMimetype, OPENDOC_PATH_MIMETYPE); + FZip.Entries.AddFileEntry(FSMetaInfManifest, OPENDOC_PATH_METAINF_MANIFEST); - WriteStringToFile(TempDir + OOXML_PATH_STYLES, FStyles); - - WriteStringToFile(TempDir + OOXML_PATH_MIMETYPE, FMimetype); - - { META-INF directory } - - ForceDirectories(TempDir + OPENDOC_PATH_METAINF); - - WriteStringToFile(TempDir + OPENDOC_PATH_METAINF_MANIFEST, FMetaInfManifest); + FZip.ZipAllFiles; + finally + FZip.Free; + FSMeta.Free; + FSSettings.Free; + FSStyles.Free; + FSContent.Free; + FSMimetype.Free; + FSMetaInfManifest.Free; + end; end; + procedure TsSpreadOpenDocWriter.WriteToStream(AStream: TStream; AData: TsWorkbook); begin - + // Not supported at the moment + raise Exception.Create('TsSpreadOpenDocWriter.WriteToStream not supported'); end; procedure TsSpreadOpenDocWriter.WriteFormula(AStream: TStream; const ARow, - ACol: Word; const AFormula: TRPNFormula); + ACol: Word; const AFormula: TsFormula); begin - +{ // The row should already be the correct one + FContent := FContent + + ' <table:table-cell office:value-type="string">' + LineEnding + + ' <text:p>' + AFormula.DoubleValue + '</text:p>' + LineEnding + + ' </table:table-cell>' + LineEnding; +<table:table-cell table:formula="of:=[.A1]+[.B2]" office:value-type="float" office:value="1833"> +<text:p>1833</text:p> +</table:table-cell>} end; procedure TsSpreadOpenDocWriter.WriteLabel(AStream: TStream; const ARow, @@ -402,12 +411,9 @@ begin ' </table:table-cell>' + LineEnding; end; -{******************************************************************* -* Initialization section -* -* Registers this reader / writer on fpSpreadsheet -* -*******************************************************************} +{ + Registers this reader / writer on fpSpreadsheet +} initialization RegisterSpreadFormat(TsCustomSpreadReader, TsSpreadOpenDocWriter, sfOpenDocument); diff --git a/components/fpspreadsheet/fpspreadsheet.pas b/components/fpspreadsheet/fpspreadsheet.pas index 242595a3e..c46d7d0c9 100755 --- a/components/fpspreadsheet/fpspreadsheet.pas +++ b/components/fpspreadsheet/fpspreadsheet.pas @@ -26,38 +26,35 @@ const STR_OOXML_EXCEL_EXTENSION = '.xlsx'; STR_OPENDOCUMENT_CALC_EXTENSION = '.ods'; -const - { TokenID values } - - { Binary Operator Tokens } - INT_EXCEL_TOKEN_TADD = $03; - INT_EXCEL_TOKEN_TSUB = $04; - INT_EXCEL_TOKEN_TMUL = $05; - INT_EXCEL_TOKEN_TDIV = $06; - INT_EXCEL_TOKEN_TPOWER = $07; - - { Constant Operand Tokens } - INT_EXCEL_TOKEN_TNUM = $1F; - - { Operand Tokens } - INT_EXCEL_TOKEN_TREFR = $24; - INT_EXCEL_TOKEN_TREFV = $44; - INT_EXCEL_TOKEN_TREFA = $64; - type - {@@ A Token of a RPN Token array for formulas } + {@@ Describes a formula - TRPNToken = record - TokenID: Byte; - Col: Byte; - Row: Word; + Supported syntax: + + =A1+B1+C1/D2... - Array with simple mathematical operations + + =SUM(A1:D1) - SUM operation in a interval + } + + TsFormula = record + FormulaStr: string; DoubleValue: double; end; - {@@ RPN Token array for formulas } + {@@ Expanded formula. Used by backend modules. Provides more information then the text only } - TRPNFormula = array of TRPNToken; + TFEKind = (fekCell, fekAdd, fekSub, fekDiv, fekMul, + fekOpSUM); + + TsFormulaElement = record + ElementKind: TFEKind; + Row1, Row2: Word; + Col1, Col2: Byte; + DoubleValue: double; + end; + + TsExpandedFormula = array of TsFormulaElement; {@@ Describes the type of content of a cell on a TsWorksheet } @@ -69,7 +66,7 @@ type Col: Byte; Row: Word; ContentType: TCellContentType; - FormulaValue: TRPNFormula; + FormulaValue: TsFormula; NumberValue: double; UTF8StringValue: ansistring; end; @@ -81,8 +78,6 @@ type TsCustomSpreadReader = class; TsCustomSpreadWriter = class; - {@@ TsWorksheet } - { TsWorksheet } TsWorksheet = class @@ -105,11 +100,9 @@ type procedure RemoveAllCells; procedure WriteUTF8Text(ARow, ACol: Cardinal; AText: ansistring); procedure WriteNumber(ARow, ACol: Cardinal; ANumber: double); - procedure WriteRPNFormula(ARow, ACol: Cardinal; AFormula: TRPNFormula); + procedure WriteFormula(ARow, ACol: Cardinal; AFormula: TsFormula); end; - {@@ TsWorkbook } - { TsWorkbook } TsWorkbook = class @@ -140,8 +133,6 @@ type TsSpreadReaderClass = class of TsCustomSpreadReader; - {@@ TsCustomSpreadReader } - { TsCustomSpreadReader } TsCustomSpreadReader = class @@ -162,19 +153,19 @@ type TsSpreadWriterClass = class of TsCustomSpreadWriter; - {@@ TsCustomSpreadWriter } - { TsCustomSpreadWriter } TsCustomSpreadWriter = class public + { Helper routines } + function ExpandFormula(AFormula: TsFormula): TsExpandedFormula; { General writing methods } procedure WriteCellCallback(data, arg: pointer); procedure WriteCellsToStream(AStream: TStream; ACells: TFPList); procedure WriteToFile(AFileName: string; AData: TsWorkbook); virtual; procedure WriteToStream(AStream: TStream; AData: TsWorkbook); virtual; { Record writing methods } - procedure WriteFormula(AStream: TStream; const ARow, ACol: Word; const AFormula: TRPNFormula); virtual; abstract; + procedure WriteFormula(AStream: TStream; const ARow, ACol: Word; const AFormula: TsFormula); virtual; abstract; procedure WriteLabel(AStream: TStream; const ARow, ACol: Word; const AValue: string); virtual; abstract; procedure WriteNumber(AStream: TStream; const ARow, ACol: Cardinal; const AValue: double); virtual; abstract; end; @@ -494,9 +485,9 @@ end; @param ARow The row of the cell @param ACol The column of the cell - @param AFormula The formula in RPN array format + @param AFormula The formula to be written } -procedure TsWorksheet.WriteRPNFormula(ARow, ACol: Cardinal; AFormula: TRPNFormula); +procedure TsWorksheet.WriteFormula(ARow, ACol: Cardinal; AFormula: TsFormula); var ACell: PCell; begin @@ -758,6 +749,50 @@ end; { TsCustomSpreadWriter } +{@@ + Expands a formula, separating it in it's constituent parts, + so that it is already partially parsed and it is easier to + convert it into the format supported by the writer module +} +function TsCustomSpreadWriter.ExpandFormula(AFormula: TsFormula): TsExpandedFormula; +var + StrPos: Integer; + ResPos: Integer; +begin + ResPos := -1; + SetLength(Result, 0); + + // The formula needs to start with a = + if AFormula.FormulaStr[1] <> '=' then raise Exception.Create('Formula doesn''t start with ='); + + StrPos := 2; + + while Length(AFormula.FormulaStr) <= StrPos do + begin + // Checks for cell with the format [Letter][Number] +{ if (AFormula.FormulaStr[StrPos] in [a..zA..Z]) and + (AFormula.FormulaStr[StrPos + 1] in [0..9]) then + begin + Inc(ResPos); + SetLength(Result, ResPos + 1); + Result[ResPos].ElementKind := fekCell; +// Result[ResPos].Col1 := fekCell; + Result[ResPos].Row1 := AFormula.FormulaStr[StrPos + 1]; + + Inc(StrPos); + end + // Checks for arithmetical operations + else} if AFormula.FormulaStr[StrPos] = '+' then + begin + Inc(ResPos); + SetLength(Result, ResPos + 1); + Result[ResPos].ElementKind := fekAdd; + end; + + Inc(StrPos); + end; +end; + {@@ Helper function for the spreadsheet writers. diff --git a/components/fpspreadsheet/fpszipper.pp b/components/fpspreadsheet/fpszipper.pp new file mode 100644 index 000000000..2a6b8a824 --- /dev/null +++ b/components/fpspreadsheet/fpszipper.pp @@ -0,0 +1,1687 @@ +{ + $Id: header,v 1.1 2000/07/13 06:33:45 michael Exp $ + This file is part of the Free Component Library (FCL) + Copyright (c) 1999-2000 by the Free Pascal development team + + See the file COPYING.FPC, included in this distribution, + for details about the copyright. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + + **********************************************************************} +{ + Copy from the zipper unit from FPC 2.3.1 rev 12624 + + Remove it after a new FPC with the fixes from this unit is released! +} +{$mode objfpc} +{$h+} +unit fpszipper; + +Interface + +Uses + SysUtils,Classes,ZStream; + + +Const + { Signatures } + END_OF_CENTRAL_DIR_SIGNATURE = $06054B50; + LOCAL_FILE_HEADER_SIGNATURE = $04034B50; + CENTRAL_FILE_HEADER_SIGNATURE = $02014B50; + +Type + Local_File_Header_Type = Packed Record + Signature : LongInt; + Extract_Version_Reqd : Word; + Bit_Flag : Word; + Compress_Method : Word; + Last_Mod_Time : Word; + Last_Mod_Date : Word; + Crc32 : LongWord; + Compressed_Size : LongInt; + Uncompressed_Size : LongInt; + Filename_Length : Word; + Extra_Field_Length : Word; + end; + + { Define the Central Directory record types } + + Central_File_Header_Type = Packed Record + Signature : LongInt; + MadeBy_Version : Word; + Extract_Version_Reqd : Word; + Bit_Flag : Word; + Compress_Method : Word; + Last_Mod_Time : Word; + Last_Mod_Date : Word; + Crc32 : LongWord; + Compressed_Size : LongInt; + Uncompressed_Size : LongInt; + Filename_Length : Word; + Extra_Field_Length : Word; + File_Comment_Length : Word; + Starting_Disk_Num : Word; + Internal_Attributes : Word; + External_Attributes : LongInt; + Local_Header_Offset : LongInt; + End; + + End_of_Central_Dir_Type = Packed Record + Signature : LongInt; + Disk_Number : Word; + Central_Dir_Start_Disk : Word; + Entries_This_Disk : Word; + Total_Entries : Word; + Central_Dir_Size : LongInt; + Start_Disk_Offset : LongInt; + ZipFile_Comment_Length : Word; + end; + +Const + Crc_32_Tab : Array[0..255] of LongWord = ( + $00000000, $77073096, $ee0e612c, $990951ba, $076dc419, $706af48f, $e963a535, $9e6495a3, + $0edb8832, $79dcb8a4, $e0d5e91e, $97d2d988, $09b64c2b, $7eb17cbd, $e7b82d07, $90bf1d91, + $1db71064, $6ab020f2, $f3b97148, $84be41de, $1adad47d, $6ddde4eb, $f4d4b551, $83d385c7, + $136c9856, $646ba8c0, $fd62f97a, $8a65c9ec, $14015c4f, $63066cd9, $fa0f3d63, $8d080df5, + $3b6e20c8, $4c69105e, $d56041e4, $a2677172, $3c03e4d1, $4b04d447, $d20d85fd, $a50ab56b, + $35b5a8fa, $42b2986c, $dbbbc9d6, $acbcf940, $32d86ce3, $45df5c75, $dcd60dcf, $abd13d59, + $26d930ac, $51de003a, $c8d75180, $bfd06116, $21b4f4b5, $56b3c423, $cfba9599, $b8bda50f, + $2802b89e, $5f058808, $c60cd9b2, $b10be924, $2f6f7c87, $58684c11, $c1611dab, $b6662d3d, + $76dc4190, $01db7106, $98d220bc, $efd5102a, $71b18589, $06b6b51f, $9fbfe4a5, $e8b8d433, + $7807c9a2, $0f00f934, $9609a88e, $e10e9818, $7f6a0dbb, $086d3d2d, $91646c97, $e6635c01, + $6b6b51f4, $1c6c6162, $856530d8, $f262004e, $6c0695ed, $1b01a57b, $8208f4c1, $f50fc457, + $65b0d9c6, $12b7e950, $8bbeb8ea, $fcb9887c, $62dd1ddf, $15da2d49, $8cd37cf3, $fbd44c65, + $4db26158, $3ab551ce, $a3bc0074, $d4bb30e2, $4adfa541, $3dd895d7, $a4d1c46d, $d3d6f4fb, + $4369e96a, $346ed9fc, $ad678846, $da60b8d0, $44042d73, $33031de5, $aa0a4c5f, $dd0d7cc9, + $5005713c, $270241aa, $be0b1010, $c90c2086, $5768b525, $206f85b3, $b966d409, $ce61e49f, + $5edef90e, $29d9c998, $b0d09822, $c7d7a8b4, $59b33d17, $2eb40d81, $b7bd5c3b, $c0ba6cad, + $edb88320, $9abfb3b6, $03b6e20c, $74b1d29a, $ead54739, $9dd277af, $04db2615, $73dc1683, + $e3630b12, $94643b84, $0d6d6a3e, $7a6a5aa8, $e40ecf0b, $9309ff9d, $0a00ae27, $7d079eb1, + $f00f9344, $8708a3d2, $1e01f268, $6906c2fe, $f762575d, $806567cb, $196c3671, $6e6b06e7, + $fed41b76, $89d32be0, $10da7a5a, $67dd4acc, $f9b9df6f, $8ebeeff9, $17b7be43, $60b08ed5, + $d6d6a3e8, $a1d1937e, $38d8c2c4, $4fdff252, $d1bb67f1, $a6bc5767, $3fb506dd, $48b2364b, + $d80d2bda, $af0a1b4c, $36034af6, $41047a60, $df60efc3, $a867df55, $316e8eef, $4669be79, + $cb61b38c, $bc66831a, $256fd2a0, $5268e236, $cc0c7795, $bb0b4703, $220216b9, $5505262f, + $c5ba3bbe, $b2bd0b28, $2bb45a92, $5cb36a04, $c2d7ffa7, $b5d0cf31, $2cd99e8b, $5bdeae1d, + $9b64c2b0, $ec63f226, $756aa39c, $026d930a, $9c0906a9, $eb0e363f, $72076785, $05005713, + $95bf4a82, $e2b87a14, $7bb12bae, $0cb61b38, $92d28e9b, $e5d5be0d, $7cdcefb7, $0bdbdf21, + $86d3d2d4, $f1d4e242, $68ddb3f8, $1fda836e, $81be16cd, $f6b9265b, $6fb077e1, $18b74777, + $88085ae6, $ff0f6a70, $66063bca, $11010b5c, $8f659eff, $f862ae69, $616bffd3, $166ccf45, + $a00ae278, $d70dd2ee, $4e048354, $3903b3c2, $a7672661, $d06016f7, $4969474d, $3e6e77db, + $aed16a4a, $d9d65adc, $40df0b66, $37d83bf0, $a9bcae53, $debb9ec5, $47b2cf7f, $30b5ffe9, + $bdbdf21c, $cabac28a, $53b39330, $24b4a3a6, $bad03605, $cdd70693, $54de5729, $23d967bf, + $b3667a2e, $c4614ab8, $5d681b02, $2a6f2b94, $b40bbe37, $c30c8ea1, $5a05df1b, $2d02ef8d + ); + +Type + + TProgressEvent = Procedure(Sender : TObject; Const Pct : Double) of object; + TOnEndOfFileEvent = Procedure(Sender : TObject; Const Ratio : Double) of object; + TOnStartFileEvent = Procedure(Sender : TObject; Const AFileName : String) of object; + +Type + + { TCompressor } + TCompressor = Class(TObject) + Protected + FInFile : TStream; { I/O file variables } + FOutFile : TStream; + FCrc32Val : LongWord; { CRC calculation variable } + FBufferSize : LongWord; + FOnPercent : Integer; + FOnProgress : TProgressEvent; + Procedure UpdC32(Octet: Byte); + Public + Constructor Create(AInFile, AOutFile : TStream; ABufSize : LongWord); virtual; + Procedure Compress; Virtual; Abstract; + Class Function ZipID : Word; virtual; Abstract; + Property BufferSize : LongWord read FBufferSize; + Property OnPercent : Integer Read FOnPercent Write FOnPercent; + Property OnProgress : TProgressEvent Read FOnProgress Write FOnProgress; + Property Crc32Val : LongWord Read FCrc32Val Write FCrc32Val; + end; + + { TDeCompressor } + TDeCompressor = Class(TObject) + Protected + FInFile : TStream; { I/O file variables } + FOutFile : TStream; + FCrc32Val : LongWord; { CRC calculation variable } + FBufferSize : LongWord; + FOnPercent : Integer; + FOnProgress : TProgressEvent; + Procedure UpdC32(Octet: Byte); + Public + Constructor Create(AInFile, AOutFile : TStream; ABufSize : LongWord); virtual; + Procedure DeCompress; Virtual; Abstract; + Class Function ZipID : Word; virtual; Abstract; + Property BufferSize : LongWord read FBufferSize; + Property OnPercent : Integer Read FOnPercent Write FOnPercent; + Property OnProgress : TProgressEvent Read FOnProgress Write FOnProgress; + Property Crc32Val : LongWord Read FCrc32Val Write FCrc32Val; + end; + + { TShrinker } + +Const + TABLESIZE = 8191; + FIRSTENTRY = 257; + +Type + CodeRec = Packed Record + Child : Smallint; + Sibling : Smallint; + Suffix : Byte; + end; + CodeArray = Array[0..TABLESIZE] of CodeRec; + TablePtr = ^CodeArray; + + FreeListPtr = ^FreeListArray; + FreeListArray = Array[FIRSTENTRY..TABLESIZE] of Word; + + BufPtr = PByte; + + TShrinker = Class(TCompressor) + Private + FBufSize : LongWord; + MaxInBufIdx : LongWord; { Count of valid chars in input buffer } + InputEof : Boolean; { End of file indicator } + CodeTable : TablePtr; { Points to code table for LZW compression } + FreeList : FreeListPtr; { Table of free code table entries } + NextFree : Word; { Index into free list table } + + ClearList : Array[0..1023] of Byte; { Bit mapped structure used in } + { during adaptive resets } + CodeSize : Byte; { Size of codes (in bits) currently being written } + MaxCode : Word; { Largest code that can be written in CodeSize bits } + InBufIdx, { Points to next char in buffer to be read } + OutBufIdx : LongWord; { Points to next free space in output buffer } + InBuf, { I/O buffers } + OutBuf : BufPtr; + FirstCh : Boolean; { Flag indicating the START of a shrink operation } + TableFull : Boolean; { Flag indicating a full symbol table } + SaveByte : Byte; { Output code buffer } + BitsUsed : Byte; { Index into output code buffer } + BytesIn : LongInt; { Count of input file bytes processed } + BytesOut : LongInt; { Count of output bytes } + FOnBytes : Longint; + Procedure FillInputBuffer; + Procedure WriteOutputBuffer; + Procedure FlushOutput; + Procedure PutChar(B : Byte); + procedure PutCode(Code : Smallint); + Procedure InitializeCodeTable; + Procedure Prune(Parent : Word); + Procedure Clear_Table; + Procedure Table_Add(Prefix : Word; Suffix : Byte); + function Table_Lookup(TargetPrefix : Smallint; + TargetSuffix : Byte; + Out FoundAt : Smallint) : Boolean; + Procedure Shrink(Suffix : Smallint); + Procedure ProcessLine(Const Source : String); + Procedure DoOnProgress(Const Pct : Double); Virtual; + Public + Constructor Create(AInFile, AOutFile : TStream; ABufSize : LongWord); override; + Destructor Destroy; override; + Procedure Compress; override; + Class Function ZipID : Word; override; + end; + + { TDeflater } + + TDeflater = Class(TCompressor) + private + FCompressionLevel: TCompressionlevel; + Public + Constructor Create(AInFile, AOutFile : TStream; ABufSize : LongWord);override; + Procedure Compress; override; + Class Function ZipID : Word; override; + Property CompressionLevel : TCompressionlevel Read FCompressionLevel Write FCompressionLevel; + end; + + { TInflater } + + TInflater = Class(TDeCompressor) + Public + Constructor Create(AInFile, AOutFile : TStream; ABufSize : LongWord);override; + Procedure DeCompress; override; + Class Function ZipID : Word; override; + end; + + { TZipFileEntry } + + TZipFileEntry = Class(TCollectionItem) + private + FArchiveFileName: String; + FDateTime: TDateTime; + FDiskFileName: String; + FHeaderPos: Longint; + FSize: Integer; + FStream: TStream; + function GetArchiveFileName: String; + Protected + Property HdrPos : Longint Read FHeaderPos Write FheaderPos; + Public + Procedure Assign(Source : TPersistent); override; + Property Stream : TStream Read FStream Write FStream; + Published + Property ArchiveFileName : String Read GetArchiveFileName Write FArchiveFileName; + Property DiskFileName : String Read FDiskFileName Write FDiskFileName; + Property Size : Integer Read FSize Write FSize; + Property DateTime : TDateTime Read FDateTime Write FDateTime; + end; + + { TZipFileEntries } + + TZipFileEntries = Class(TCollection) + private + function GetZ(AIndex : Integer): TZipFileEntry; + procedure SetZ(AIndex : Integer; const AValue: TZipFileEntry); + Public + Function AddFileEntry(Const ADiskFileName : String): TZipFileEntry; + Function AddFileEntry(Const ADiskFileName, AArchiveFileName : String): TZipFileEntry; + Function AddFileEntry(Const AStream : TSTream; Const AArchiveFileName : String): TZipFileEntry; + Property Entries[AIndex : Integer] : TZipFileEntry Read GetZ Write SetZ; default; + end; + + + { TZipper } + + TZipper = Class(TObject) + Private + FEntries: TZipFileEntries; + FZipping : Boolean; + FBufSize : LongWord; + FFileName : String; { Name of resulting Zip file } + FFiles : TStrings; + FInMemSize : Integer; + FOutFile : TFileStream; + FInFile : TStream; { I/O file variables } + LocalHdr : Local_File_Header_Type; + CentralHdr : Central_File_Header_Type; + EndHdr : End_of_Central_Dir_Type; + FOnPercent : LongInt; + FOnProgress : TProgressEvent; + FOnEndOfFile : TOnEndOfFileEvent; + FOnStartFile : TOnStartFileEvent; + function CheckEntries: Integer; + procedure SetEntries(const AValue: TZipFileEntries); + Protected + Procedure OpenOutput; + Procedure CloseOutput; + Procedure CloseInput(Item : TZipFileEntry); + Procedure StartZipFile(Item : TZipFileEntry); + Function UpdateZipHeader(Item : TZipFileEntry; FZip : TStream; ACRC : LongWord;AMethod : Word) : Boolean; + Procedure BuildZipDirectory; + Procedure DoEndOfFile; + Procedure ZipOneFile(Item : TZipFileEntry); virtual; + Function OpenInput(Item : TZipFileEntry) : Boolean; + Procedure GetFileInfo; + Procedure SetBufSize(Value : LongWord); + Procedure SetFileName(Value : String); + Function CreateCompressor(Item : TZipFileEntry; AinFile,AZipStream : TStream) : TCompressor; virtual; + Public + Constructor Create; + Destructor Destroy;override; + Procedure ZipAllFiles; virtual; + Procedure ZipFiles(AFileName : String; FileList : TStrings); + Procedure ZipFiles(AFileName : String; Entries : TZipFileEntries); + Procedure Clear; + Public + Property BufferSize : LongWord Read FBufSize Write SetBufSize; + Property OnPercent : Integer Read FOnPercent Write FOnPercent; + Property OnProgress : TProgressEvent Read FOnProgress Write FOnProgress; + Property OnStartFile : TOnStartFileEvent Read FOnStartFile Write FOnStartFile; + Property OnEndFile : TOnEndOfFileEvent Read FOnEndOfFile Write FOnEndOfFile; + Property FileName : String Read FFileName Write SetFileName; + Property Files : TStrings Read FFiles; + Property InMemSize : Integer Read FInMemSize Write FInMemSize; + Property Entries : TZipFileEntries Read FEntries Write SetEntries; + end; + + { TYbZipper } + + { TUnZipper } + + TUnZipper = Class(TObject) + Private + FUnZipping : Boolean; + FBufSize : LongWord; + FFileName : String; { Name of resulting Zip file } + FOutputPath : String; + FEntries : TZipFileEntries; + FFiles : TStrings; + FOutFile : TFileStream; + FZipFile : TFileStream; { I/O file variables } + LocalHdr : Local_File_Header_Type; + CentralHdr : Central_File_Header_Type; + EndHdr : End_of_Central_Dir_Type; + + FOnPercent : LongInt; + FOnProgress : TProgressEvent; + FOnEndOfFile : TOnEndOfFileEvent; + FOnStartFile : TOnStartFileEvent; + Protected + Procedure OpenInput; + Procedure CloseOutput; + Procedure CloseInput; + Procedure ReadZipHeader(Item : TZipFileEntry; out ACRC : LongWord;out AMethod : Word); + Procedure ReadZipDirectory; + Procedure DoEndOfFile; + Procedure UnZipOneFile(Item : TZipFileEntry); virtual; + Function OpenOutput(OutFileName : String) : Boolean; + Procedure SetBufSize(Value : LongWord); + Procedure SetFileName(Value : String); + Procedure SetOutputPath(Value:String); + Function CreateDeCompressor(Item : TZipFileEntry; AMethod : Word;AZipFile,AOutFile : TStream) : TDeCompressor; virtual; + Public + Constructor Create; + Destructor Destroy;override; + Procedure UnZipAllFiles; virtual; + Procedure UnZipFiles(AFileName : String; FileList : TStrings); + Procedure UnZipAllFiles(AFileName : String); + Procedure Clear; + Public + Property BufferSize : LongWord Read FBufSize Write SetBufSize; + Property OnPercent : Integer Read FOnPercent Write FOnPercent; + Property OnProgress : TProgressEvent Read FOnProgress Write FOnProgress; + Property OnStartFile : TOnStartFileEvent Read FOnStartFile Write FOnStartFile; + Property OnEndFile : TOnEndOfFileEvent Read FOnEndOfFile Write FOnEndOfFile; + Property FileName : String Read FFileName Write SetFileName; + Property OutputPath : String Read FOutputPath Write SetOutputPath; + Property Files : TStrings Read FFiles; + Property Entries : TZipFileEntries Read FEntries Write FEntries; + end; + + EZipError = Class(Exception); + +Implementation + +ResourceString + SErrBufsizeChange = 'Changing buffer size is not allowed while (un)zipping'; + SErrFileChange = 'Changing output file name is not allowed while (un)zipping'; + SErrInvalidCRC = 'Invalid CRC checksum while unzipping %s'; + SErrCorruptZIP = 'Corrupt ZIP file %s'; + SErrUnsupportedCompressionFormat = 'Unsupported compression format %d'; + SErrMissingFileName = 'Missing filename in entry %d'; + SErrMissingArchiveName = 'Missing archive filename in streamed entry %d'; + SErrFileDoesNotExist = 'File "%s" does not exist.'; + +{ --------------------------------------------------------------------- + Auxiliary + ---------------------------------------------------------------------} + +{$IFDEF FPC_BIG_ENDIAN} +function SwapLFH(const Values: Local_File_Header_Type): Local_File_Header_Type; +begin + with Values do + begin + Result.Signature := SwapEndian(Signature); + Result.Extract_Version_Reqd := SwapEndian(Extract_Version_Reqd); + Result.Bit_Flag := SwapEndian(Bit_Flag); + Result.Compress_Method := SwapEndian(Compress_Method); + Result.Last_Mod_Time := SwapEndian(Last_Mod_Time); + Result.Last_Mod_Date := SwapEndian(Last_Mod_Date); + Result.Crc32 := SwapEndian(Crc32); + Result.Compressed_Size := SwapEndian(Compressed_Size); + Result.Uncompressed_Size := SwapEndian(Uncompressed_Size); + Result.Filename_Length := SwapEndian(Filename_Length); + Result.Extra_Field_Length := SwapEndian(Extra_Field_Length); + end; +end; + +function SwapCFH(const Values: Central_File_Header_Type): Central_File_Header_Type; +begin + with Values do + begin + Result.Signature := SwapEndian(Signature); + Result.MadeBy_Version := SwapEndian(MadeBy_Version); + Result.Extract_Version_Reqd := SwapEndian(Extract_Version_Reqd); + Result.Bit_Flag := SwapEndian(Bit_Flag); + Result.Compress_Method := SwapEndian(Compress_Method); + Result.Last_Mod_Time := SwapEndian(Last_Mod_Time); + Result.Last_Mod_Date := SwapEndian(Last_Mod_Date); + Result.Crc32 := SwapEndian(Crc32); + Result.Compressed_Size := SwapEndian(Compressed_Size); + Result.Uncompressed_Size := SwapEndian(Uncompressed_Size); + Result.Filename_Length := SwapEndian(Filename_Length); + Result.Extra_Field_Length := SwapEndian(Extra_Field_Length); + Result.File_Comment_Length := SwapEndian(File_Comment_Length); + Result.Starting_Disk_Num := SwapEndian(Starting_Disk_Num); + Result.Internal_Attributes := SwapEndian(Internal_Attributes); + Result.External_Attributes := SwapEndian(External_Attributes); + Result.Local_Header_Offset := SwapEndian(Local_Header_Offset); + end; +end; + +function SwapECD(const Values: End_of_Central_Dir_Type): End_of_Central_Dir_Type; +begin + with Values do + begin + Result.Signature := SwapEndian(Signature); + Result.Disk_Number := SwapEndian(Disk_Number); + Result.Central_Dir_Start_Disk := SwapEndian(Central_Dir_Start_Disk); + Result.Entries_This_Disk := SwapEndian(Entries_This_Disk); + Result.Total_Entries := SwapEndian(Total_Entries); + Result.Central_Dir_Size := SwapEndian(Central_Dir_Size); + Result.Start_Disk_Offset := SwapEndian(Start_Disk_Offset); + Result.ZipFile_Comment_Length := SwapEndian(ZipFile_Comment_Length); + end; +end; +{$ENDIF FPC_BIG_ENDIAN} + +Procedure DateTimeToZipDateTime(DT : TDateTime; out ZD,ZT : Word); + +Var + Y,M,D,H,N,S,MS : Word; + +begin + DecodeDate(DT,Y,M,D); + DecodeTime(DT,H,N,S,MS); + Y:=Y-1980; + ZD:=d+(32*M)+(512*Y); + ZT:=(S div 2)+(32*N)+(2048*h); +end; + +Procedure ZipDateTimeToDateTime(ZD,ZT : Word;out DT : TDateTime); + +Var + Y,M,D,H,N,S,MS : Word; + +begin + MS:=0; + S:=(ZT and 31) shl 1; + N:=(ZT shr 5) and 63; + H:=(ZT shr 12) and 31; + D:=ZD and 31; + M:=(ZD shr 5) and 15; + Y:=((ZD shr 9) and 127)+1980; + DT:=ComposeDateTime(EncodeDate(Y,M,D),EncodeTime(H,N,S,MS)); +end; + +{ --------------------------------------------------------------------- + TDeCompressor + ---------------------------------------------------------------------} + + +Procedure TDeCompressor.UpdC32(Octet: Byte); + +Begin + FCrc32Val := Crc_32_Tab[Byte(FCrc32Val XOR LongInt(Octet))] XOR ((FCrc32Val SHR 8) AND $00FFFFFF); +end; + +constructor TDeCompressor.Create(AInFile, AOutFile: TStream; ABufSize: LongWord); +begin + FinFile:=AInFile; + FoutFile:=AOutFile; + FBufferSize:=ABufSize; + CRC32Val:=$FFFFFFFF; +end; + + +{ --------------------------------------------------------------------- + TCompressor + ---------------------------------------------------------------------} + + +Procedure TCompressor.UpdC32(Octet: Byte); + +Begin + FCrc32Val := Crc_32_Tab[Byte(FCrc32Val XOR LongInt(Octet))] XOR ((FCrc32Val SHR 8) AND $00FFFFFF); +end; + +constructor TCompressor.Create(AInFile, AOutFile: TStream; ABufSize: LongWord); +begin + FinFile:=AInFile; + FoutFile:=AOutFile; + FBufferSize:=ABufSize; + CRC32Val:=$FFFFFFFF; +end; + + +{ --------------------------------------------------------------------- + TDeflater + ---------------------------------------------------------------------} + +constructor TDeflater.Create(AInFile, AOutFile: TStream; ABufSize: LongWord); +begin + Inherited; + FCompressionLevel:=clDefault; +end; + + +procedure TDeflater.Compress; + +Var + Buf : PByte; + I,Count,NewCount : Integer; + C : TCompressionStream; + +begin + CRC32Val:=$FFFFFFFF; + Buf:=GetMem(FBufferSize); + Try + C:=TCompressionStream.Create(FCompressionLevel,FOutFile,True); + Try + Repeat + Count:=FInFile.Read(Buf^,FBufferSize); + For I:=0 to Count-1 do + UpdC32(Buf[i]); + NewCount:=Count; + While (NewCount>0) do + NewCount:=NewCount-C.Write(Buf^,NewCount); + Until (Count=0); + Finally + C.Free; + end; + Finally + FreeMem(Buf); + end; + Crc32Val:=NOT Crc32Val; +end; + +class function TDeflater.ZipID: Word; +begin + Result:=8; +end; + +{ --------------------------------------------------------------------- + TInflater + ---------------------------------------------------------------------} + +constructor TInflater.Create(AInFile, AOutFile: TStream; ABufSize: LongWord); +begin + Inherited; +end; + + +procedure TInflater.DeCompress; + +Var + Buf : PByte; + I,Count : Integer; + C : TDeCompressionStream; + +begin + CRC32Val:=$FFFFFFFF; + Buf:=GetMem(FBufferSize); + Try + C:=TDeCompressionStream.Create(FInFile,True); + Try + Repeat + Count:=C.Read(Buf^,FBufferSize); + For I:=0 to Count-1 do + UpdC32(Buf[i]); + FOutFile.Write(Buf^,Count); + Until (Count=0); + Finally + C.Free; + end; + Finally + FreeMem(Buf); + end; + Crc32Val:=NOT Crc32Val; +end; + +class function TInflater.ZipID: Word; +begin + Result:=8; +end; + + +{ --------------------------------------------------------------------- + TShrinker + ---------------------------------------------------------------------} + +Const + DefaultInMemSize = 256*1024; { Files larger than 256k are processed on disk } + DefaultBufSize = 16384; { Use 16K file buffers } + MINBITS = 9; { Starting code size of 9 bits } + MAXBITS = 13; { Maximum code size of 13 bits } + SPECIAL = 256; { Special function code } + INCSIZE = 1; { Code indicating a jump in code size } + CLEARCODE = 2; { Code indicating code table has been cleared } + STDATTR = $23; { Standard file attribute for DOS Find First/Next } + +constructor TShrinker.Create(AInFile, AOutFile : TStream; ABufSize : LongWord); +begin + Inherited; + FBufSize:=ABufSize; + InBuf:=GetMem(FBUFSIZE); + OutBuf:=GetMem(FBUFSIZE); + CodeTable:=GetMem(SizeOf(CodeTable^)); + FreeList:=GetMem(SizeOf(FreeList^)); +end; + +destructor TShrinker.Destroy; +begin + FreeMem(CodeTable); + FreeMem(FreeList); + FreeMem(InBuf); + FreeMem(OutBuf); + inherited Destroy; +end; + +Procedure TShrinker.Compress; + +Var + OneString : String; + Remaining : Word; + +begin + BytesIn := 1; + BytesOut := 1; + InitializeCodeTable; + FillInputBuffer; + FirstCh:= TRUE; + Crc32Val:=$FFFFFFFF; + FOnBytes:=Round((FInFile.Size * FOnPercent) / 100); + While NOT InputEof do + begin + Remaining:=Succ(MaxInBufIdx - InBufIdx); + If Remaining>255 then + Remaining:=255; + If Remaining=0 then + FillInputBuffer + else + begin + SetLength(OneString,Remaining); + Move(InBuf[InBufIdx], OneString[1], Remaining); + Inc(InBufIdx, Remaining); + ProcessLine(OneString); + end; + end; + Crc32Val := NOT Crc32Val; + ProcessLine(''); +end; + +class function TShrinker.ZipID: Word; +begin + Result:=1; +end; + + +Procedure TShrinker.DoOnProgress(Const Pct: Double); + +begin + If Assigned(FOnProgress) then + FOnProgress(Self,Pct); +end; + + +Procedure TShrinker.FillInputBuffer; + +Begin + MaxInbufIDx:=FInfile.Read(InBuf[0], FBufSize); + If MaxInbufIDx=0 then + InputEof := TRUE + else + InputEOF := FALSE; + InBufIdx := 0; +end; + + +Procedure TShrinker.WriteOutputBuffer; +Begin + FOutFile.WriteBuffer(OutBuf[0], OutBufIdx); + OutBufIdx := 0; +end; + + +Procedure TShrinker.PutChar(B : Byte); + +Begin + OutBuf[OutBufIdx] := B; + Inc(OutBufIdx); + If OutBufIdx>=FBufSize then + WriteOutputBuffer; + Inc(BytesOut); +end; + +Procedure TShrinker.FlushOutput; +Begin + If OutBufIdx>0 then + WriteOutputBuffer; +End; + + +procedure TShrinker.PutCode(Code : Smallint); + +var + ACode : LongInt; + XSize : Smallint; + +begin + if (Code=-1) then + begin + if BitsUsed>0 then + PutChar(SaveByte); + end + else + begin + ACode := Longint(Code); + XSize := CodeSize+BitsUsed; + ACode := (ACode shl BitsUsed) or SaveByte; + while (XSize div 8) > 0 do + begin + PutChar(Lo(ACode)); + ACode := ACode shr 8; + Dec(XSize,8); + end; + BitsUsed := XSize; + SaveByte := Lo(ACode); + end; +end; + + +Procedure TShrinker.InitializeCodeTable; + +Var + I : Word; +Begin + For I := 0 to TableSize do + begin + With CodeTable^[I] do + begin + Child := -1; + Sibling := -1; + If (I<=255) then + Suffix := I; + end; + If (I>=257) then + FreeList^[I] := I; + end; + NextFree := FIRSTENTRY; + TableFull := FALSE; +end; + + +Procedure TShrinker.Prune(Parent : Word); + +Var + CurrChild : Smallint; + NextSibling : Smallint; +Begin + CurrChild := CodeTable^[Parent].Child; + { Find first Child that has descendants .. clear any that don't } + While (CurrChild <> -1) AND (CodeTable^[CurrChild].Child = -1) do + begin + CodeTable^[Parent].Child := CodeTable^[CurrChild].Sibling; + CodeTable^[CurrChild].Sibling := -1; + { Turn on ClearList bit to indicate a cleared entry } + ClearList[CurrChild DIV 8] := (ClearList[CurrChild DIV 8] OR (1 SHL (CurrChild MOD 8))); + CurrChild := CodeTable^[Parent].Child; + end; + If CurrChild <> -1 then + begin { If there are any children left ...} + Prune(CurrChild); + NextSibling := CodeTable^[CurrChild].Sibling; + While NextSibling <> -1 do + begin + If CodeTable^[NextSibling].Child = -1 then + begin + CodeTable^[CurrChild].Sibling := CodeTable^[NextSibling].Sibling; + CodeTable^[NextSibling].Sibling := -1; + { Turn on ClearList bit to indicate a cleared entry } + ClearList[NextSibling DIV 8] := (ClearList[NextSibling DIV 8] OR (1 SHL (NextSibling MOD 8))); + NextSibling := CodeTable^[CurrChild].Sibling; + end + else + begin + CurrChild := NextSibling; + Prune(CurrChild); + NextSibling := CodeTable^[CurrChild].Sibling; + end; + end; + end; +end; + + +Procedure TShrinker.Clear_Table; +Var + Node : Word; +Begin + FillChar(ClearList, SizeOf(ClearList), $00); + For Node := 0 to 255 do + Prune(Node); + NextFree := Succ(TABLESIZE); + For Node := TABLESIZE downto FIRSTENTRY do + begin + If (ClearList[Node DIV 8] AND (1 SHL (Node MOD 8))) <> 0 then + begin + Dec(NextFree); + FreeList^[NextFree] := Node; + end; + end; + If NextFree <= TABLESIZE then + TableFull := FALSE; +end; + + +Procedure TShrinker.Table_Add(Prefix : Word; Suffix : Byte); +Var + FreeNode : Word; +Begin + If NextFree <= TABLESIZE then + begin + FreeNode := FreeList^[NextFree]; + Inc(NextFree); + CodeTable^[FreeNode].Child := -1; + CodeTable^[FreeNode].Sibling := -1; + CodeTable^[FreeNode].Suffix := Suffix; + If CodeTable^[Prefix].Child = -1 then + CodeTable^[Prefix].Child := FreeNode + else + begin + Prefix := CodeTable^[Prefix].Child; + While CodeTable^[Prefix].Sibling <> -1 do + Prefix := CodeTable^[Prefix].Sibling; + CodeTable^[Prefix].Sibling := FreeNode; + end; + end; + if NextFree > TABLESIZE then + TableFull := TRUE; +end; + +function TShrinker.Table_Lookup( TargetPrefix : Smallint; + TargetSuffix : Byte; + Out FoundAt : Smallint ) : Boolean; + +var TempPrefix : Smallint; + +begin + TempPrefix := TargetPrefix; + Table_lookup := False; + if CodeTable^[TempPrefix].Child <> -1 then + begin + TempPrefix := CodeTable^[TempPrefix].Child; + repeat + if CodeTable^[TempPrefix].Suffix = TargetSuffix then + begin + Table_lookup := True; + break; + end; + if CodeTable^[TempPrefix].Sibling = -1 then + break; + TempPrefix := CodeTable^[TempPrefix].Sibling; + until False; + end; + if Table_Lookup then + FoundAt := TempPrefix + else + FoundAt := -1; +end; + +Procedure TShrinker.Shrink(Suffix : Smallint); + +Const + LastCode : Smallint = 0; + +Var + WhereFound : Smallint; + +Begin + If FirstCh then + begin + SaveByte := $00; + BitsUsed := 0; + CodeSize := MINBITS; + MaxCode := (1 SHL CodeSize) - 1; + LastCode := Suffix; + FirstCh := FALSE; + end + else + begin + If Suffix <> -1 then + begin + If TableFull then + begin + Putcode(LastCode); + PutCode(SPECIAL); + Putcode(CLEARCODE); + Clear_Table; + Table_Add(LastCode, Suffix); + LastCode := Suffix; + end + else + begin + If Table_Lookup(LastCode, Suffix, WhereFound) then + begin + LastCode := WhereFound; + end + else + begin + PutCode(LastCode); + Table_Add(LastCode, Suffix); + LastCode := Suffix; + If (FreeList^[NextFree] > MaxCode) and (CodeSize < MaxBits) then + begin + PutCode(SPECIAL); + PutCode(INCSIZE); + Inc(CodeSize); + MaxCode := (1 SHL CodeSize) -1; + end; + end; + end; + end + else + begin + PutCode(LastCode); + PutCode(-1); + FlushOutput; + end; + end; +end; + +Procedure TShrinker.ProcessLine(Const Source : String); + +Var + I : Word; + +Begin + If Source = '' then + Shrink(-1) + else + For I := 1 to Length(Source) do + begin + Inc(BytesIn); + If (Pred(BytesIn) MOD FOnBytes) = 0 then + DoOnProgress(100 * ( BytesIn / FInFile.Size)); + UpdC32(Ord(Source[I])); + Shrink(Ord(Source[I])); + end; +end; + +{ --------------------------------------------------------------------- + TZipper + ---------------------------------------------------------------------} + + +Procedure TZipper.GetFileInfo; + +Var + F : TZipFileEntry; + Info : TSearchRec; + I : Longint; + +Begin + For I := 0 to FEntries.Count-1 do + begin + F:=FEntries[i]; + If F.Stream=Nil then + begin + If (F.DiskFileName='') then + Raise EZipError.CreateFmt(SErrMissingFileName,[I]); + If FindFirst(F.DiskFileName, STDATTR, Info)=0 then + try + F.Size:=Info.Size; + F.DateTime:=FileDateToDateTime(Info.Time); + finally + FindClose(Info); + end + else + Raise EZipError.CreateFmt(SErrFileDoesNotExist,[F.DiskFileName]); + end + else + begin + If (F.ArchiveFileName='') then + Raise EZipError.CreateFmt(SErrMissingArchiveName,[I]); + F.Size:=F.Stream.Size; + end; + end; +end; + + +procedure TZipper.SetEntries(const AValue: TZipFileEntries); +begin + if FEntries=AValue then exit; + FEntries.Assign(AValue); +end; + +Procedure TZipper.OpenOutput; + +Begin + FOutFile:=TFileStream.Create(FFileName,fmCreate); +End; + + +Function TZipper.OpenInput(Item : TZipFileEntry) : Boolean; + +Begin + If (Item.Stream<>nil) then + FInFile:=Item.Stream + else + FInFile:=TFileStream.Create(Item.DiskFileName,fmOpenRead); + Result:=True; + If Assigned(FOnStartFile) then + FOnStartFile(Self,Item.ArchiveFileName); +End; + + +Procedure TZipper.CloseOutput; + +Begin + FreeAndNil(FOutFile); +end; + + +Procedure TZipper.CloseInput(Item : TZipFileEntry); + +Begin + If (FInFile<>Item.Stream) then + FreeAndNil(FInFile) + else + FinFile:=Nil; +end; + + +Procedure TZipper.StartZipFile(Item : TZipFileEntry); + +Begin + FillChar(LocalHdr,SizeOf(LocalHdr),0); + With LocalHdr do + begin + Signature := LOCAL_FILE_HEADER_SIGNATURE; + Extract_Version_Reqd := 10; + Bit_Flag := 0; + Compress_Method := 1; + DateTimeToZipDateTime(Item.DateTime,Last_Mod_Date,Last_Mod_Time); + Crc32 := 0; + Compressed_Size := 0; + Uncompressed_Size := Item.Size; + FileName_Length := 0; + Extra_Field_Length := 0; + end ; +End; + + +Function TZipper.UpdateZipHeader(Item : TZipFileEntry; FZip : TStream; ACRC : LongWord; AMethod : Word) : Boolean; +var + ZFileName : ShortString; +Begin + ZFileName:=Item.ArchiveFileName; + With LocalHdr do + begin + FileName_Length := Length(ZFileName); + Compressed_Size := FZip.Size; + Crc32 := ACRC; + Compress_method:=AMethod; + Result:=Not (Compressed_Size >= Uncompressed_Size); + If Not Result then + begin { No... } + Compress_Method := 0; { ...change stowage type } + Compressed_Size := Uncompressed_Size; { ...update compressed size } + end; + end; + FOutFile.WriteBuffer({$IFDEF ENDIAN_BIG}SwapLFH{$ENDIF}(LocalHdr),SizeOf(LocalHdr)); + FOutFile.WriteBuffer(ZFileName[1],Length(ZFileName)); +End; + + +Procedure TZipper.BuildZipDirectory; + +Var + SavePos : LongInt; + HdrPos : LongInt; + CenDirPos : LongInt; + ACount : Word; + ZFileName : ShortString; + +Begin + ACount := 0; + CenDirPos := FOutFile.Position; + FOutFile.Seek(0,soFrombeginning); { Rewind output file } + HdrPos := FOutFile.Position; + FOutFile.ReadBuffer(LocalHdr, SizeOf(LocalHdr)); +{$IFDEF FPC_BIG_ENDIAN} + LocalHdr := SwapLFH(LocalHdr); +{$ENDIF} + Repeat + SetLength(ZFileName,LocalHdr.FileName_Length); + FOutFile.ReadBuffer(ZFileName[1], LocalHdr.FileName_Length); + SavePos := FOutFile.Position; + FillChar(CentralHdr,SizeOf(CentralHdr),0); + With CentralHdr do + begin + Signature := CENTRAL_FILE_HEADER_SIGNATURE; + MadeBy_Version := LocalHdr.Extract_Version_Reqd; + Move(LocalHdr.Extract_Version_Reqd, Extract_Version_Reqd, 26); + Last_Mod_Time:=localHdr.Last_Mod_Time; + Last_Mod_Date:=localHdr.Last_Mod_Date; + File_Comment_Length := 0; + Starting_Disk_Num := 0; + Internal_Attributes := 0; + External_Attributes := faARCHIVE; + Local_Header_Offset := HdrPos; + end; + FOutFile.Seek(0,soFromEnd); + FOutFile.WriteBuffer({$IFDEF FPC_BIG_ENDIAN}SwapCFH{$ENDIF}(CentralHdr),SizeOf(CentralHdr)); + FOutFile.WriteBuffer(ZFileName[1],Length(ZFileName)); + Inc(ACount); + FOutFile.Seek(SavePos + LocalHdr.Compressed_Size,soFromBeginning); + HdrPos:=FOutFile.Position; + FOutFile.ReadBuffer(LocalHdr, SizeOf(LocalHdr)); +{$IFDEF FPC_BIG_ENDIAN} + LocalHdr := SwapLFH(LocalHdr); +{$ENDIF} + Until LocalHdr.Signature = CENTRAL_FILE_HEADER_SIGNATURE; + FOutFile.Seek(0,soFromEnd); + FillChar(EndHdr,SizeOf(EndHdr),0); + With EndHdr do + begin + Signature := END_OF_CENTRAL_DIR_SIGNATURE; + Disk_Number := 0; + Central_Dir_Start_Disk := 0; + Entries_This_Disk := ACount; + Total_Entries := ACount; + Central_Dir_Size := FOutFile.Size-CenDirPos; + Start_Disk_Offset := CenDirPos; + ZipFile_Comment_Length := 0; + FOutFile.WriteBuffer({$IFDEF FPC_BIG_ENDIAN}SwapECD{$ENDIF}(EndHdr), SizeOf(EndHdr)); + end; +end; + +Function TZipper.CreateCompressor(Item : TZipFileEntry; AInFile,AZipStream : TStream) : TCompressor; + +begin + Result:=TDeflater.Create(AinFile,AZipStream,FBufSize); +end; + +Procedure TZipper.ZipOneFile(Item : TZipFileEntry); + +Var + CRC : LongWord; + ZMethod : Word; + ZipStream : TStream; + TmpFileName : String; + +Begin + OpenInput(Item); + Try + StartZipFile(Item); + If (FInfile.Size<=FInMemSize) then + ZipStream:=TMemoryStream.Create + else + begin + TmpFileName:=ChangeFileExt(FFileName,'.tmp'); + ZipStream:=TFileStream.Create(TmpFileName,fmCreate); + end; + Try + With CreateCompressor(Item, FinFile,ZipStream) do + Try + OnProgress:=Self.OnProgress; + OnPercent:=Self.OnPercent; + Compress; + CRC:=Crc32Val; + ZMethod:=ZipID; + Finally + Free; + end; + If UpdateZipHeader(Item,ZipStream,CRC,ZMethod) then + // Compressed file smaller than original file. + FOutFile.CopyFrom(ZipStream,0) + else + begin + // Original file smaller than compressed file. + FInfile.Seek(0,soFromBeginning); + FOutFile.CopyFrom(FInFile,0); + end; + finally + ZipStream.Free; + If (TmpFileName<>'') then + DeleteFile(TmpFileName); + end; + Finally + CloseInput(Item); + end; +end; + +Procedure TZipper.ZipAllFiles; + +Var + I : Integer; + filecnt : integer; +Begin + If CheckEntries=0 then + Exit; + FZipping:=True; + Try + GetFileInfo; + OpenOutput; + Try + filecnt:=0; + For I:=0 to FEntries.Count-1 do + begin + ZipOneFile(FEntries[i]); + inc(filecnt); + end; + if filecnt>0 then + BuildZipDirectory; + finally + CloseOutput; + end; + finally + FZipping:=False; + end; +end; + + +Procedure TZipper.SetBufSize(Value : LongWord); + +begin + If FZipping then + Raise EZipError.Create(SErrBufsizeChange); + If Value>=DefaultBufSize then + FBufSize:=Value; +end; + +Procedure TZipper.SetFileName(Value : String); + +begin + If FZipping then + Raise EZipError.Create(SErrFileChange); + FFileName:=Value; +end; + +Procedure TZipper.ZipFiles(AFileName : String; FileList : TStrings); + +begin + FFiles.Assign(FileList); + FFileName:=AFileName; + ZipAllFiles; +end; + +procedure TZipper.ZipFiles(AFileName: String; Entries: TZipFileEntries); +begin + FFileName:=AFileName; + FEntries.Assign(Entries); + ZipAllFiles; +end; + +Procedure TZipper.DoEndOfFile; + +Var + ComprPct : Double; + +begin + If (LocalHdr.Uncompressed_Size>0) then + ComprPct := (100.0 * (LocalHdr.Uncompressed_Size - LocalHdr.Compressed_Size)) / LocalHdr.Uncompressed_Size + else + ComprPct := 0; + If Assigned(FOnEndOfFile) then + FOnEndOfFile(Self,ComprPct); +end; + +Constructor TZipper.Create; + +begin + FBufSize:=DefaultBufSize; + FInMemSize:=DefaultInMemSize; + FFiles:=TStringList.Create; + FEntries:=TZipFileEntries.Create(TZipFileEntry); + FOnPercent:=1; +end; + +Function TZipper.CheckEntries : Integer; + +Var + I : Integer; + +begin + If (FFiles.Count>0) and (FEntries.Count=0) then + begin + FEntries.Clear; + For I:=0 to FFiles.Count-1 do + begin + FEntries.AddFileEntry(FFiles[i]); + end; + end; + Result:=FEntries.Count; +end; + + +Procedure TZipper.Clear; + +begin + FEntries.Clear; + FFiles.Clear; +end; + +Destructor TZipper.Destroy; + +begin + Clear; + FreeAndNil(FEntries); + FreeAndNil(FFiles); + Inherited; +end; + + +{ --------------------------------------------------------------------- + TUnZipper + ---------------------------------------------------------------------} + +Procedure TUnZipper.OpenInput; + +Begin + FZipFile:=TFileStream.Create(FFileName,fmOpenRead); +End; + + +Function TUnZipper.OpenOutput(OutFileName : String) : Boolean; + +Begin + ForceDirectories(ExtractFilePath(OutFileName)); + FOutFile:=TFileStream.Create(OutFileName,fmCreate); + Result:=True; + If Assigned(FOnStartFile) then + FOnStartFile(Self,OutFileName); +End; + + +Procedure TUnZipper.CloseOutput; + +Begin + FreeAndNil(FOutFile); +end; + + +Procedure TUnZipper.CloseInput; + +Begin + FreeAndNil(FZipFile); +end; + + +Procedure TUnZipper.ReadZipHeader(Item : TZipFileEntry; out ACRC : LongWord; out AMethod : Word); + +Var + S : String; + D : TDateTime; + +Begin + FZipFile.Seek(Item.HdrPos,soFromBeginning); + FZipFile.ReadBuffer(LocalHdr,SizeOf(LocalHdr)); +{$IFDEF FPC_BIG_ENDIAN} + LocalHdr := SwapLFH(LocalHdr); +{$ENDIF} + With LocalHdr do + begin + SetLength(S,Filename_Length); + FZipFile.ReadBuffer(S[1],Filename_Length); + FZipFile.Seek(Extra_Field_Length,soCurrent); + Item.ArchiveFileName:=S; + Item.DiskFileName:=S; + Item.Size:=Uncompressed_Size; + ZipDateTimeToDateTime(Last_Mod_Date,Last_Mod_Time,D); + Item.DateTime:=D; + ACrc:=Crc32; + AMethod:=Compress_method; + end; +End; + + +Procedure TUnZipper.ReadZipDirectory; + +Var + i, + EndHdrPos, + CenDirPos : LongInt; + NewNode : TZipFileEntry; + S : String; + +Begin + EndHdrPos:=FZipFile.Size-SizeOf(EndHdr); + if EndHdrPos < 0 then + raise EZipError.CreateFmt(SErrCorruptZIP,[FZipFile.FileName]); + FZipFile.Seek(EndHdrPos,soFromBeginning); + FZipFile.ReadBuffer(EndHdr, SizeOf(EndHdr)); +{$IFDEF FPC_BIG_ENDIAN} + EndHdr := SwapECD(EndHdr); +{$ENDIF} + With EndHdr do + begin + if Signature <> END_OF_CENTRAL_DIR_SIGNATURE then + raise EZipError.CreateFmt(SErrCorruptZIP,[FZipFile.FileName]); + CenDirPos:=Start_Disk_Offset; + end; + FZipFile.Seek(CenDirPos,soFrombeginning); + for i:=0 to EndHdr.Entries_This_Disk-1 do + begin + FZipFile.ReadBuffer(CentralHdr, SizeOf(CentralHdr)); +{$IFDEF FPC_BIG_ENDIAN} + CentralHdr := SwapCFH(CentralHdr); +{$ENDIF} + With CentralHdr do + begin + if Signature<>CENTRAL_FILE_HEADER_SIGNATURE then + raise EZipError.CreateFmt(SErrCorruptZIP,[FZipFile.FileName]); + NewNode:=FEntries.Add as TZipFileEntry; + NewNode.HdrPos := Local_Header_Offset; + SetLength(S,Filename_Length); + FZipFile.ReadBuffer(S[1],Filename_Length); + NewNode.ArchiveFileName:=S; + FZipFile.Seek(Extra_Field_Length+File_Comment_Length,soCurrent); + end; + end; +end; + +Function TUnZipper.CreateDeCompressor(Item : TZipFileEntry; AMethod : Word;AZipFile,AOutFile : TStream) : TDeCompressor; +begin + case AMethod of + 8 : + Result:=TInflater.Create(AZipFile,AOutFile,FBufSize); + else + raise EZipError.CreateFmt(SErrUnsupportedCompressionFormat,[AMethod]); + end; +end; + +Procedure TUnZipper.UnZipOneFile(Item : TZipFileEntry); + +Var + Count : Longint; + CRC : LongWord; + ZMethod : Word; + OutputFileName : string; +Begin + Try + ReadZipHeader(Item,CRC,ZMethod); + OutputFileName:=Item.DiskFileName; + if FOutputPath<>'' then + OutputFileName:=IncludeTrailingPathDelimiter(FOutputPath)+OutputFileName; + OpenOutput(OutputFileName); + if ZMethod=0 then + begin + Count:=FOutFile.CopyFrom(FZipFile,LocalHdr.Compressed_Size); +{$warning TODO: Implement CRC Check} + end + else + With CreateDecompressor(Item, ZMethod, FZipFile, FOutFile) do + Try + OnProgress:=Self.OnProgress; + OnPercent:=Self.OnPercent; + DeCompress; + if CRC<>Crc32Val then + raise EZipError.CreateFmt(SErrInvalidCRC,[Item.ArchiveFileName]); + Finally + Free; + end; + Finally + CloseOutput; + end; +end; + + +Procedure TUnZipper.UnZipAllFiles; +Var + Item : TZipFileEntry; + I : Integer; + AllFiles : Boolean; + +Begin + FUnZipping:=True; + Try + AllFiles:=(FFiles.Count=0); + OpenInput; + Try + ReadZipDirectory; + For I:=0 to FEntries.Count-1 do + begin + Item:=FEntries[i]; + if AllFiles or (FFiles.IndexOf(Item.ArchiveFileName)<>-1) then + UnZipOneFile(Item); + end; + Finally + CloseInput; + end; + finally + FUnZipping:=False; + end; +end; + + +Procedure TUnZipper.SetBufSize(Value : LongWord); + +begin + If FUnZipping then + Raise EZipError.Create(SErrBufsizeChange); + If Value>=DefaultBufSize then + FBufSize:=Value; +end; + +Procedure TUnZipper.SetFileName(Value : String); + +begin + If FUnZipping then + Raise EZipError.Create(SErrFileChange); + FFileName:=Value; +end; + +Procedure TUnZipper.SetOutputPath(Value:String); +begin + If FUnZipping then + Raise EZipError.Create(SErrFileChange); + FOutputPath:=Value; +end; + +Procedure TUnZipper.UnZipFiles(AFileName : String; FileList : TStrings); + +begin + FFiles.Assign(FileList); + FFileName:=AFileName; + UnZipAllFiles; +end; + +Procedure TUnZipper.UnZipAllFiles(AFileName : String); + +begin + FFileName:=AFileName; + UnZipAllFiles; +end; + +Procedure TUnZipper.DoEndOfFile; + +Var + ComprPct : Double; + +begin + If (LocalHdr.Uncompressed_Size>0) then + ComprPct := (100.0 * (LocalHdr.Uncompressed_Size - LocalHdr.Compressed_Size)) / LocalHdr.Uncompressed_Size + else + ComprPct := 0; + If Assigned(FOnEndOfFile) then + FOnEndOfFile(Self,ComprPct); +end; + +Constructor TUnZipper.Create; + +begin + FBufSize:=DefaultBufSize; + FFiles:=TStringList.Create; + TStringlist(FFiles).Sorted:=True; + FEntries:=TZipFileEntries.Create(TZipFileEntry); + FOnPercent:=1; +end; + +Procedure TUnZipper.Clear; + +begin + FFiles.Clear; + FEntries.Clear; +end; + +Destructor TUnZipper.Destroy; + +begin + Clear; + FreeAndNil(FFiles); + FreeAndNil(FEntries); + Inherited; +end; + +{ TZipFileEntry } + +function TZipFileEntry.GetArchiveFileName: String; +begin + Result:=FArchiveFileName; + If (Result='') then + Result:=FDiskFileName; +end; + +procedure TZipFileEntry.Assign(Source: TPersistent); + +Var + Z : TZipFileEntry; + +begin + if Source is TZipFileEntry then + begin + Z:=Source as TZipFileEntry; + FArchiveFileName:=Z.FArchiveFileName; + FDiskFileName:=Z.FDiskFileName; + FSize:=Z.FSize; + FDateTime:=Z.FDateTime; + FStream:=Z.FStream; + end + else + inherited Assign(Source); +end; + +{ TZipFileEntries } + +function TZipFileEntries.GetZ(AIndex : Integer): TZipFileEntry; +begin + Result:=TZipFileEntry(Items[AIndex]); +end; + +procedure TZipFileEntries.SetZ(AIndex : Integer; const AValue: TZipFileEntry); +begin + Items[AIndex]:=AValue; +end; + +function TZipFileEntries.AddFileEntry(const ADiskFileName: String + ): TZipFileEntry; +begin + Result:=Add as TZipFileEntry; + Result.DiskFileName:=ADiskFileName; +end; + +function TZipFileEntries.AddFileEntry(const ADiskFileName, + AArchiveFileName: String): TZipFileEntry; +begin + Result:=AddFileEntry(ADiskFileName); + Result.ArchiveFileName:=AArchiveFileName; +end; + +function TZipFileEntries.AddFileEntry(const AStream: TSTream; + const AArchiveFileName: String): TZipFileEntry; +begin + Result:=Add as TZipFileEntry; + Result.Stream:=AStream; + Result.ArchiveFileName:=AArchiveFileName; +end; + +End. diff --git a/components/fpspreadsheet/laz_fpspreadsheet.lpk b/components/fpspreadsheet/laz_fpspreadsheet.lpk index 7288ac779..3a92f1b00 100644 --- a/components/fpspreadsheet/laz_fpspreadsheet.lpk +++ b/components/fpspreadsheet/laz_fpspreadsheet.lpk @@ -8,13 +8,13 @@ <PathDelim Value="\"/> <SearchPaths> <OtherUnitFiles Value="C:\Programas\lazarus-ccr\components\fpspreadsheet\"/> - <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)\"/> + <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/> </SearchPaths> <Other> <CompilerPath Value="$(CompPath)"/> </Other> </CompilerOptions> - <Files Count="9"> + <Files Count="10"> <Item1> <Filename Value="fpolestorage.pas"/> <UnitName Value="fpolestorage"/> @@ -51,6 +51,10 @@ <Filename Value="fpsutils.pas"/> <UnitName Value="fpsutils"/> </Item9> + <Item10> + <Filename Value="fpszipper.pp"/> + <UnitName Value="fpszipper"/> + </Item10> </Files> <Type Value="RunAndDesignTime"/> <RequiredPkgs Count="1"> diff --git a/components/fpspreadsheet/laz_fpspreadsheet.pas b/components/fpspreadsheet/laz_fpspreadsheet.pas index 36146bbc6..5fa602f39 100644 --- a/components/fpspreadsheet/laz_fpspreadsheet.pas +++ b/components/fpspreadsheet/laz_fpspreadsheet.pas @@ -8,7 +8,7 @@ interface uses fpolestorage, fpsallformats, fpsopendocument, fpspreadsheet, xlsbiff2, - xlsbiff5, xlsbiff8, xlsxooxml, fpsutils, LazarusPackageIntf; + xlsbiff5, xlsbiff8, xlsxooxml, fpsutils, fpszipper, LazarusPackageIntf; implementation diff --git a/components/fpspreadsheet/xlsbiff2.pas b/components/fpspreadsheet/xlsbiff2.pas index 8287bca86..2cdeb7967 100755 --- a/components/fpspreadsheet/xlsbiff2.pas +++ b/components/fpspreadsheet/xlsbiff2.pas @@ -59,7 +59,7 @@ type { Record writing methods } procedure WriteBOF(AStream: TStream); procedure WriteEOF(AStream: TStream); - procedure WriteFormula(AStream: TStream; const ARow, ACol: Word; const AFormula: TRPNFormula); override; + procedure WriteFormula(AStream: TStream; const ARow, ACol: Word; const AFormula: TsFormula); override; procedure WriteLabel(AStream: TStream; const ARow, ACol: Word; const AValue: string); override; procedure WriteNumber(AStream: TStream; const ARow, ACol: Cardinal; const AValue: double); override; end; @@ -84,17 +84,43 @@ const INT_EXCEL_CHART = $0020; INT_EXCEL_MACRO_SHEET = $0040; + { Types and constants for formulas } +type + TRPNItem = record + TokenID: Byte; + Col: Byte; + Row: Word; + DoubleValue: Double; + end; + + TRPNFormula = array of TRPNItem; + +const + { TokenID values } + + { Binary Operator Tokens } + INT_EXCEL_TOKEN_TADD = $03; + INT_EXCEL_TOKEN_TSUB = $04; + INT_EXCEL_TOKEN_TMUL = $05; + INT_EXCEL_TOKEN_TDIV = $06; + INT_EXCEL_TOKEN_TPOWER = $07; + + { Constant Operand Tokens } + INT_EXCEL_TOKEN_TNUM = $1F; + + { Operand Tokens } + INT_EXCEL_TOKEN_TREFR = $24; + INT_EXCEL_TOKEN_TREFV = $44; + INT_EXCEL_TOKEN_TREFA = $64; + { TsSpreadBIFF2Writer } -{******************************************************************* -* TsSpreadBIFF2Writer.WriteToStream () -* -* DESCRIPTION: Writes an Excel 2 file to a stream -* -* Excel 2.x files support only one Worksheet per Workbook, -* so only the first will be written. -* -*******************************************************************} +{ + Writes an Excel 2 file to a stream + + Excel 2.x files support only one Worksheet per Workbook, + so only the first will be written. +} procedure TsSpreadBIFF2Writer.WriteToStream(AStream: TStream; AData: TsWorkbook); begin WriteBOF(AStream); @@ -104,14 +130,11 @@ begin WriteEOF(AStream); end; -{******************************************************************* -* TsSpreadBIFF2Writer.WriteBOF () -* -* DESCRIPTION: Writes an Excel 2 BOF record -* -* This must be the first record on an Excel 2 stream -* -*******************************************************************} +{ + Writes an Excel 2 BOF record + + This must be the first record on an Excel 2 stream +} procedure TsSpreadBIFF2Writer.WriteBOF(AStream: TStream); begin { BIFF Record header } @@ -125,14 +148,11 @@ begin AStream.WriteWord(WordToLE(INT_EXCEL_SHEET)); end; -{******************************************************************* -* TsSpreadBIFF2Writer.WriteEOF () -* -* DESCRIPTION: Writes an Excel 2 EOF record -* -* This must be the last record on an Excel 2 stream -* -*******************************************************************} +{ + Writes an Excel 2 EOF record + + This must be the last record on an Excel 2 stream +} procedure TsSpreadBIFF2Writer.WriteEOF(AStream: TStream); begin { BIFF Record header } @@ -140,25 +160,31 @@ begin AStream.WriteWord($0000); end; -{******************************************************************* -* TsSpreadBIFF2Writer.WriteFormula () -* -* DESCRIPTION: Writes an Excel 2 FORMULA record -* -* To input a formula to this method, first convert it -* to RPN, and then list all it's members in the -* AFormula array -* -*******************************************************************} +{ + Writes an Excel 2 FORMULA record + + The formula needs to be converted from usual user-readable string + to an RPN array + + // or, in RPN: A1, B1, + + SetLength(MyFormula, 3); + MyFormula[0].TokenID := INT_EXCEL_TOKEN_TREFV; A1 + MyFormula[0].Col := 0; + MyFormula[0].Row := 0; + MyFormula[1].TokenID := INT_EXCEL_TOKEN_TREFV; B1 + MyFormula[1].Col := 1; + MyFormula[1].Row := 0; + MyFormula[2].TokenID := INT_EXCEL_TOKEN_TADD; + +} procedure TsSpreadBIFF2Writer.WriteFormula(AStream: TStream; const ARow, - ACol: Word; const AFormula: TRPNFormula); -var + ACol: Word; const AFormula: TsFormula); +{var FormulaResult: double; i: Integer; RPNLength: Word; - TokenArraySizePos, RecordSizePos, FinalPos: Cardinal; + TokenArraySizePos, RecordSizePos, FinalPos: Cardinal;} begin - RPNLength := 0; +(* RPNLength := 0; FormulaResult := 0.0; { BIFF Record header } @@ -227,7 +253,7 @@ begin AStream.WriteByte(RPNLength); AStream.Position := RecordSizePos; AStream.WriteWord(WordToLE(17 + RPNLength)); - AStream.position := FinalPos; + AStream.position := FinalPos;*) end; {******************************************************************* diff --git a/components/fpspreadsheet/xlsbiff5.pas b/components/fpspreadsheet/xlsbiff5.pas index 070e8f7f8..fa78cecd2 100755 --- a/components/fpspreadsheet/xlsbiff5.pas +++ b/components/fpspreadsheet/xlsbiff5.pas @@ -97,7 +97,7 @@ type procedure WriteDimensions(AStream: TStream); procedure WriteEOF(AStream: TStream); procedure WriteFont(AStream: TStream; AFont: TFPCustomFont); - procedure WriteFormula(AStream: TStream; const ARow, ACol: Word; const AFormula: TRPNFormula); override; + procedure WriteFormula(AStream: TStream; const ARow, ACol: Word; const AFormula: TsFormula); override; procedure WriteIndex(AStream: TStream); procedure WriteLabel(AStream: TStream; const ARow, ACol: Word; const AValue: string); override; procedure WriteNumber(AStream: TStream; const ARow, ACol: Cardinal; const AValue: double); override; @@ -536,14 +536,14 @@ end; * *******************************************************************} procedure TsSpreadBIFF5Writer.WriteFormula(AStream: TStream; const ARow, - ACol: Word; const AFormula: TRPNFormula); -var + ACol: Word; const AFormula: TsFormula); +{var FormulaResult: double; i: Integer; RPNLength: Word; - TokenArraySizePos, RecordSizePos, FinalPos: Int64; + TokenArraySizePos, RecordSizePos, FinalPos: Int64;} begin - RPNLength := 0; +(* RPNLength := 0; FormulaResult := 0.0; { BIFF Record header } @@ -612,7 +612,7 @@ begin AStream.WriteByte(RPNLength); AStream.Position := RecordSizePos; AStream.WriteWord(WordToLE(22 + RPNLength)); - AStream.position := FinalPos; + AStream.position := FinalPos;*) end; {******************************************************************* diff --git a/components/fpspreadsheet/xlsbiff8.pas b/components/fpspreadsheet/xlsbiff8.pas index 05e47e978..ce58f100e 100755 --- a/components/fpspreadsheet/xlsbiff8.pas +++ b/components/fpspreadsheet/xlsbiff8.pas @@ -66,7 +66,7 @@ type procedure WriteEOF(AStream: TStream); procedure WriteFont(AStream: TStream; AFontName: Widestring = 'Arial'); procedure WriteFormat(AStream: TStream; AIndex: Word = 0; AFormatString: Widestring = 'General'); - procedure WriteFormula(AStream: TStream; const ARow, ACol: Word; const AFormula: TRPNFormula); override; + procedure WriteFormula(AStream: TStream; const ARow, ACol: Word; const AFormula: TsFormula); override; procedure WriteLabel(AStream: TStream; const ARow, ACol: Word; const AValue: string); override; procedure WriteNumber(AStream: TStream; const ARow, ACol: Cardinal; const AValue: double); override; procedure WriteXF(AStream: TStream); @@ -260,14 +260,14 @@ end; * *******************************************************************} procedure TsSpreadBIFF5Writer.WriteFormula(AStream: TStream; const ARow, - ACol: Word; const AFormula: TRPNFormula); -var + ACol: Word; const AFormula: TsFormula); +{var FormulaResult: double; i: Integer; RPNLength: Word; - TokenArraySizePos, RecordSizePos, FinalPos: Cardinal; + TokenArraySizePos, RecordSizePos, FinalPos: Cardinal;} begin - RPNLength := 0; +(* RPNLength := 0; FormulaResult := 0.0; { BIFF Record header } @@ -336,7 +336,7 @@ begin AStream.WriteByte(RPNLength); AStream.Position := RecordSizePos; AStream.WriteWord(WordToLE(17 + RPNLength)); - AStream.position := FinalPos; + AStream.position := FinalPos;*) end; {******************************************************************* diff --git a/components/fpspreadsheet/xlsxooxml.pas b/components/fpspreadsheet/xlsxooxml.pas index c4cef5824..b3f526c6f 100755 --- a/components/fpspreadsheet/xlsxooxml.pas +++ b/components/fpspreadsheet/xlsxooxml.pas @@ -5,13 +5,13 @@ Writes an OOXML (Office Open XML) document An OOXML document is a compressed ZIP file with the following files inside: -[Content_Types].xml -_rels\.rels -xl\_rels\workbook.xml.rels -xl\workbook.xml -xl\styles.xml -xl\sharedStrings.xml -xl\worksheets\sheet1.xml +[Content_Types].xml - +_rels\.rels - +xl\_rels\workbook.xml.rels - +xl\workbook.xml - Global workbook data and list of worksheets +xl\styles.xml - +xl\sharedStrings.xml - +xl\worksheets\sheet1.xml - Contents of each worksheet ... xl\worksheets\sheetN.xml @@ -20,8 +20,6 @@ Specifications obtained from: http://openxmldeveloper.org/default.aspx AUTHORS: Felipe Monteiro de Carvalho - -IMPORTANT: This writer doesn't work yet!!! This is just initial code. } unit xlsxooxml; @@ -32,7 +30,8 @@ unit xlsxooxml; interface uses - Classes, SysUtils, zipper, + Classes, SysUtils, + fpszipper, {NOTE: fpszipper is the latest zipper.pp Change to standard zipper when FPC 2.4 is released } fpspreadsheet; type @@ -41,12 +40,23 @@ type TsSpreadOOXMLWriter = class(TsCustomSpreadWriter) protected - FZip: TZipper; + { Strings with the contents of files } FContentTypes: string; FRelsRels: string; - FWorkbook, FWorkbookRels, FStyles, FSharedString, FSheet1: string; - procedure FillFileContentStrings(AData: TsWorkbook); + FWorkbook, FWorkbookRels, FStyles, FSharedStrings: string; + FSheets: array of string; + FSharedStringsCount: Integer; + { Streams with the contents of files } + FSContentTypes: TStringStream; + FSRelsRels: TStringStream; + FSWorkbook, FSWorkbookRels, FSStyles, FSSharedStrings: TStringStream; + FSSheets: array of TStringStream; + { Routines to write those files } + procedure WriteGlobalFiles; + procedure WriteContent(AData: TsWorkbook); + procedure WriteWorksheet(CurSheet: TsWorksheet); public + destructor Destroy; override; { General writing methods } procedure WriteStringToFile(AFileName, AString: string); procedure WriteToFile(AFileName: string; AData: TsWorkbook); override; @@ -64,15 +74,15 @@ const { OOXML Directory structure constants } OOXML_PATH_TYPES = '[Content_Types].xml'; - OOXML_PATH_RELS = '_rels\'; - OOXML_PATH_RELS_RELS = '_rels\.rels'; - OOXML_PATH_XL = 'xl\'; - OOXML_PATH_XL_RELS = 'xl\_rels\'; - OOXML_PATH_XL_RELS_RELS = 'xl\_rels\workbook.xml.rels'; - OOXML_PATH_XL_WORKBOOK = 'xl\workbook.xml'; - OOXML_PATH_XL_STYLES = 'xl\styles.xml'; - OOXML_PATH_XL_STRINGS = 'xl\sharedStrings.xml'; - OOXML_PATH_XL_WORKSHEETS = 'xl\worksheets\'; + OOXML_PATH_RELS = '_rels' + PathDelim; + OOXML_PATH_RELS_RELS = '_rels' + PathDelim + '.rels'; + OOXML_PATH_XL = 'xl' + PathDelim; + OOXML_PATH_XL_RELS = 'xl' + PathDelim + '_rels' + PathDelim; + OOXML_PATH_XL_RELS_RELS = 'xl' + PathDelim + '_rels' + PathDelim + 'workbook.xml.rels'; + OOXML_PATH_XL_WORKBOOK = 'xl' + PathDelim + 'workbook.xml'; + OOXML_PATH_XL_STYLES = 'xl' + PathDelim + 'styles.xml'; + OOXML_PATH_XL_STRINGS = 'xl' + PathDelim + 'sharedStrings.xml'; + OOXML_PATH_XL_WORKSHEETS = 'xl' + PathDelim + 'worksheets' + PathDelim; { OOXML schemas constants } SCHEMAS_TYPES = 'http://schemas.openxmlformats.org/package/2006/content-types'; @@ -95,7 +105,7 @@ const { TsSpreadOOXMLWriter } -procedure TsSpreadOOXMLWriter.FillFileContentStrings(AData: TsWorkbook); +procedure TsSpreadOOXMLWriter.WriteGlobalFiles; begin // WriteCellsToStream(AStream, AData.GetFirstWorksheet.FCells); @@ -116,28 +126,6 @@ begin '<Relationship Type="' + SCHEMAS_DOCUMENT + '" Target="/xl/workbook.xml" Id="rId1" />' + LineEnding + '</Relationships>'; - FWorkbookRels := - XML_HEADER + LineEnding + - '<Relationships xmlns="' + SCHEMAS_RELS + '">' + LineEnding + - '<Relationship Type="' + SCHEMAS_WORKSHEET + '" Target="/xl/worksheets/sheet1.xml" Id="rId1" />' + LineEnding + - '<Relationship Type="' + SCHEMAS_STYLES + '" Target="/xl/styles.xml" Id="rId2" />' + LineEnding + - '<Relationship Type="' + SCHEMAS_STRINGS + '" Target="/xl/sharedStrings.xml" Id="rId3" />' + LineEnding + - '</Relationships>'; - - FWorkbook := - XML_HEADER + LineEnding + - '<workbook xmlns="' + SCHEMAS_SPREADML + '" xmlns:r="' + SCHEMAS_DOC_RELS + '">' + LineEnding + - ' <fileVersion appName="xl" lastEdited="4" lowestEdited="4" rupBuild="4505" />' + LineEnding + - ' <workbookPr defaultThemeVersion="124226" />' + LineEnding + - ' <bookViews>' + LineEnding + - ' <workbookView xWindow="480" yWindow="90" windowWidth="15195" windowHeight="12525" />' + LineEnding + - ' </bookViews>' + LineEnding + - ' <sheets>' + LineEnding + - ' <sheet name="Sheet1" sheetId="1" r:id="rId1" />' + LineEnding + - ' </sheets>' + LineEnding + - ' <calcPr calcId="114210" />' + LineEnding + - '</workbook>'; - FStyles := XML_HEADER + LineEnding + '<styleSheet xmlns="' + SCHEMAS_SPREADML + '">' + LineEnding + @@ -176,11 +164,71 @@ begin ' <dxfs count="0" />' + LineEnding + ' <tableStyles count="0" defaultTableStyle="TableStyleMedium9" defaultPivotStyle="PivotStyleLight16" />' + LineEnding + '</styleSheet>'; +end; - FSharedString := +procedure TsSpreadOOXMLWriter.WriteContent(AData: TsWorkbook); +var + i: Integer; +begin + { Workbook relations - Mark relation to all sheets } + FWorkbookRels := XML_HEADER + LineEnding + - '<sst xmlns="' + SCHEMAS_SPREADML + '" count="4" uniqueCount="4">' + LineEnding + - ' <si>' + LineEnding + + '<Relationships xmlns="' + SCHEMAS_RELS + '">' + LineEnding + + '<Relationship Type="' + SCHEMAS_STYLES + '" Target="/xl/styles.xml" Id="rId1" />' + LineEnding + + '<Relationship Type="' + SCHEMAS_STRINGS + '" Target="/xl/sharedStrings.xml" Id="rId2" />' + LineEnding; + + for i := 1 to AData.GetWorksheetCount do + begin + FWorkbookRels := FWorkbookRels + + '<Relationship Type="' + SCHEMAS_WORKSHEET + '" Target="/xl/worksheets/sheet' + IntToStr(i) + + '.xml" Id="rId' + IntToStr(i + 2) + '" />' + LineEnding; + end; + + FWorkbookRels := FWorkbookRels + + '</Relationships>'; + + // Global workbook data - Mark all sheets + FWorkbook := + XML_HEADER + LineEnding + + '<workbook xmlns="' + SCHEMAS_SPREADML + '" xmlns:r="' + SCHEMAS_DOC_RELS + '">' + LineEnding + + ' <fileVersion appName="xl" lastEdited="4" lowestEdited="4" rupBuild="4505" />' + LineEnding + + ' <workbookPr defaultThemeVersion="124226" />' + LineEnding + + ' <bookViews>' + LineEnding + + ' <workbookView xWindow="480" yWindow="90" windowWidth="15195" windowHeight="12525" />' + LineEnding + + ' </bookViews>' + LineEnding; + + for i := 1 to AData.GetWorksheetCount do + begin + FWorkbook := FWorkbook + + ' <sheets>' + LineEnding + + ' <sheet name="Sheet' + IntToStr(i) + '" sheetId="' + + IntToStr(i) + '" r:id="rId' + IntToStr(i) + '" />' + LineEnding + + ' </sheets>' + LineEnding; + end; + + FWorkbook := FWorkbook + + ' <calcPr calcId="114210" />' + LineEnding + + '</workbook>'; + + // Preparation for Shared strings + FSharedStringsCount := 0; + FSharedStrings := ''; + + // Write all worksheets, which fills also FSharedStrings + SetLength(FSheets, 0); + + for i := 0 to AData.GetWorksheetCount - 1 do + begin + WriteWorksheet(Adata.GetWorksheetByIndex(i)); + end; + + // Finalization of the shared strings document + FSharedStrings := + XML_HEADER + LineEnding + + '<sst xmlns="' + SCHEMAS_SPREADML + '" count="' + IntToStr(FSharedStringsCount) + + '" uniqueCount="' + IntToStr(FSharedStringsCount) + '">' + LineEnding + + FSharedStrings + +{ ' <si>' + LineEnding + ' <t>First</t>' + LineEnding + ' </si>' + LineEnding + ' <si>' + LineEnding + @@ -191,10 +239,18 @@ begin ' </si>' + LineEnding + ' <si>' + LineEnding + ' <t>Fourth</t>' + LineEnding + - ' </si>' + LineEnding + + ' </si>' + LineEnding + } '</sst>'; +end; - FSheet1 := +procedure TsSpreadOOXMLWriter.WriteWorksheet(CurSheet: TsWorksheet); +var + CurStr: Integer; +begin + CurStr := Length(FSheets); + SetLength(FSheets, CurStr + 1); + + FSheets[CurStr] := XML_HEADER + LineEnding + '<worksheet xmlns="' + SCHEMAS_SPREADML + '" xmlns:r="' + SCHEMAS_DOC_RELS + '">' + LineEnding + ' <sheetViews>' + LineEnding + @@ -228,17 +284,22 @@ begin ' <c r="D2" t="s">' + LineEnding + ' <v>3</v>' + LineEnding + ' </c>' + LineEnding + - ' </row>' + LineEnding + + ' </row>' + LineEnding + ' </sheetData>' + LineEnding + '</worksheet>'; end; -{******************************************************************* -* TsSpreadOOXMLWriter.WriteStringToFile () -* -* DESCRIPTION: Writes a string to a file. Helper convenience method. -* -*******************************************************************} +destructor TsSpreadOOXMLWriter.Destroy; +begin + SetLength(FSheets, 0); + SetLength(FSSheets, 0); + + inherited Destroy; +end; + +{ + Writes a string to a file. Helper convenience method. +} procedure TsSpreadOOXMLWriter.WriteStringToFile(AFileName, AString: string); var TheStream : TFileStream; @@ -250,127 +311,92 @@ begin TheStream.Free; end; -{******************************************************************* -* TsSpreadOOXMLWriter.WriteToFile () -* -* DESCRIPTION: Writes an OOXML document to the disc -* -*******************************************************************} +{ + Writes an OOXML document to the disc +} procedure TsSpreadOOXMLWriter.WriteToFile(AFileName: string; AData: TsWorkbook); var - TempDir: string; + FZip: TZipper; + i: Integer; begin -{ FZip := TZipper.Create; - FZip.ZipFiles(AFileName, x); - FZip.Free;} - - FillFileContentStrings(AData); + { Fill the strings with the contents of the files } - TempDir := IncludeTrailingBackslash(AFileName); + WriteGlobalFiles(); + WriteContent(AData); - { files on the root path } + { Write the data to streams } - ForceDirectories(TempDir); + FSContentTypes := TStringStream.Create(FContentTypes); + FSRelsRels := TStringStream.Create(FRelsRels); + FSWorkbookRels := TStringStream.Create(FWorkbookRels); + FSWorkbook := TStringStream.Create(FWorkbook); + FSStyles := TStringStream.Create(FStyles); + FSSharedStrings := TStringStream.Create(FSharedStrings); - WriteStringToFile(TempDir + OOXML_PATH_TYPES, FContentTypes); - - { _rels directory } + SetLength(FSSheets, Length(FSheets)); - ForceDirectories(TempDir + OOXML_PATH_RELS); + for i := 0 to Length(FSheets) - 1 do + FSSheets[i] := TStringStream.Create(FSheets[i]); - WriteStringToFile(TempDir + OOXML_PATH_RELS_RELS, FRelsRels); + { Now compress the files } - { xl directory } + FZip := TZipper.Create; + try + FZip.FileName := AFileName; - ForceDirectories(TempDir + OOXML_PATH_XL_RELS); - - WriteStringToFile(TempDir + OOXML_PATH_XL_RELS_RELS, FWorkbookRels); - - WriteStringToFile(TempDir + OOXML_PATH_XL_WORKBOOK, FWorkbook); + FZip.Entries.AddFileEntry(FSContentTypes, OOXML_PATH_TYPES); + FZip.Entries.AddFileEntry(FSRelsRels, OOXML_PATH_RELS_RELS); + FZip.Entries.AddFileEntry(FSWorkbookRels, OOXML_PATH_XL_RELS_RELS); + FZip.Entries.AddFileEntry(FSWorkbook, OOXML_PATH_XL_WORKBOOK); + FZip.Entries.AddFileEntry(FSStyles, OOXML_PATH_XL_STYLES); + FZip.Entries.AddFileEntry(FSSharedStrings, OOXML_PATH_XL_STRINGS); - WriteStringToFile(TempDir + OOXML_PATH_XL_STYLES, FStyles); + for i := 0 to Length(FSheets) - 1 do + FZip.Entries.AddFileEntry(FSSheets[i], OOXML_PATH_XL_WORKSHEETS + 'sheet' + IntToStr(i + 1) + '.xml'); - WriteStringToFile(TempDir + OOXML_PATH_XL_STRINGS, FSharedString); - - { xl\worksheets directory } + FZip.ZipAllFiles; + finally + FSContentTypes.Free; + FSRelsRels.Free; + FSWorkbookRels.Free; + FSWorkbook.Free; + FSStyles.Free; + FSSharedStrings.Free; - ForceDirectories(TempDir + OOXML_PATH_XL_WORKSHEETS); + for i := 0 to Length(FSSheets) - 1 do + FSSheets[i].Free; - WriteStringToFile(TempDir + OOXML_PATH_XL_WORKSHEETS + 'sheet1.xml', FSheet1); + FZip.Free; + end; end; procedure TsSpreadOOXMLWriter.WriteToStream(AStream: TStream; AData: TsWorkbook); begin - + // Not supported at the moment + raise Exception.Create('TsSpreadOpenDocWriter.WriteToStream not supported'); end; -{******************************************************************* -* TsSpreadOOXMLWriter.WriteLabel () -* -* DESCRIPTION: Writes an Excel 2 LABEL record -* -* Writes a string to the sheet -* -*******************************************************************} +{ + Writes a string to the sheet +} procedure TsSpreadOOXMLWriter.WriteLabel(AStream: TStream; const ARow, ACol: Word; const AValue: string); -var - L: Byte; begin - L := Length(AValue); - { BIFF Record header } -// AStream.WriteWord(WordToLE(INT_EXCEL_ID_LABEL)); -// AStream.WriteWord(WordToLE(8 + L)); - - { BIFF Record data } -// AStream.WriteWord(WordToLE(ARow)); -// AStream.WriteWord(WordToLE(ACol)); - - { BIFF2 Attributes } - AStream.WriteByte($0); - AStream.WriteByte($0); - AStream.WriteByte($0); - - { String with 8-bit size } - AStream.WriteByte(L); - AStream.WriteBuffer(AValue[1], L); end; -{******************************************************************* -* TsSpreadOOXMLWriter.WriteNumber () -* -* DESCRIPTION: Writes an Excel 2 NUMBER record -* -* Writes a number (64-bit IEE 754 floating point) to the sheet -* -*******************************************************************} +{ + Writes a number (64-bit IEE 754 floating point) to the sheet +} procedure TsSpreadOOXMLWriter.WriteNumber(AStream: TStream; const ARow, ACol: Cardinal; const AValue: double); begin - { BIFF Record header } -// AStream.WriteWord(WordToLE(INT_EXCEL_ID_NUMBER)); -// AStream.WriteWord(WordToLE(15)); - { BIFF Record data } -// AStream.WriteWord(WordToLE(ARow)); -// AStream.WriteWord(WordToLE(ACol)); - - { BIFF2 Attributes } - AStream.WriteByte($0); - AStream.WriteByte($0); - AStream.WriteByte($0); - - { IEE 754 floating-point value } - AStream.WriteBuffer(AValue, 8); end; -{******************************************************************* -* Initialization section -* -* Registers this reader / writer on fpSpreadsheet -* -*******************************************************************} +{ + Registers this reader / writer on fpSpreadsheet +} initialization RegisterSpreadFormat(TsCustomSpreadReader, TsSpreadOOXMLWriter, sfOOXML);