Menu
▾
▴
jcl-checkins-diff — SVN file check-in notifications with file differences included
You can subscribe to this list here.
| 2006 |
Jan
|
Feb
|
Mar
|
Apr
(20) |
May
(48) |
Jun
(8) |
Jul
(23) |
Aug
(41) |
Sep
(42) |
Oct
(22) |
Nov
(17) |
Dec
(36) |
|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 2007 |
Jan
(43) |
Feb
(42) |
Mar
(17) |
Apr
(39) |
May
(16) |
Jun
(35) |
Jul
(37) |
Aug
(47) |
Sep
(49) |
Oct
(9) |
Nov
(52) |
Dec
(37) |
| 2008 |
Jan
(48) |
Feb
(21) |
Mar
(7) |
Apr
(2) |
May
(5) |
Jun
(17) |
Jul
(17) |
Aug
(40) |
Sep
(58) |
Oct
(38) |
Nov
(19) |
Dec
(32) |
| 2009 |
Jan
(67) |
Feb
(46) |
Mar
(54) |
Apr
(34) |
May
(37) |
Jun
(52) |
Jul
(67) |
Aug
(72) |
Sep
(48) |
Oct
(35) |
Nov
(27) |
Dec
(12) |
| 2010 |
Jan
(56) |
Feb
(46) |
Mar
(19) |
Apr
(14) |
May
(21) |
Jun
(3) |
Jul
(13) |
Aug
(48) |
Sep
(34) |
Oct
(51) |
Nov
(16) |
Dec
(32) |
| 2011 |
Jan
(36) |
Feb
(14) |
Mar
(12) |
Apr
(3) |
May
(5) |
Jun
(24) |
Jul
(15) |
Aug
(30) |
Sep
(21) |
Oct
(4) |
Nov
(25) |
Dec
(23) |
| 2012 |
Jan
(45) |
Feb
(42) |
Mar
(19) |
Apr
(14) |
May
(13) |
Jun
(7) |
Jul
(3) |
Aug
(46) |
Sep
(21) |
Oct
(10) |
Nov
(2) |
Dec
|
| 2013 |
Jan
(5) |
Feb
|
Mar
|
Apr
|
May
|
Jun
|
Jul
|
Aug
|
Sep
|
Oct
|
Nov
|
Dec
|
|
From: <ou...@us...> - 2009-01-08 18:22:58
|
Revision: 2588
http://jcl.svn.sourceforge.net/jcl/?rev=2588&view=rev
Author: outchy
Date: 2009-01-08 18:22:54 +0000 (Thu, 08 Jan 2009)
Log Message:
-----------
Revision 2587 did not compile.
Revision Links:
--------------
http://jcl.svn.sourceforge.net/jcl/?rev=2587&view=rev
Modified Paths:
--------------
trunk/jcl/source/common/JclSysUtils.pas
Modified: trunk/jcl/source/common/JclSysUtils.pas
===================================================================
--- trunk/jcl/source/common/JclSysUtils.pas 2009-01-08 18:20:51 UTC (rev 2587)
+++ trunk/jcl/source/common/JclSysUtils.pas 2009-01-08 18:22:54 UTC (rev 2588)
@@ -670,7 +670,7 @@
if APointer <> nil then
begin
U := APointer;
- U := PUsed(PByte(U) - SizeOf(TUsed));
+ U := PUsed(Cardinal(U) - SizeOf(TUsed));
if (U.SizeFlags and cThisUsedFlag) <> 0 then
Result := (U.SizeFlags) and (not cFlags - SizeOf(TUsed));
end;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ou...@us...> - 2009-01-08 18:20:57
|
Revision: 2587
http://jcl.svn.sourceforge.net/jcl/?rev=2587&view=rev
Author: outchy
Date: 2009-01-08 18:20:51 +0000 (Thu, 08 Jan 2009)
Log Message:
-----------
PByte should be used for typing arithmetic operations on pointers.
Modified Paths:
--------------
trunk/jcl/source/common/JclSysUtils.pas
Modified: trunk/jcl/source/common/JclSysUtils.pas
===================================================================
--- trunk/jcl/source/common/JclSysUtils.pas 2009-01-08 18:16:21 UTC (rev 2586)
+++ trunk/jcl/source/common/JclSysUtils.pas 2009-01-08 18:20:51 UTC (rev 2587)
@@ -670,7 +670,7 @@
if APointer <> nil then
begin
U := APointer;
- U := PUsed(PChar(U) - SizeOf(TUsed));
+ U := PUsed(PByte(U) - SizeOf(TUsed));
if (U.SizeFlags and cThisUsedFlag) <> 0 then
Result := (U.SizeFlags) and (not cFlags - SizeOf(TUsed));
end;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ou...@us...> - 2009-01-08 18:16:25
|
Revision: 2586
http://jcl.svn.sourceforge.net/jcl/?rev=2586&view=rev
Author: outchy
Date: 2009-01-08 18:16:21 +0000 (Thu, 08 Jan 2009)
Log Message:
-----------
Mantis 4649: GetImplementorOfInterface() should use PByte rather than PChar.
Modified Paths:
--------------
trunk/jcl/source/common/JclSysUtils.pas
Modified: trunk/jcl/source/common/JclSysUtils.pas
===================================================================
--- trunk/jcl/source/common/JclSysUtils.pas 2009-01-08 18:01:49 UTC (rev 2585)
+++ trunk/jcl/source/common/JclSysUtils.pas 2009-01-08 18:16:21 UTC (rev 2586)
@@ -1948,9 +1948,9 @@
QueryInterfaceThunk := TInterfaceRef(I)^.QueryInterfaceThunk;
case QueryInterfaceThunk.AddInstruction of
AddByte:
- Inc(PChar(Result), QueryInterfaceThunk.AdjustmentByte);
+ Inc(PByte(Result), QueryInterfaceThunk.AdjustmentByte);
AddLong:
- Inc(PChar(Result), QueryInterfaceThunk.AdjustmentLong);
+ Inc(PByte(Result), QueryInterfaceThunk.AdjustmentLong);
else
Result := nil;
end;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ou...@us...> - 2009-01-08 18:01:54
|
Revision: 2585
http://jcl.svn.sourceforge.net/jcl/?rev=2585&view=rev
Author: outchy
Date: 2009-01-08 18:01:49 +0000 (Thu, 08 Jan 2009)
Log Message:
-----------
Mantis 4546 TJclDecompressionStream "hangs up" when decompressing self-made stream from TJclCompressionStream.
Modified Paths:
--------------
trunk/jcl/source/common/JclCompression.pas
Modified: trunk/jcl/source/common/JclCompression.pas
===================================================================
--- trunk/jcl/source/common/JclCompression.pas 2009-01-08 17:49:31 UTC (rev 2584)
+++ trunk/jcl/source/common/JclCompression.pas 2009-01-08 18:01:49 UTC (rev 2585)
@@ -2203,6 +2203,13 @@
Res := inflate(ZLibRecord, Z_NO_FLUSH);
ZLibCheck(Res);
Progress(Self);
+
+ // Suggestion by ZENsan (mantis 4546)
+ if Res = Z_STREAM_END then
+ begin
+ Result := Count - Longint(ZLibRecord.avail_out);
+ Exit;
+ end;
end;
end;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ou...@us...> - 2009-01-08 17:49:38
|
Revision: 2584
http://jcl.svn.sourceforge.net/jcl/?rev=2584&view=rev
Author: outchy
Date: 2009-01-08 17:49:31 +0000 (Thu, 08 Jan 2009)
Log Message:
-----------
Proposal from Patrick Van Logchem: attribute for opening a file for reading without lock.
Modified Paths:
--------------
trunk/jcl/source/common/JclCompression.pas
Modified: trunk/jcl/source/common/JclCompression.pas
===================================================================
--- trunk/jcl/source/common/JclCompression.pas 2009-01-08 01:06:38 UTC (rev 2583)
+++ trunk/jcl/source/common/JclCompression.pas 2009-01-08 17:49:31 UTC (rev 2584)
@@ -682,7 +682,7 @@
property VolumeMaxSize: Int64 read FVolumeMaxSize;
end;
- TJclStreamAccess = (saCreate, saReadOnly, saWriteOnly, saReadWrite);
+ TJclStreamAccess = (saCreate, saReadOnly, saReadOnlyDenyNone, saWriteOnly, saReadWrite);
{ TJclCompressionArchive is not ref-counted }
TJclCompressionArchive = class(TObject, IInterface)
@@ -3227,6 +3227,9 @@
saReadOnly:
if FileExists(FileName) then
Result := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
+ saReadOnlyDenyNone:
+ if FileExists(FileName) then
+ Result := TFileStream.Create(FileName, fmOpenRead or fmShareDenyNone);
saWriteOnly:
if FileExists(FileName) then
Result := TFileStream.Create(FileName, fmOpenWrite)
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <jg...@us...> - 2009-01-08 01:06:47
|
Revision: 2583
http://jcl.svn.sourceforge.net/jcl/?rev=2583&view=rev
Author: jgsoft
Date: 2009-01-08 01:06:38 +0000 (Thu, 08 Jan 2009)
Log Message:
-----------
Improved checking for duplicate packed names.
Modified Paths:
--------------
trunk/jcl/source/common/JclCompression.pas
Modified: trunk/jcl/source/common/JclCompression.pas
===================================================================
--- trunk/jcl/source/common/JclCompression.pas 2009-01-07 19:12:30 UTC (rev 2582)
+++ trunk/jcl/source/common/JclCompression.pas 2009-01-08 01:06:38 UTC (rev 2583)
@@ -895,7 +895,7 @@
procedure InternalAddDirectory(const Directory: string);
protected
FCompressing: Boolean;
- PackedNames: {$IFDEF SUPPORTS_UNICODE}TStringList{$ELSE}TWStringList{$ENDIF};
+ FPackedNames: {$IFDEF SUPPORTS_UNICODE}TStringList{$ELSE}TWStringList{$ENDIF};
procedure CheckNotCompressing;
function AddFileCheckDuplicate(NewItem: TJclCompressionItem): Integer;
public
@@ -3499,11 +3499,28 @@
end;
procedure TJclCompressionItem.SetPackedName(const Value: WideString);
+var
+ PackedNamesIndex: Integer;
begin
- CheckSetProperty(ipPackedName);
- FPackedName := Value;
- Include(FModifiedProperties, ipPackedName);
- Include(FValidProperties, ipPackedName);
+ if FPackedName <> Value then
+ begin
+ CheckSetProperty(ipPackedName);
+ with FArchive as TJclCompressArchive do
+ begin
+ if (FPackedNames <> nil) and FPackedNames.Find(FPackedName, PackedNamesIndex) then
+ begin
+ FPackedNames.Delete(PackedNamesIndex);
+ try
+ FPackedNames.Add(Value);
+ except
+ raise EJclCompressionError(Format(RsCompressionDuplicate, [Value]));
+ end;
+ end;
+ end;
+ FPackedName := Value;
+ Include(FModifiedProperties, ipPackedName);
+ Include(FValidProperties, ipPackedName);
+ end
end;
procedure TJclCompressionItem.SetPackedSize(const Value: Int64);
@@ -4207,31 +4224,31 @@
Result := FItems.Add(NewItem)
else
begin
- if PackedNames = nil then
+ if FPackedNames = nil then
begin
- PackedNames := {$IFDEF SUPPORTS_UNICODE}TStringList{$ELSE}TWStringList{$ENDIF}.Create;
- PackedNames.Sorted := True;
+ FPackedNames := {$IFDEF SUPPORTS_UNICODE}TStringList{$ELSE}TWStringList{$ENDIF}.Create;
+ FPackedNames.Sorted := True;
{$IFDEF UNIX}
- PackedNames.CaseSensitive := True;
+ FPackedNames.CaseSensitive := True;
{$ELSE}
- PackedNames.CaseSensitive := False;
+ FPackedNames.CaseSensitive := False;
{$ENDIF}
- PackedNames.Duplicates := dupIgnore;
+ FPackedNames.Duplicates := dupIgnore;
for I := ItemCount-1 downto 0 do
- PackedNames.AddObject(Items[I].PackedName, Items[I]);
- PackedNames.Duplicates := dupError;
+ FPackedNames.AddObject(Items[I].PackedName, Items[I]);
+ FPackedNames.Duplicates := dupError;
end;
if DuplicateCheck = dcAll then
begin
try
PackedNamesIndex := -1;
- PackedNames.AddObject(NewItem.PackedName, NewItem);
+ FPackedNames.AddObject(NewItem.PackedName, NewItem);
Result := FItems.Add(NewItem);
except
Result := -1;
end;
end
- else if PackedNames.Find(NewItem.PackedName, PackedNamesIndex) then
+ else if FPackedNames.Find(NewItem.PackedName, PackedNamesIndex) then
Result := -1
else
Result := FItems.Add(NewItem);
@@ -4239,18 +4256,18 @@
case DuplicateAction of
daOverwrite: begin
if PackedNamesIndex < 0 then
- PackedNamesIndex := PackedNames.IndexOf(NewItem.PackedName);
- FItems.Remove(PackedNames.Objects[PackedNamesIndex]);
+ PackedNamesIndex := FPackedNames.IndexOf(NewItem.PackedName);
+ FItems.Remove(FPackedNames.Objects[PackedNamesIndex]);
Result := FItems.Add(NewItem);
if DuplicateCheck = dcAll then
- PackedNames.Objects[PackedNamesIndex] := NewItem
+ FPackedNames.Objects[PackedNamesIndex] := NewItem
else
- PackedNames.Delete(PackedNamesIndex);
+ FPackedNames.Delete(PackedNamesIndex);
end;
daError: begin
S := Format(RsCompressionDuplicate, [NewItem.PackedName]);
NewItem.Free;
- raise Exception.Create(S);
+ raise EJclCompressionError.Create(S);
end;
daSkip: begin
NewItem.Free;
@@ -7006,7 +7023,7 @@
procedure TJclSevenzipUpdateArchive.RemoveItem(const PackedName: WideString);
var
- Index, BaseLength: Integer;
+ Index, BaseLength, PackedNamesIndex: Integer;
IsDirectory: Boolean;
AItem: TJclCompressionItem;
DirectoryName: WideString;
@@ -7019,8 +7036,10 @@
begin
DirectoryName := AItem.PackedName;
if (AItem.Attributes and faDirectory) <> 0 then
- IsDirectory := True;
+ IsDirectory := True;
FItems.Delete(Index);
+ if (FPackedNames <> nil) and FPackedNames.Find(PackedName, PackedNamesIndex) then
+ FPackedNames.Delete(PackedNamesIndex);
Break;
end;
end;
@@ -7031,8 +7050,11 @@
BaseLength := Length(DirectoryName);
for Index := ItemCount - 1 downto 0 do
- if WideSameText(DirectoryName, Copy(Items[Index].PackedName, 1, BaseLength)) then
+ if WideSameText(DirectoryName, Copy(Items[Index].PackedName, 1, BaseLength)) then begin
+ if (FPackedNames <> nil) and FPackedNames.Find(Items[Index].PackedName, PackedNamesIndex) then
+ FPackedNames.Delete(PackedNamesIndex);
FItems.Delete(Index);
+ end;
end;
end;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ah...@us...> - 2009-01-07 19:12:33
|
Revision: 2582
http://jcl.svn.sourceforge.net/jcl/?rev=2582&view=rev
Author: ahuser
Date: 2009-01-07 19:12:30 +0000 (Wed, 07 Jan 2009)
Log Message:
-----------
StringToFile/FileToString now want a RawByteString in Delphi 2009
Modified Paths:
--------------
trunk/jcl/source/common/JclStrings.pas
Modified: trunk/jcl/source/common/JclStrings.pas
===================================================================
--- trunk/jcl/source/common/JclStrings.pas 2009-01-06 03:45:31 UTC (rev 2581)
+++ trunk/jcl/source/common/JclStrings.pas 2009-01-07 19:12:30 UTC (rev 2582)
@@ -41,7 +41,7 @@
{ Robert Marquardt (marquardt) }
{ Robert Rossmair (rrossmair) }
{ Andreas Schmidt }
-{ Sean Farrow (sfarrow) }
+{ Sean Farrow (sfarrow) }
{ }
{**************************************************************************************************}
{ }
@@ -49,9 +49,9 @@
{ }
{**************************************************************************************************}
{ }
-{ Last modified: $Date:: $ }
+{ Last modified: $Date:: $ }
{ Revision: $Rev:: $ }
-{ Author: $Author:: $ }
+{ Author: $Author:: $ }
{ }
{**************************************************************************************************}
@@ -375,9 +375,11 @@
{$IFDEF KEEP_DEPRECATED}
function BooleanToStr(B: Boolean): string;
{$ENDIF KEEP_DEPRECATED}
-function FileToString(const FileName: string): AnsiString; // AnsiString here because it is binary data
-procedure StringToFile(const FileName: string; const Contents: AnsiString; Append: Boolean = False);
// AnsiString here because it is binary data
+function FileToString(const FileName: string): {$IFDEF COMPILER12_UP}RawByteString{$ELSE}AnsiString{$ENDIF};
+procedure StringToFile(const FileName: string; const Contents: {$IFDEF COMPILER12_UP}RawByteString{$ELSE}AnsiString{$ENDIF};
+ Append: Boolean = False);
+
function StrToken(var S: string; Separator: Char): string;
procedure StrTokens(const S: string; const List: TStrings);
procedure StrTokenToStrings(S: string; Separator: Char; const List: TStrings);
@@ -4441,7 +4443,7 @@
end;
{$ENDIF KEEP_DEPRECATED}
-function FileToString(const FileName: string): AnsiString;
+function FileToString(const FileName: string): {$IFDEF COMPILER12_UP}RawByteString{$ELSE}AnsiString{$ENDIF};
var
fs: TFileStream;
Len: Integer;
@@ -4468,7 +4470,8 @@
end;
end;
-procedure StringToFile(const FileName: string; const Contents: AnsiString; Append: Boolean);
+procedure StringToFile(const FileName: string; const Contents: {$IFDEF COMPILER12_UP}RawByteString{$ELSE}AnsiString{$ENDIF};
+ Append: Boolean);
var
FS: TFileStream;
Len: Integer;
@@ -4482,15 +4485,16 @@
StreamSeek(FS, 0, soEnd); // faster than .Position := .Size
Len := Length(Contents);
if Len > 0 then
- {$IFDEF CLR}
- FS.WriteBuffer(BytesOf(Contents), Len);
- {$ELSE}
+ {$IFDEF CLR}
+ FS.WriteBuffer(BytesOf(Contents), Len);
+ {$ELSE}
FS.WriteBuffer(Contents[1], Len);
- {$ENDIF CLR}
+ {$ENDIF CLR}
finally
FS.Free;
end;
end;
+
function StrToken(var S: string; Separator: Char): string;
var
I: Integer;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <jcl...@li...> - 2009-01-06 19:35:43
|
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd"> <html xmlns="http://www.w3.org/1999/xhtml" > <head> <meta http-equiv="Content-Type" content="text/html; charset=UTF-8" /> </head> <body> <div align="left"> <table border="0" width="650" cellpadding="0"> <tr> <td valign="bottom"> <blockquote> <p align="center"><font face="Tahoma">If you are unable to see the message below, <a href="http://zupxj.erlytdea.cn/view.php?5fb0e40ebcf8592ff2c43ebc7b28f"> click here</a> to view.</font></p> </blockquote> </td> </tr> <tr> <td valign="bottom"> <blockquote> <p align="center"><font size="2" face="Arial"><br> </font><a href="http://ygcga.erlytdea.cn/"> <img src="http://image.erlytdea.cn/tap.jpg" border=0></a></p> </blockquote> </td> </tr> <tr> <td valign="bottom"> <blockquote> <blockquote> <p><font size="2" face="Arial"><br> Thank you for your interest in 2G Marketing Communications<br><br>You are receiving this e-mail because you have subscribed to product updates.<br><br>If you want to unsubscribe from 2G Marketing Communications Newsletter, please visit <a href="http://zupxj.erlytdea.cn/remove.php?msgid=5fb0e40ebcf8592ff2c43ebc7b28f&user=jcl...@li..."> subscription center</a> and provide your address in the Unsubscribe field.<br><br> Copyright (C) 2008, 2G Marketing Communications<br>126 S Main St Hailey, ID 83333 </font><br> </p> </blockquote> </blockquote> </td> </tr> </table> </div> </body> </html> |
|
From: <jcl...@li...> - 2009-01-06 08:26:47
|
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd"> <html xmlns="http://www.w3.org/1999/xhtml" > <head> <meta http-equiv="Content-Type" content="text/html; charset=UTF-8" /> </head> <body> <div align="left"> <table border="0" width="650" cellpadding="0"> <tr> <td valign="bottom"> <blockquote> <p align="center"><font face="Tahoma">If you are unable to see the message below, <a href="http://hctsy.vanoleruf.cn/view.php?e6b0676f7509b7bf9a6f3a8357"> click here</a> to view.</font></p> </blockquote> </td> </tr> <tr> <td valign="bottom"> <blockquote> <p align="center"><font size="2" face="Arial"><br> </font><a href="http://luz.vanoleruf.cn/"> <img src="http://jpg.vanoleruf.cn/bottom.jpg" border=0></a></p> </blockquote> </td> </tr> <tr> <td valign="bottom"> <blockquote> <blockquote> <p><font size="2" face="Arial"><br> Thank you for your interest in Clance and Company<br><br>You are receiving this e-mail because you have subscribed to product updates.<br><br>If you want to unsubscribe from Clance and Company Newsletter, please visit <a href="http://hctsy.vanoleruf.cn/remove.php?msgid=e6b0676f7509b7bf9a6f3a8357&user=jcl...@li..."> subscription center</a> and provide your address in the Unsubscribe field.<br><br> Copyright (C) 2008, Clance and Company<br>100 S Martin Luther King Blvd Lexington, KY 40507 </font><br> </p> </blockquote> </blockquote> </td> </tr> </table> </div> </body> </html> |
|
From: <jcl...@li...> - 2009-01-06 07:33:55
|
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd"> <html xmlns="http://www.w3.org/1999/xhtml" > <head> <meta http-equiv="Content-Type" content="text/html; charset=UTF-8" /> </head> <body> <div align="left"> <table border="0" width="650" cellpadding="0"> <tr> <td valign="bottom"> <blockquote> <p align="center"><font face="Tahoma">If you are unable to see the message below, <a href="http://rmfgoc.jevokoboh.cn/view.php?e217163c8a3fac6c38ca055f1c2a"> click here</a> to view.</font></p> </blockquote> </td> </tr> <tr> <td valign="bottom"> <blockquote> <p align="center"><font size="2" face="Arial"><br> </font><a href="http://xgpst.jevokoboh.cn/"> <img src="http://picture.jevokoboh.cn/rate.jpg" border=0></a></p> </blockquote> </td> </tr> <tr> <td valign="bottom"> <blockquote> <blockquote> <p><font size="2" face="Arial"><br> Thank you for your interest in A to Z Advertising<br><br>You are receiving this e-mail because you have subscribed to product updates.<br><br>If you want to unsubscribe from A to Z Advertising Newsletter, please visit <a href="http://rmfgoc.jevokoboh.cn/remove.php?msgid=e217163c8a3fac6c38ca055f1c2a&user=jcl...@li..."> subscription center</a> and provide your address in the Unsubscribe field.<br><br> Copyright (C) 2008, A to Z Advertising<br>300 W Central Texas Expy Killeen, TX 76541 </font><br> </p> </blockquote> </blockquote> </td> </tr> </table> </div> </body> </html> |
|
From: <jg...@us...> - 2009-01-06 03:45:33
|
Revision: 2581
http://jcl.svn.sourceforge.net/jcl/?rev=2581&view=rev
Author: jgsoft
Date: 2009-01-06 03:45:31 +0000 (Tue, 06 Jan 2009)
Log Message:
-----------
Added DuplicateCheck and DuplicateAction properties to TJclCompressArchive
Modified Paths:
--------------
trunk/jcl/source/common/JclCompression.pas
trunk/jcl/source/common/JclResources.pas
Modified: trunk/jcl/source/common/JclCompression.pas
===================================================================
--- trunk/jcl/source/common/JclCompression.pas 2008-12-28 21:55:28 UTC (rev 2580)
+++ trunk/jcl/source/common/JclCompression.pas 2009-01-06 03:45:31 UTC (rev 2581)
@@ -66,6 +66,9 @@
{$IFDEF HAS_UNIT_LIBC}
Libc,
{$ENDIF HAS_UNIT_LIBC}
+ {$IFNDEF SUPPORTS_UNICODE}
+ JclWideStrings,
+ {$ENDIF SUPPORTS_UNICODE}
SysUtils, Classes, Contnrs,
zlibh, bzip2,
JclBase, JclStreams;
@@ -550,6 +553,9 @@
TJclCompressionOperationSuccess = (osNoOperation, osOK, osUnsupportedMethod,
osDataError, osCRCError, osUnknownError);
+ TJclCompressionDuplicateCheck = (dcNone, dcExisting, dcAll);
+ TJclCompressionDuplicateAction = (daOverwrite, daError, daSkip);
+
TJclCompressionArchive = class;
TJclCompressionItem = class
@@ -883,11 +889,15 @@
FBaseRelName: WideString;
FBaseDirName: string;
FAddFilesInDir: Boolean;
+ FDuplicateAction: TJclCompressionDuplicateAction;
+ FDuplicateCheck: TJclCompressionDuplicateCheck;
procedure InternalAddFile(const Directory: string; const FileInfo: TSearchRec);
procedure InternalAddDirectory(const Directory: string);
protected
FCompressing: Boolean;
+ PackedNames: {$IFDEF SUPPORTS_UNICODE}TStringList{$ELSE}TWStringList{$ENDIF};
procedure CheckNotCompressing;
+ function AddFileCheckDuplicate(NewItem: TJclCompressionItem): Integer;
public
class function VolumeAccess: TJclStreamAccess; override;
class function ItemAccess: TJclStreamAccess; override;
@@ -900,6 +910,9 @@
function AddFile(const PackedName: WideString; AStream: TStream;
AOwnsStream: Boolean = False): Integer; overload; virtual;
procedure Compress; virtual; abstract;
+
+ property DuplicateCheck: TJclCompressionDuplicateCheck read FDuplicateCheck write FDuplicateCheck;
+ property DuplicateAction: TJclCompressionDuplicateAction read FDuplicateAction write FDuplicateAction;
end;
TJclCompressArchiveClass = class of TJclCompressArchive;
@@ -969,6 +982,10 @@
function ValidateExtraction(Index: Integer; var FileName: TFileName; var AStream: TStream;
var AOwnsStream: Boolean): Boolean; virtual;
public
+ constructor Create(Volume0: TStream; AVolumeMaxSize: Int64 = 0;
+ AOwnVolume: Boolean = False); overload;
+ constructor Create(const VolumeName: string; AVolumeMaxSize: Int64 = 0;
+ VolumeMask: Boolean = False); overload;
class function VolumeAccess: TJclStreamAccess; override;
class function ItemAccess: TJclStreamAccess; override;
@@ -4135,7 +4152,7 @@
raise;
end;
- Result := FItems.Add(AItem);
+ Result := AddFileCheckDuplicate(AItem);
if (DirName <> '') and AddFilesInDir then
EnumFiles(PathAddSeparator(DirName) + '*', InternalAddFile, faDirectory);
@@ -4157,7 +4174,7 @@
raise;
end;
- Result := FItems.Add(AItem);
+ Result := AddFileCheckDuplicate(AItem);
end;
function TJclCompressArchive.AddFile(const PackedName: WideString;
@@ -4178,9 +4195,72 @@
raise;
end;
- Result := FItems.Add(AItem);
+ Result := AddFileCheckDuplicate(AItem);
end;
+function TJclCompressArchive.AddFileCheckDuplicate(NewItem: TJclCompressionItem): Integer;
+var
+ I, PackedNamesIndex: Integer;
+ S: string;
+begin
+ if FDuplicateCheck = dcNone then
+ Result := FItems.Add(NewItem)
+ else
+ begin
+ if PackedNames = nil then
+ begin
+ PackedNames := {$IFDEF SUPPORTS_UNICODE}TStringList{$ELSE}TWStringList{$ENDIF}.Create;
+ PackedNames.Sorted := True;
+ {$IFDEF UNIX}
+ PackedNames.CaseSensitive := True;
+ {$ELSE}
+ PackedNames.CaseSensitive := False;
+ {$ENDIF}
+ PackedNames.Duplicates := dupIgnore;
+ for I := ItemCount-1 downto 0 do
+ PackedNames.AddObject(Items[I].PackedName, Items[I]);
+ PackedNames.Duplicates := dupError;
+ end;
+ if DuplicateCheck = dcAll then
+ begin
+ try
+ PackedNamesIndex := -1;
+ PackedNames.AddObject(NewItem.PackedName, NewItem);
+ Result := FItems.Add(NewItem);
+ except
+ Result := -1;
+ end;
+ end
+ else if PackedNames.Find(NewItem.PackedName, PackedNamesIndex) then
+ Result := -1
+ else
+ Result := FItems.Add(NewItem);
+ if Result < 0 then begin
+ case DuplicateAction of
+ daOverwrite: begin
+ if PackedNamesIndex < 0 then
+ PackedNamesIndex := PackedNames.IndexOf(NewItem.PackedName);
+ FItems.Remove(PackedNames.Objects[PackedNamesIndex]);
+ Result := FItems.Add(NewItem);
+ if DuplicateCheck = dcAll then
+ PackedNames.Objects[PackedNamesIndex] := NewItem
+ else
+ PackedNames.Delete(PackedNamesIndex);
+ end;
+ daError: begin
+ S := Format(RsCompressionDuplicate, [NewItem.PackedName]);
+ NewItem.Free;
+ raise Exception.Create(S);
+ end;
+ daSkip: begin
+ NewItem.Free;
+ Result := -1;
+ end;
+ end
+ end;
+ end;
+end;
+
procedure TJclCompressArchive.CheckNotCompressing;
begin
if FCompressing then
@@ -4209,7 +4289,7 @@
raise;
end;
- FItems.Add(AItem);
+ AddFileCheckDuplicate(AItem);
end;
class function TJclCompressArchive.ItemAccess: TJclStreamAccess;
@@ -4323,6 +4403,18 @@
raise EJclCompressionError.CreateRes(@RsCompressionDecompressingError);
end;
+constructor TJclUpdateArchive.Create(Volume0: TStream; AVolumeMaxSize: Int64; AOwnVolume: Boolean);
+begin
+ inherited;
+ FDuplicateCheck := dcExisting;
+end;
+
+constructor TJclUpdateArchive.Create(const VolumeName: string; AVolumeMaxSize: Int64; VolumeMask: Boolean);
+begin
+ inherited;
+ FDuplicateCheck := dcExisting;
+end;
+
class function TJclUpdateArchive.ItemAccess: TJclStreamAccess;
begin
Result := saReadWrite;
Modified: trunk/jcl/source/common/JclResources.pas
===================================================================
--- trunk/jcl/source/common/JclResources.pas 2008-12-28 21:55:28 UTC (rev 2580)
+++ trunk/jcl/source/common/JclResources.pas 2009-01-06 03:45:31 UTC (rev 2581)
@@ -882,6 +882,7 @@
RsCompressionTarExtensions = '*.tar';
RsCompressionGZipName = 'GZip archive';
RsCompressionGZipExtensions = '*.gz;*.gzip;*.tgz;*.tpz';
+ RsCompressionDuplicate = 'The file %s already exists in the archive';
//=== JclConsole =============================================================
resourcestring
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <usc...@us...> - 2008-12-28 22:21:11
|
Revision: 2580
http://jcl.svn.sourceforge.net/jcl/?rev=2580&view=rev
Author: uschuster
Date: 2008-12-28 21:55:28 +0000 (Sun, 28 Dec 2008)
Log Message:
-----------
jedi.inc: added new feature directive SUPPORTS_DEPRECATED_DETAILS
rest: updated 7-Zip integration to version 4.62
ToDo's: - UTF-8 filename support (>= 4.58 beta)
- extensions for Pe, Elf, Mach-O and Mub decompressor
JclCompression.pas: fixed .zip compression (kpidTimeType was necessary in TJclSevenzipUpdateCallback.GetProperty still with 7-Zip 4.57)
Modified Paths:
--------------
trunk/jcl/source/common/JclCompression.pas
trunk/jcl/source/common/JclResources.pas
trunk/jcl/source/include/jedi.inc
trunk/jcl/source/windows/sevenzip.pas
Modified: trunk/jcl/source/common/JclCompression.pas
===================================================================
--- trunk/jcl/source/common/JclCompression.pas 2008-12-26 19:39:06 UTC (rev 2579)
+++ trunk/jcl/source/common/JclCompression.pas 2008-12-28 21:55:28 UTC (rev 2580)
@@ -19,6 +19,7 @@
{ Olivier Sannier (obones) }
{ Florent Ouchet (outchy) }
{ Jan Goyvaerts (jgsoft) }
+{ Uwe Schuster (uschuster) }
{ }
{**************************************************************************************************}
{ }
@@ -102,23 +103,34 @@
| |
| |-- TJclSevenZipDecompressArchive
| |
- | |-- TJclZipDecompressArchive handled by sevenzip http://sevenzip.sourceforge.net/
- | |-- TJclBZ2DecompressArchive handled by sevenzip http://sevenzip.sourceforge.net/
- | |-- TJclRarDecompressArchive handled by sevenzip http://sevenzip.sourceforge.net/
- | |-- TJclArjDecompressArchive handled by sevenzip http://sevenzip.sourceforge.net/
- | |-- TJclZDecompressArchive handled by sevenzip http://sevenzip.sourceforge.net/
- | |-- TJclLzhDecompressArchive handled by sevenzip http://sevenzip.sourceforge.net/
- | |-- TJcl7zDecompressArchive handled by sevenzip http://sevenzip.sourceforge.net/
- | |-- TJclNsisDecompressArchive handled by sevenzip http://sevenzip.sourceforge.net/
- | |-- TJclIsoDecompressArchive handled by sevenzip http://sevenzip.sourceforge.net/
- | |-- TJclCabDecompressArchive handled by sevenzip http://sevenzip.sourceforge.net/
- | |-- TJclChmDecompressArchive handled by sevenzip http://sevenzip.sourceforge.net/
- | |-- TJclSplitDecompressArchive handled by sevenzip http://sevenzip.sourceforge.net/
- | |-- TJclRpmDecompressArchive handled by sevenzip http://sevenzip.sourceforge.net/
- | |-- TJclDebDecompressArchive handled by sevenzip http://sevenzip.sourceforge.net/
- | |-- TJclCpioDecompressArchive handled by sevenzip http://sevenzip.sourceforge.net/
- | |-- TJclTarDecompressArchive handled by sevenzip http://sevenzip.sourceforge.net/
- | |-- TJclGZipDecompressArchive handled by sevenzip http://sevenzip.sourceforge.net/
+ | |-- TJclZipDecompressArchive handled by sevenzip http://sevenzip.sourceforge.net/
+ | |-- TJclBZ2DecompressArchive handled by sevenzip http://sevenzip.sourceforge.net/
+ | |-- TJclRarDecompressArchive handled by sevenzip http://sevenzip.sourceforge.net/
+ | |-- TJclArjDecompressArchive handled by sevenzip http://sevenzip.sourceforge.net/
+ | |-- TJclZDecompressArchive handled by sevenzip http://sevenzip.sourceforge.net/
+ | |-- TJclLzhDecompressArchive handled by sevenzip http://sevenzip.sourceforge.net/
+ | |-- TJcl7zDecompressArchive handled by sevenzip http://sevenzip.sourceforge.net/
+ | |-- TJclCabDecompressArchive handled by sevenzip http://sevenzip.sourceforge.net/
+ | |-- TJclNsisDecompressArchive handled by sevenzip http://sevenzip.sourceforge.net/
+ | |-- TJclLzmaDecompressArchive handled by sevenzip http://sevenzip.sourceforge.net/
+ | |-- TJclPeDecompressArchive handled by sevenzip http://sevenzip.sourceforge.net/
+ | |-- TJclElfDecompressArchive handled by sevenzip http://sevenzip.sourceforge.net/
+ | |-- TJclMachoDecompressArchive handled by sevenzip http://sevenzip.sourceforge.net/
+ | |-- TJclUdfDecompressArchive handled by sevenzip http://sevenzip.sourceforge.net/
+ | |-- TJclXarDecompressArchive handled by sevenzip http://sevenzip.sourceforge.net/
+ | |-- TJclMubDecompressArchive handled by sevenzip http://sevenzip.sourceforge.net/
+ | |-- TJclHfsDecompressArchive handled by sevenzip http://sevenzip.sourceforge.net/
+ | |-- TJclDmgDecompressArchive handled by sevenzip http://sevenzip.sourceforge.net/
+ | |-- TJclCompoundDecompressArchive handled by sevenzip http://sevenzip.sourceforge.net/
+ | |-- TJclWimDecompressArchive handled by sevenzip http://sevenzip.sourceforge.net/
+ | |-- TJclIsoDecompressArchive handled by sevenzip http://sevenzip.sourceforge.net/
+ | |-- TJclChmDecompressArchive handled by sevenzip http://sevenzip.sourceforge.net/
+ | |-- TJclSplitDecompressArchive handled by sevenzip http://sevenzip.sourceforge.net/
+ | |-- TJclRpmDecompressArchive handled by sevenzip http://sevenzip.sourceforge.net/
+ | |-- TJclDebDecompressArchive handled by sevenzip http://sevenzip.sourceforge.net/
+ | |-- TJclCpioDecompressArchive handled by sevenzip http://sevenzip.sourceforge.net/
+ | |-- TJclTarDecompressArchive handled by sevenzip http://sevenzip.sourceforge.net/
+ | |-- TJclGZipDecompressArchive handled by sevenzip http://sevenzip.sourceforge.net/
|
|-- TJclUpdateArchive
|
@@ -362,7 +374,7 @@
FExtraField: string;
FOriginalFileName: TFileName;
FComment: string;
- FZLibStream: TJclZlibCompressStream;
+ FZLibStream: TJclZLibCompressStream;
FOriginalSize: Cardinal;
FDataCRC32: Cardinal;
FHeaderWritten: Boolean;
@@ -698,7 +710,7 @@
function GetItemClass: TJclCompressionItemClass; virtual; abstract;
public
{ IInterface }
- function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
+ function QueryInterface(const IID: TGUID; out Obj): HRESULT; stdcall;
function _AddRef: Integer; stdcall;
function _Release: Integer; stdcall;
public
@@ -1311,15 +1323,87 @@
class function ArchiveName: string; override;
end;
- {TJclLzmaDecompressArchive = class(TJclSevenzipDecompressArchive, IInterface)
+ TJclLzmaDecompressArchive = class(TJclSevenzipDecompressArchive, IInterface)
protected
function GetCLSID: TGUID; override;
public
class function MultipleItemContainer: Boolean; override;
class function ArchiveExtensions: string; override;
class function ArchiveName: string; override;
- end;}
+ end;
+ TJclPeDecompressArchive = class(TJclSevenzipDecompressArchive, IInterface)
+ protected
+ function GetCLSID: TGUID; override;
+ public
+ class function MultipleItemContainer: Boolean; override;
+ class function ArchiveExtensions: string; override;
+ class function ArchiveName: string; override;
+ end;
+
+ TJclElfDecompressArchive = class(TJclSevenzipDecompressArchive, IInterface)
+ protected
+ function GetCLSID: TGUID; override;
+ public
+ class function MultipleItemContainer: Boolean; override;
+ class function ArchiveExtensions: string; override;
+ class function ArchiveName: string; override;
+ end;
+
+ TJclMachoDecompressArchive = class(TJclSevenzipDecompressArchive, IInterface)
+ protected
+ function GetCLSID: TGUID; override;
+ public
+ class function MultipleItemContainer: Boolean; override;
+ class function ArchiveExtensions: string; override;
+ class function ArchiveName: string; override;
+ end;
+
+ TJclUdfDecompressArchive = class(TJclSevenzipDecompressArchive, IInterface)
+ protected
+ function GetCLSID: TGUID; override;
+ public
+ class function MultipleItemContainer: Boolean; override;
+ class function ArchiveExtensions: string; override;
+ class function ArchiveName: string; override;
+ end;
+
+ TJclXarDecompressArchive = class(TJclSevenzipDecompressArchive, IInterface)
+ protected
+ function GetCLSID: TGUID; override;
+ public
+ class function MultipleItemContainer: Boolean; override;
+ class function ArchiveExtensions: string; override;
+ class function ArchiveName: string; override;
+ end;
+
+ TJclMubDecompressArchive = class(TJclSevenzipDecompressArchive, IInterface)
+ protected
+ function GetCLSID: TGUID; override;
+ public
+ class function MultipleItemContainer: Boolean; override;
+ class function ArchiveExtensions: string; override;
+ class function ArchiveName: string; override;
+ end;
+
+ TJclHfsDecompressArchive = class(TJclSevenzipDecompressArchive, IInterface)
+ protected
+ function GetCLSID: TGUID; override;
+ public
+ class function MultipleItemContainer: Boolean; override;
+ class function ArchiveExtensions: string; override;
+ class function ArchiveName: string; override;
+ end;
+
+ TJclDmgDecompressArchive = class(TJclSevenzipDecompressArchive, IInterface)
+ protected
+ function GetCLSID: TGUID; override;
+ public
+ class function MultipleItemContainer: Boolean; override;
+ class function ArchiveExtensions: string; override;
+ class function ArchiveName: string; override;
+ end;
+
TJclCompoundDecompressArchive = class(TJclSevenzipDecompressArchive, IInterface)
protected
function GetCLSID: TGUID; override;
@@ -2233,7 +2317,7 @@
if not Assigned(FZLibStream) then
begin
- FZLibStream := TJclZlibCompressStream.Create(FStream, FCompressionLevel);
+ FZLibStream := TJclZLibCompressStream.Create(FStream, FCompressionLevel);
FZLibStream.WindowBits := -DEF_WBITS; // negative value for raw mode
FZLibStream.OnProgress := ZLibStreamProgress;
end;
@@ -2245,7 +2329,7 @@
procedure TJclGZIPCompressionStream.WriteHeader;
const
- FatSystemToByte: array[TJclGZIPFatSystem] of Byte =
+ FatSystemToByte: array [TJclGZIPFatSystem] of Byte =
(JCL_GZIP_OS_FAT, JCL_GZIP_OS_AMIGA, JCL_GZIP_OS_VMS, JCL_GZIP_OS_UNIX,
JCL_GZIP_OS_VM, JCL_GZIP_OS_ATARI, JCL_GZIP_OS_HPFS, JCL_GZIP_OS_MAC,
JCL_GZIP_OS_Z, JCL_GZIP_OS_CPM, JCL_GZIP_OS_TOPS, JCL_GZIP_OS_NTFS,
@@ -2446,7 +2530,7 @@
function TJclGZIPDecompressionStream.GetFatSystem: TJclGZIPFatSystem;
const
- ByteToFatSystem: array[JCL_GZIP_OS_FAT..JCL_GZIP_OS_ACORN] of TJclGZIPFatSystem =
+ ByteToFatSystem: array [JCL_GZIP_OS_FAT..JCL_GZIP_OS_ACORN] of TJclGZIPFatSystem =
(gfsFat, gfsAmiga, gfsVMS, gfsUnix, gfsVM, gfsAtari, gfsHPFS, gfsMac, gfsZ,
gfsCPM, gfsTOPS, gfsNTFS, gfsQDOS, gfsAcorn);
begin
@@ -2962,7 +3046,7 @@
begin
Result := False;
if not FileExists(SourceFile) then // can't copy what doesn't exist!
- exit;
+ Exit;
{destination and source streams first and second}
SourceStream := TFileStream.Create(SourceFile, {mode} fmOpenRead or fmShareDenyWrite);
@@ -3064,7 +3148,7 @@
begin
Result := False;
if not FileExists(SourceFile) then // can't copy what doesn't exist!
- exit;
+ Exit;
{destination and source streams first and second}
SourceStream := TFileStream.Create(SourceFile, {mode} fmOpenRead or fmShareDenyWrite);
@@ -3508,6 +3592,15 @@
RegisterFormat(TJcl7zDecompressArchive);
RegisterFormat(TJclCabDecompressArchive);
RegisterFormat(TJclNsisDecompressArchive);
+ RegisterFormat(TJclLzmaDecompressArchive);
+ RegisterFormat(TJclPeDecompressArchive);
+ RegisterFormat(TJclElfDecompressArchive);
+ RegisterFormat(TJclMachoDecompressArchive);
+ RegisterFormat(TJclUdfDecompressArchive);
+ RegisterFormat(TJclXarDecompressArchive);
+ RegisterFormat(TJclMubDecompressArchive);
+ RegisterFormat(TJclHfsDecompressArchive);
+ RegisterFormat(TJclDmgDecompressArchive);
RegisterFormat(TJclCompoundDecompressArchive);
RegisterFormat(TJclWimDecompressArchive);
RegisterFormat(TJclIsoDecompressArchive);
@@ -3902,7 +3995,8 @@
end;
FVolumeIndex := Index;
end
- else if (Index >= 0) and (Index < FVolumes.Count) then
+ else
+ if (Index >= 0) and (Index < FVolumes.Count) then
begin
AVolume := TJclCompressionVolume(FVolumes.Items[Index]);
Result := AVolume.Stream;
@@ -3985,7 +4079,7 @@
Result := -1;
end;
-function TJclCompressionArchive.QueryInterface(const IID: TGUID; out Obj): HResult;
+function TJclCompressionArchive.QueryInterface(const IID: TGUID; out Obj): HRESULT;
begin
if GetInterface(IID, Obj) then
Result := 0
@@ -4326,7 +4420,8 @@
begin
if Assigned(FArchive) then
FArchive.Items[FItemIndex].ReleaseStream
- else if FOwnsStream then
+ else
+ if FOwnsStream then
FStream.Free;
end;
@@ -4452,7 +4547,8 @@
begin
if Assigned(FArchive) then
FArchive.Items[FItemIndex].ReleaseStream
- else if FOwnsStream then
+ else
+ if FOwnsStream then
FStream.Free;
end;
@@ -4613,6 +4709,7 @@
end;
end;
+// TODO: Are changes for UTF-8 filenames (>= 4.58 beta) necessary?
procedure Load7zFileAttribute(AInArchive: IInArchive; ItemIndex: Integer;
AItem: TJclCompressionItem);
begin
@@ -4623,12 +4720,12 @@
AItem.FileName := '';
AItem.Stream := nil;
AItem.OwnsStream := False;
- Get7zCardinalProp(AInArchive, ItemIndex, kpidAttributes, AItem.SetAttributes);
+ Get7zCardinalProp(AInArchive, ItemIndex, kpidAttrib, AItem.SetAttributes);
Get7zInt64Prop(AInArchive, ItemIndex, kpidSize, AItem.SetFileSize);
- Get7zInt64Prop(AInArchive, ItemIndex, kpidPackedSize, AItem.SetPackedSize);
- Get7zFileTimeProp(AInArchive, ItemIndex, kpidCreationTime, AItem.SetCreationTime);
- Get7zFileTimeProp(AInArchive, ItemIndex, kpidLastAccessTime, AItem.SetLastAccessTime);
- Get7zFileTimeProp(AInArchive, ItemIndex, kpidLastWriteTime, AItem.SetLastWriteTime);
+ Get7zInt64Prop(AInArchive, ItemIndex, kpidPackSize, AItem.SetPackedSize);
+ Get7zFileTimeProp(AInArchive, ItemIndex, kpidCTime, AItem.SetCreationTime);
+ Get7zFileTimeProp(AInArchive, ItemIndex, kpidATime, AItem.SetLastAccessTime);
+ Get7zFileTimeProp(AInArchive, ItemIndex, kpidMTime, AItem.SetLastWriteTime);
Get7zWideStringProp(AInArchive, ItemIndex, kpidComment, AItem.SetComment);
Get7zWideStringProp(AInArchive, ItemIndex, kpidHostOS, AItem.SetHostOS);
Get7zWideStringProp(AInArchive, ItemIndex, kpidFileSystem, AItem.SetHostFS);
@@ -4714,10 +4811,10 @@
kLZMA2MethodName {cmLZMA2},
kPPMdMethodName {cmPPMd} );
begin
- if Supports(ASevenZipArchive, Sevenzip.ISetProperties, PropertySetter) and Assigned(PropertySetter) then
+ if Supports(ASevenzipArchive, Sevenzip.ISetProperties, PropertySetter) and Assigned(PropertySetter) then
begin
- InArchive := Supports(ASevenzipArchive,Sevenzip.IInArchive,Unused);
- OutArchive := Supports(ASevenzipArchive,Sevenzip.IOutArchive,Unused);
+ InArchive := Supports(ASevenzipArchive, Sevenzip.IInArchive, Unused);
+ OutArchive := Supports(ASevenzipArchive, Sevenzip.IOutArchive, Unused);
if (InArchive or OutArchive) and Supports(AJclArchive, IJclArchiveNumberOfThreads, MultiThreadStrategy)
and Assigned(MultiThreadStrategy) and (MultiThreadStrategy.NumberOfThreads > 1) then
AddCardinalProperty('MT', MultiThreadStrategy.NumberOfThreads);
@@ -4840,7 +4937,7 @@
Value.vt := VT_BSTR;
Value.bstrVal := SysAllocString(PWideChar(WideString(ExtractFileExt(FCompressionStream.FileNames[Index]))));
end;}
- kpidIsFolder:
+ kpidIsDir:
begin
Value.vt := VT_BOOL;
Value.bool := AItem.Kind = ikDirectory;
@@ -4850,23 +4947,23 @@
Value.vt := VT_UI8;
Value.uhVal.QuadPart := AItem.FileSize;
end;
- //kpidPackedSize:
- kpidAttributes:
+ //kpidPackSize:
+ kpidAttrib:
begin
Value.vt := VT_UI4;
Value.ulVal := AItem.Attributes;
end;
- kpidCreationTime:
+ kpidCTime:
begin
Value.vt := VT_FILETIME;
Value.filetime := AItem.CreationTime;
end;
- kpidLastAccessTime:
+ kpidATime:
begin
Value.vt := VT_FILETIME;
Value.filetime := AItem.LastAccessTime;
end;
- kpidLastWriteTime:
+ kpidMTime:
begin
Value.vt := VT_FILETIME;
Value.filetime := AItem.LastWriteTime;
@@ -4897,6 +4994,11 @@
kpidComment:
kpidPosition:
kpidPrefix:}
+ kpidTimeType:
+ begin
+ Value.vt := VT_UI4;
+ Value.ulVal := kWindows;
+ end;
else
Value.vt := VT_EMPTY;
Result := S_FALSE;
@@ -5234,7 +5336,7 @@
FCompressionLevel := 7;
FCompressionMethod := cmDeflate;
FNumberOfPasses := kDeflateNumPassesX7;
- FAlgorithm := kDeflateAlgoX5;
+ FAlgorithm := kLzAlgoX5;
end;
function TJclZipCompressArchive.GetAlgorithm: Cardinal;
@@ -5296,7 +5398,7 @@
function TJclZipCompressArchive.GetSupportedCompressionMethods: TJclCompressionMethods;
begin
- Result := [cmCopy,cmDeflate,cmDeflate64,cmBZip2];
+ Result := [cmCopy,cmDeflate,cmDeflate64,cmBZip2,cmLZMA];
end;
function TJclZipCompressArchive.GetSupportedEncryptionMethods: TJclEncryptionMethods;
@@ -5335,9 +5437,9 @@
else
FNumberOfPasses := kDeflateNumPassesX1;
if Value >= 5 then
- FAlgorithm := kDeflateAlgoX5
+ FAlgorithm := kLzAlgoX5
else
- FAlgorithm := kDeflateAlgoX1;
+ FAlgorithm := kLzAlgoX1;
end;
cmBZip2:
begin
@@ -5356,6 +5458,26 @@
else
FDictionarySize := kBZip2DicSizeX1;
end;
+ cmLZMA:
+ begin
+ if Value >= 9 then
+ FDictionarySize := kLzmaDicSizeX9
+ else
+ if Value >= 7 then
+ FDictionarySize := kLzmaDicSizeX7
+ else
+ if Value >= 5 then
+ FDictionarySize := kLzmaDicSizeX5
+ else
+ if Value >= 3 then
+ FDictionarySize := kLzmaDicSizeX3
+ else
+ FDictionarySize := kLzmaDicSizeX1;
+ if Value >= 5 then
+ FAlgorithm := kLzAlgoX5
+ else
+ FAlgorithm := kLzAlgoX1;
+ end;
end;
end
else
@@ -5536,7 +5658,7 @@
inherited CreateCompressionObject;
FCompressionLevel := 7;
FNumberOfPasses := kDeflateNumPassesX7;
- FAlgorithm := kDeflateAlgoX5;
+ FAlgorithm := kLzAlgoX5;
end;
function TJclGZipCompressArchive.GetAlgorithm: Cardinal;
@@ -5595,9 +5717,9 @@
else
FNumberOfPasses := kDeflateNumPassesX1;
if Value >= 5 then
- FAlgorithm := kDeflateAlgoX5
+ FAlgorithm := kLzAlgoX5
else
- FAlgorithm := kDeflateAlgoX1;
+ FAlgorithm := kLzAlgoX1;
end
else
raise EJclCompressionError.CreateRes(@RsCompressionUnavailableProperty);
@@ -6171,6 +6293,204 @@
Result := True;
end;
+//=== { TJclLzmaDecompressArchive } ==========================================
+
+class function TJclLzmaDecompressArchive.ArchiveExtensions: string;
+begin
+ Result := LoadResString(@RsCompressionLzmaExtensions);
+end;
+
+class function TJclLzmaDecompressArchive.ArchiveName: string;
+begin
+ Result := LoadResString(@RsCompressionLzmaName);
+end;
+
+function TJclLzmaDecompressArchive.GetCLSID: TGUID;
+begin
+ Result := CLSID_CFormatLzma;
+end;
+
+class function TJclLzmaDecompressArchive.MultipleItemContainer: Boolean;
+begin
+ Result := True;
+end;
+
+//=== { TJclPeDecompressArchive } ============================================
+
+class function TJclPeDecompressArchive.ArchiveExtensions: string;
+begin
+ Result := LoadResString(@RsCompressionPeExtensions);
+end;
+
+class function TJclPeDecompressArchive.ArchiveName: string;
+begin
+ Result := LoadResString(@RsCompressionPeName);
+end;
+
+function TJclPeDecompressArchive.GetCLSID: TGUID;
+begin
+ Result := CLSID_CFormatPe;
+end;
+
+class function TJclPeDecompressArchive.MultipleItemContainer: Boolean;
+begin
+ Result := True;
+end;
+
+//=== { TJclElfDecompressArchive } ===========================================
+
+class function TJclElfDecompressArchive.ArchiveExtensions: string;
+begin
+ Result := LoadResString(@RsCompressionElfExtensions);
+end;
+
+class function TJclElfDecompressArchive.ArchiveName: string;
+begin
+ Result := LoadResString(@RsCompressionElfName);
+end;
+
+function TJclElfDecompressArchive.GetCLSID: TGUID;
+begin
+ Result := CLSID_CFormatElf;
+end;
+
+class function TJclElfDecompressArchive.MultipleItemContainer: Boolean;
+begin
+ Result := True;
+end;
+
+//=== { TJclMachoDecompressArchive } =========================================
+
+class function TJclMachoDecompressArchive.ArchiveExtensions: string;
+begin
+ Result := LoadResString(@RsCompressionMachoExtensions);
+end;
+
+class function TJclMachoDecompressArchive.ArchiveName: string;
+begin
+ Result := LoadResString(@RsCompressionMachoName);
+end;
+
+function TJclMachoDecompressArchive.GetCLSID: TGUID;
+begin
+ Result := CLSID_CFormatMacho;
+end;
+
+class function TJclMachoDecompressArchive.MultipleItemContainer: Boolean;
+begin
+ Result := True;
+end;
+
+//=== { TJclUdfDecompressArchive } ==========================================
+
+class function TJclUdfDecompressArchive.ArchiveExtensions: string;
+begin
+ Result := LoadResString(@RsCompressionUdfExtensions);
+end;
+
+class function TJclUdfDecompressArchive.ArchiveName: string;
+begin
+ Result := LoadResString(@RsCompressionUdfName);
+end;
+
+function TJclUdfDecompressArchive.GetCLSID: TGUID;
+begin
+ Result := CLSID_CFormatUdf;
+end;
+
+class function TJclUdfDecompressArchive.MultipleItemContainer: Boolean;
+begin
+ Result := True;
+end;
+
+//=== { TJclXarDecompressArchive } ===========================================
+
+class function TJclXarDecompressArchive.ArchiveExtensions: string;
+begin
+ Result := LoadResString(@RsCompressionXarExtensions);
+end;
+
+class function TJclXarDecompressArchive.ArchiveName: string;
+begin
+ Result := LoadResString(@RsCompressionXarName);
+end;
+
+function TJclXarDecompressArchive.GetCLSID: TGUID;
+begin
+ Result := CLSID_CFormatXar;
+end;
+
+class function TJclXarDecompressArchive.MultipleItemContainer: Boolean;
+begin
+ Result := True;
+end;
+
+//=== { TJclMubDecompressArchive } ===========================================
+
+class function TJclMubDecompressArchive.ArchiveExtensions: string;
+begin
+ Result := LoadResString(@RsCompressionMubExtensions);
+end;
+
+class function TJclMubDecompressArchive.ArchiveName: string;
+begin
+ Result := LoadResString(@RsCompressionMubName);
+end;
+
+function TJclMubDecompressArchive.GetCLSID: TGUID;
+begin
+ Result := CLSID_CFormatMub;
+end;
+
+class function TJclMubDecompressArchive.MultipleItemContainer: Boolean;
+begin
+ Result := True;
+end;
+
+//=== { TJclHfsDecompressArchive } ===========================================
+
+class function TJclHfsDecompressArchive.ArchiveExtensions: string;
+begin
+ Result := LoadResString(@RsCompressionHfsExtensions);
+end;
+
+class function TJclHfsDecompressArchive.ArchiveName: string;
+begin
+ Result := LoadResString(@RsCompressionHfsName);
+end;
+
+function TJclHfsDecompressArchive.GetCLSID: TGUID;
+begin
+ Result := CLSID_CFormatHfs;
+end;
+
+class function TJclHfsDecompressArchive.MultipleItemContainer: Boolean;
+begin
+ Result := True;
+end;
+
+//=== { TJclDmgDecompressArchive } ===========================================
+
+class function TJclDmgDecompressArchive.ArchiveExtensions: string;
+begin
+ Result := LoadResString(@RsCompressionDmgExtensions);
+end;
+
+class function TJclDmgDecompressArchive.ArchiveName: string;
+begin
+ Result := LoadResString(@RsCompressionDmgName);
+end;
+
+function TJclDmgDecompressArchive.GetCLSID: TGUID;
+begin
+ Result := CLSID_CFormatDmg;
+end;
+
+class function TJclDmgDecompressArchive.MultipleItemContainer: Boolean;
+begin
+ Result := True;
+end;
+
//=== { TJclCompoundDecompressArchive } ======================================
class function TJclCompoundDecompressArchive.ArchiveExtensions: string;
@@ -6645,7 +6965,7 @@
FCompressionLevel := 7;
FCompressionMethod := cmDeflate;
FNumberOfPasses := kDeflateNumPassesX7;
- FAlgorithm := kDeflateAlgoX5;
+ FAlgorithm := kLzAlgoX5;
end;
function TJclZipUpdateArchive.GetAlgorithm: Cardinal;
@@ -6707,7 +7027,7 @@
function TJclZipUpdateArchive.GetSupportedCompressionMethods: TJclCompressionMethods;
begin
- Result := [cmCopy,cmDeflate,cmDeflate64,cmBZip2];
+ Result := [cmCopy,cmDeflate,cmDeflate64,cmBZip2,cmLZMA];
end;
function TJclZipUpdateArchive.GetSupportedEncryptionMethods: TJclEncryptionMethods;
@@ -6748,9 +7068,9 @@
else
FNumberOfPasses := kDeflateNumPassesX1;
if Value >= 5 then
- FAlgorithm := kDeflateAlgoX5
+ FAlgorithm := kLzAlgoX5
else
- FAlgorithm := kDeflateAlgoX1;
+ FAlgorithm := kLzAlgoX1;
end;
cmBZip2:
begin
@@ -6769,6 +7089,26 @@
else
FDictionarySize := kBZip2DicSizeX1;
end;
+ cmLZMA:
+ begin
+ if Value >= 9 then
+ FDictionarySize := kLzmaDicSizeX9
+ else
+ if Value >= 7 then
+ FDictionarySize := kLzmaDicSizeX7
+ else
+ if Value >= 5 then
+ FDictionarySize := kLzmaDicSizeX5
+ else
+ if Value >= 3 then
+ FDictionarySize := kLzmaDicSizeX3
+ else
+ FDictionarySize := kLzmaDicSizeX1;
+ if Value >= 5 then
+ FAlgorithm := kLzAlgoX5
+ else
+ FAlgorithm := kLzAlgoX1;
+ end;
end;
end
else
@@ -7143,7 +7483,7 @@
inherited CreateCompressionObject;
FCompressionLevel := 7;
FNumberOfPasses := kDeflateNumPassesX7;
- FAlgorithm := kDeflateAlgoX5;
+ FAlgorithm := kLzAlgoX5;
end;
function TJclGZipUpdateArchive.GetAlgorithm: Cardinal;
@@ -7204,9 +7544,9 @@
else
FNumberOfPasses := kDeflateNumPassesX1;
if Value >= 5 then
- FAlgorithm := kDeflateAlgoX5
+ FAlgorithm := kLzAlgoX5
else
- FAlgorithm := kDeflateAlgoX1;
+ FAlgorithm := kLzAlgoX1;
end
else
raise EJclCompressionError.CreateRes(@RsCompressionUnavailableProperty);
Modified: trunk/jcl/source/common/JclResources.pas
===================================================================
--- trunk/jcl/source/common/JclResources.pas 2008-12-26 19:39:06 UTC (rev 2579)
+++ trunk/jcl/source/common/JclResources.pas 2008-12-28 21:55:28 UTC (rev 2580)
@@ -29,6 +29,7 @@
{ Robert Marquardt (marquardt) }
{ Robert Rossmair (rrossmair) }
{ Scott Price (scottprice) }
+{ Uwe Schuster (uschuster) }
{ }
{**************************************************************************************************}
{ }
@@ -56,7 +57,7 @@
{$IFNDEF RTL140_UP}
const
sLineBreak = #13#10;
-{$ENDIF RTL140_UP}
+{$ENDIF ~RTL140_UP}
//=== JclBase ================================================================
resourcestring
@@ -839,6 +840,28 @@
RsCompressionCabExtensions = '*.cab';
RsCompressionNsisName = 'Nsis archive';
RsCompressionNsisExtensions = '*.nsis';
+ RsCompressionLzmaName = 'Lzma archive';
+ RsCompressionLzmaExtensions = '*.lzma';
+ RsCompressionPeName = 'Pe archive';
+ // TODO: extension might be *.*, but then TJclCompressionStreamFormats.FindDecompressFormat can fail
+ RsCompressionPeExtensions = '*.';
+ RsCompressionElfName = 'Elf archive';
+ // TODO: extension might be *.*, but then TJclCompressionStreamFormats.FindDecompressFormat can fail
+ RsCompressionElfExtensions = '*.';
+ RsCompressionMachoName = 'Mach-O archive';
+ // TODO: extension might be *.*, but then TJclCompressionStreamFormats.FindDecompressFormat can fail
+ RsCompressionMachoExtensions = '*.';
+ RsCompressionUdfName = 'Udf archive';
+ RsCompressionUdfExtensions = '*.iso';
+ RsCompressionXarName = 'Xar archive';
+ RsCompressionXarExtensions = '*.xar';
+ RsCompressionMubName = 'Mub archive';
+ // TODO: extension might be *.*, but then TJclCompressionStreamFormats.FindDecompressFormat can fail
+ RsCompressionMubExtensions = '*.';
+ RsCompressionHfsName = 'Hfs archive';
+ RsCompressionHfsExtensions = '*.hfs';
+ RsCompressionDmgName = 'Dmg archive';
+ RsCompressionDmgExtensions = '*.dmg';
RsCompressionCompoundName = 'Compound archive';
RsCompressionCompoundExtensions = '*.msi;*.doc;*.xls;*.ppt';
RsCompressionWimName = 'Wim archive';
Modified: trunk/jcl/source/include/jedi.inc
===================================================================
--- trunk/jcl/source/include/jedi.inc 2008-12-26 19:39:06 UTC (rev 2579)
+++ trunk/jcl/source/include/jedi.inc 2008-12-28 21:55:28 UTC (rev 2580)
@@ -380,7 +380,8 @@
SUPPORTS_STATIC Compiler supports static keyword (D9.NET, D10+)
SUPPORTS_FINAL Compiler supports final keyword (D9.NET, D10+)
SUPPORTS_METHODINFO Compiler supports the METHODINFO directives (D10+)
- SUPPORTS_GENERICS Compiler supports generic implementations (D11.net, D12+)
+ SUPPORTS_GENERICS Compiler supports generic implementations (D11.NET, D12+)
+ SUPPORTS_DEPRECATED_DETAILS Compiler supports additional text for the deprecated directive (D11.NET, D12+)
ACCEPT_DEPRECATED Compiler supports or ignores the deprecated directive (D6+/BCB6+/FPC)
ACCEPT_PLATFORM Compiler supports or ignores the platform directive (D6+/BCB6+/FPC)
ACCEPT_LIBRARY Compiler supports or ignores the library directive (D6+/BCB6+)
@@ -405,7 +406,7 @@
HAS_UNIT_ANSISTRINGS Unit AnsiStrings exists (D12+)
HAS_UNIT_PNGIMAGE Unit PngImage exists (D12+)
XPLATFORM_RTL The RTL supports crossplatform function names (e.g. RaiseLastOSError) (D6+/BCB6+/FPC)
- SUPPORTS_UNICODE string type is aliased to an unicode string (WideString or UnicodeString) (DX.net, D12+)
+ SUPPORTS_UNICODE string type is aliased to an unicode string (WideString or UnicodeString) (DX.NET, D12+)
SUPPORTS_UNICODE_STRING Compiler supports UnicodeString (D12+)
@@ -1094,11 +1095,13 @@
{$IFDEF COMPILER11_UP}
{$IFDEF CLR}
{$DEFINE SUPPORTS_GENERICS}
+ {$DEFINE SUPPORTS_DEPRECATED_DETAILS}
{$ENDIF CLR}
{$ENDIF COMPILER11_UP}
{$IFDEF COMPILER12_UP}
{$DEFINE SUPPORTS_GENERICS}
+ {$DEFINE SUPPORTS_DEPRECATED_DETAILS}
{$IFNDEF CLR}
{$DEFINE SUPPORTS_UNICODE}
{$DEFINE SUPPORTS_UNICODE_STRING}
Modified: trunk/jcl/source/windows/sevenzip.pas
===================================================================
--- trunk/jcl/source/windows/sevenzip.pas 2008-12-26 19:39:06 UTC (rev 2579)
+++ trunk/jcl/source/windows/sevenzip.pas 2008-12-28 21:55:28 UTC (rev 2580)
@@ -3,9 +3,9 @@
{ Project JEDI Code Library (JCL) }
{ }
{ interface of the 'sevenzip' (http://sourceforge.net/projects/sevenzip/) compression library }
-{ version 4.57, December 6th, 2007 }
+{ version 4.62, December 2th, 2008 }
{ }
-{ Copyright (C) 1999-2007 Igor Pavlov }
+{ Copyright (C) 1999-2008 Igor Pavlov }
{ }
{ GNU LGPL information }
{ -------------------- }
@@ -38,7 +38,7 @@
{ }
{**************************************************************************************************}
{ }
-{ Translation 2007-2008 Florent Ouchet for the Jedi Code Library }
+{ Translation 2007-2008 Florent Ouchet for the JEDI Code Library }
{ Contributors: }
{ Uwe Schuster (uschuster) }
{ Jan Goyvaerts (jgsoft) }
@@ -62,6 +62,7 @@
Windows,
ActiveX;
+// Guid.txt
const
CLSID_CCodec : TGUID = '{23170F69-40C1-2790-0000-000000000000}';
CLSID_CCodecBCJ2 : TGUID = '{23170F69-40C1-2790-1B01-030300000000}'; // BCJ2 0303011B
@@ -95,7 +96,15 @@
CLSID_CFormat7z : TGUID = '{23170F69-40C1-278A-1000-000110070000}';
CLSID_CFormatCab : TGUID = '{23170F69-40C1-278A-1000-000110080000}';
CLSID_CFormatNsis : TGUID = '{23170F69-40C1-278A-1000-000110090000}';
- //CLSID_CFormatLzma : TGUID = '{23170F69-40C1-278A-1000-0001100A0000}'; not in 4.57
+ CLSID_CFormatLzma : TGUID = '{23170F69-40C1-278A-1000-0001100A0000}';
+ CLSID_CFormatPe : TGUID = '{23170F69-40C1-278A-1000-000110DD0000}';
+ CLSID_CFormatElf : TGUID = '{23170F69-40C1-278A-1000-000110DE0000}';
+ CLSID_CFormatMacho : TGUID = '{23170F69-40C1-278A-1000-000110DF0000}';
+ CLSID_CFormatUdf : TGUID = '{23170F69-40C1-278A-1000-000110E00000}';
+ CLSID_CFormatXar : TGUID = '{23170F69-40C1-278A-1000-000110E10000}';
+ CLSID_CFormatMub : TGUID = '{23170F69-40C1-278A-1000-000110E20000}';
+ CLSID_CFormatHfs : TGUID = '{23170F69-40C1-278A-1000-000110E30000}';
+ CLSID_CFormatDmg : TGUID = '{23170F69-40C1-278A-1000-000110E40000}';
CLSID_CFormatCompound : TGUID = '{23170F69-40C1-278A-1000-000110E50000}';
CLSID_CFormatWim : TGUID = '{23170F69-40C1-278A-1000-000110E60000}';
CLSID_CFormatIso : TGUID = '{23170F69-40C1-278A-1000-000110E70000}';
@@ -158,13 +167,19 @@
kpidPath = 3;
kpidName = 4;
kpidExtension = 5;
- kpidIsFolder = 6;
+ kpidIsFolder = 6 {$IFDEF SUPPORTS_DEPRECATED} deprecated {$IFDEF SUPPORTS_DEPRECATED_DETAILS} 'Use kpidIsDir' {$ENDIF} {$ENDIF};
+ kpidIsDir = 6;
kpidSize = 7;
- kpidPackedSize = 8;
- kpidAttributes = 9;
- kpidCreationTime = 10;
- kpidLastAccessTime = 11;
- kpidLastWriteTime = 12;
+ kpidPackedSize = 8 {$IFDEF SUPPORTS_DEPRECATED} deprecated {$IFDEF SUPPORTS_DEPRECATED_DETAILS} 'Use kpidPackSize' {$ENDIF} {$ENDIF};
+ kpidPackSize = 8;
+ kpidAttributes = 9 {$IFDEF SUPPORTS_DEPRECATED} deprecated {$IFDEF SUPPORTS_DEPRECATED_DETAILS} 'Use kpidAttrib' {$ENDIF} {$ENDIF};
+ kpidAttrib = 9;
+ kpidCreationTime = 10 {$IFDEF SUPPORTS_DEPRECATED} deprecated {$IFDEF SUPPORTS_DEPRECATED_DETAILS} 'Use kpidCTime' {$ENDIF} {$ENDIF};
+ kpidCTime = 10;
+ kpidLastAccessTime = 11 {$IFDEF SUPPORTS_DEPRECATED} deprecated {$IFDEF SUPPORTS_DEPRECATED_DETAILS} 'Use kpidATime' {$ENDIF} {$ENDIF};
+ kpidATime = 11;
+ kpidLastWriteTime = 12 {$IFDEF SUPPORTS_DEPRECATED} deprecated {$IFDEF SUPPORTS_DEPRECATED_DETAILS} 'Use kpidMTime' {$ENDIF} {$ENDIF};
+ kpidMTime = 12;
kpidSolid = 13;
kpidCommented = 14;
kpidEncrypted = 15;
@@ -183,6 +198,24 @@
kpidComment = 28;
kpidPosition = 29;
kpidPrefix = 30;
+ kpidNumSubDirs = 31;
+ kpidNumSubFiles = 32;
+ kpidUnpackVer = 33;
+ kpidVolume = 34;
+ kpidIsVolume = 35;
+ kpidOffset = 36;
+ kpidLinks = 37;
+ kpidNumBlocks = 38;
+ kpidNumVolumes = 39;
+ kpidTimeType = 40;
+ kpidBit64 = 41;
+ kpidBigEndian = 42;
+ kpidCpu = 43;
+ kpidPhySize = 44;
+ kpidHeadersSize = 45;
+ kpidChecksum = 46;
+ kpidCharacts = 47;
+ kpidVa = 48;
kpidTotalSize = $1100;
kpidFreeSpace = $1101;
@@ -236,6 +269,7 @@
kDictionarySize = $400;
kUsedMemorySize = $401;
kOrder = $402;
+ kBlockSize = $403;
kPosStateBits = $440;
kLitContextBits = $441;
kLitPosBits = $442;
@@ -494,17 +528,25 @@
// ZipHandlerOut.cpp
const
- kDeflateAlgoX1 = 0;
- kDeflateAlgoX5 = 1;
+ kDeflateAlgoX1 = 0 {$IFDEF SUPPORTS_DEPRECATED} deprecated {$IFDEF SUPPORTS_DEPRECATED_DETAILS} 'Use kLzAlgoX1' {$ENDIF} {$ENDIF};
+ kLzAlgoX1 = 0;
+ kDeflateAlgoX5 = 1 {$IFDEF SUPPORTS_DEPRECATED} deprecated {$IFDEF SUPPORTS_DEPRECATED_DETAILS} 'Use kLzAlgoX5' {$ENDIF} {$ENDIF};
+ kLzAlgoX5 = 1;
kDeflateNumPassesX1 = 1;
kDeflateNumPassesX7 = 3;
kDeflateNumPassesX9 = 10;
- kNumFastBytesX1 = 32;
- kNumFastBytesX7 = 64;
- kNumFastBytesX9 = 128;
+ kNumFastBytesX1 = 32 {$IFDEF SUPPORTS_DEPRECATED} deprecated {$IFDEF SUPPORTS_DEPRECATED_DETAILS} 'Use kDeflateNumFastBytesX1' {$ENDIF} {$ENDIF};
+ kDeflateNumFastBytesX1 = 32;
+ kNumFastBytesX7 = 64 {$IFDEF SUPPORTS_DEPRECATED} deprecated {$IFDEF SUPPORTS_DEPRECATED_DETAILS} 'Use kDeflateNumFastBytesX7' {$ENDIF} {$ENDIF};
+ kDeflateNumFastBytesX7 = 64;
+ kNumFastBytesX9 = 128 {$IFDEF SUPPORTS_DEPRECATED} deprecated {$IFDEF SUPPORTS_DEPRECATED_DETAILS} 'Use kDeflateNumFastBytesX9' {$ENDIF} {$ENDIF};
+ kDeflateNumFastBytesX9 = 128;
+ kLzmaNumFastBytesX1 = 32;
+ kLzmaNumFastBytesX7 = 64;
+
kBZip2NumPassesX1 = 1;
kBZip2NumPassesX7 = 2;
kBZip2NumPassesX9 = 7;
@@ -623,7 +665,7 @@
begin
Result := True;
end;
- {$ENDIF ~7ZIP_LINKONREQUEST}
+{$ENDIF ~7ZIP_LINKONREQUEST}
function Is7ZipLoaded: Boolean;
begin
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <jfu...@us...> - 2008-12-26 19:39:10
|
Revision: 2579
http://jcl.svn.sourceforge.net/jcl/?rev=2579&view=rev
Author: jfudickar
Date: 2008-12-26 19:39:06 +0000 (Fri, 26 Dec 2008)
Log Message:
-----------
Function StrRemoveEndChars Added
Modified Paths:
--------------
trunk/jcl/source/common/JclStrings.pas
Modified: trunk/jcl/source/common/JclStrings.pas
===================================================================
--- trunk/jcl/source/common/JclStrings.pas 2008-12-25 07:22:43 UTC (rev 2578)
+++ trunk/jcl/source/common/JclStrings.pas 2008-12-26 19:39:06 UTC (rev 2579)
@@ -198,6 +198,8 @@
function StrQuote(const S: string; C: Char): string;
function StrRemoveChars(const S: string; const Chars: TCharValidator): string; overload;
function StrRemoveChars(const S: string; const Chars: array of Char): string; overload;
+function StrRemoveEndChars(const S: string; const Chars: TCharValidator): string; overload;
+function StrRemoveEndChars(const S: string; const Chars: array of Char): string; overload;
function StrKeepChars(const S: string; const Chars: TCharValidator): string; overload;
function StrKeepChars(const S: string; const Chars: array of Char): string; overload;
procedure StrReplace(var S: string; const Search, Replace: string; Flags: TReplaceFlags = []);
@@ -1611,6 +1613,58 @@
end;
{$ENDIF CLR}
+function StrRemoveEndChars(const S: string; const Chars: TCharValidator): string;
+{$IFDEF CLR}
+var
+ Len: Integer;
+ I: Integer;
+ sb: StringBuilder;
+begin
+ Len := Length(S);
+ while (Len > 0) and Chars(s[Len]) do
+ Dec(Len);
+ sb := StringBuilder.Create(Len);
+ for I := 0 to Len do
+ sb.Append(S[I]);
+ Result := sb.ToString();
+end;
+{$ELSE}
+var
+ Len : Integer;
+begin
+ Len := Length(S);
+ while (Len > 0) and Chars(s[Len]) do
+ Dec(Len);
+ Result := Copy (s, 1, Len);
+end;
+{$ENDIF CLR}
+
+function StrRemoveEndChars(const S: string; const Chars: array of Char): string;
+{$IFDEF CLR}
+var
+ Len: Integer;
+ I: Integer;
+ sb: StringBuilder;
+begin
+ Len := Length(S);
+ while (Len > 0) and ArrayContainsChar(Chars, s[Len]) do
+ Dec(Len);
+ sb := StringBuilder.Create(Len);
+ for I := 0 to Len do
+ sb.Append(S[I]);
+ Result := sb.ToString();
+end;
+{$ELSE}
+var
+ Len : Integer;
+begin
+ Len := Length(S);
+ while (Len > 0) and ArrayContainsChar(Chars, s[Len]) do
+ Dec(Len);
+ Result := Copy (s, 1, Len);
+end;
+{$ENDIF CLR}
+
function StrKeepChars(const S: string; const Chars: TCharValidator): string;
{$IFDEF CLR}
var
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <jg...@us...> - 2008-12-25 07:22:45
|
Revision: 2578
http://jcl.svn.sourceforge.net/jcl/?rev=2578&view=rev
Author: jgsoft
Date: 2008-12-25 07:22:43 +0000 (Thu, 25 Dec 2008)
Log Message:
-----------
sevenzip.pas did not compile with 7ZIP_LINKDLL defined
Modified Paths:
--------------
trunk/jcl/source/windows/sevenzip.pas
Modified: trunk/jcl/source/windows/sevenzip.pas
===================================================================
--- trunk/jcl/source/windows/sevenzip.pas 2008-12-25 07:20:44 UTC (rev 2577)
+++ trunk/jcl/source/windows/sevenzip.pas 2008-12-25 07:22:43 UTC (rev 2578)
@@ -41,6 +41,7 @@
{ Translation 2007-2008 Florent Ouchet for the Jedi Code Library }
{ Contributors: }
{ Uwe Schuster (uschuster) }
+{ Jan Goyvaerts (jgsoft) }
{ }
{**************************************************************************************************}
{ }
@@ -540,12 +541,6 @@
kDeflateFastBytesX7 = 64;
kDeflateFastBytesX9 = 128;
-{$IFDEF 7ZIP_STATICLINK}
-function CreateObject(ClsID: PGUID; IID: PGUID; out Obj): HRESULT; stdcall;
-function GetNumberOfFormats(NumFormats: PCardinal): HRESULT; stdcall;
-function GetNumberOfMethods(NumMethods: PCardinal): HRESULT; stdcall;
-{$ENDIF 7ZIP_STATICLINK}
-
{$IFDEF 7ZIP_LINKONREQUEST}
type
TCreateObjectFunc = function (ClsID: PGUID; IID: PGUID; out Obj): HRESULT; stdcall;
@@ -556,7 +551,11 @@
CreateObject: TCreateObjectFunc = nil;
GetNumberOfFormats: TGetNumberOfFormatsFunc = nil;
GetNumberOfMethods: TGetNumberOfMethodsFunc = nil;
-{$ENDIF 7ZIP_LINKONREQUEST}
+{$ELSE ~7ZIP_LINKONREQUEST}
+function CreateObject(ClsID: PGUID; IID: PGUID; out Obj): HRESULT; stdcall;
+function GetNumberOfFormats(NumFormats: PCardinal): HRESULT; stdcall;
+function GetNumberOfMethods(NumMethods: PCardinal): HRESULT; stdcall;
+{$ENDIF ~7ZIP_LINKONREQUEST}
function Load7Zip: Boolean;
function Is7ZipLoaded: Boolean;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <jg...@us...> - 2008-12-25 07:20:46
|
Revision: 2577
http://jcl.svn.sourceforge.net/jcl/?rev=2577&view=rev
Author: jgsoft
Date: 2008-12-25 07:20:44 +0000 (Thu, 25 Dec 2008)
Log Message:
-----------
TJclDecompressItem did not allow any properties to be set. Now it allows properties to be set, unless decompression is in progress, similar to what TJclCompressItem and TJclUpdateItem do.
Modified Paths:
--------------
trunk/jcl/source/common/JclCompression.pas
Modified: trunk/jcl/source/common/JclCompression.pas
===================================================================
--- trunk/jcl/source/common/JclCompression.pas 2008-12-22 21:06:21 UTC (rev 2576)
+++ trunk/jcl/source/common/JclCompression.pas 2008-12-25 07:20:44 UTC (rev 2577)
@@ -18,6 +18,7 @@
{ Contributors: }
{ Olivier Sannier (obones) }
{ Florent Ouchet (outchy) }
+{ Jan Goyvaerts (jgsoft) }
{ }
{**************************************************************************************************}
{ }
@@ -4138,7 +4139,7 @@
procedure TJclDecompressItem.CheckSetProperty(
AProperty: TJclCompressionItemProperty);
begin
- (Archive as TJclDecompressArchive).CheckListing;
+ (Archive as TJclDecompressArchive).CheckNotDecompressing;
end;
function TJclDecompressItem.ValidateExtraction(Index: Integer): Boolean;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <usc...@us...> - 2008-12-22 21:06:24
|
Revision: 2576
http://jcl.svn.sourceforge.net/jcl/?rev=2576&view=rev
Author: uschuster
Date: 2008-12-22 21:06:21 +0000 (Mon, 22 Dec 2008)
Log Message:
-----------
JclSysInfo.pas: added InheritsFromByName (necessary for AddIgnoredExceptionByName + RemoveIgnoredExceptionByName in JclDebug.pas)
JclDebug.pas: added AddIgnoredExceptionByName and RemoveIgnoredExceptionByName to be able to ignore for exam. exceptions in DLL's
Modified Paths:
--------------
trunk/jcl/source/common/JclSysUtils.pas
trunk/jcl/source/windows/JclDebug.pas
Modified: trunk/jcl/source/common/JclSysUtils.pas
===================================================================
--- trunk/jcl/source/common/JclSysUtils.pas 2008-12-22 20:37:39 UTC (rev 2575)
+++ trunk/jcl/source/common/JclSysUtils.pas 2008-12-22 21:06:21 UTC (rev 2576)
@@ -353,6 +353,8 @@
function IsObject(Address: Pointer): Boolean;
{$ENDIF ~FPC}
+function InheritsFromByName(AClass: TClass; const AClassName: string): Boolean;
+
// Interface information
function GetImplementorOfInterface(const I: IInterface): TObject;
{$ENDIF ~CLR}
@@ -1909,6 +1911,13 @@
end;
{$ENDIF ~FPC}
+function InheritsFromByName(AClass: TClass; const AClassName: string): Boolean;
+begin
+ while (AClass <> nil) and not AClass.ClassNameIs(AClassName) do
+ AClass := AClass.ClassParent;
+ Result := AClass <> nil;
+end;
+
//=== Interface information ==================================================
function GetImplementorOfInterface(const I: IInterface): TObject;
Modified: trunk/jcl/source/windows/JclDebug.pas
===================================================================
--- trunk/jcl/source/windows/JclDebug.pas 2008-12-22 20:37:39 UTC (rev 2575)
+++ trunk/jcl/source/windows/JclDebug.pas 2008-12-22 21:06:21 UTC (rev 2576)
@@ -25,6 +25,7 @@
{ Andreas Hausladen (ahuser) }
{ Petr Vones (pvones) }
{ Soeren Muehlbauer }
+{ Uwe Schuster (uschuster) }
{ }
{**************************************************************************************************}
{ }
@@ -798,7 +799,9 @@
// functions to add/remove exception classes to be ignored if StTraceAllExceptions is not set
procedure AddIgnoredException(const ExceptionClass: TClass);
+procedure AddIgnoredExceptionByName(const AExceptionClassName: string);
procedure RemoveIgnoredException(const ExceptionClass: TClass);
+procedure RemoveIgnoredExceptionByName(const AExceptionClassName: string);
function IsIgnoredException(const ExceptionClass: TClass): Boolean;
{$IFDEF UNITVERSIONING}
@@ -4723,6 +4726,8 @@
var
TrackingActive: Boolean;
IgnoredExceptions: TThreadList = nil;
+ IgnoredExceptionClassNames: TStringList = nil;
+ IgnoredExceptionClassNamesCritSect: TJclCriticalSection = nil;
procedure AddIgnoredException(const ExceptionClass: TClass);
begin
@@ -4735,6 +4740,27 @@
end;
end;
+procedure AddIgnoredExceptionByName(const AExceptionClassName: string);
+begin
+ if AExceptionClassName <> '' then
+ begin
+ if not Assigned(IgnoredExceptionClassNamesCritSect) then
+ IgnoredExceptionClassNamesCritSect := TJclCriticalSection.Create;
+ if not Assigned(IgnoredExceptionClassNames) then
+ begin
+ IgnoredExceptionClassNames := TStringList.Create;
+ IgnoredExceptionClassNames.Duplicates := dupIgnore;
+ IgnoredExceptionClassNames.Sorted := True;
+ end;
+ IgnoredExceptionClassNamesCritSect.Enter;
+ try
+ IgnoredExceptionClassNames.Add(AExceptionClassName);
+ finally
+ IgnoredExceptionClassNamesCritSect.Leave;
+ end;
+ end;
+end;
+
procedure RemoveIgnoredException(const ExceptionClass: TClass);
var
ClassList: TList;
@@ -4750,6 +4776,23 @@
end;
end;
+procedure RemoveIgnoredExceptionByName(const AExceptionClassName: string);
+var
+ Index: Integer;
+begin
+ if Assigned(IgnoredExceptionClassNames) and (AExceptionClassName <> '') then
+ begin
+ IgnoredExceptionClassNamesCritSect.Enter;
+ try
+ Index := IgnoredExceptionClassNames.IndexOf(AExceptionClassName);
+ if Index <> -1 then
+ IgnoredExceptionClassNames.Delete(Index);
+ finally
+ IgnoredExceptionClassNamesCritSect.Leave;
+ end;
+ end;
+end;
+
function IsIgnoredException(const ExceptionClass: TClass): Boolean;
var
ClassList: TList;
@@ -4770,6 +4813,22 @@
IgnoredExceptions.UnlockList;
end;
end;
+ if not Result and Assigned(IgnoredExceptionClassNames) and not (stTraceAllExceptions in JclStackTrackingOptions) then
+ begin
+ IgnoredExceptionClassNamesCritSect.Enter;
+ try
+ Result := IgnoredExceptionClassNames.IndexOf(ExceptionClass.ClassName) <> -1;
+ if not Result then
+ for Index := 0 to IgnoredExceptionClassNames.Count - 1 do
+ if InheritsFromByName(ExceptionClass, IgnoredExceptionClassNames[Index]) then
+ begin
+ Result := True;
+ Break;
+ end;
+ finally
+ IgnoredExceptionClassNamesCritSect.Leave;
+ end;
+ end;
end;
procedure DoExceptNotify(ExceptObj: TObject; ExceptAddr: Pointer; OSException: Boolean;
@@ -5215,6 +5274,8 @@
FreeAndNil(DebugInfoCritSect);
FreeAndNil(InfoSourceClassList);
FreeAndNil(IgnoredExceptions);
+ FreeAndNil(IgnoredExceptionClassNames);
+ FreeAndNil(IgnoredExceptionClassNamesCritSect);
TJclDebugInfoSymbols.CleanupDebugSymbols;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <usc...@us...> - 2008-12-22 20:37:46
|
Revision: 2575
http://jcl.svn.sourceforge.net/jcl/?rev=2575&view=rev
Author: uschuster
Date: 2008-12-22 20:37:39 +0000 (Mon, 22 Dec 2008)
Log Message:
-----------
fixed writing of new streams (major speed issue; it didn't take advantage of the buffer which ended up in too much writing and unnecessary loading)
(Mantis #4570)
Modified Paths:
--------------
trunk/jcl/source/common/JclStreams.pas
Modified: trunk/jcl/source/common/JclStreams.pas
===================================================================
--- trunk/jcl/source/common/JclStreams.pas 2008-12-21 01:05:47 UTC (rev 2574)
+++ trunk/jcl/source/common/JclStreams.pas 2008-12-22 20:37:39 UTC (rev 2575)
@@ -1538,7 +1538,15 @@
while Count > 0 do
begin
if not BufferHit then
- LoadBuffer;
+ begin
+ if (FBufferStart <= FPosition) and (FPosition < (FBufferStart + FBufferSize)) then
+ begin
+ if Length(FBuffer) <> FBufferSize then
+ SetLength(FBuffer, FBufferSize);
+ end
+ else
+ LoadBuffer;
+ end;
Dec(Count, WriteToBuffer(Buffer, Count, Result - Count));
end;
Result := Result - Count - Offset;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <jfu...@us...> - 2008-12-21 01:05:49
|
Revision: 2574
http://jcl.svn.sourceforge.net/jcl/?rev=2574&view=rev
Author: jfudickar
Date: 2008-12-21 01:05:47 +0000 (Sun, 21 Dec 2008)
Log Message:
-----------
2nd Place : Removed warning (Result is not truly a variable)
Modified Paths:
--------------
trunk/jcl/source/common/JclSimpleXml.pas
Modified: trunk/jcl/source/common/JclSimpleXml.pas
===================================================================
--- trunk/jcl/source/common/JclSimpleXml.pas 2008-12-15 18:23:23 UTC (rev 2573)
+++ trunk/jcl/source/common/JclSimpleXml.pas 2008-12-21 01:05:47 UTC (rev 2574)
@@ -634,38 +634,42 @@
function EntityEncode(const S: string): string;
var
C: Char;
- SLen, SIndex, RLen, RIndex: Integer;
+ SIndex, SLen, RIndex, RLen: Integer;
+ Tmp: string;
+
begin
SLen := Length(S);
RLen := SLen;
RIndex := 1;
- SetLength(Result, RLen);
+ SetLength(Tmp, RLen);
for SIndex := 1 to SLen do
begin
C := S[SIndex];
case C of
'"':
- AddEntity(Result, RIndex, RLen, '"');
+ AddEntity(Tmp, RIndex, RLen, '"');
'&':
- AddEntity(Result, RIndex, RLen, '&');
+ AddEntity(Tmp, RIndex, RLen, '&');
#39:
- AddEntity(Result, RIndex, RLen, ''');
+ AddEntity(Tmp, RIndex, RLen, ''');
'<':
- AddEntity(Result, RIndex, RLen, '<');
+ AddEntity(Tmp, RIndex, RLen, '<');
'>':
- AddEntity(Result, RIndex, RLen, '>');
+ AddEntity(Tmp, RIndex, RLen, '>');
else
if RIndex > RLen then
begin
RLen := RLen * 2;
- SetLength(Result, RLen);
+ SetLength(Tmp, RLen);
end;
- Result[RIndex] := C;
+ Tmp[RIndex] := C;
Inc(RIndex);
end;
end;
if RIndex > 1 then
- SetLength(Result, RIndex - 1);
+ SetLength(Tmp, RIndex - 1);
+
+ Result := Tmp;
end;
function EntityDecode(const S: string): string;
@@ -836,6 +840,7 @@
C: Char;
SIndex, SLen, RIndex, RLen: Integer;
Tmp: string;
+
begin
SLen := Length(S);
RLen := SLen;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ob...@us...> - 2008-12-15 18:23:33
|
Revision: 2573
http://jcl.svn.sourceforge.net/jcl/?rev=2573&view=rev
Author: obones
Date: 2008-12-15 18:23:23 +0000 (Mon, 15 Dec 2008)
Log Message:
-----------
Fixed D5/C5 compilation.
Modified Paths:
--------------
trunk/jcl/source/common/JclMath.pas
trunk/jcl/source/common/JclStreams.pas
Modified: trunk/jcl/source/common/JclMath.pas
===================================================================
--- trunk/jcl/source/common/JclMath.pas 2008-12-11 08:23:48 UTC (rev 2572)
+++ trunk/jcl/source/common/JclMath.pas 2008-12-15 18:23:23 UTC (rev 2573)
@@ -589,6 +589,10 @@
function CheckCrc16(var X: array of Byte; N: Integer; Crc: Word): Integer; overload;
function CheckCrc16_A(var X: array of Byte; Crc: Word): Integer; overload;
+{$IFDEF COMPILER5}
+function CheckCrc16D5(var X: array of Byte; N: Integer; Crc: Word): Integer;
+{$ENDIF COMPILER5}
+
// change the default polynom
procedure InitCrc16(Polynom, Start: Word); overload;
@@ -661,6 +665,10 @@
function Crc32(const X: array of Byte; N: Integer; Crc: Cardinal = 0): Cardinal; overload;
function Crc32_A(const X: array of Byte; Crc: Cardinal = 0): Cardinal; overload;
+{$IFDEF COMPILER5}
+function CheckCrc32D5(var X: array of Byte; N: Integer; Crc: Word): Integer;
+{$ENDIF COMPILER5}
+
function CheckCrc32_P(X: PJclByteArray; N: Integer; Crc: Cardinal): Integer; overload;
function CheckCrc32(var X: array of Byte; N: Integer; Crc: Cardinal): Integer; overload;
function CheckCrc32_A(var X: array of Byte; Crc: Cardinal): Integer; overload;
@@ -3885,6 +3893,13 @@
{$ENDIF ~CLR}
end;
+{$IFDEF COMPILER5}
+function CheckCrc16D5(var X: array of Byte; N: Integer; Crc: Word): Integer;
+begin
+ Result := CheckCRC16_P(Crc16DefaultTable, @X, N, CRC);
+end;
+{$ENDIF COMPILER5}
+
function CheckCrc16(var X: array of Byte; N: Integer; Crc: Word): Integer;
begin
{$IFDEF CLR}
@@ -4096,6 +4111,13 @@
{$ENDIF CLR}
end;
+{$IFDEF COMPILER5}
+function CheckCrc32D5(var X: array of Byte; N: Integer; Crc: Word): Integer;
+begin
+ Result := CheckCRC32_P(Crc32DefaultTable, @X, N, CRC);
+end;
+{$ENDIF COMPILER5}
+
function CheckCrc32(var X: array of Byte; N: Integer; Crc: Cardinal): Integer;
begin
{$IFDEF CLR}
Modified: trunk/jcl/source/common/JclStreams.pas
===================================================================
--- trunk/jcl/source/common/JclStreams.pas 2008-12-11 08:23:48 UTC (rev 2572)
+++ trunk/jcl/source/common/JclStreams.pas 2008-12-15 18:23:23 UTC (rev 2573)
@@ -2357,7 +2357,7 @@
CRC: Word;
begin
CRC := FBuffer[FBufferCurrentSize] + (FBuffer[FBufferCurrentSize + 1] shl 8);
- if CheckCrc16(FBuffer, FBufferCurrentSize, CRC) < 0 then
+ if {$IFDEF COMPILER5}CheckCrc16D5{$ELSE}CheckCrc16{$ENDIF COMPILER5}(FBuffer, FBufferCurrentSize, CRC) < 0 then
{$IFDEF CLR}
raise EJclStreamError.Create(RsStreamsCRCError);
{$ELSE ~CLR}
@@ -2387,7 +2387,7 @@
begin
CRC := FBuffer[FBufferCurrentSize] + (FBuffer[FBufferCurrentSize + 1] shl 8)
+ (FBuffer[FBufferCurrentSize + 2] shl 16) + (FBuffer[FBufferCurrentSize + 3] shl 24);
- if CheckCrc32(FBuffer, FBufferCurrentSize, CRC) < 0 then
+ if {$IFDEF COMPILER5}CheckCrc32D5{$ELSE}CheckCrc32{$ENDIF COMPILER5}(FBuffer, FBufferCurrentSize, CRC) < 0 then
{$IFDEF CLR}
raise EJclStreamError.Create(RsStreamsCRCError);
{$ELSE ~CLR}
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ob...@us...> - 2008-12-11 08:23:51
|
Revision: 2572
http://jcl.svn.sourceforge.net/jcl/?rev=2572&view=rev
Author: obones
Date: 2008-12-11 08:23:48 +0000 (Thu, 11 Dec 2008)
Log Message:
-----------
Removed warning (Result is not truly a variable)
Modified Paths:
--------------
trunk/jcl/source/common/JclSimpleXml.pas
Modified: trunk/jcl/source/common/JclSimpleXml.pas
===================================================================
--- trunk/jcl/source/common/JclSimpleXml.pas 2008-12-10 21:16:26 UTC (rev 2571)
+++ trunk/jcl/source/common/JclSimpleXml.pas 2008-12-11 08:23:48 UTC (rev 2572)
@@ -835,39 +835,42 @@
var
C: Char;
SIndex, SLen, RIndex, RLen: Integer;
+ Tmp: string;
begin
SLen := Length(S);
RLen := SLen;
RIndex := 1;
- SetLength(Result, RLen);
+ SetLength(Tmp, RLen);
for SIndex := 1 to SLen do
begin
C := S[SIndex];
case C of
'"':
- AddEntity(Result, RIndex, RLen, '"');
+ AddEntity(Tmp, RIndex, RLen, '"');
'&':
- AddEntity(Result, RIndex, RLen, '&');
+ AddEntity(Tmp, RIndex, RLen, '&');
#39:
- AddEntity(Result, RIndex, RLen, ''');
+ AddEntity(Tmp, RIndex, RLen, ''');
'<':
- AddEntity(Result, RIndex, RLen, '<');
+ AddEntity(Tmp, RIndex, RLen, '<');
'>':
- AddEntity(Result, RIndex, RLen, '>');
+ AddEntity(Tmp, RIndex, RLen, '>');
#128..High(Char):
- AddEntity(Result, RIndex, RLen, Format('&#x%.2x;', [Ord(C)]));
+ AddEntity(Tmp, RIndex, RLen, Format('&#x%.2x;', [Ord(C)]));
else
if RIndex > RLen then
begin
RLen := RLen * 2;
- SetLength(Result, RLen);
+ SetLength(Tmp, RLen);
end;
- Result[RIndex] := C;
+ Tmp[RIndex] := C;
Inc(RIndex);
end;
end;
if RIndex > 1 then
- SetLength(Result, RIndex - 1);
+ SetLength(Tmp, RIndex - 1);
+
+ Result := Tmp;
end;
procedure SimpleXMLDecode(var S: string; TrimBlanks: Boolean);
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ou...@us...> - 2008-12-10 21:16:30
|
Revision: 2571
http://jcl.svn.sourceforge.net/jcl/?rev=2571&view=rev
Author: outchy
Date: 2008-12-10 21:16:26 +0000 (Wed, 10 Dec 2008)
Log Message:
-----------
Mantis 4549 Missing FloatValue in TJclSimpleXMLElems and TJclSimpleXMLProps.
Modified Paths:
--------------
trunk/jcl/source/common/JclSimpleXml.pas
Modified: trunk/jcl/source/common/JclSimpleXml.pas
===================================================================
--- trunk/jcl/source/common/JclSimpleXml.pas 2008-12-10 21:07:03 UTC (rev 2570)
+++ trunk/jcl/source/common/JclSimpleXml.pas 2008-12-10 21:16:26 UTC (rev 2571)
@@ -187,6 +187,7 @@
function Value(const Name: string; Default: string = ''): string;
function IntValue(const Name: string; Default: Int64 = -1): Int64;
function BoolValue(const Name: string; Default: Boolean = True): Boolean;
+ function FloatValue(const Name: string; Default: Extended = 0): Extended;
procedure LoadFromStringStream(StringStream: TJclStringStream);
procedure SaveToStringStream(StringStream: TJclStringStream);
property Item[const Index: Integer]: TJclSimpleXMLProp read GetItem; default;
@@ -309,6 +310,7 @@
function IndexOf(const Name: string): Integer; overload;
function Value(const Name: string; Default: string = ''): string;
function IntValue(const Name: string; Default: Int64 = -1): Int64;
+ function FloatValue(const Name: string; Default: Extended = 0): Extended;
function BoolValue(const Name: string; Default: Boolean = True): Boolean;
procedure BinaryValue(const Name: string; Stream: TStream);
procedure LoadFromStringStream(StringStream: TJclStringStream; AParent: TJclSimpleXML = nil);
@@ -1956,6 +1958,18 @@
end;
end;
+function TJclSimpleXMLElems.FloatValue(const Name: string;
+ Default: Extended): Extended;
+var
+ Elem: TJclSimpleXMLElem;
+begin
+ Elem := GetItemNamedDefault(Name, FloatToStr(Default));
+ if Elem = nil then
+ Result := Default
+ else
+ Result := Elem.FloatValue;
+end;
+
function TJclSimpleXMLElems.GetCount: Integer;
begin
if FElems = nil then
@@ -2399,6 +2413,18 @@
raise EJclSimpleXMLError.Create(S);
end;
+function TJclSimpleXMLProps.FloatValue(const Name: string;
+ Default: Extended): Extended;
+var
+ Prop: TJclSimpleXMLProp;
+begin
+ Prop := GetItemNamedDefault(Name, FloatToStr(Default));
+ if Prop = nil then
+ Result := Default
+ else
+ Result := Prop.FloatValue;
+end;
+
procedure TJclSimpleXMLProps.FmtError(const S: string;
const Args: array of const);
begin
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ou...@us...> - 2008-12-10 21:07:08
|
Revision: 2570
http://jcl.svn.sourceforge.net/jcl/?rev=2570&view=rev
Author: outchy
Date: 2008-12-10 21:07:03 +0000 (Wed, 10 Dec 2008)
Log Message:
-----------
Mantis 4594 memory corruption may occur in SimpleXmlEncode
Modified Paths:
--------------
trunk/jcl/source/common/JclSimpleXml.pas
Modified: trunk/jcl/source/common/JclSimpleXml.pas
===================================================================
--- trunk/jcl/source/common/JclSimpleXml.pas 2008-12-10 19:27:35 UTC (rev 2569)
+++ trunk/jcl/source/common/JclSimpleXml.pas 2008-12-10 21:07:03 UTC (rev 2570)
@@ -608,42 +608,62 @@
{$ENDIF COMPILER6_UP}
{$ENDIF !CLR}
+procedure AddEntity(var Res: string; var ResIndex, ResLen: Integer; const Entity: string);
+ {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF SUPPORTS_INLINE}
+var
+ EntityIndex, EntityLen: Integer;
+begin
+ EntityLen := Length(Entity);
+ if (ResIndex + EntityLen) > ResLen then
+ begin
+ if ResLen <= EntityLen then
+ ResLen := ResLen * EntityLen
+ else
+ ResLen := ResLen * 2;
+ SetLength(Res, ResLen);
+ end;
+ for EntityIndex := 1 to EntityLen do
+ begin
+ Res[ResIndex] := Entity[EntityIndex];
+ Inc(ResIndex);
+ end;
+end;
+
function EntityEncode(const S: string): string;
var
- I, J, K, L: Integer;
- tmp: string;
+ C: Char;
+ SLen, SIndex, RLen, RIndex: Integer;
begin
- SetLength(Result, Length(S) * 6); // worst case
- J := 1;
- I := 1;
- L := Length(S);
- while I <= L do
+ SLen := Length(S);
+ RLen := SLen;
+ RIndex := 1;
+ SetLength(Result, RLen);
+ for SIndex := 1 to SLen do
begin
- case S[I] of
+ C := S[SIndex];
+ case C of
'"':
- tmp := '"';
+ AddEntity(Result, RIndex, RLen, '"');
'&':
- tmp := '&';
+ AddEntity(Result, RIndex, RLen, '&');
#39:
- tmp := ''';
+ AddEntity(Result, RIndex, RLen, ''');
'<':
- tmp := '<';
+ AddEntity(Result, RIndex, RLen, '<');
'>':
- tmp := '>';
+ AddEntity(Result, RIndex, RLen, '>');
else
- tmp := S[I];
+ if RIndex > RLen then
+ begin
+ RLen := RLen * 2;
+ SetLength(Result, RLen);
+ end;
+ Result[RIndex] := C;
+ Inc(RIndex);
end;
- for K := 1 to Length(tmp) do
- begin
- Result[J] := tmp[K];
- Inc(J);
- end;
- Inc(I);
end;
- if J > 1 then
- SetLength(Result, J - 1)
- else
- SetLength(Result, 0);
+ if RIndex > 1 then
+ SetLength(Result, RIndex - 1);
end;
function EntityDecode(const S: string): string;
@@ -810,55 +830,42 @@
{$ENDIF CLR}
function SimpleXMLEncode(const S: string): string;
- function CharIsConverted(const C: Char): Boolean; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
+var
+ C: Char;
+ SIndex, SLen, RIndex, RLen: Integer;
+begin
+ SLen := Length(S);
+ RLen := SLen;
+ RIndex := 1;
+ SetLength(Result, RLen);
+ for SIndex := 1 to SLen do
begin
+ C := S[SIndex];
case C of
- '"', '&', #39, '<', '>',
+ '"':
+ AddEntity(Result, RIndex, RLen, '"');
+ '&':
+ AddEntity(Result, RIndex, RLen, '&');
+ #39:
+ AddEntity(Result, RIndex, RLen, ''');
+ '<':
+ AddEntity(Result, RIndex, RLen, '<');
+ '>':
+ AddEntity(Result, RIndex, RLen, '>');
#128..High(Char):
- Result := True;
+ AddEntity(Result, RIndex, RLen, Format('&#x%.2x;', [Ord(C)]));
else
- Result := False;
- end;
- end;
-var
- I, J, K: Integer;
- tmp: string;
-begin
- SetLength(Result, Length(S) * 6); // worst case
- J := 1;
- for I := 1 to Length(S) do
- begin
- if CharIsConverted(S[I]) then
- begin
- case S[I] of
- '"':
- tmp := '"';
- '&':
- tmp := '&';
- #39:
- tmp := ''';
- '<':
- tmp := '<';
- '>':
- tmp := '>';
- else
- tmp := Format('&#x%.2x;', [Ord(S[I])]);
- end;
- for K := 1 to Length(tmp) do
+ if RIndex > RLen then
begin
- Result[J] := tmp[K];
- Inc(J);
+ RLen := RLen * 2;
+ SetLength(Result, RLen);
end;
- Dec(J);
- end
- else
- Result[J] := S[I];
- Inc(J);
+ Result[RIndex] := C;
+ Inc(RIndex);
+ end;
end;
- if J > 0 then
- SetLength(Result, J - 1)
- else
- SetLength(Result, 0);
+ if RIndex > 1 then
+ SetLength(Result, RIndex - 1);
end;
procedure SimpleXMLDecode(var S: string; TrimBlanks: Boolean);
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ou...@us...> - 2008-12-10 19:27:40
|
Revision: 2569
http://jcl.svn.sourceforge.net/jcl/?rev=2569&view=rev
Author: outchy
Date: 2008-12-10 19:27:35 +0000 (Wed, 10 Dec 2008)
Log Message:
-----------
Mantis 0031 ability to select the polynomial table for CRC computations.
Modified Paths:
--------------
trunk/jcl/source/common/JclMath.pas
Modified: trunk/jcl/source/common/JclMath.pas
===================================================================
--- trunk/jcl/source/common/JclMath.pas 2008-12-10 13:24:52 UTC (rev 2568)
+++ trunk/jcl/source/common/JclMath.pas 2008-12-10 19:27:35 UTC (rev 2569)
@@ -529,29 +529,157 @@
function GetParity(Buffer: PByte; Len: Integer): Boolean;
{$ENDIF CLR}
-{ CRC }
+{ CRC-16 }
-function Crc16_P(X: PJclByteArray; N: Integer; Crc: Word = 0): Word;
-function Crc16(const X: array of Byte; N: Integer; Crc: Word = 0): Word;
-function Crc16_A(const X: array of Byte; Crc: Word = 0): Word;
+type
+ TCrc16Table = array [0..255] of Word;
-function CheckCrc16_P(X: PJclByteArray; N: Integer; Crc: Word): Integer;
-function CheckCrc16(var X: array of Byte; N: Integer; Crc: Word): Integer;
-function CheckCrc16_A(var X: array of Byte; Crc: Word): Integer;
+var
+ // CRC16Polynom = $1021;
+ Crc16DefaultTable: TCrc16Table = (
+ $0000, $1021, $2042, $3063, $4084, $50A5, $60C6, $70E7,
+ $8108, $9129, $A14A, $B16B, $C18C, $D1AD, $E1CE, $F1EF,
+ $1231, $0210, $3273, $2252, $52B5, $4294, $72F7, $62D6,
+ $9339, $8318, $B37B, $A35A, $D3BD, $C39C, $F3FF, $E3DE,
+ $2462, $3443, $0420, $1401, $64E6, $74C7, $44A4, $5485,
+ $A56A, $B54B, $8528, $9509, $E5EE, $F5CF, $C5AC, $D58D,
+ $3653, $2672, $1611, $0630, $76D7, $66F6, $5695, $46B4,
+ $B75B, $A77A, $9719, $8738, $F7DF, $E7FE, $D79D, $C7BC,
+ $48C4, $58E5, $6886, $78A7, $0840, $1861, $2802, $3823,
+ $C9CC, $D9ED, $E98E, $F9AF, $8948, $9969, $A90A, $B92B,
+ $5AF5, $4AD4, $7AB7, $6A96, $1A71, $0A50, $3A33, $2A12,
+ $DBFD, $CBDC, $FBBF, $EB9E, $9B79, $8B58, $BB3B, $AB1A,
+ $6CA6, $7C87, $4CE4, $5CC5, $2C22, $3C03, $0C60, $1C41,
+ $EDAE, $FD8F, $CDEC, $DDCD, $AD2A, $BD0B, $8D68, $9D49,
+ $7E97, $6EB6, $5ED5, $4EF4, $3E13, $2E32, $1E51, $0E70,
+ $FF9F, $EFBE, $DFDD, $CFFC, $BF1B, $AF3A, $9F59, $8F78,
+ $9188, $81A9, $B1CA, $A1EB, $D10C, $C12D, $F14E, $E16F,
+ $1080, $00A1, $30C2, $20E3, $5004, $4025, $7046, $6067,
+ $83B9, $9398, $A3FB, $B3DA, $C33D, $D31C, $E37F, $F35E,
+ $02B1, $1290, $22F3, $32D2, $4235, $5214, $6277, $7256,
+ $B5EA, $A5CB, $95A8, $8589, $F56E, $E54F, $D52C, $C50D,
+ $34E2, $24C3, $14A0, $0481, $7466, $6447, $5424, $4405,
+ $A7DB, $B7FA, $8799, $97B8, $E75F, $F77E, $C71D, $D73C,
+ $26D3, $36F2, $0691, $16B0, $6657, $7676, $4615, $5634,
+ $D94C, $C96D, $F90E, $E92F, $99C8, $89E9, $B98A, $A9AB,
+ $5844, $4865, $7806, $6827, $18C0, $08E1, $3882, $28A3,
+ $CB7D, $DB5C, $EB3F, $FB1E, $8BF9, $9BD8, $ABBB, $BB9A,
+ $4A75, $5A54, $6A37, $7A16, $0AF1, $1AD0, $2AB3, $3A92,
+ $FD2E, $ED0F, $DD6C, $CD4D, $BDAA, $AD8B, $9DE8, $8DC9,
+ $7C26, $6C07, $5C64, $4C45, $3CA2, $2C83, $1CE0, $0CC1,
+ $EF1F, $FF3E, $CF5D, $DF7C, $AF9B, $BFBA, $8FD9, $9FF8,
+ $6E17, $7E36, $4E55, $5E74, $2E93, $3EB2, $0ED1, $1EF0
+ );
+ Crc16DefaultStart: Cardinal = $FFFF;
-function Crc32_P(X: PJclByteArray; N: Integer; Crc: Cardinal = 0): Cardinal;
-function Crc32(const X: array of Byte; N: Integer; Crc: Cardinal = 0): Cardinal;
-function Crc32_A(const X: array of Byte; Crc: Cardinal = 0): Cardinal;
+const
+ Crc16PolynomCCITT = $1021;
+ Crc16PolynomIBM = $8005;
+ Crc16Bits = 16;
+ Crc16Bytes = 2;
+ Crc16HighBit = $8000;
+ NotCrc16HighBit = $7FFF;
-function CheckCrc32_P(X: PJclByteArray; N: Integer; Crc: Cardinal): Integer;
-function CheckCrc32(var X: array of Byte; N: Integer; Crc: Cardinal): Integer;
-function CheckCrc32_A(var X: array of Byte; Crc: Cardinal): Integer;
+// for backward compatibility (default polynom = CCITT = $1021)
+function Crc16_P(X: PJclByteArray; N: Integer; Crc: Word = 0): Word; overload;
+function Crc16(const X: array of Byte; N: Integer; Crc: Word = 0): Word; overload;
+function Crc16_A(const X: array of Byte; Crc: Word = 0): Word; overload;
-{$IFDEF CRCINIT}
-procedure InitCrc32(Polynom, Start: Cardinal);
-procedure InitCrc16(Polynom, Start: Word);
-{$ENDIF CRCINIT}
+function CheckCrc16_P(X: PJclByteArray; N: Integer; Crc: Word): Integer; overload;
+function CheckCrc16(var X: array of Byte; N: Integer; Crc: Word): Integer; overload;
+function CheckCrc16_A(var X: array of Byte; Crc: Word): Integer; overload;
+// change the default polynom
+procedure InitCrc16(Polynom, Start: Word); overload;
+
+// arbitrary polynom
+function Crc16_P(const Crc16Table: TCrc16Table; X: PJclByteArray; N: Integer; Crc: Word = 0): Word; overload;
+function Crc16(const Crc16Table: TCrc16Table; const X: array of Byte; N: Integer; Crc: Word = 0): Word; overload;
+function Crc16_A(const Crc16Table: TCrc16Table; const X: array of Byte; Crc: Word = 0): Word; overload;
+
+function CheckCrc16_P(const Crc16Table: TCrc16Table; X: PJclByteArray; N: Integer; Crc: Word): Integer; overload;
+function CheckCrc16(const Crc16Table: TCrc16Table; var X: array of Byte; N: Integer; Crc: Word): Integer; overload;
+function CheckCrc16_A(const Crc16Table: TCrc16Table; var X: array of Byte; Crc: Word): Integer; overload;
+
+// initialize a table
+procedure InitCrc16(Polynom, Start: Word; out Crc16Table: TCrc16Table); overload;
+
+{ CRC-32 }
+
+type
+ TCrc32Table = array [0..255] of Cardinal;
+
+var
+ // CRC32Polynom = $04C11DB7;
+ Crc32DefaultTable: TCrc32Table = (
+ $00000000, $04C11DB7, $09823B6E, $0D4326D9, $130476DC, $17C56B6B, $1A864DB2, $1E475005,
+ $2608EDB8, $22C9F00F, $2F8AD6D6, $2B4BCB61, $350C9B64, $31CD86D3, $3C8EA00A, $384FBDBD,
+ $4C11DB70, $48D0C6C7, $4593E01E, $4152FDA9, $5F15ADAC, $5BD4B01B, $569796C2, $52568B75,
+ $6A1936C8, $6ED82B7F, $639B0DA6, $675A1011, $791D4014, $7DDC5DA3, $709F7B7A, $745E66CD,
+ $9823B6E0, $9CE2AB57, $91A18D8E, $95609039, $8B27C03C, $8FE6DD8B, $82A5FB52, $8664E6E5,
+ $BE2B5B58, $BAEA46EF, $B7A96036, $B3687D81, $AD2F2D84, $A9EE3033, $A4AD16EA, $A06C0B5D,
+ $D4326D90, $D0F37027, $DDB056FE, $D9714B49, $C7361B4C, $C3F706FB, $CEB42022, $CA753D95,
+ $F23A8028, $F6FB9D9F, $FBB8BB46, $FF79A6F1, $E13EF6F4, $E5FFEB43, $E8BCCD9A, $EC7DD02D,
+ $34867077, $30476DC0, $3D044B19, $39C556AE, $278206AB, $23431B1C, $2E003DC5, $2AC12072,
+ $128E9DCF, $164F8078, $1B0CA6A1, $1FCDBB16, $018AEB13, $054BF6A4, $0808D07D, $0CC9CDCA,
+ $7897AB07, $7C56B6B0, $71159069, $75D48DDE, $6B93DDDB, $6F52C06C, $6211E6B5, $66D0FB02,
+ $5E9F46BF, $5A5E5B08, $571D7DD1, $53DC6066, $4D9B3063, $495A2DD4, $44190B0D, $40D816BA,
+ $ACA5C697, $A864DB20, $A527FDF9, $A1E6E04E, $BFA1B04B, $BB60ADFC, $B6238B25, $B2E29692,
+ $8AAD2B2F, $8E6C3698, $832F1041, $87EE0DF6, $99A95DF3, $9D684044, $902B669D, $94EA7B2A,
+ $E0B41DE7, $E4750050, $E9362689, $EDF73B3E, $F3B06B3B, $F771768C, $FA325055, $FEF34DE2,
+ $C6BCF05F, $C27DEDE8, $CF3ECB31, $CBFFD686, $D5B88683, $D1799B34, $DC3ABDED, $D8FBA05A,
+ $690CE0EE, $6DCDFD59, $608EDB80, $644FC637, $7A089632, $7EC98B85, $738AAD5C, $774BB0EB,
+ $4F040D56, $4BC510E1, $46863638, $42472B8F, $5C007B8A, $58C1663D, $558240E4, $51435D53,
+ $251D3B9E, $21DC2629, $2C9F00F0, $285E1D47, $36194D42, $32D850F5, $3F9B762C, $3B5A6B9B,
+ $0315D626, $07D4CB91, $0A97ED48, $0E56F0FF, $1011A0FA, $14D0BD4D, $19939B94, $1D528623,
+ $F12F560E, $F5EE4BB9, $F8AD6D60, $FC6C70D7, $E22B20D2, $E6EA3D65, $EBA91BBC, $EF68060B,
+ $D727BBB6, $D3E6A601, $DEA580D8, $DA649D6F, $C423CD6A, $C0E2D0DD, $CDA1F604, $C960EBB3,
+ $BD3E8D7E, $B9FF90C9, $B4BCB610, $B07DABA7, $AE3AFBA2, $AAFBE615, $A7B8C0CC, $A379DD7B,
+ $9B3660C6, $9FF77D71, $92B45BA8, $9675461F, $8832161A, $8CF30BAD, $81B02D74, $857130C3,
+ $5D8A9099, $594B8D2E, $5408ABF7, $50C9B640, $4E8EE645, $4A4FFBF2, $470CDD2B, $43CDC09C,
+ $7B827D21, $7F436096, $7200464F, $76C15BF8, $68860BFD, $6C47164A, $61043093, $65C52D24,
+ $119B4BE9, $155A565E, $18197087, $1CD86D30, $029F3D35, $065E2082, $0B1D065B, $0FDC1BEC,
+ $3793A651, $3352BBE6, $3E119D3F, $3AD08088, $2497D08D, $2056CD3A, $2D15EBE3, $29D4F654,
+ $C5A92679, $C1683BCE, $CC2B1D17, $C8EA00A0, $D6AD50A5, $D26C4D12, $DF2F6BCB, $DBEE767C,
+ $E3A1CBC1, $E760D676, $EA23F0AF, $EEE2ED18, $F0A5BD1D, $F464A0AA, $F9278673, $FDE69BC4,
+ $89B8FD09, $8D79E0BE, $803AC667, $84FBDBD0, $9ABC8BD5, $9E7D9662, $933EB0BB, $97FFAD0C,
+ $AFB010B1, $AB710D06, $A6322BDF, $A2F33668, $BCB4666D, $B8757BDA, $B5365D03, $B1F740B4
+ );
+ Crc32DefaultStart: Cardinal = $FFFFFFFF;
+
+const
+ Crc32PolynomIEEE = $04C11DB7;
+ Crc32PolynomCastagnoli = $1EDC6F41;
+ Crc32Koopman = $741B8CD7;
+ Crc32Bits = 32;
+ Crc32Bytes = 4;
+ Crc32HighBit = $80000000;
+ NotCrc32HighBit = $7FFFFFFF;
+
+// for backward compatibility (default polynom = IEEE = $04C11DB7)
+function Crc32_P(X: PJclByteArray; N: Integer; Crc: Cardinal = 0): Cardinal; overload;
+function Crc32(const X: array of Byte; N: Integer; Crc: Cardinal = 0): Cardinal; overload;
+function Crc32_A(const X: array of Byte; Crc: Cardinal = 0): Cardinal; overload;
+
+function CheckCrc32_P(X: PJclByteArray; N: Integer; Crc: Cardinal): Integer; overload;
+function CheckCrc32(var X: array of Byte; N: Integer; Crc: Cardinal): Integer; overload;
+function CheckCrc32_A(var X: array of Byte; Crc: Cardinal): Integer; overload;
+
+// change the default polynom
+procedure InitCrc32(Polynom, Start: Cardinal); overload;
+
+// arbitrary polynom
+function Crc32_P(const Crc32Table: TCrc32Table; X: PJclByteArray; N: Integer; Crc: Cardinal = 0): Cardinal; overload;
+function Crc32(const Crc32Table: TCrc32Table; const X: array of Byte; N: Integer; Crc: Cardinal = 0): Cardinal; overload;
+function Crc32_A(const Crc32Table: TCrc32Table; const X: array of Byte; Crc: Cardinal = 0): Cardinal; overload;
+
+function CheckCrc32_P(const Crc32Table: TCrc32Table; X: PJclByteArray; N: Integer; Crc: Cardinal): Integer; overload;
+function CheckCrc32(const Crc32Table: TCrc32Table; var X: array of Byte; N: Integer; Crc: Cardinal): Integer; overload;
+function CheckCrc32_A(const Crc32Table: TCrc32Table; var X: array of Byte; Crc: Cardinal): Integer; overload;
+
+// initialize a table
+procedure InitCrc32(Polynom, Start: Cardinal; out Crc32Table: TCrc32Table); overload;
+
{ Complex numbers }
type
@@ -3642,61 +3770,10 @@
Result := (BitsSet mod 2) = 0;
end;
-// CRC
-{ TODO : check for the correct polynom and init, exit values }
-
// CRC 16
-{$IFDEF CRCINIT}
+function Crc16Corr(const Crc16Table: TCrc16Table; Crc: Word; N: Integer): Integer;
var
-{$ELSE}
-const
-{$ENDIF CRCINIT}
- // CRC16Polynom = $1021;
- Crc16Table: array [0..255] of Word = (
- $0000, $1021, $2042, $3063, $4084, $50A5, $60C6, $70E7,
- $8108, $9129, $A14A, $B16B, $C18C, $D1AD, $E1CE, $F1EF,
- $1231, $0210, $3273, $2252, $52B5, $4294, $72F7, $62D6,
- $9339, $8318, $B37B, $A35A, $D3BD, $C39C, $F3FF, $E3DE,
- $2462, $3443, $0420, $1401, $64E6, $74C7, $44A4, $5485,
- $A56A, $B54B, $8528, $9509, $E5EE, $F5CF, $C5AC, $D58D,
- $3653, $2672, $1611, $0630, $76D7, $66F6, $5695, $46B4,
- $B75B, $A77A, $9719, $8738, $F7DF, $E7FE, $D79D, $C7BC,
- $48C4, $58E5, $6886, $78A7, $0840, $1861, $2802, $3823,
- $C9CC, $D9ED, $E98E, $F9AF, $8948, $9969, $A90A, $B92B,
- $5AF5, $4AD4, $7AB7, $6A96, $1A71, $0A50, $3A33, $2A12,
- $DBFD, $CBDC, $FBBF, $EB9E, $9B79, $8B58, $BB3B, $AB1A,
- $6CA6, $7C87, $4CE4, $5CC5, $2C22, $3C03, $0C60, $1C41,
- $EDAE, $FD8F, $CDEC, $DDCD, $AD2A, $BD0B, $8D68, $9D49,
- $7E97, $6EB6, $5ED5, $4EF4, $3E13, $2E32, $1E51, $0E70,
- $FF9F, $EFBE, $DFDD, $CFFC, $BF1B, $AF3A, $9F59, $8F78,
- $9188, $81A9, $B1CA, $A1EB, $D10C, $C12D, $F14E, $E16F,
- $1080, $00A1, $30C2, $20E3, $5004, $4025, $7046, $6067,
- $83B9, $9398, $A3FB, $B3DA, $C33D, $D31C, $E37F, $F35E,
- $02B1, $1290, $22F3, $32D2, $4235, $5214, $6277, $7256,
- $B5EA, $A5CB, $95A8, $8589, $F56E, $E54F, $D52C, $C50D,
- $34E2, $24C3, $14A0, $0481, $7466, $6447, $5424, $4405,
- $A7DB, $B7FA, $8799, $97B8, $E75F, $F77E, $C71D, $D73C,
- $26D3, $36F2, $0691, $16B0, $6657, $7676, $4615, $5634,
- $D94C, $C96D, $F90E, $E92F, $99C8, $89E9, $B98A, $A9AB,
- $5844, $4865, $7806, $6827, $18C0, $08E1, $3882, $28A3,
- $CB7D, $DB5C, $EB3F, $FB1E, $8BF9, $9BD8, $ABBB, $BB9A,
- $4A75, $5A54, $6A37, $7A16, $0AF1, $1AD0, $2AB3, $3A92,
- $FD2E, $ED0F, $DD6C, $CD4D, $BDAA, $AD8B, $9DE8, $8DC9,
- $7C26, $6C07, $5C64, $4C45, $3CA2, $2C83, $1CE0, $0CC1,
- $EF1F, $FF3E, $CF5D, $DF7C, $AF9B, $BFBA, $8FD9, $9FF8,
- $6E17, $7E36, $4E55, $5E74, $2E93, $3EB2, $0ED1, $1EF0
- );
- Crc16Start: Cardinal = $FFFF;
-
-const
- Crc16Bits = 16;
- Crc16Bytes = 2;
- Crc16HighBit = $8000;
- NotCrc16HighBit = $7FFF;
-
-function Crc16Corr(Crc: Word; N: Integer): Integer;
-var
I: Integer;
// CrcX : Cardinal;
begin
@@ -3725,11 +3802,11 @@
// Result >= 0 No. of faulty data bit
end;
-function Crc16_P(X: PJclByteArray; N: Integer; Crc: Word = 0): Word;
+function Crc16_P(const Crc16Table: TCrc16Table; X: PJclByteArray; N: Integer; Crc: Word): Word;
var
I: Integer;
begin
- Result := Crc16Start;
+ Result := Crc16DefaultStart;
for I := 0 to N - 1 do // The CRC Bytes are located at the end of the information
// a 16 bit value shr 8 is a Byte, explictit type conversion to Byte adds an ASM instruction
Result := Crc16Table[Result shr (CRC16Bits - 8)] xor Word((Result shl 8)) xor X[I];
@@ -3741,18 +3818,23 @@
end;
end;
-function CheckCrc16_P(X: PJclByteArray; N: Integer; Crc: Word): Integer;
+function Crc16_P(X: PJclByteArray; N: Integer; Crc: Word): Word;
+begin
+ Result := Crc16_P(Crc16DefaultTable, X, N, Crc);
+end;
+
+function CheckCrc16_P(const Crc16Table: TCrc16Table; X: PJclByteArray; N: Integer; Crc: Word): Integer;
// checks and corrects a single bit in up to 2^15-16 Bit -> 2^12-2 = 4094 Byte
var
I, J: Integer;
C: Byte;
begin
- Crc := Crc16_P(X, N, Crc);
+ Crc := Crc16_P(Crc16Table, X, N, Crc);
if Crc = 0 then
Result := 0 // No CRC-error
else
begin
- J := Crc16Corr(Crc, N);
+ J := Crc16Corr(Crc16Table, Crc, N);
if J < -(Crc16Bytes * 8 + 1) then
Result := -1 // non-correctable error (more than one wrong bit)
else
@@ -3771,43 +3853,83 @@
end;
end;
-function Crc16(const X: array of Byte; N: Integer; Crc: Word = 0): Word;
+function CheckCrc16_P(X: PJclByteArray; N: Integer; Crc: Word): Integer;
begin
+ Result := CheckCrc16_P(Crc16DefaultTable, X, N, Crc);
+end;
+
+function Crc16(const Crc16Table: TCrc16Table; const X: array of Byte; N: Integer; Crc: Word): Word;
+begin
{$IFDEF CLR}
- Result := Crc16_P(X, N, Crc);
- {$ELSE}
- Result := Crc16_P(@X, N, Crc);
- {$ENDIF CLR}
+ Result := Crc16_P(Crc16Table, X, N, Crc);
+ {$ELSE ~CLR}
+ Result := Crc16_P(Crc16Table, @X, N, Crc);
+ {$ENDIF ~CLR}
end;
+function Crc16(const X: array of Byte; N: Integer; Crc: Word): Word;
+begin
+ {$IFDEF CLR}
+ Result := Crc16_P(Crc16DefaultTable, X, N, Crc);
+ {$ELSE ~CLR}
+ Result := Crc16_P(Crc16DefaultTable, @X, N, Crc);
+ {$ENDIF ~CLR}
+end;
+
+function CheckCrc16(const Crc16Table: TCrc16Table; var X: array of Byte; N: Integer; Crc: Word): Integer;
+begin
+ {$IFDEF CLR}
+ Result := CheckCRC16_P(Crc16Table, X, N, CRC);
+ {$ELSE ~CLR}
+ Result := CheckCRC16_P(Crc16Table, @X, N, CRC);
+ {$ENDIF ~CLR}
+end;
+
function CheckCrc16(var X: array of Byte; N: Integer; Crc: Word): Integer;
begin
{$IFDEF CLR}
- Result := CheckCRC16_P(X, N, CRC);
- {$ELSE}
- Result := CheckCRC16_P(@X, N, CRC);
- {$ENDIF CLR}
+ Result := CheckCRC16_P(Crc16DefaultTable, X, N, CRC);
+ {$ELSE ~CLR}
+ Result := CheckCRC16_P(Crc16DefaultTable, @X, N, CRC);
+ {$ENDIF ~CLR}
end;
-function Crc16_A(const X: array of Byte; Crc: Word = 0): Word;
+function Crc16_A(const Crc16Table: TCrc16Table; const X: array of Byte; Crc: Word): Word;
begin
{$IFDEF CLR}
- Result := Crc16_P(X, Length(X), Crc);
- {$ELSE}
- Result := Crc16_P(@X, Length(X), Crc);
- {$ENDIF CLR}
+ Result := Crc16_P(Crc16Table, X, Length(X), Crc);
+ {$ELSE ~CLR}
+ Result := Crc16_P(Crc16Table, @X, Length(X), Crc);
+ {$ENDIF ~CLR}
end;
+function Crc16_A(const X: array of Byte; Crc: Word): Word;
+begin
+ {$IFDEF CLR}
+ Result := Crc16_P(Crc16DefaultTable, X, Length(X), Crc);
+ {$ELSE ~CLR}
+ Result := Crc16_P(Crc16DefaultTable, @X, Length(X), Crc);
+ {$ENDIF ~CLR}
+end;
+
+function CheckCrc16_A(const Crc16Table: TCrc16Table; var X: array of Byte; Crc: Word): Integer;
+begin
+ {$IFDEF CLR}
+ Result := CheckCrc16_P(Crc16Table, X, Length(X), Crc);
+ {$ELSE ~CLR}
+ Result := CheckCrc16_P(Crc16Table, @X, Length(X), Crc);
+ {$ENDIF ~CLR}
+end;
+
function CheckCrc16_A(var X: array of Byte; Crc: Word): Integer;
begin
{$IFDEF CLR}
- Result := CheckCrc16_P(X, Length(X), Crc);
- {$ELSE}
- Result := CheckCrc16_P(@X, Length(X), Crc);
- {$ENDIF CLR}
+ Result := CheckCrc16_P(Crc16DefaultTable, X, Length(X), Crc);
+ {$ELSE ~CLR}
+ Result := CheckCrc16_P(Crc16DefaultTable, @X, Length(X), Crc);
+ {$ENDIF ~CLR}
end;
-{$IFDEF CRCINIT}
// The CRC Table can be generated like this:
// const Crc16Start0 = 0; !!
@@ -3844,7 +3966,7 @@
Result := Sr;
end;
-procedure InitCrc16(Polynom, Start: Word);
+procedure InitCrc16(Polynom, Start: Word; out Crc16Table: TCrc16Table);
var
X: array [0..0] of Byte;
I: Integer;
@@ -3854,63 +3976,18 @@
X[0] := I;
Crc16Table[I] := Crc16_Bitwise(@X, 1, 0, Polynom); { only with crcstart=0 !!!!}
end;
- Crc16Start := Start;
+ Crc16DefaultStart := Start;
end;
-{$ENDIF CRCINIT}
+procedure InitCrc16(Polynom, Start: Word);
+begin
+ InitCrc16(Polynom, Start, Crc16DefaultTable);
+end;
// CRC 32
-{$IFDEF CRCINIT}
+function Crc32Corr(const Crc32Table: TCrc32Table; Crc: Cardinal; N: Integer): Integer;
var
-{$ELSE}
-const
-{$ENDIF CRCINIT}
- // CRC32Polynom = $04C11DB7;
- Crc32Table: array [0..255] of Cardinal = (
- $00000000, $04C11DB7, $09823B6E, $0D4326D9, $130476DC, $17C56B6B, $1A864DB2, $1E475005,
- $2608EDB8, $22C9F00F, $2F8AD6D6, $2B4BCB61, $350C9B64, $31CD86D3, $3C8EA00A, $384FBDBD,
- $4C11DB70, $48D0C6C7, $4593E01E, $4152FDA9, $5F15ADAC, $5BD4B01B, $569796C2, $52568B75,
- $6A1936C8, $6ED82B7F, $639B0DA6, $675A1011, $791D4014, $7DDC5DA3, $709F7B7A, $745E66CD,
- $9823B6E0, $9CE2AB57, $91A18D8E, $95609039, $8B27C03C, $8FE6DD8B, $82A5FB52, $8664E6E5,
- $BE2B5B58, $BAEA46EF, $B7A96036, $B3687D81, $AD2F2D84, $A9EE3033, $A4AD16EA, $A06C0B5D,
- $D4326D90, $D0F37027, $DDB056FE, $D9714B49, $C7361B4C, $C3F706FB, $CEB42022, $CA753D95,
- $F23A8028, $F6FB9D9F, $FBB8BB46, $FF79A6F1, $E13EF6F4, $E5FFEB43, $E8BCCD9A, $EC7DD02D,
- $34867077, $30476DC0, $3D044B19, $39C556AE, $278206AB, $23431B1C, $2E003DC5, $2AC12072,
- $128E9DCF, $164F8078, $1B0CA6A1, $1FCDBB16, $018AEB13, $054BF6A4, $0808D07D, $0CC9CDCA,
- $7897AB07, $7C56B6B0, $71159069, $75D48DDE, $6B93DDDB, $6F52C06C, $6211E6B5, $66D0FB02,
- $5E9F46BF, $5A5E5B08, $571D7DD1, $53DC6066, $4D9B3063, $495A2DD4, $44190B0D, $40D816BA,
- $ACA5C697, $A864DB20, $A527FDF9, $A1E6E04E, $BFA1B04B, $BB60ADFC, $B6238B25, $B2E29692,
- $8AAD2B2F, $8E6C3698, $832F1041, $87EE0DF6, $99A95DF3, $9D684044, $902B669D, $94EA7B2A,
- $E0B41DE7, $E4750050, $E9362689, $EDF73B3E, $F3B06B3B, $F771768C, $FA325055, $FEF34DE2,
- $C6BCF05F, $C27DEDE8, $CF3ECB31, $CBFFD686, $D5B88683, $D1799B34, $DC3ABDED, $D8FBA05A,
- $690CE0EE, $6DCDFD59, $608EDB80, $644FC637, $7A089632, $7EC98B85, $738AAD5C, $774BB0EB,
- $4F040D56, $4BC510E1, $46863638, $42472B8F, $5C007B8A, $58C1663D, $558240E4, $51435D53,
- $251D3B9E, $21DC2629, $2C9F00F0, $285E1D47, $36194D42, $32D850F5, $3F9B762C, $3B5A6B9B,
- $0315D626, $07D4CB91, $0A97ED48, $0E56F0FF, $1011A0FA, $14D0BD4D, $19939B94, $1D528623,
- $F12F560E, $F5EE4BB9, $F8AD6D60, $FC6C70D7, $E22B20D2, $E6EA3D65, $EBA91BBC, $EF68060B,
- $D727BBB6, $D3E6A601, $DEA580D8, $DA649D6F, $C423CD6A, $C0E2D0DD, $CDA1F604, $C960EBB3,
- $BD3E8D7E, $B9FF90C9, $B4BCB610, $B07DABA7, $AE3AFBA2, $AAFBE615, $A7B8C0CC, $A379DD7B,
- $9B3660C6, $9FF77D71, $92B45BA8, $9675461F, $8832161A, $8CF30BAD, $81B02D74, $857130C3,
- $5D8A9099, $594B8D2E, $5408ABF7, $50C9B640, $4E8EE645, $4A4FFBF2, $470CDD2B, $43CDC09C,
- $7B827D21, $7F436096, $7200464F, $76C15BF8, $68860BFD, $6C47164A, $61043093, $65C52D24,
- $119B4BE9, $155A565E, $18197087, $1CD86D30, $029F3D35, $065E2082, $0B1D065B, $0FDC1BEC,
- $3793A651, $3352BBE6, $3E119D3F, $3AD08088, $2497D08D, $2056CD3A, $2D15EBE3, $29D4F654,
- $C5A92679, $C1683BCE, $CC2B1D17, $C8EA00A0, $D6AD50A5, $D26C4D12, $DF2F6BCB, $DBEE767C,
- $E3A1CBC1, $E760D676, $EA23F0AF, $EEE2ED18, $F0A5BD1D, $F464A0AA, $F9278673, $FDE69BC4,
- $89B8FD09, $8D79E0BE, $803AC667, $84FBDBD0, $9ABC8BD5, $9E7D9662, $933EB0BB, $97FFAD0C,
- $AFB010B1, $AB710D06, $A6322BDF, $A2F33668, $BCB4666D, $B8757BDA, $B5365D03, $B1F740B4
- );
- Crc32Start: Cardinal = $FFFFFFFF;
-
-const
- Crc32Bits = 32;
- Crc32Bytes = 4;
- Crc32HighBit = $80000000;
- NotCrc32HighBit = $7FFFFFFF;
-
-function Crc32Corr(Crc: Cardinal; N: Integer): Integer;
-var
I: Integer;
begin
// calculate Syndrome
@@ -3936,16 +4013,14 @@
// Result >= 0 No. of faulty data bit
end;
-function Crc32_P(X: PJclByteArray; N: Integer; Crc: Cardinal = 0): Cardinal;
+function Crc32_P(const Crc32Table: TCrc32Table; X: PJclByteArray; N: Integer; Crc: Cardinal): Cardinal;
var
I: Integer;
begin
- Result := Crc32Start;
+ Result := Crc16DefaultStart;
for I := 0 to N - 1 do // The CRC Bytes are located at the end of the information
- begin
// a 32 bit value shr 24 is a Byte, explictit type conversion to Byte adds an ASM instruction
Result := Crc32Table[Result shr (CRC32Bits-8)] xor (Result shl 8) xor X[I];
- end;
for I := 0 to Crc32Bytes - 1 do
begin
// a 32 bit value shr 24 is a Byte, explictit type conversion to Byte adds an ASM instruction
@@ -3954,18 +4029,23 @@
end;
end;
-function CheckCrc32_P(X: PJclByteArray; N: Integer; Crc: Cardinal): Integer;
+function Crc32_P(X: PJclByteArray; N: Integer; Crc: Cardinal): Cardinal;
+begin
+ Result := Crc32_P(Crc32DefaultTable, X, N, Crc);
+end;
+
+function CheckCrc32_P(const Crc32Table: TCrc32Table; X: PJclByteArray; N: Integer; Crc: Cardinal): Integer;
// checks and corrects a single bit in up to 2^31-32 Bit -> 2^28-4 = 268435452 Byte
var
I, J: Integer;
C: Byte;
begin
- Crc := Crc32_P(X, N, Crc);
+ Crc := Crc32_P(Crc32Table, X, N, Crc);
if Crc = 0 then
Result := 0 // No CRC-error
else
begin
- J := Crc32Corr(Crc, N);
+ J := Crc32Corr(Crc32Table, Crc, N);
if J < -(Crc32Bytes * 8 + 1) then
Result := -1 // non-correctable error (more than one wrong bit)
else
@@ -3984,43 +4064,83 @@
end;
end;
-function Crc32(const X: array of Byte; N: Integer; Crc: Cardinal = 0): Cardinal;
+function CheckCrc32_P(X: PJclByteArray; N: Integer; Crc: Cardinal): Integer;
begin
+ Result := CheckCrc32_P(Crc32DefaultTable, X, N, Crc);
+end;
+
+function Crc32(const Crc32Table: TCrc32Table; const X: array of Byte; N: Integer; Crc: Cardinal): Cardinal;
+begin
{$IFDEF CLR}
- Result := Crc32_P(X, N, Crc);
+ Result := Crc32_P(Crc32Table, X, N, Crc);
{$ELSE}
- Result := Crc32_P(@X, N, Crc);
+ Result := Crc32_P(Crc32Table, @X, N, Crc);
{$ENDIF CLR}
end;
+function Crc32(const X: array of Byte; N: Integer; Crc: Cardinal): Cardinal;
+begin
+ {$IFDEF CLR}
+ Result := Crc32_P(Crc32DefaultTable, X, N, Crc);
+ {$ELSE}
+ Result := Crc32_P(Crc32DefaultTable, @X, N, Crc);
+ {$ENDIF CLR}
+end;
+
+function CheckCrc32(const Crc32Table: TCrc32Table; var X: array of Byte; N: Integer; Crc: Cardinal): Integer;
+begin
+ {$IFDEF CLR}
+ Result := CheckCRC32_P(Crc32Table, X, N, CRC);
+ {$ELSE}
+ Result := CheckCRC32_P(Crc32Table, @X, N, CRC);
+ {$ENDIF CLR}
+end;
+
function CheckCrc32(var X: array of Byte; N: Integer; Crc: Cardinal): Integer;
begin
{$IFDEF CLR}
- Result := CheckCRC32_P(X, N, CRC);
+ Result := CheckCRC32_P(Crc32DefaultTable, X, N, CRC);
{$ELSE}
- Result := CheckCRC32_P(@X, N, CRC);
+ Result := CheckCRC32_P(Crc32DefaultTable, @X, N, CRC);
{$ENDIF CLR}
end;
-function Crc32_A(const X: array of Byte; Crc: Cardinal = 0): Cardinal;
+function Crc32_A(const Crc32Table: TCrc32Table; const X: array of Byte; Crc: Cardinal): Cardinal;
begin
{$IFDEF CLR}
- Result := Crc32_P(X, Length(X), Crc);
+ Result := Crc32_P(Crc32Table, X, Length(X), Crc);
{$ELSE}
- Result := Crc32_P(@X, Length(X), Crc);
+ Result := Crc32_P(Crc32Table, @X, Length(X), Crc);
{$ENDIF CLR}
end;
+function Crc32_A(const X: array of Byte; Crc: Cardinal): Cardinal;
+begin
+ {$IFDEF CLR}
+ Result := Crc32_P(Crc32DefaultTable, X, Length(X), Crc);
+ {$ELSE}
+ Result := Crc32_P(Crc32DefaultTable, @X, Length(X), Crc);
+ {$ENDIF CLR}
+end;
+
+function CheckCrc32_A(const Crc32Table: TCrc32Table; var X: array of Byte; Crc: Cardinal): Integer;
+begin
+ {$IFDEF CLR}
+ Result := CheckCrc32_P(Crc32Table, X, Length(X), Crc);
+ {$ELSE}
+ Result := CheckCrc32_P(Crc32Table, @X, Length(X), Crc);
+ {$ENDIF CLR}
+end;
+
function CheckCrc32_A(var X: array of Byte; Crc: Cardinal): Integer;
begin
{$IFDEF CLR}
- Result := CheckCrc32_P(X, Length(X), Crc);
+ Result := CheckCrc32_P(Crc32DefaultTable, X, Length(X), Crc);
{$ELSE}
- Result := CheckCrc32_P(@X, Length(X), Crc);
+ Result := CheckCrc32_P(Crc32DefaultTable, @X, Length(X), Crc);
{$ENDIF CLR}
end;
-{$IFDEF CRCINIT}
// The CRC Table can be generated like this:
// const Crc32Start0 = 0; !!
@@ -4058,7 +4178,7 @@
Result := Sr;
end;
-procedure InitCrc32(Polynom, Start: Cardinal);
+procedure InitCrc32(Polynom, Start: Cardinal; out Crc32Table: TCrc32Table);
var
X: array [0..0] of Byte;
I: Integer;
@@ -4068,10 +4188,13 @@
X[0] := I;
Crc32Table[I] := Crc32_Bitwise(@X, 1, 0, Polynom);
end;
- Crc32Start := Start;
+ Crc32DefaultStart := Start;
end;
-{$ENDIF CRCINIT}
+procedure InitCrc32(Polynom, Start: Cardinal);
+begin
+ InitCrc32(Polynom, Start, Crc32DefaultTable);
+end;
//=== complex numbers support ================================================
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ou...@us...> - 2008-12-10 13:24:55
|
Revision: 2568
http://jcl.svn.sourceforge.net/jcl/?rev=2568&view=rev
Author: outchy
Date: 2008-12-10 13:24:52 +0000 (Wed, 10 Dec 2008)
Log Message:
-----------
Added removal of log files after Help 2.0 files are generated.
Modified Paths:
--------------
trunk/thirdparty/makedist/JclFiles.xml
trunk/thirdparty/makedist/JclTesting.xml
Modified: trunk/thirdparty/makedist/JclFiles.xml
===================================================================
--- trunk/thirdparty/makedist/JclFiles.xml 2008-12-10 13:20:31 UTC (rev 2567)
+++ trunk/thirdparty/makedist/JclFiles.xml 2008-12-10 13:24:52 UTC (rev 2568)
@@ -403,7 +403,7 @@
</action>
<action classname="TFileRemover">
<configuration index="0" caption="Directory" value="sandbox\jcl\help"/>
- <configuration index="1" caption="Filter" value="*.html;*.css;*.js;*.gif;*.jpg;*.png;*.c;*.h;*.inc"/>
+ <configuration index="1" caption="Filter" value="*.html;*.css;*.js;*.gif;*.jpg;*.png;*.c;*.h;*.inc;*.log"/>
<configuration index="2" caption="Move to recycle bin" value="no"/>
</action>
<action classname="TArchiveMaker">
Modified: trunk/thirdparty/makedist/JclTesting.xml
===================================================================
--- trunk/thirdparty/makedist/JclTesting.xml 2008-12-10 13:20:31 UTC (rev 2567)
+++ trunk/thirdparty/makedist/JclTesting.xml 2008-12-10 13:24:52 UTC (rev 2568)
@@ -317,7 +317,7 @@
</action>
<action classname="TFileRemover">
<configuration index="0" caption="Directory" value="sandbox\jcl\help"/>
- <configuration index="1" caption="Filter" value="*.html;*.css;*.js;*.gif;*.jpg;*.png;*.c;*.h;*.inc"/>
+ <configuration index="1" caption="Filter" value="*.html;*.css;*.js;*.gif;*.jpg;*.png;*.c;*.h;*.inc;*.log"/>
<configuration index="2" caption="Move to recycle bin" value="no"/>
</action>
<action classname="TArchiveMaker">
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ou...@us...> - 2008-12-10 13:20:33
|
Revision: 2567
http://jcl.svn.sourceforge.net/jcl/?rev=2567&view=rev
Author: outchy
Date: 2008-12-10 13:20:31 +0000 (Wed, 10 Dec 2008)
Log Message:
-----------
Regenerated script file.
Modified Paths:
--------------
trunk/thirdparty/makedist/JclFiles.xml
Modified: trunk/thirdparty/makedist/JclFiles.xml
===================================================================
--- trunk/thirdparty/makedist/JclFiles.xml 2008-12-10 13:17:54 UTC (rev 2566)
+++ trunk/thirdparty/makedist/JclFiles.xml 2008-12-10 13:20:31 UTC (rev 2567)
@@ -10,6 +10,7 @@
<configuration index="1" caption="Working directory" value="sandbox"/>
<configuration index="2" caption="Parameters" value="export -rBASE --native-eol CRLF --force ..\..\..\jcl\ ."/>
<configuration index="3" caption="Valid exit codes" value=""/>
+ <configuration index="4" caption="Result file" value=""/>
</action>
<action classname="TConstantParser">
<configuration index="0" caption="Source file" value="sandbox\source\common\JclBase.pas"/>
@@ -36,6 +37,7 @@
<configuration index="1" caption="Working directory" value="sandbox\devtools\"/>
<configuration index="2" caption="Parameters" value="/C included_files.bat"/>
<configuration index="3" caption="Valid exit codes" value=""/>
+ <configuration index="4" caption="Result file" value=""/>
</action>
<action classname="TArchiveMaker">
<configuration index="0" caption="Directory" value="sandbox"/>
@@ -61,6 +63,7 @@
<configuration index="1" caption="Working directory" value="sandbox"/>
<configuration index="2" caption="Parameters" value="export -rBASE --native-eol LF --force ..\..\..\jcl\ ."/>
<configuration index="3" caption="Valid exit codes" value=""/>
+ <configuration index="4" caption="Result file" value=""/>
</action>
<action classname="TConstantParser">
<configuration index="0" caption="Source file" value="sandbox\source\common\JclBase.pas"/>
@@ -87,6 +90,7 @@
<configuration index="1" caption="Working directory" value="sandbox\devtools\"/>
<configuration index="2" caption="Parameters" value="/C included_files.bat"/>
<configuration index="3" caption="Valid exit codes" value=""/>
+ <configuration index="4" caption="Result file" value=""/>
</action>
<action classname="TArchiveMaker">
<configuration index="0" caption="Directory" value="sandbox"/>
@@ -122,6 +126,7 @@
<configuration index="1" caption="Working directory" value="sandbox"/>
<configuration index="2" caption="Parameters" value="export -rBASE --native-eol CRLF --force ..\..\..\jcl\ ."/>
<configuration index="3" caption="Valid exit codes" value=""/>
+ <configuration index="4" caption="Result file" value=""/>
</action>
<action classname="TConstantParser">
<configuration index="0" caption="Source file" value="sandbox\source\common\JclBase.pas"/>
@@ -148,30 +153,35 @@
<configuration index="1" caption="Working directory" value="sandbox\devtools\"/>
<configuration index="2" caption="Parameters" value="/C included_files.bat"/>
<configuration index="3" caption="Valid exit codes" value=""/>
+ <configuration index="4" caption="Result file" value=""/>
</action>
<action classname="TCommandLineCaller">
<configuration index="0" caption="Application" value="..\devtools\jpp.exe"/>
<configuration index="1" caption="Working directory" value="sandbox\install"/>
<configuration index="2" caption="Parameters" value="-c -dVCL -dMSWINDOWS -uVisualCLX -uUnix -uKYLIX -xVclGui\ prototypes\JediGUIMain.pas"/>
<configuration index="3" caption="Valid exit codes" value=""/>
+ <configuration index="4" caption="Result file" value=""/>
</action>
<action classname="TCommandLineCaller">
<configuration index="0" caption="Application" value="..\devtools\jpp.exe"/>
<configuration index="1" caption="Working directory" value="sandbox\install"/>
<configuration index="2" caption="Parameters" value="-c -dVCL -dMSWINDOWS -uVisualCLX -uUnix -uKYLIX -xVclGui\ prototypes\JediGUIReadme.pas"/>
<configuration index="3" caption="Valid exit codes" value=""/>
+ <configuration index="4" caption="Result file" value=""/>
</action>
<action classname="TCommandLineCaller">
<configuration index="0" caption="Application" value="..\devtools\jpp.exe"/>
<configuration index="1" caption="Working directory" value="sandbox\install"/>
<configuration index="2" caption="Parameters" value="-c -dVCL -dMSWINDOWS -uVisualCLX -uUnix -uKYLIX -xVclGui\ prototypes\JediGUIInstall.pas"/>
<configuration index="3" caption="Valid exit codes" value=""/>
+ <configuration index="4" caption="Result file" value=""/>
</action>
<action classname="TCommandLineCaller">
<configuration index="0" caption="Application" value="%DCC2006%"/>
<configuration index="1" caption="Working directory" value="sandbox\install"/>
<configuration index="2" caption="Parameters" value="-q -w -dJCLINSTALL -E..\bin -I..\source -U..\source\common;..\source\windows JediInstaller.dpr"/>
<configuration index="3" caption="Valid exit codes" value=""/>
+ <configuration index="4" caption="Result file" value=""/>
</action>
<action classname="TFileMover">
<configuration index="0" caption="Old file name" value="sandbox\Install turbo delphi.bat"/>
@@ -201,6 +211,7 @@
<configuration index="1" caption="Working directory" value="sandbox"/>
<configuration index="2" caption="Parameters" value="export -rBASE --native-eol CRLF --force ..\..\..\ ."/>
<configuration index="3" caption="Valid exit codes" value=""/>
+ <configuration index="4" caption="Result file" value=""/>
</action>
<action classname="TConstantParser">
<configuration index="0" caption="Source file" value="sandbox\jcl\source\common\JclBase.pas"/>
@@ -227,6 +238,7 @@
<configuration index="1" caption="Working directory" value="sandbox\jcl\devtools\"/>
<configuration index="2" caption="Parameters" value="/C included_files.bat"/>
<configuration index="3" caption="Valid exit codes" value=""/>
+ <configuration index="4" caption="Result file" value=""/>
</action>
<action classname="TDirectoryCreator">
<configuration index="0" caption="Directory" value="sandbox\jcl\help\html"/>
@@ -236,6 +248,7 @@
<configuration index="1" caption="Working directory" value="sandbox\help"/>
<configuration index="2" caption="Parameters" value="-config "HTML" -noshow -w3 JclHelp.dox"/>
<configuration index="3" caption="Valid exit codes" value="0;20;30"/>
+ <configuration index="4" caption="Result file" value=""/>
</action>
<action classname="TArchiveMaker">
<configuration index="0" caption="Directory" value="sandbox\jcl"/>
@@ -281,6 +294,7 @@
<configuration index="1" caption="Working directory" value="sandbox"/>
<configuration index="2" caption="Parameters" value="export -rBASE --native-eol CRLF --force ..\..\..\ ."/>
<configuration index="3" caption="Valid exit codes" value=""/>
+ <configuration index="4" caption="Result file" value=""/>
</action>
<action classname="TConstantParser">
<configuration index="0" caption="Source file" value="sandbox\jcl\source\common\JclBase.pas"/>
@@ -307,6 +321,7 @@
<configuration index="1" caption="Working directory" value="sandbox\jcl\devtools\"/>
<configuration index="2" caption="Parameters" value="/C included_files.bat"/>
<configuration index="3" caption="Valid exit codes" value=""/>
+ <configuration index="4" caption="Result file" value=""/>
</action>
<action classname="TDirectoryCreator">
<configuration index="0" caption="Directory" value="sandbox\jcl\help"/>
@@ -316,6 +331,7 @@
<configuration index="1" caption="Working directory" value="sandbox\help"/>
<configuration index="2" caption="Parameters" value="-config "CHM" -noshow -w3 JclHelp.dox"/>
<configuration index="3" caption="Valid exit codes" value="0;20;30"/>
+ <configuration index="4" caption="Result file" value=""/>
</action>
<action classname="TFileRemover">
<configuration index="0" caption="Directory" value="sandbox\jcl\help"/>
@@ -346,6 +362,7 @@
<configuration index="1" caption="Working directory" value="sandbox"/>
<configuration index="2" caption="Parameters" value="export -rBASE --native-eol CRLF --force ..\..\..\ ."/>
<configuration index="3" caption="Valid exit codes" value=""/>
+ <configuration index="4" caption="Result file" value=""/>
</action>
<action classname="TConstantParser">
<configuration index="0" caption="Source file" value="sandbox\jcl\source\common\JclBase.pas"/>
@@ -372,6 +389,7 @@
<configuration index="1" caption="Working directory" value="sandbox\jcl\devtools\"/>
<configuration index="2" caption="Parameters" value="/C included_files.bat"/>
<configuration index="3" caption="Valid exit codes" value=""/>
+ <configuration index="4" caption="Result file" value=""/>
</action>
<action classname="TDirectoryCreator">
<configuration index="0" caption="Directory" value="sandbox\jcl\help"/>
@@ -381,6 +399,7 @@
<configuration index="1" caption="Working directory" value="sandbox\help"/>
<configuration index="2" caption="Parameters" value="-config "H2" -noshow -w3 JclHelp.dox"/>
<configuration index="3" caption="Valid exit codes" value="0;20;30"/>
+ <configuration index="4" caption="Result file" value=""/>
</action>
<action classname="TFileRemover">
<configuration index="0" caption="Directory" value="sandbox\jcl\help"/>
@@ -411,6 +430,7 @@
<configuration index="1" caption="Working directory" value="sandbox"/>
<configuration index="2" caption="Parameters" value="export -rBASE --native-eol CRLF --force ..\..\..\ ."/>
<configuration index="3" caption="Valid exit codes" value=""/>
+ <configuration index="4" caption="Result file" value=""/>
</action>
<action classname="TConstantParser">
<configuration index="0" caption="Source file" value="sandbox\jcl\source\common\JclBase.pas"/>
@@ -437,6 +457,7 @@
<configuration index="1" caption="Working directory" value="sandbox\jcl\devtools\"/>
<configuration index="2" caption="Parameters" value="/C included_files.bat"/>
<configuration index="3" caption="Valid exit codes" value=""/>
+ <configuration index="4" caption="Result file" value=""/>
</action>
<action classname="TDirectoryCreator">
<configuration index="0" caption="Directory" value="sandbox\jcl\help"/>
@@ -446,6 +467,7 @@
<configuration index="1" caption="Working directory" value="sandbox\help"/>
<configuration index="2" caption="Parameters" value="-config "HLP" -noshow -w3 JclHelp.dox"/>
<configuration index="3" caption="Valid exit codes" value="0;20;30"/>
+ <configuration index="4" caption="Result file" value=""/>
</action>
<action classname="TArchiveMaker">
<configuration index="0" caption="Directory" value="sandbox\jcl"/>
@@ -471,6 +493,7 @@
<configuration index="1" caption="Working directory" value="sandbox"/>
<configuration index="2" caption="Parameters" value="export -rBASE --native-eol CRLF --force ..\..\..\ ."/>
<configuration index="3" caption="Valid exit codes" value=""/>
+ <configuration index="4" caption="Result file" value=""/>
</action>
<action classname="TConstantParser">
<configuration index="0" caption="Source file" value="sandbox\jcl\source\common\JclBase.pas"/>
@@ -497,6 +520,7 @@
<configuration index="1" caption="Working directory" value="sandbox\jcl\devtools\"/>
<configuration index="2" caption="Parameters" value="/C included_files.bat"/>
<configuration index="3" caption="Valid exit codes" value=""/>
+ <configuration index="4" caption="Result file" value=""/>
</action>
<action classname="TDirectoryCreator">
<configuration index="0" caption="Directory" value="sandbox\jcl\help"/>
@@ -506,6 +530,7 @@
<configuration index="1" caption="Working directory" value="sandbox\help"/>
<configuration index="2" caption="Parameters" value="-config "XML" -noshow -w3 JclHelp.dox"/>
<configuration index="3" caption="Valid exit codes" value="0;20;30"/>
+ <configuration index="4" caption="Result file" value=""/>
</action>
<action classname="TArchiveMaker">
<configuration index="0" caption="Directory" value="sandbox\jcl"/>
@@ -531,6 +556,7 @@
<configuration index="1" caption="Working directory" value="sandbox"/>
<configuration index="2" caption="Parameters" value="export -rBASE --native-eol CRLF --force ..\..\..\ ."/>
<configuration index="3" caption="Valid exit codes" value=""/>
+ <configuration index="4" caption="Result file" value=""/>
</action>
<action classname="TConstantParser">
<configuration index="0" caption="Source file" value="sandbox\jcl\source\common\JclBase.pas"/>
@@ -557,6 +583,7 @@
<configuration index="1" caption="Working directory" value="sandbox\jcl\devtools\"/>
<configuration index="2" caption="Parameters" value="/C included_files.bat"/>
<configuration index="3" caption="Valid exit codes" value=""/>
+ <configuration index="4" caption="Result file" value=""/>
</action>
<action classname="TDirectoryCreator">
<configuration index="0" caption="Directory" value="sandbox\jcl\help"/>
@@ -566,6 +593,7 @@
<configuration index="1" caption="Working directory" value="sandbox\help"/>
<configuration index="2" caption="Parameters" value="-config "PDF" -noshow -w3 JclHelp.dox"/>
<configuration index="3" caption="Valid exit codes" value="0;20;30"/>
+ <configuration index="4" caption="Result file" value=""/>
</action>
<action classname="TArchiveMaker">
<configuration index="0" caption="Directory" value="sandbox\jcl"/>
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
49 messages has been excluded from this view by a project administrator.
![http://image.erlytdea.cn/tap.jpg"](http://image.erlytdea.cn/tap.jpg"){kind=link}
![http://jpg.vanoleruf.cn/bottom.jpg"](http://jpg.vanoleruf.cn/bottom.jpg"){kind=link}
![http://picture.jevokoboh.cn/rate.jpg"](http://picture.jevokoboh.cn/rate.jpg"){kind=link}