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-03-02 21:59:01
|
Revision: 2666
http://jcl.svn.sourceforge.net/jcl/?rev=2666&view=rev
Author: outchy
Date: 2009-03-02 21:58:52 +0000 (Mon, 02 Mar 2009)
Log Message:
-----------
TJclStringStream: new functions to read the entire stream and store the result to a string
Modified Paths:
--------------
trunk/jcl/source/common/JclStreams.pas
Modified: trunk/jcl/source/common/JclStreams.pas
===================================================================
--- trunk/jcl/source/common/JclStreams.pas 2009-03-02 21:55:53 UTC (rev 2665)
+++ trunk/jcl/source/common/JclStreams.pas 2009-03-02 21:58:52 UTC (rev 2666)
@@ -27,7 +27,7 @@
{ }
{**************************************************************************************************}
{ }
-{ Last modified: $Date:: $ }
+{ Last modified: $Date:: $ }
{ Revision: $Rev:: $ }
{ Author: $Author:: $ }
{ }
@@ -531,9 +531,12 @@
function GetCalcedSize: Int64; override;
public
constructor Create(AStream: TStream; AOwnsStream: Boolean = False); virtual;
- function ReadString(var Buffer: string; Start, Count: Longint): Longint;
- function ReadAnsiString(var Buffer: AnsiString; Start, Count: Longint): Longint;
- function ReadWideString(var Buffer: WideString; Start, Count: Longint): Longint;
+ function ReadString(var Buffer: string; Start, Count: Longint): Longint; overload;
+ function ReadString(BufferSize: Longint = 4096): string; overload;
+ function ReadAnsiString(var Buffer: AnsiString; Start, Count: Longint): Longint; overload;
+ function ReadAnsiString(BufferSize: Longint = 4096): AnsiString; overload;
+ function ReadWideString(var Buffer: WideString; Start, Count: Longint): Longint; overload;
+ function ReadWideString(BufferSize: Longint = 4096): WideString; overload;
function WriteString(const Buffer: string; Start, Count: Longint): Longint;
function WriteAnsiString(const Buffer: AnsiString; Start, Count: Longint): Longint;
function WriteWideString(const Buffer: WideString; Start, Count: Longint): Longint;
@@ -2869,6 +2872,20 @@
FPeekPosition := FPosition;
end;
+function TJclStringStream.ReadString(BufferSize: Longint): string;
+var
+ Buffer: string;
+ ProcessedLength: Longint;
+begin
+ Result := '';
+ SetLength(Buffer, BufferSize);
+ repeat
+ ProcessedLength := ReadString(Buffer, 1, BufferSize);
+ if ProcessedLength > 0 then
+ Result := Result + Copy(Buffer, 1, ProcessedLength);
+ until ProcessedLength = 0;
+end;
+
function TJclStringStream.ReadAnsiChar(var Buffer: AnsiChar): Boolean;
var
Ch: UCS4;
@@ -2902,6 +2919,20 @@
FPeekPosition := FPosition;
end;
+function TJclStringStream.ReadAnsiString(BufferSize: Longint): AnsiString;
+var
+ Buffer: AnsiString;
+ ProcessedLength: Longint;
+begin
+ Result := '';
+ SetLength(Buffer, BufferSize);
+ repeat
+ ProcessedLength := ReadAnsiString(Buffer, 1, BufferSize);
+ if ProcessedLength > 0 then
+ Result := Result + Copy(Buffer, 1, ProcessedLength);
+ until ProcessedLength = 0;
+end;
+
function TJclStringStream.ReadChar(var Buffer: Char): Boolean;
var
Ch: UCS4;
@@ -2945,6 +2976,20 @@
FPeekPosition := FPosition;
end;
+function TJclStringStream.ReadWideString(BufferSize: Longint): WideString;
+var
+ Buffer: WideString;
+ ProcessedLength: Longint;
+begin
+ Result := '';
+ SetLength(Buffer, BufferSize);
+ repeat
+ ProcessedLength := ReadWideString(Buffer, 1, BufferSize);
+ if ProcessedLength > 0 then
+ Result := Result + Copy(Buffer, 1, ProcessedLength);
+ until ProcessedLength = 0;
+end;
+
function TJclStringStream.SkipBOM: Longint;
var
Pos: Int64;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ou...@us...> - 2009-03-02 21:56:02
|
Revision: 2665
http://jcl.svn.sourceforge.net/jcl/?rev=2665&view=rev
Author: outchy
Date: 2009-03-02 21:55:53 +0000 (Mon, 02 Mar 2009)
Log Message:
-----------
Prototype update, possible Unicode failure.
Modified Paths:
--------------
trunk/jcl/source/prototypes/Hardlinks.pas
Modified: trunk/jcl/source/prototypes/Hardlinks.pas
===================================================================
--- trunk/jcl/source/prototypes/Hardlinks.pas 2009-03-02 06:16:36 UTC (rev 2664)
+++ trunk/jcl/source/prototypes/Hardlinks.pas 2009-03-02 21:55:53 UTC (rev 2665)
@@ -355,7 +355,7 @@
{$IFNDEF RTDL}
function RtlCreateUnicodeStringFromAsciiz(var destination: UNICODE_STRING;
- source: PChar): Boolean; stdcall; external szNtDll;
+ source: PAnsiChar): Boolean; stdcall; external szNtDll;
function ZwClose(Handle: THandle): NTSTATUS; stdcall; external szNtDll;
@@ -398,7 +398,7 @@
type
TRtlCreateUnicodeStringFromAsciiz = function(var destination: UNICODE_STRING;
- source: PChar): Boolean; stdcall;
+ source: PAnsiChar): Boolean; stdcall;
TZwClose = function(Handle: THandle): NTSTATUS; stdcall;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ou...@us...> - 2009-03-02 06:16:39
|
Revision: 2664
http://jcl.svn.sourceforge.net/jcl/?rev=2664&view=rev
Author: outchy
Date: 2009-03-02 06:16:36 +0000 (Mon, 02 Mar 2009)
Log Message:
-----------
Fixed compilation with latest JCL source code.
Modified Paths:
--------------
trunk/jpp/JppState.pas
Modified: trunk/jpp/JppState.pas
===================================================================
--- trunk/jpp/JppState.pas 2009-03-01 15:33:19 UTC (rev 2663)
+++ trunk/jpp/JppState.pas 2009-03-02 06:16:36 UTC (rev 2664)
@@ -241,7 +241,7 @@
if not Found then
for i := 0 to ASearchPath.Size - 1 do
begin
- fn := ASearchPath.Items[i] + PathDelim + AName;
+ fn := ASearchPath.Strings[i] + PathDelim + AName;
if FileExists(fn) then
begin
Found := True;
@@ -353,10 +353,10 @@
ADefines: IJclStrMap;
AMacros: IJclStrStrMap;
begin
- ADefines := (InternalPeekDefines as IJclIntfCloneable).Clone as IJclStrMap;
- AExcludedFiles := (InternalPeekExcludedFiles as IJclIntfCloneable).Clone as IJclStrList;
- ASearchPath := (InternalPeekSearchPath as IJclIntfCloneable).Clone as IJclStrList;
- AMacros := (InternalPeekMacros as IJclIntfCloneable).Clone as IJclStrStrMap;
+ ADefines := (InternalPeekDefines as IJclIntfCloneable).IntfClone as IJclStrMap;
+ AExcludedFiles := (InternalPeekExcludedFiles as IJclIntfCloneable).IntfClone as IJclStrList;
+ ASearchPath := (InternalPeekSearchPath as IJclIntfCloneable).IntfClone as IJclStrList;
+ AMacros := (InternalPeekMacros as IJclIntfCloneable).IntfClone as IJclStrStrMap;
InternalPushState(AExcludedFiles, ASearchPath, AMacros, ADefines);
end;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <jed...@us...> - 2009-03-01 15:33:23
|
Revision: 2663
http://jcl.svn.sourceforge.net/jcl/?rev=2663&view=rev
Author: jedi_mbe
Date: 2009-03-01 15:33:19 +0000 (Sun, 01 Mar 2009)
Log Message:
-----------
* Completed test suites for JclStrings
* Fixed some bugs in JclStrings routines
* Moved documentation for StrAnsiToOEM and StrOEMToAnsi from Strings.dtx to AnsiStrings.dtx
Modified Paths:
--------------
trunk/help/Strings.dtx
trunk/jcl/source/common/JclStrings.pas
trunk/qa/automated/dunit/units/TestJclStrings.pas
Added Paths:
-----------
trunk/help/AnsiStrings.dtx
Added: trunk/help/AnsiStrings.dtx
===================================================================
--- trunk/help/AnsiStrings.dtx (rev 0)
+++ trunk/help/AnsiStrings.dtx 2009-03-01 15:33:19 UTC (rev 2663)
@@ -0,0 +1,28 @@
+@@StrAnsiToOem
+<GROUP StringManipulation.StringTransformationRoutines>
+Summary:
+ Translates an ANSI string into a string using the OEM character set.
+Description:
+ The StrAnsiToOem function translates an ansi string into a string using the
+ OEM defined character set.
+Parameters:
+ S - The string to translate.
+Result:
+ The translated string.
+Donator:
+ Anonymous
+--------------------------------------------------------------------------------
+@@StrOemToAnsi
+<GROUP StringManipulation.StringTransformationRoutines>
+Summary:
+ Translates an OEM string into an ansi string.
+Description:
+ The StrOemToAnsi function translated a string using the OEM defined character set
+ into an ansi string.
+Parameters:
+ S - The string to translate.
+Result:
+ The translated string.
+Donator:
+ Anonymous
+--------------------------------------------------------------------------------
Modified: trunk/help/Strings.dtx
===================================================================
--- trunk/help/Strings.dtx 2009-03-01 11:57:08 UTC (rev 2662)
+++ trunk/help/Strings.dtx 2009-03-01 15:33:19 UTC (rev 2663)
@@ -1254,7 +1254,7 @@
Parameters:
S - The string in which to search for N occurences of SubStr.
SubStr - The sub-string to search for.
- Index - The number of occurences of sub-string in S.
+ N - The number of occurences of sub-string in S.
Result:
Index into S where the N-th occurence of SubStr is located. If SubStr has less
than N occurences in S the result is 0.
@@ -2377,34 +2377,6 @@
Donator:
Team JCL
--------------------------------------------------------------------------------
-@@StrAnsiToOem
-<GROUP StringManipulation.StringTransformationRoutines>
-Summary:
- Translates an ANSI string into a string using the OEM character set.
-Description:
- The StrAnsiToOem function translates an ansi string into a string using the
- OEM defined character set.
-Parameters:
- S - The string to translate.
-Result:
- The translated string.
-Donator:
- Anonymous
---------------------------------------------------------------------------------
-@@StrOemToAnsi
-<GROUP StringManipulation.StringTransformationRoutines>
-Summary:
- Translates an OEM string into an ansi string.
-Description:
- The StrOemToAnsi function translated a string using the OEM defined character set
- into an ansi string.
-Parameters:
- S - The string to translate.
-Result:
- The translated string.
-Donator:
- Anonymous
---------------------------------------------------------------------------------
@@StrCharsCount
<GROUP StringManipulation.StringTransformationRoutines>
Summary:
@@ -3974,4 +3946,5 @@
<c>a positive value</c> if S1 is greater than S2
Donator:
Marcel Bestebroer
+--------------------------------------------------------------------------------
Modified: trunk/jcl/source/common/JclStrings.pas
===================================================================
--- trunk/jcl/source/common/JclStrings.pas 2009-03-01 11:57:08 UTC (rev 2662)
+++ trunk/jcl/source/common/JclStrings.pas 2009-03-01 15:33:19 UTC (rev 2663)
@@ -158,7 +158,8 @@
type
TCharValidator = function(const C: Char): Boolean;
-function ArrayContainsChar(const Chars: array of Char; const C: Char): Boolean;
+function ArrayContainsChar(const Chars: array of Char; const C: Char): Boolean; overload;
+function ArrayContainsChar(const Chars: array of Char; const C: Char; out Index: Integer): Boolean; overload;
// String Test Routines
function StrIsAlpha(const S: string): Boolean;
@@ -1012,6 +1013,13 @@
{$ENDIF ~CLR}
function ArrayContainsChar(const Chars: array of Char; const C: Char): Boolean;
+var
+ idx: Integer;
+begin
+ Result := ArrayContainsChar(Chars, C, idx);
+end;
+
+function ArrayContainsChar(const Chars: array of Char; const C: Char; out Index: Integer): Boolean;
{ optimized version for sorted arrays
var
I, L, H: Integer;
@@ -1035,14 +1043,11 @@
end;
Result := False;
end;}
-var
- I: Integer;
begin
- Result := True;
- for I := Low(Chars) to High(Chars) do
- if Chars[I] = C then
- Exit;
- Result := False;
+ Index := High(Chars);
+ while (Index >= Low(Chars)) and (Chars[Index] <> C) do
+ Dec(Index);
+ Result := Index >= Low(Chars);
end;
// String Test Routines
@@ -1098,6 +1103,10 @@
Result := False;
if CheckAll then
begin
+ // this will not work with the current definition of the validator. The validator would need to check each character
+ // it requires against the string (which is currently not provided to the Validator). The current implementation of
+ // CheckAll will check if all characters in S will be accepted by the provided Validator, which is wrong and incon-
+ // sistent with the documentation and the array-based overload.
for I := 1 to Length(S) do
begin
Result := Chars(S[I]);
@@ -1120,18 +1129,19 @@
var
I: Integer;
begin
- Result := False;
if CheckAll then
begin
- for I := 1 to Length(S) do
+ Result := True;
+ I := High(Chars);
+ while (I >= 0) and Result do
begin
- Result := ArrayContainsChar(Chars, S[I]);
- if not Result then
- Break;
+ Result := CharPos(S, Chars[I]) > 0;
+ Dec(I);
end;
end
else
begin
+ Result := False;
for I := 1 to Length(S) do
begin
Result := ArrayContainsChar(Chars, S[I]);
@@ -3035,18 +3045,18 @@
{$ELSE ~CLR}
function StrFind(const Substr, S: string; const Index: Integer): Integer;
var
- Pos: PChar;
+ pos: Integer;
begin
if (SubStr <> '') and (S <> '') then
begin
- pos := StrPos(@S[Index], PChar(SubStr));
- if Pos = nil then
- result := 0
+ pos := StrIPos(Substr, Copy(S, Index, Length(S) - Index + 1));
+ if pos = 0 then
+ Result := 0
else
- Result := (Cardinal(Pos) - Cardinal(@S[1])) div SizeOf(Char) + 1;
+ Result := Index + Pos - 1;
end
else
- result := 0;
+ Result := 0;
end;
{$ENDIF ~CLR}
Modified: trunk/qa/automated/dunit/units/TestJclStrings.pas
===================================================================
--- trunk/qa/automated/dunit/units/TestJclStrings.pas 2009-03-01 11:57:08 UTC (rev 2662)
+++ trunk/qa/automated/dunit/units/TestJclStrings.pas 2009-03-01 15:33:19 UTC (rev 2663)
@@ -100,7 +100,6 @@
procedure _StrTrimCharsRight;
procedure _StrTrimQuotes;
procedure _StrUpper_StrUpperInPlace_StrUpperBuff;
- procedure _StrOemToAnsi_StrAnsiToOem;
end;
{ TJclStringManagment }
@@ -412,8 +411,24 @@
//--------------------------------------------------------------------------------------------------
+function ContainsValidator(const C: Char): Boolean;
+begin
+ Result := (C = 'g') or (C = 'r');
+end;
+
procedure TJclStringTransformation._StrContainsChars;
begin
+ CheckEquals(True, StrContainsChars('AbcdefghiJkl', ['g', 'r'], False), 'array, CheckAll set to False');
+ CheckEquals(False, StrContainsChars('AbcdefghiJkl', ['g', 'r'], True), 'array, CheckAll set to True, only 1 occurring');
+ CheckEquals(True, StrContainsChars('AbcdefghiJklr', ['g', 'r'], True), 'array, CheckAll set to True, both occurring');
+
+ CheckEquals(True, StrContainsChars('AbcdefghiJkl', ContainsValidator, False), 'validator, CheckAll set to False');
+ // CheckAll=True will not work with a validator, at least not with the same meaning as with the array-based tests.
+ // The tests are disabled for now.
+ {
+ CheckEquals(False, StrContainsChars('AbcdefghiJkl', ContainsValidator, True), 'validator, CheckAll set to True, only 1 occurring');
+ CheckEquals(True, StrContainsChars('AbcdefghiJklr', ContainsValidator, True), 'validator, CheckAll set to True, both occurring');
+ }
end;
//--------------------------------------------------------------------------------------------------
@@ -1159,8 +1174,8 @@
i,t: Integer;
s, s3, sn: string;
begin
- CheckEquals(StrTrimCharLeft('',#0),'','StrTrimCharLeft');
- CheckEquals(StrTrimCharLeft('AAAAAAAAAA','A'),'','StrTrimCharLeft');
+ CheckEquals('', StrTrimCharLeft('', #0), 'StrTrimCharLeft1');
+ CheckEquals('', StrTrimCharLeft('AAAAAAAAAA', 'A'), 'StrTrimCharLeft2');
GenerateAll(200, 2000, StringArray);
GenerateAll(1, 2000, StringArray2);
@@ -1182,14 +1197,25 @@
dec(t);
end;
- CheckEquals(StrTrimCharLeft(S3,SN[1]), S,'StrTrimCharLeft');
+ CheckEquals(S, StrTrimCharLeft(S3,SN[1]), 'StrTrimCharLeft3.' + IntToStr(i));
end;
end;
//--------------------------------------------------------------------------------------------------
+function TrimValidator(const C: Char): Boolean;
+begin
+ Result := (C = 'A') or (C = 'B');
+end;
+
procedure TJclStringTransformation._StrTrimCharsLeft;
begin
+ CheckEquals('', StrTrimCharsLeft('', []), 'empty str, empty array');
+ CheckEquals('ABC', StrTrimCharsLeft('ABC', []), 'non-empty str, empty array');
+ CheckEquals('BCA', StrTrimCharsLeft('ABCA', ['A']), 'ABCA str, A array');
+ CheckEquals('CA', StrTrimCharsLeft('ABCA', ['B', 'A']), 'ABCA str, BA array');
+
+ CheckEquals('CA', StrTrimCharsLeft('ABCA', TrimValidator), 'ABCA str, AB validator');
end;
//--------------------------------------------------------------------------------------------------
@@ -1201,8 +1227,8 @@
begin
// -- StrTrimCharRight --
- CheckEquals(StrTrimCharRight('',#0),'','StrTrimCharRight');
- CheckEquals(StrTrimCharRight('AAAAAAAAAA','A'),'','StrTrimCharRight');
+ CheckEquals('', StrTrimCharRight('', #0), 'StrTrimCharRight1');
+ CheckEquals('', StrTrimCharRight('AAAAAAAAAA', 'A'), 'StrTrimCharRight2');
GenerateAll(200, 2000, StringArray);
GenerateAll(1, 2000, StringArray2);
@@ -1224,7 +1250,7 @@
dec(t);
end;
- CheckEquals(StrTrimCharRight(S3,SN[1]), S,'StrTrimCharRight');
+ CheckEquals(S, StrTrimCharRight(S3, SN[1]), 'StrTrimCharRight3.' + IntToStr(i));
end;
end;
@@ -1232,6 +1258,12 @@
procedure TJclStringTransformation._StrTrimCharsRight;
begin
+ CheckEquals('', StrTrimCharsRight('', []), 'empty str, empty array');
+ CheckEquals('ABC', StrTrimCharsRight('ABC', []), 'non-empty str, empty array');
+ CheckEquals('ABC', StrTrimCharsRight('ABCA', ['A']), 'ABCA str, A array');
+ CheckEquals('AB', StrTrimCharsRight('ABCA', ['C', 'A']), 'ABCA str, CA array');
+
+ CheckEquals('ABC', StrTrimCharsRight('ABCAABA', TrimValidator), 'ABCAABA str, AB validator');
end;
//--------------------------------------------------------------------------------------------------
@@ -1288,10 +1320,6 @@
//--------------------------------------------------------------------------------------------------
-procedure TJclStringTransformation._StrOemToAnsi_StrAnsiToOem;
-begin
-end;
-
//==================================================================================================
// String Managment
//==================================================================================================
@@ -1611,8 +1639,9 @@
procedure TJclStringSearchandReplace._StrFind;
begin
- CheckEquals(0, StrFind('abc', 'Test'));
- CheckEquals(1, StrFind('Test', 'Test'));
+ CheckEquals(0, StrFind('abc', 'Test'), 'StrFind_1');
+ CheckEquals(1, StrFind('Test', 'Test'), 'StrFind_2');
+ CheckEquals(1, StrFind('Test', 'test'), 'StrFind_3');
end;
//--------------------------------------------------------------------------------------------------
@@ -1645,18 +1674,36 @@
procedure TJclStringSearchandReplace._StrIndex;
begin
+ CheckEquals(-1, StrIndex('', ['A', 'B']), 'Empty string in array of AB');
+ CheckEquals(-1, StrIndex('A', []), '''A'' string in empty array');
+ CheckEquals(0, StrIndex('A', ['A', 'B']), '''A'' string in array of AB, equal case');
+ CheckEquals(0, StrIndex('a', ['A', 'B']), '''A'' string in array of AB, differing case');
+ CheckEquals(1, StrIndex('B', ['A', 'B']), '''B'' string in array of AB, equal case');
+ CheckEquals(2, StrIndex('C', ['A', 'B', 'C', 'C']), '''C'' string in array of ABCC, equal case');
end;
//--------------------------------------------------------------------------------------------------
procedure TJclStringSearchandReplace._StrILastPos;
begin
+ CheckEquals(10, StrILastPos('A', 'aaaaaaaaaa'), 'StrILastPos_1');
+ CheckEquals(16, StrILastPos('abA', 'aabaaababababababa'), 'StrILastPos_2');
+ CheckEquals(8, StrILastPos('abbA', 'abbaabbabba'), 'StrILastPos_3');
+ CheckEquals(0, StrILastPos('_abba', 'abbaabbabba'), 'StrILastPos_4');
+ CheckEquals(5, StrILastPos('_aBBa', 'abba_abbabba'), 'StrILastPos_5');
+ CheckEquals(15, StrILastPos('ABA', 'aabaaaABAbabababa'), 'StrILastPos_6');
end;
//--------------------------------------------------------------------------------------------------
procedure TJclStringSearchandReplace._StrIPos;
begin
+ CheckEquals(1, StrIPos('A', 'aaaaaaaaaa'), 'StrIPos_1');
+ CheckEquals(2, StrIPos('abA', 'aabaaababababababa'), 'StrIPos_2');
+ CheckEquals(1, StrIPos('abbA', 'abbaabbabba'), 'StrIPos_3');
+ CheckEquals(0, StrIPos('_abba', 'abbaabbabba'), 'StrIPos_4');
+ CheckEquals(5, StrIPos('_aBBa', 'abba_abbabba'), 'StrIPos_5');
+ CheckEquals(2, StrIPos('ABA', 'aabaaaABAbabababa'), 'StrIPos_6');
end;
//--------------------------------------------------------------------------------------------------
@@ -1744,6 +1791,12 @@
procedure TJclStringSearchandReplace._StrNIPos;
begin
+ CheckEquals(5, StrNIPos('aaaaaaaaaa', 'A', 5), 'StrNIPos_1');
+ CheckEquals(0, StrNIPos('aabaaababababababa', 'abA', 0), 'StrNIPos_2');
+ CheckEquals(0, StrNIPos('abbaabbabba', 'abbA', 4), 'StrNIPos_3');
+ CheckEquals(8, StrNIPos('abbaabbabba', 'abba', 3), 'StrNIPos_4');
+ CheckEquals(5, StrNIPos('abba_abbabba', '_aBBa', 1), 'StrNIPos_5');
+ CheckEquals(11, StrNIPos('aabaaaABAbabababa', 'ABA', 4), 'StrNIPos_6');
end;
//--------------------------------------------------------------------------------------------------
@@ -1814,7 +1867,15 @@
//--------------------------------------------------------------------------------------------------
procedure TJclStringCharacterTestRoutines._CharIsBlank;
+var
+ c1: char;
+
begin
+ for c1 := #0 to #255 do
+ CheckEquals(
+ (c1 in [#9, ' ', #160]),
+ CharIsBlank(c1),
+ 'CharIsBlank #' + IntToStr(Ord(c1)));
end;
//--------------------------------------------------------------------------------------------------
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <jed...@us...> - 2009-03-01 11:57:12
|
Revision: 2662
http://jcl.svn.sourceforge.net/jcl/?rev=2662&view=rev
Author: jedi_mbe
Date: 2009-03-01 11:57:08 +0000 (Sun, 01 Mar 2009)
Log Message:
-----------
* TJclTabSet now holds its data in a separate class
* Added NewReference method to TJclTabSet.
Modified Paths:
--------------
trunk/help/Strings.dtx
trunk/jcl/source/common/JclStrings.pas
trunk/qa/automated/dunit/units/TestJclStrings.pas
Modified: trunk/help/Strings.dtx
===================================================================
--- trunk/help/Strings.dtx 2009-02-25 18:53:45 UTC (rev 2661)
+++ trunk/help/Strings.dtx 2009-03-01 11:57:08 UTC (rev 2662)
@@ -3204,6 +3204,8 @@
Notes:
This method is <i><b>nil</b>-safe</i>; when invoked on a
<b>nil</b>-reference, this method will return <b>nil</b>.
+See Also
+ NewReference
Donator:
Marcel Bestebroer
--------------------------------------------------------------------------------
@@ -3452,6 +3454,32 @@
Donator:
Marcel Bestebroer
--------------------------------------------------------------------------------
+@@TJclTabSet.NewReference
+Summary:
+ Initializes a new tab set instance referencing the current instance.
+Description:
+ The NewReference method initializes a new instance of the TJclTabSet class and
+ sets a reference in the new instance to the current instance.
+
+ NewReference allows several tabset instances to hold the same tab set
+ settings, regardless of which instance changes them. Only when the last
+ tab set instance is destroyed, will the actual tab set data be disposed of.
+
+ Contrast this to Clone, which will simply copy the data from the original
+ instance to the new one. Whenever you change the settings in one instance,
+ the other will remain unaffected.
+Result:
+ <b>nil</b> if NewReference is called on a <b>nil</b> instance<p>
+ <i>- or -</i><p>
+ A new TJclTabSet instance identical to the instance Close was called on
+Notes:
+ This method is <i><b>nil</b>-safe</i>; when invoked on a
+ <b>nil</b>-reference, this method will return <b>nil</b>.
+See Also
+ Clone
+Donator:
+ Marcel Bestebroer
+--------------------------------------------------------------------------------
@@TJclTabSet.OptimalFillInfo
Summary:
Determines the optimal number of tab and space characters needed to fill the
Modified: trunk/jcl/source/common/JclStrings.pas
===================================================================
--- trunk/jcl/source/common/JclStrings.pas 2009-02-25 18:53:45 UTC (rev 2661)
+++ trunk/jcl/source/common/JclStrings.pas 2009-03-01 11:57:08 UTC (rev 2662)
@@ -49,7 +49,7 @@
{ }
{**************************************************************************************************}
{ }
-{ Last modified: $Date:: $ }
+{ Last modified: $Date:: $ }
{ Revision: $Rev:: $ }
{ Author: $Author:: $ }
{ }
@@ -514,15 +514,12 @@
type
TJclTabSet = class {$IFNDEF CLR}(TInterfacedObject, IToString){$ENDIF}
private
- FStops: TDynIntegerArray;
- FRealWidth: Integer;
- FWidth: Integer;
- FZeroBased: Boolean;
- procedure CalcRealWidth;
+ FData: TObject;
function GetCount: Integer;
function GetStops(Index: Integer): Integer;
function GetTabWidth: Integer;
function GetZeroBased: Boolean;
+ constructor InternalCreate(Data: TObject);
procedure SetStops(Index, Value: Integer);
procedure SetTabWidth(Value: Integer);
procedure SetZeroBased(Value: Boolean);
@@ -536,7 +533,11 @@
constructor Create(TabWidth: Integer); overload;
constructor Create(const Tabstops: array of Integer; ZeroBased: Boolean); overload;
constructor Create(const Tabstops: array of Integer; ZeroBased: Boolean; TabWidth: Integer); overload;
+ destructor Destroy; override;
+
+ // cloning and referencing
function Clone: TJclTabSet;
+ function NewReference: TJclTabSet;
// Tab stops manipulation
function Add(Column: Integer): Integer;
@@ -5578,31 +5579,33 @@
Result := TabSet.Optimize(S);
end;
-//=== { TJclTabSet } =====================================================
+// === { TTabSetData } ===================================================
-constructor TJclTabSet.Create;
-begin
- // no tab stops, tab width set to auto
- Create([], True, 0);
-end;
+type
+ TTabSetData = class
+ public
+ FStops: TDynIntegerArray;
+ FRealWidth: Integer;
+ FRefCount: Integer;
+ FWidth: Integer;
+ FZeroBased: Boolean;
+ constructor Create(TabStops: array of Integer; ZeroBased: Boolean; TabWidth: Integer);
-constructor TJclTabSet.Create(TabWidth: Integer);
-begin
- // no tab stops, specified tab width
- Create([], True, TabWidth);
-end;
+ function Add(Column: Integer): Integer;
+ function AddRef: Integer;
+ procedure CalcRealWidth;
+ function FindStop(Column: Integer): Integer;
+ function ReleaseRef: Integer;
+ procedure RemoveAt(Index: Integer);
+ procedure SetStops(Index, Value: Integer);
+ end;
-constructor TJclTabSet.Create(const Tabstops: array of Integer; ZeroBased: Boolean);
-begin
- // specified tab stops, tab width equal to distance between last two tab stops
- Create(Tabstops, ZeroBased, 0);
-end;
-
-constructor TJclTabSet.Create(const Tabstops: array of Integer; ZeroBased: Boolean; TabWidth: Integer);
+constructor TTabSetData.Create(TabStops: array of Integer; ZeroBased: Boolean; TabWidth: Integer);
var
idx: Integer;
begin
inherited Create;
+ FRefCount := 1;
for idx := 0 to High(Tabstops) do
Add(Tabstops[idx]);
FWidth := TabWidth;
@@ -5610,11 +5613,9 @@
CalcRealWidth;
end;
-function TJclTabSet.Add(Column: Integer): Integer;
+function TTabSetData.Add(Column: Integer): Integer;
begin
- if Self = nil then
- raise NullReferenceException.Create;
- if Column < StartColumn then
+ if Column < Ord(FZeroBased) then
raise ArgumentOutOfRangeException.Create('Column');
Result := FindStop(Column);
if Result < 0 then
@@ -5639,8 +5640,13 @@
end;
end;
-procedure TJclTabSet.CalcRealWidth;
+function TTabSetData.AddRef: Integer;
begin
+ Result := InterlockedIncrement(FRefCount);
+end;
+
+procedure TTabSetData.CalcRealWidth;
+begin
if FWidth < 1 then
begin
if Length(FStops) > 1 then
@@ -5655,19 +5661,120 @@
FRealWidth := FWidth;
end;
+function TTabSetData.FindStop(Column: Integer): Integer;
+begin
+ Result := High(FStops);
+ while (Result >= 0) and (FStops[Result] > Column) do
+ Dec(Result);
+ if (Result >= 0) and (FStops[Result] <> Column) then
+ Result := not Succ(Result);
+end;
+
+function TTabSetData.ReleaseRef: Integer;
+begin
+ Result := InterlockedDecrement(FRefCount);
+ if Result <= 0 then
+ Destroy;
+end;
+
+procedure TTabSetData.RemoveAt(Index: Integer);
+begin
+ MoveArray(FStops, Succ(Index), Index, High(FStops) - Index);
+ SetLength(FStops, High(FStops));
+ CalcRealWidth;
+end;
+
+procedure TTabSetData.SetStops(Index, Value: Integer);
+var
+ temp: Integer;
+begin
+ if (Index < 0) or (Index >= Length(FStops)) then
+ begin
+ {$IFDEF CLR}
+ raise ArgumentOutOfRangeException.Create;
+ {$ELSE ~CLR}
+ raise ArgumentOutOfRangeException.CreateRes(@RsArgumentOutOfRange);
+ {$ENDIF ~CLR}
+ end
+ else
+ begin
+ temp := FindStop(Value);
+ if temp < 0 then
+ begin
+ // remove existing tab stop...
+ RemoveAt(Index);
+ // now add the new tab stop
+ Add(Value);
+ end
+ else
+ if temp <> Index then
+ begin
+ // new tab stop already present at another index
+ {$IFDEF CLR}
+ raise EJclStringError.Create(RsTabs_DuplicatesNotAllowed);
+ {$ELSE ~CLR}
+ raise EJclStringError.CreateRes(@RsTabs_DuplicatesNotAllowed);
+ {$ENDIF ~CLR}
+ end;
+ end;
+end;
+
+//=== { TJclTabSet } =====================================================
+
+constructor TJclTabSet.Create;
+begin
+ // no tab stops, tab width set to auto
+ Create([], True, 0);
+end;
+
+constructor TJclTabSet.Create(TabWidth: Integer);
+begin
+ // no tab stops, specified tab width
+ Create([], True, TabWidth);
+end;
+
+constructor TJclTabSet.Create(const Tabstops: array of Integer; ZeroBased: Boolean);
+begin
+ // specified tab stops, tab width equal to distance between last two tab stops
+ Create(Tabstops, ZeroBased, 0);
+end;
+
+constructor TJclTabSet.Create(const Tabstops: array of Integer; ZeroBased: Boolean; TabWidth: Integer);
+begin
+ inherited Create;
+ FData := TTabSetData.Create(Tabstops, ZeroBased, TabWidth);
+end;
+
+destructor TJclTabSet.Destroy;
+begin
+ // release the reference to the tab set data
+ TTabSetData(FData).ReleaseRef;
+ // make sure we won't accidentally refer to it later, just in case something goes wrong during destruction
+ FData := nil;
+ // really destroy the instance
+ inherited Destroy;
+end;
+
+function TJclTabSet.Add(Column: Integer): Integer;
+begin
+ if Self = nil then
+ raise NullReferenceException.Create;
+ Result := TTabSetData(FData).Add(Column);
+end;
+
function TJclTabSet.Clone: TJclTabSet;
begin
if Self <> nil then
- Result := TJclTabSet.Create(FStops, FZeroBased, FWidth)
+ Result := TJclTabSet.Create(TTabSetData(FData).FStops, TTabSetData(FData).FZeroBased, TTabSetData(FData).FWidth)
else
Result := nil;
end;
function TJclTabSet.Delete(Column: Integer): Integer;
begin
- Result := FindStop(Column);
+ Result := TTabSetData(FData).FindStop(Column);
if Result >= 0 then
- RemoveAt(Result);
+ TTabSetData(FData).RemoveAt(Result);
end;
function TJclTabSet.Expand(const S: string): string;
@@ -5715,13 +5822,7 @@
function TJclTabSet.FindStop(Column: Integer): Integer;
begin
if Self <> nil then
- begin
- Result := High(FStops);
- while (Result >= 0) and (FStops[Result] > Column) do
- Dec(Result);
- if (Result >= 0) and (FStops[Result] <> Column) then
- Result := not Succ(Result);
- end
+ Result := TTabSetData(FData).FindStop(Column)
else
Result := -1;
end;
@@ -5845,7 +5946,7 @@
function TJclTabSet.GetCount: Integer;
begin
if Self <> nil then
- Result := Length(FStops)
+ Result := Length(TTabSetData(FData).FStops)
else
Result := 0;
end;
@@ -5854,7 +5955,7 @@
begin
if Self <> nil then
begin
- if (Index < 0) or (Index >= Length(FStops)) then
+ if (Index < 0) or (Index >= Length(TTabSetData(FData).FStops)) then
begin
{$IFDEF CLR}
raise EJclStringError.Create(RsArgumentOutOfRange);
@@ -5863,7 +5964,7 @@
{$ENDIF ~CLR}
end
else
- Result := FStops[Index];
+ Result := TTabSetData(FData).FStops[Index];
end
else
begin
@@ -5878,14 +5979,14 @@
function TJclTabSet.GetTabWidth: Integer;
begin
if Self <> nil then
- Result := FWidth
+ Result := TTabSetData(FData).FWidth
else
Result := 0;
end;
function TJclTabSet.GetZeroBased: Boolean;
begin
- Result := (Self = nil) or FZeroBased;
+ Result := (Self = nil) or TTabSetData(FData).FZeroBased;
end;
procedure TJclTabSet.OptimalFillInfo(StartColumn, TargetColumn: Integer; out TabsNeeded, SpacesNeeded: Integer);
@@ -5987,51 +6088,15 @@
procedure TJclTabSet.RemoveAt(Index: Integer);
begin
if Self <> nil then
- begin
- MoveArray(FStops, Succ(Index), Index, High(FStops) - Index);
- SetLength(FStops, High(FStops));
- CalcRealWidth;
- end
+ TTabSetData(FData).RemoveAt(Index)
else
raise NullReferenceException.Create;
end;
procedure TJclTabSet.SetStops(Index, Value: Integer);
-var
- temp: Integer;
begin
if Self <> nil then
- begin
- if (Index < 0) or (Index >= Length(FStops)) then
- begin
- {$IFDEF CLR}
- raise ArgumentOutOfRangeException.Create;
- {$ELSE ~CLR}
- raise ArgumentOutOfRangeException.CreateRes(@RsArgumentOutOfRange);
- {$ENDIF ~CLR}
- end
- else
- begin
- temp := FindStop(Value);
- if temp < 0 then
- begin
- // remove existing tab stop...
- RemoveAt(Index);
- // now add the new tab stop
- Add(Value);
- end
- else
- if temp <> Index then
- begin
- // new tab stop already present at another index
- {$IFDEF CLR}
- raise EJclStringError.Create(RsTabs_DuplicatesNotAllowed);
- {$ELSE ~CLR}
- raise EJclStringError.CreateRes(@RsTabs_DuplicatesNotAllowed);
- {$ENDIF ~CLR}
- end;
- end;
- end
+ TTabSetData(FData).SetStops(Index, Value)
else
raise NullReferenceException.Create;
end;
@@ -6040,8 +6105,8 @@
begin
if Self <> nil then
begin
- FWidth := Value;
- CalcRealWidth;
+ TTabSetData(FData).FWidth := Value;
+ TTabSetData(FData).CalcRealWidth;
end
else
raise NullReferenceException.Create;
@@ -6054,25 +6119,34 @@
begin
if Self <> nil then
begin
- if Value <> FZeroBased then
+ if Value <> TTabSetData(FData).FZeroBased then
begin
- FZeroBased := Value;
+ TTabSetData(FData).FZeroBased := Value;
if Value then
shift := -1
else
shift := 1;
- for idx := 0 to High(FStops) do
- FStops[idx] := FStops[idx] + shift;
+ for idx := 0 to High(TTabSetData(FData).FStops) do
+ TTabSetData(FData).FStops[idx] := TTabSetData(FData).FStops[idx] + shift;
end;
end
else
raise NullReferenceException.Create;
end;
+constructor TJclTabSet.InternalCreate(Data: TObject);
+begin
+ inherited Create;
+ // add a reference to the data
+ TTabSetData(Data).AddRef;
+ // assign the data to this instance
+ FData := TTabSetData(Data);
+end;
+
function TJclTabSet.InternalTabStops: TDynIntegerArray;
begin
if Self <> nil then
- Result := FStops
+ Result := TTabSetData(FData).FStops
else
Result := nil;
end;
@@ -6080,11 +6154,19 @@
function TJclTabSet.InternalTabWidth: Integer;
begin
if Self <> nil then
- Result := FRealWidth
+ Result := TTabSetData(FData).FRealWidth
else
Result := 2;
end;
+function TJclTabSet.NewReference: TJclTabSet;
+begin
+ if Self <> nil then
+ Result := TJclTabSet.InternalCreate(FData)
+ else
+ Result := nil;
+end;
+
function TJclTabSet.StartColumn: Integer;
begin
if GetZeroBased then
@@ -6105,14 +6187,14 @@
if Result >= GetCount then
begin
if GetCount > 0 then
- Result := FStops[High(FStops)]
+ Result := TTabSetData(FData).FStops[High(TTabSetData(FData).FStops)]
else
Result := StartColumn;
while Result <= Column do
Inc(Result, ActualTabWidth);
end
else
- Result := FStops[Result];
+ Result := TTabSetData(FData).FStops[Result];
end;
function TJclTabSet.ToString: string;
Modified: trunk/qa/automated/dunit/units/TestJclStrings.pas
===================================================================
--- trunk/qa/automated/dunit/units/TestJclStrings.pas 2009-02-25 18:53:45 UTC (rev 2661)
+++ trunk/qa/automated/dunit/units/TestJclStrings.pas 2009-03-01 11:57:08 UTC (rev 2662)
@@ -171,6 +171,7 @@
procedure _NilSet;
procedure _OptimalFill;
procedure _Optimize;
+ procedure _Referencing;
procedure _TabFrom;
procedure _TabStopAdding;
procedure _TabStopDeleting;
@@ -2415,6 +2416,14 @@
CheckEquals(tabs1.Count, tabs2.Count, 'NormalClone: .Count');
CheckEquals(tabs1.TabStops[0], tabs2.TabStops[0], 'NormalClone: .TabStops[0]');
CheckEquals(tabs1.TabStops[1], tabs2.TabStops[1], 'NormalClone: .TabStops[1]');
+
+ // changing values in one reference should not influence the other reference
+ tabs1.TabWidth := 3;
+ CheckEquals(2, tabs2.TabWidth, 'NormalReference: .TabWidth changed');
+
+ // freeing the first instance should leave the second instance working
+ FreeAndNil(tabs1);
+ CheckEquals(2, tabs2.TabWidth, 'NormalReference: .TabWidth after freeing instance 1');
finally
FreeAndNil(tabs2);
end;
@@ -2570,6 +2579,57 @@
//------------------------------------------------------------------------------
+procedure TJclStringTabSet._Referencing;
+var
+ tabs1: TJclTabSet;
+ tabs2: TJclTabSet;
+
+ procedure NilReference;
+ begin
+ tabs1 := nil;
+ tabs2 := tabs1.NewReference;
+ try
+ CheckTrue(tabs2 = nil, 'NilReference: tabs2 = nil');
+ finally
+ FreeAndNil(tabs2);
+ end;
+ end;
+
+ procedure NormalReference;
+ begin
+ tabs1 := TJclTabSet.Create([4, 8], False, 2);
+ try
+ tabs2 := tabs1.NewReference;
+ try
+ CheckTrue(tabs1 <> tabs2, 'NormalReference: tabs1 <> tabs2');
+ CheckEquals(tabs1.TabWidth, tabs2.TabWidth, 'NormalReference: .TabWidth');
+ CheckEquals(tabs1.ActualTabWidth, tabs2.ActualTabWidth, 'NormalReference: .ActualTabWidth');
+ CheckEquals(tabs1.Count, tabs2.Count, 'NormalReference: .Count');
+ CheckEquals(tabs1.TabStops[0], tabs2.TabStops[0], 'NormalReference: .TabStops[0]');
+ CheckEquals(tabs1.TabStops[1], tabs2.TabStops[1], 'NormalReference: .TabStops[1]');
+
+ // changing values in one reference should also occur in the other reference
+ tabs1.TabWidth := 3;
+ CheckEquals(3, tabs2.TabWidth, 'NormalReference: .TabWidth changed');
+
+ // freeing the first instance should leave the second instance working
+ FreeAndNil(tabs1);
+ CheckEquals(3, tabs2.TabWidth, 'NormalReference: .TabWidth after freeing instance 1');
+ finally
+ FreeAndNil(tabs2);
+ end;
+ finally
+ FreeAndNil(tabs1);
+ end;
+ end;
+
+begin
+ NilReference;
+ NormalReference;
+end;
+
+//------------------------------------------------------------------------------
+
procedure TJclStringTabSet._TabFrom;
var
tabs: TJclTabSet;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ou...@us...> - 2009-02-25 18:53:49
|
Revision: 2661
http://jcl.svn.sourceforge.net/jcl/?rev=2661&view=rev
Author: outchy
Date: 2009-02-25 18:53:45 +0000 (Wed, 25 Feb 2009)
Log Message:
-----------
Fix from Mark Ford in newsgroups: typo in Unicode-enabled code.
Modified Paths:
--------------
trunk/jcl/source/windows/JclShell.pas
Modified: trunk/jcl/source/windows/JclShell.pas
===================================================================
--- trunk/jcl/source/windows/JclShell.pas 2009-02-24 17:42:51 UTC (rev 2660)
+++ trunk/jcl/source/windows/JclShell.pas 2009-02-25 18:53:45 UTC (rev 2661)
@@ -37,7 +37,7 @@
{ }
{**************************************************************************************************}
{ }
-{ Last modified: $Date:: $ }
+{ Last modified: $Date:: $ }
{ Revision: $Rev:: $ }
{ Author: $Author:: $ }
{ }
@@ -835,7 +835,7 @@
Result := nil;
{$IFDEF SUPPORTS_UNICODE}
Path := PChar(ExtractFilePath(FileName));
- ItemName := Path;
+ ItemName := PChar(ExtractFileName(FileName));
{$ELSE ~SUPPORTS_UNICODE}
MultiByteToWideChar(CP_ACP, MB_PRECOMPOSED, PAnsiChar(ExtractFilePath(FileName)), -1, Path, MAX_PATH);
MultiByteToWideChar(CP_ACP, MB_PRECOMPOSED, PAnsiChar(ExtractFileName(FileName)), -1, ItemName, MAX_PATH);
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ou...@us...> - 2009-02-24 17:42:58
|
Revision: 2660
http://jcl.svn.sourceforge.net/jcl/?rev=2660&view=rev
Author: outchy
Date: 2009-02-24 17:42:51 +0000 (Tue, 24 Feb 2009)
Log Message:
-----------
Report by Martin in newsgroups: JCL debug expert to use C++Builder project options.
Modified Paths:
--------------
trunk/jcl/experts/common/JclOtaConsts.pas
trunk/jcl/experts/common/JclOtaUtils.pas
Modified: trunk/jcl/experts/common/JclOtaConsts.pas
===================================================================
--- trunk/jcl/experts/common/JclOtaConsts.pas 2009-02-20 18:57:02 UTC (rev 2659)
+++ trunk/jcl/experts/common/JclOtaConsts.pas 2009-02-24 17:42:51 UTC (rev 2660)
@@ -77,6 +77,7 @@
JclDebugDeleteMapFileRegValue = 'JclDebugDeleteMapFile';
MapFileOptionName = 'MapFile';
OutputDirOptionName = 'OutputDir';
+ FinalOutputDirOptionName = 'FinalOutputDir';
RuntimeOnlyOptionName = 'RuntimeOnly';
PkgDllDirOptionName = 'PkgDllDir';
BPLOutputDirOptionName = 'PackageDPLOutput';
Modified: trunk/jcl/experts/common/JclOtaUtils.pas
===================================================================
--- trunk/jcl/experts/common/JclOtaUtils.pas 2009-02-20 18:57:02 UTC (rev 2659)
+++ trunk/jcl/experts/common/JclOtaUtils.pas 2009-02-24 17:42:51 UTC (rev 2660)
@@ -1102,8 +1102,16 @@
end;
end
else
+ begin
Result := VarToStr(Project.ProjectOptions.Values[OutputDirOptionName]);
+ if Result = 'false' then
+ Result := '';
+
+ if Result = '' then
+ Result := VarToStr(Project.ProjectOptions.Values[FinalOutputDirOptionName]);
+ end;
+
if Result = 'false' then
Result := '';
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ou...@us...> - 2009-02-20 18:57:21
|
Revision: 2659
http://jcl.svn.sourceforge.net/jcl/?rev=2659&view=rev
Author: outchy
Date: 2009-02-20 18:57:02 +0000 (Fri, 20 Feb 2009)
Log Message:
-----------
/jcl-msi is a branch and therefore it should be placed in /branches.
Added Paths:
-----------
branches/jcl-msi/
Removed Paths:
-------------
jcl-msi/
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ou...@us...> - 2009-02-20 17:30:54
|
Revision: 2658
http://jcl.svn.sourceforge.net/jcl/?rev=2658&view=rev
Author: outchy
Date: 2009-02-20 17:30:42 +0000 (Fri, 20 Feb 2009)
Log Message:
-----------
Support for out-of-place archive updates.
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 2009-02-20 17:03:48 UTC (rev 2657)
+++ trunk/jcl/source/common/JclCompression.pas 2009-02-20 17:30:42 UTC (rev 2658)
@@ -41,7 +41,7 @@
{ }
{**************************************************************************************************}
{ }
-{ Last modified: $Date:: $ }
+{ Last modified: $Date:: $ }
{ Revision: $Rev:: $ }
{ Author: $Author:: $ }
{ }
@@ -674,17 +674,23 @@
TJclCompressionVolume = class
protected
FFileName: TFileName;
+ FTmpFileName: TFileName;
FStream: TStream;
+ FTmpStream: TStream;
FOwnsStream: Boolean;
+ FOwnsTmpStream: Boolean;
FVolumeMaxSize: Int64;
public
- constructor Create(AStream: TStream; AOwnsStream: Boolean; AFileName: TFileName;
- AVolumeMaxSize: Int64);
+ constructor Create(AStream, ATmpStream: TStream; AOwnsStream, AOwnsTmpStream: Boolean;
+ AFileName, ATmpFileName: TFileName; AVolumeMaxSize: Int64);
destructor Destroy; override;
procedure ReleaseStreams;
property FileName: TFileName read FFileName;
+ property TmpFileName: TFileName read FTmpFileName;
property Stream: TStream read FStream;
+ property TmpStream: TStream read FTmpStream;
property OwnsStream: Boolean read FOwnsStream;
+ property OwnsTmpStream: Boolean read FOwnsTmpStream;
property VolumeMaxSize: Int64 read FVolumeMaxSize;
end;
@@ -713,12 +719,12 @@
procedure CreateCompressionObject; virtual;
procedure FreeCompressionObject; virtual;
- function InternalOpenVolume(const FileName: TFileName): TStream;
+ function InternalOpenStream(const FileName: TFileName): TStream;
function TranslateItemPath(const ItemPath, OldBase, NewBase: WideString): WideString;
procedure DoProgress(const Value, MaxValue: Int64);
- function NeedVolume(Index: Integer): TStream;
- function NeedVolumeMaxSize(Index: Integer): Int64;
+ function NeedStream(Index: Integer): TStream;
+ function NeedStreamMaxSize(Index: Integer): Int64;
procedure ReleaseVolumes;
function GetItemClass: TJclCompressionItemClass; virtual; abstract;
public
@@ -734,17 +740,21 @@
class function ArchiveName: string; virtual;
constructor Create(Volume0: TStream; AVolumeMaxSize: Int64 = 0;
- AOwnVolume: Boolean = False); overload;
+ AOwnVolume: Boolean = False); overload; virtual;
constructor Create(const VolumeFileName: TFileName; AVolumeMaxSize: Int64 = 0;
- VolumeMask: Boolean = False); overload;
+ VolumeMask: Boolean = False); overload; virtual;
// if VolumeMask is true then VolumeFileName represents a mask to get volume file names
// "myfile%d.zip" "myfile.zip.%.3d" ...
destructor Destroy; override;
function AddVolume(const VolumeFileName: TFileName;
AVolumeMaxSize: Int64 = 0): Integer; overload; virtual;
+ function AddVolume(const VolumeFileName, TmpVolumeFileName: TFileName;
+ AVolumeMaxSize: Int64 = 0): Integer; overload; virtual;
function AddVolume(VolumeStream: TStream; AVolumeMaxSize: Int64 = 0;
AOwnsStream: Boolean = False): Integer; overload; virtual;
+ function AddVolume(VolumeStream, TmpVolumeStream: TStream; AVolumeMaxSize: Int64 = 0;
+ AOwnsStream: Boolean = False; AOwnsTmpStream: Boolean = False): Integer; overload; virtual;
// miscellaneous
procedure ClearVolumes;
@@ -1000,9 +1010,9 @@
var AOwnsStream: Boolean): Boolean; virtual;
public
constructor Create(Volume0: TStream; AVolumeMaxSize: Int64 = 0;
- AOwnVolume: Boolean = False); overload;
+ AOwnVolume: Boolean = False); overload; override;
constructor Create(const VolumeFileName: TFileName; AVolumeMaxSize: Int64 = 0;
- VolumeMask: Boolean = False); overload;
+ VolumeMask: Boolean = False); overload; override;
class function VolumeAccess: TJclStreamAccess; override;
class function ItemAccess: TJclStreamAccess; override;
@@ -1019,6 +1029,39 @@
property AutoCreateSubDir: Boolean read FAutoCreateSubDir;
end;
+ // ancestor class for all archives that update files in-place (not creating a copy of the volumes)
+ TJclInPlaceUpdateArchive = class(TJclUpdateArchive, IInterface)
+ end;
+
+ // called when tmp volumes will replace volumes after out-of-place update
+ TJclCompressionReplaceEvent = function (Sender: TObject; const SrcFileName, DestFileName: TFileName;
+ var SrcStream, DestStream: TStream; var OwnsSrcStream, OwnsDestStream: Boolean): Boolean;
+
+ // ancestor class for all archives that update files out-of-place (by creating a copy of the volumes)
+ TJclOutOfPlaceUpdateArchive = class(TJclUpdateArchive, IInterface)
+ private
+ FReplaceVolumes: Boolean;
+ FTmpVolumeIndex: Integer;
+ FOnReplace: TJclCompressionReplaceEvent;
+ FOnTmpVolume: TJclCompressionVolumeEvent;
+ protected
+ function NeedTmpStream(Index: Integer): TStream;
+ function InternalOpenTmpStream(const FileName: TFileName): TStream;
+ public
+ class function TmpVolumeAccess: TJclStreamAccess; virtual;
+
+ constructor Create(Volume0: TStream; AVolumeMaxSize: Int64 = 0;
+ AOwnVolume: Boolean = False); overload; override;
+ constructor Create(const VolumeFileName: TFileName; AVolumeMaxSize: Int64 = 0;
+ VolumeMask: Boolean = False); overload; override;
+
+ procedure Compress; override;
+
+ property ReplaceVolumes: Boolean read FReplaceVolumes write FReplaceVolumes;
+ property OnReplace: TJclCompressionReplaceEvent read FOnReplace write FOnReplace;
+ property OnTmpVolume: TJclCompressionVolumeEvent read FOnTmpVolume write FOnTmpVolume;
+ end;
+
TJclUpdateArchiveClass = class of TJclUpdateArchive;
// registered archive formats
@@ -1545,7 +1588,7 @@
//sevenzip classes for updates (read and write)
type
- TJclSevenzipUpdateArchive = class(TJclUpdateArchive, IInterface)
+ TJclSevenzipUpdateArchive = class(TJclOutOfPlaceUpdateArchive, IInterface)
private
FInArchive: IInArchive;
FOutArchive: IOutArchive;
@@ -3881,13 +3924,16 @@
//=== { TJclCompressionVolume } ==============================================
-constructor TJclCompressionVolume.Create(AStream: TStream; AOwnsStream: Boolean;
- AFileName: TFileName; AVolumeMaxSize: Int64);
+constructor TJclCompressionVolume.Create(AStream, ATmpStream: TStream; AOwnsStream, AOwnsTmpStream: Boolean;
+ AFileName, ATmpFileName: TFileName; AVolumeMaxSize: Int64);
begin
inherited Create;
FStream := AStream;
+ FTmpStream := ATmpStream;
FOwnsStream := AOwnsStream;
+ FOwnsTmpStream := AOwnsTmpStream;
FFileName := AFileName;
+ FTmpFileName := ATmpFileName;
FVolumeMaxSize := AVolumeMaxSize;
end;
@@ -3900,7 +3946,9 @@
procedure TJclCompressionVolume.ReleaseStreams;
begin
if OwnsStream then
- FStream.Free;
+ FreeAndNil(FStream);
+ if OwnsTmpStream then
+ FreeAndNil(FTmpStream);
end;
//=== { TJclCompressionArchive } =============================================
@@ -3947,9 +3995,27 @@
function TJclCompressionArchive.AddVolume(VolumeStream: TStream;
AVolumeMaxSize: Int64; AOwnsStream: Boolean): Integer;
begin
- Result := FVolumes.Add(TJclCompressionVolume.Create(VolumeStream, AOwnsStream, '', AVolumeMaxSize));
+ Result := FVolumes.Add(TJclCompressionVolume.Create(VolumeStream, nil, AOwnsStream, True, '', '', AVolumeMaxSize));
end;
+function TJclCompressionArchive.AddVolume(VolumeStream, TmpVolumeStream: TStream;
+ AVolumeMaxSize: Int64; AOwnsStream, AOwnsTmpStream: Boolean): Integer;
+begin
+ Result := FVolumes.Add(TJclCompressionVolume.Create(VolumeStream, TmpVolumeStream, AOwnsStream, AOwnsTmpStream, '', '', AVolumeMaxSize));
+end;
+
+function TJclCompressionArchive.AddVolume(const VolumeFileName: TFileName;
+ AVolumeMaxSize: Int64): Integer;
+begin
+ Result := FVolumes.Add(TJclCompressionVolume.Create(nil, nil, True, True, VolumeFileName, '', AVolumeMaxSize));
+end;
+
+function TJclCompressionArchive.AddVolume(const VolumeFileName, TmpVolumeFileName: TFileName;
+ AVolumeMaxSize: Int64): Integer;
+begin
+ Result := FVolumes.Add(TJclCompressionVolume.Create(nil, nil, True, True, VolumeFileName, TmpVolumeFileName, AVolumeMaxSize));
+end;
+
class function TJclCompressionArchive.ArchiveExtensions: string;
begin
Result := '';
@@ -3960,12 +4026,6 @@
Result := '';
end;
-function TJclCompressionArchive.AddVolume(const VolumeFileName: TFileName;
- AVolumeMaxSize: Int64): Integer;
-begin
- Result := FVolumes.Add(TJclCompressionVolume.Create(nil, True, VolumeFileName, AVolumeMaxSize));
-end;
-
procedure TJclCompressionArchive.CheckOperationSuccess;
var
Index: Integer;
@@ -4041,7 +4101,7 @@
Result := FVolumes.Count;
end;
-function TJclCompressionArchive.InternalOpenVolume(
+function TJclCompressionArchive.InternalOpenStream(
const FileName: TFileName): TStream;
begin
Result := OpenFileStream(FileName, VolumeAccess);
@@ -4057,7 +4117,7 @@
Result := True;
end;
-function TJclCompressionArchive.NeedVolume(Index: Integer): TStream;
+function TJclCompressionArchive.NeedStream(Index: Integer): TStream;
var
AVolume: TJclCompressionVolume;
AOwnsStream: Boolean;
@@ -4084,7 +4144,7 @@
if Assigned(AVolume) then
begin
if not Assigned(Result) then
- Result := InternalOpenVolume(AFileName);
+ Result := InternalOpenStream(AFileName);
AVolume.FFileName := AFileName;
AVolume.FStream := Result;
AVolume.FOwnsStream := AOwnsStream;
@@ -4092,9 +4152,9 @@
else
begin
while FVolumes.Count < Index do
- FVolumes.Add(TJclCompressionVolume.Create(nil, True, Format(VolumeFileNameMask, [Index + VolumeIndexOffset]), FVolumeMaxSize));
+ FVolumes.Add(TJclCompressionVolume.Create(nil, nil, True, True, Format(VolumeFileNameMask, [Index + VolumeIndexOffset]), '', FVolumeMaxSize));
if not Assigned(Result) then
- Result := InternalOpenVolume(AFileName);
+ Result := InternalOpenStream(AFileName);
if Assigned(Result) then
begin
if Index < FVolumes.Count then
@@ -4106,7 +4166,7 @@
AVolume.FVolumeMaxSize := FVolumeMaxSize;
end
else
- FVolumes.Add(TJclCompressionVolume.Create(Result, AOwnsStream, AFileName, FVolumeMaxSize));
+ FVolumes.Add(TJclCompressionVolume.Create(Result, nil, AOwnsStream, True, AFileName, '', FVolumeMaxSize));
end;
end;
FVolumeIndex := Index;
@@ -4123,7 +4183,7 @@
FVolumeIndex := Index;
end;
-function TJclCompressionArchive.NeedVolumeMaxSize(Index: Integer): Int64;
+function TJclCompressionArchive.NeedStreamMaxSize(Index: Integer): Int64;
var
AVolume: TJclCompressionVolume;
begin
@@ -4142,7 +4202,7 @@
else
begin
while FVolumes.Count < Index do
- FVolumes.Add(TJclCompressionVolume.Create(nil, True, Format(VolumeFileNameMask, [Index + VolumeIndexOffset]), FVolumeMaxSize));
+ FVolumes.Add(TJclCompressionVolume.Create(nil, nil, True, True, Format(VolumeFileNameMask, [Index + VolumeIndexOffset]), '', FVolumeMaxSize));
if Index < FVolumes.Count then
begin
AVolume := TJclCompressionVolume(FVolumes.Items[Index]);
@@ -4152,7 +4212,7 @@
AVolume.FVolumeMaxSize := FVolumeMaxSize;
end
else
- FVolumes.Add(TJclCompressionVolume.Create(nil, True, Format(VolumeFileNameMask, [Index + VolumeIndexOffset]), FVolumeMaxSize));
+ FVolumes.Add(TJclCompressionVolume.Create(nil, nil, True, True, Format(VolumeFileNameMask, [Index + VolumeIndexOffset]), '', FVolumeMaxSize));
end;
end;
Result := FVolumeMaxSize;
@@ -4611,9 +4671,179 @@
class function TJclUpdateArchive.VolumeAccess: TJclStreamAccess;
begin
- Result := saReadWrite;
+ Result := saReadOnly;
end;
+//=== { TJclOutOfPlaceUpdateArchive } ========================================
+
+procedure TJclOutOfPlaceUpdateArchive.Compress;
+var
+ Index: Integer;
+ AVolume: TJclCompressionVolume;
+ SrcFileName, DestFileName: TFileName;
+ SrcStream, DestStream: TStream;
+ OwnsSrcStream, OwnsDestStream, AllHandled, Handled: Boolean;
+ CopiedSize: Int64;
+begin
+ // release volume streams and other finalization
+ inherited Compress;
+
+ if ReplaceVolumes then
+ begin
+ AllHandled := True;
+
+ // replace streams by tmp streams
+ for Index := 0 to FVolumes.Count - 1 do
+ begin
+ AVolume := TJclCompressionVolume(FVolumes.Items[Index]);
+
+ SrcFileName := AVolume.TmpFileName;
+ DestFileName := AVolume.FileName;
+ SrcStream := AVolume.TmpStream;
+ DestStream := AVolume.Stream;
+ OwnsSrcStream := AVolume.OwnsTmpStream;
+ OwnsDestStream := AVolume.OwnsStream;
+
+ Handled := Assigned(FOnReplace) and FOnReplace(Self, SrcFileName, DestFileName, SrcStream, DestStream, OwnsSrcStream, OwnsDestStream);
+
+ if not Handled then
+ begin
+ if (SrcFileName <> '') and (DestFileName <> '') and
+ (OwnsSrcStream or not Assigned(SrcStream)) and
+ (OwnsDestStream or not Assigned(DestStream)) then
+ begin
+ // close references before moving files
+ if OwnsSrcStream then
+ FreeAndNil(SrcStream);
+ if OwnsDestStream then
+ FreeAndNil(DestStream);
+ Handled := FileMove(SrcFileName, DestFileName, True);
+ end
+ else
+ if (SrcFileName = '') and (DestFileName = '') and Assigned(SrcStream) and Assigned(DestStream) then
+ begin
+ // in-memory moves
+ StreamSeek(SrcStream, 0, soBeginning);
+ StreamSeek(DestStream, 0, soBeginning);
+ CopiedSize := StreamCopy(SrcStream, DestStream);
+ // reset size
+ DestStream.Size := CopiedSize;
+ end;
+ // identity
+ // else
+ // Handled := False;
+ end;
+
+ // update volume information
+ AVolume.FTmpStream := SrcStream;
+ AVolume.FStream := DestStream;
+ AVolume.FOwnsTmpStream := OwnsSrcStream;
+ AVolume.FOwnsStream := OwnsDestStream;
+ AVolume.FTmpFileName := SrcFileName;
+ AVolume.FFileName := DestFileName;
+
+ AllHandled := AllHandled and Handled;
+ end;
+ if not AllHandled then
+ raise EJclCompressionError.CreateRes(@RsCompressionReplaceError);
+ end;
+end;
+
+constructor TJclOutOfPlaceUpdateArchive.Create(Volume0: TStream;
+ AVolumeMaxSize: Int64; AOwnVolume: Boolean);
+begin
+ inherited Create(Volume0, AVolumeMaxSize, AOwnVolume);
+ FReplaceVolumes := True;
+ FTmpVolumeIndex := -1;
+end;
+
+constructor TJclOutOfPlaceUpdateArchive.Create(const VolumeFileName: TFileName;
+ AVolumeMaxSize: Int64; VolumeMask: Boolean);
+begin
+ inherited Create(VolumeFileName, AVolumeMaxSize, VolumeMask);
+ FReplaceVolumes := True;
+ FTmpVolumeIndex := -1;
+end;
+
+function TJclOutOfPlaceUpdateArchive.InternalOpenTmpStream(
+ const FileName: TFileName): TStream;
+begin
+ Result := OpenFileStream(FileName, TmpVolumeAccess);
+end;
+
+function TJclOutOfPlaceUpdateArchive.NeedTmpStream(Index: Integer): TStream;
+var
+ AVolume: TJclCompressionVolume;
+ AOwnsStream: Boolean;
+ AFileName: TFileName;
+begin
+ Result := nil;
+
+ if Index <> FTmpVolumeIndex then
+ begin
+ AOwnsStream := VolumeFileNameMask <> '';
+ AVolume := nil;
+ AFileName := FindUnusedFileName(Format(VolumeFileNameMask, [Index + VolumeIndexOffset]), '.tmp');
+ if (Index >= 0) and (Index < FVolumes.Count) then
+ begin
+ AVolume := TJclCompressionVolume(FVolumes.Items[Index]);
+ Result := AVolume.TmpStream;
+ AOwnsStream := AVolume.OwnsTmpStream;
+ AFileName := AVolume.TmpFileName;
+ if AFileName = '' then
+ AFileName := FindUnusedFileName(AVolume.FileName, '.tmp');
+ end;
+
+ if Assigned(FOnTmpVolume) then
+ FOnTmpVolume(Self, Index, AFileName, Result, AOwnsStream);
+
+ if Assigned(AVolume) then
+ begin
+ if not Assigned(Result) then
+ Result := InternalOpenTmpStream(AFileName);
+ AVolume.FTmpFileName := AFileName;
+ AVolume.FTmpStream := Result;
+ AVolume.FOwnsTmpStream := AOwnsStream;
+ end
+ else
+ begin
+ while FVolumes.Count < Index do
+ FVolumes.Add(TJclCompressionVolume.Create(nil, nil, True, True, Format(VolumeFileNameMask, [Index + VolumeIndexOffset]), '', FVolumeMaxSize));
+ if not Assigned(Result) then
+ Result := InternalOpenTmpStream(AFileName);
+ if Assigned(Result) then
+ begin
+ if Index < FVolumes.Count then
+ begin
+ AVolume := TJclCompressionVolume(FVolumes.Items[Index]);
+ AVolume.FTmpFileName := AFileName;
+ AVolume.FTmpStream := Result;
+ AVolume.FOwnsTmpStream := AOwnsStream;
+ AVolume.FVolumeMaxSize := FVolumeMaxSize;
+ end
+ else
+ FVolumes.Add(TJclCompressionVolume.Create(nil, Result, True, AOwnsStream, '', AFileName, FVolumeMaxSize));
+ end;
+ end;
+ FTmpVolumeIndex := Index;
+ end
+ else
+ if (Index >= 0) and (Index < FVolumes.Count) then
+ begin
+ AVolume := TJclCompressionVolume(FVolumes.Items[Index]);
+ Result := AVolume.TmpStream;
+ if Assigned(Result) then
+ StreamSeek(Result, 0, soBeginning);
+ end
+ else
+ FTmpVolumeIndex := Index;
+end;
+
+class function TJclOutOfPlaceUpdateArchive.TmpVolumeAccess: TJclStreamAccess;
+begin
+ Result := saWriteOnly;
+end;
+
//=== { TJclSevenzipOutStream } ==============================================
type
@@ -5462,8 +5692,8 @@
FCompressing := True;
try
SplitStream := TJclDynamicSplitStream.Create(False);
- SplitStream.OnVolume := NeedVolume;
- SplitStream.OnVolumeMaxSize := NeedVolumeMaxSize;
+ SplitStream.OnVolume := NeedStream;
+ SplitStream.OnVolumeMaxSize := NeedStreamMaxSize;
OutStream := TJclSevenzipOutStream.Create(SplitStream, True, False);
UpdateCallback := TJclSevenzipUpdateCallback.Create(Self);
@@ -6412,12 +6642,12 @@
if (FVolumeMaxSize <> 0) or (FVolumes.Count <> 0) then
begin
SplitStream := TJclDynamicSplitStream.Create(False);
- SplitStream.OnVolume := NeedVolume;
- SplitStream.OnVolumeMaxSize := NeedVolumeMaxSize;
+ SplitStream.OnVolume := NeedStream;
+ SplitStream.OnVolumeMaxSize := NeedStreamMaxSize;
AInStream := TJclSevenzipInStream.Create(SplitStream, True);
end
else
- AInStream := TJclSevenzipInStream.Create(NeedVolume(0), False);
+ AInStream := TJclSevenzipInStream.Create(NeedStream(0), False);
OpenCallback := TJclSevenzipOpenCallback.Create(Self);
SetSevenzipArchiveCompressionProperties(Self, FInArchive);
@@ -7097,8 +7327,8 @@
FCompressing := True;
try
SplitStream := TJclDynamicSplitStream.Create(True);
- SplitStream.OnVolume := NeedVolume;
- SplitStream.OnVolumeMaxSize := NeedVolumeMaxSize;
+ SplitStream.OnVolume := NeedTmpStream;
+ SplitStream.OnVolumeMaxSize := NeedStreamMaxSize;
OutStream := TJclSevenzipOutStream.Create(SplitStream, True, True);
UpdateCallback := TJclSevenzipUpdateCallback.Create(Self);
@@ -7107,7 +7337,9 @@
SevenzipCheck(FOutArchive.UpdateItems(OutStream, ItemCount, UpdateCallback));
finally
FCompressing := False;
- // release volumes and other finalizations
+ // release reference to volume streams
+ OutStream := nil;
+ // replace streams by tmp streams
inherited Compress;
end;
end;
@@ -7296,8 +7528,8 @@
if not FOpened then
begin
SplitStream := TJclDynamicSplitStream.Create(True);
- SplitStream.OnVolume := NeedVolume;
- SplitStream.OnVolumeMaxSize := NeedVolumeMaxSize;
+ SplitStream.OnVolume := NeedStream;
+ SplitStream.OnVolumeMaxSize := NeedStreamMaxSize;
AInStream := TJclSevenzipInStream.Create(SplitStream, True);
OpenCallback := TJclSevenzipOpenCallback.Create(Self);
Modified: trunk/jcl/source/common/JclResources.pas
===================================================================
--- trunk/jcl/source/common/JclResources.pas 2009-02-20 17:03:48 UTC (rev 2657)
+++ trunk/jcl/source/common/JclResources.pas 2009-02-20 17:30:42 UTC (rev 2658)
@@ -38,7 +38,7 @@
{ }
{**************************************************************************************************}
{ }
-{ Last modified: $Date:: $ }
+{ Last modified: $Date:: $ }
{ Revision: $Rev:: $ }
{ Author: $Author:: $ }
{ }
@@ -884,6 +884,7 @@
RsCompressionGZipName = 'GZip archive';
RsCompressionGZipExtensions = '*.gz;*.gzip;*.tgz;*.tpz';
RsCompressionDuplicate = 'The file %s already exists in the archive';
+ RsCompressionReplaceError = 'At least one compression volumes could not be replaced after an archive out-of-place update';
//=== JclConsole =============================================================
resourcestring
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ou...@us...> - 2009-02-20 17:03:53
|
Revision: 2657
http://jcl.svn.sourceforge.net/jcl/?rev=2657&view=rev
Author: outchy
Date: 2009-02-20 17:03:48 +0000 (Fri, 20 Feb 2009)
Log Message:
-----------
changed type of parameters that denote file names to TFileName.
Modified Paths:
--------------
trunk/jcl/source/common/JclCompression.pas
Modified: trunk/jcl/source/common/JclCompression.pas
===================================================================
--- trunk/jcl/source/common/JclCompression.pas 2009-02-20 16:51:17 UTC (rev 2656)
+++ trunk/jcl/source/common/JclCompression.pas 2009-02-20 17:03:48 UTC (rev 2657)
@@ -41,7 +41,7 @@
{ }
{**************************************************************************************************}
{ }
-{ Last modified: $Date:: $ }
+{ Last modified: $Date:: $ }
{ Revision: $Rev:: $ }
{ Author: $Author:: $ }
{ }
@@ -207,8 +207,8 @@
procedure RegisterFormat(AClass: TJclCompressionStreamClass);
procedure UnregisterFormat(AClass: TJclCompressionStreamClass);
- function FindCompressFormat(const AFileName: string): TJclCompressStreamClass;
- function FindDecompressFormat(const AFileName: string): TJclDecompressStreamClass;
+ function FindCompressFormat(const AFileName: TFileName): TJclCompressStreamClass;
+ function FindDecompressFormat(const AFileName: TFileName): TJclDecompressStreamClass;
property CompressFormatCount: Integer read GetCompressFormatCount;
property CompressFormats[Index: Integer]: TJclCompressStreamClass read GetCompressFormat;
@@ -516,18 +516,18 @@
TJclCompressStreamProgressCallback = procedure(FileSize, Position: Int64; UserData: Pointer) of object;
{helper functions - one liners by wpostma}
-function GZipFile(SourceFile, DestinationFile: string; CompressionLevel: Integer = Z_DEFAULT_COMPRESSION;
+function GZipFile(SourceFile, DestinationFile: TFileName; CompressionLevel: Integer = Z_DEFAULT_COMPRESSION;
ProgressCallback: TJclCompressStreamProgressCallback = nil; UserData: Pointer = nil): Boolean;
-function UnGZipFile(SourceFile, DestinationFile: string;
+function UnGZipFile(SourceFile, DestinationFile: TFileName;
ProgressCallback: TJclCompressStreamProgressCallback = nil; UserData: Pointer = nil): Boolean;
procedure GZipStream(SourceStream, DestinationStream: TStream; CompressionLevel: Integer = Z_DEFAULT_COMPRESSION;
ProgressCallback: TJclCompressStreamProgressCallback = nil; UserData: Pointer = nil);
procedure UnGZipStream(SourceStream, DestinationStream: TStream;
ProgressCallback: TJclCompressStreamProgressCallback = nil; UserData: Pointer = nil);
-function BZip2File(SourceFile, DestinationFile: string; CompressionLevel: Integer = 5;
+function BZip2File(SourceFile, DestinationFile: TFileName; CompressionLevel: Integer = 5;
ProgressCallback: TJclCompressStreamProgressCallback = nil; UserData: Pointer = nil): Boolean;
-function UnBZip2File(SourceFile, DestinationFile: string;
+function UnBZip2File(SourceFile, DestinationFile: TFileName;
ProgressCallback: TJclCompressStreamProgressCallback = nil; UserData: Pointer = nil): Boolean;
procedure BZip2Stream(SourceStream, DestinationStream: TStream; CompressionLevel: Integer = 5;
ProgressCallback: TJclCompressStreamProgressCallback = nil; UserData: Pointer = nil);
@@ -700,7 +700,7 @@
FVolumeIndex: Integer;
FVolumeIndexOffset: Integer;
FVolumeMaxSize: Int64;
- FVolumeNameMask: string;
+ FVolumeFileNameMask: TFileName;
FProgressMax: Int64;
function GetItemCount: Integer;
function GetItem(Index: Integer): TJclCompressionItem;
@@ -735,13 +735,13 @@
constructor Create(Volume0: TStream; AVolumeMaxSize: Int64 = 0;
AOwnVolume: Boolean = False); overload;
- constructor Create(const VolumeName: string; AVolumeMaxSize: Int64 = 0;
+ constructor Create(const VolumeFileName: TFileName; AVolumeMaxSize: Int64 = 0;
VolumeMask: Boolean = False); overload;
- // if VolumeMask is true then VolumeName represents a mask to get volume file names
+ // if VolumeMask is true then VolumeFileName represents a mask to get volume file names
// "myfile%d.zip" "myfile.zip.%.3d" ...
destructor Destroy; override;
- function AddVolume(const VolumeName: string;
+ function AddVolume(const VolumeFileName: TFileName;
AVolumeMaxSize: Int64 = 0): Integer; overload; virtual;
function AddVolume(VolumeStream: TStream; AVolumeMaxSize: Int64 = 0;
AOwnsStream: Boolean = False): Integer; overload; virtual;
@@ -761,7 +761,7 @@
property VolumeCount: Integer read GetVolumeCount;
property Volumes[Index: Integer]: TJclCompressionVolume read GetVolume;
property VolumeMaxSize: Int64 read FVolumeMaxSize;
- property VolumeNameMask: string read FVolumeNameMask;
+ property VolumeFileNameMask: TFileName read FVolumeFileNameMask;
property VolumeIndexOffset: Integer read FVolumeIndexOffset write FVolumeIndexOffset;
property OnProgress: TJclCompressionProgressEvent read FOnProgress write FOnProgress;
@@ -923,7 +923,7 @@
const DirName: string = ''; RecurseIntoDir: Boolean = False;
AddFilesInDir: Boolean = False): Integer; overload; virtual;
function AddFile(const PackedName: WideString;
- const FileName: string): Integer; overload; virtual;
+ const FileName: TFileName): Integer; overload; virtual;
function AddFile(const PackedName: WideString; AStream: TStream;
AOwnsStream: Boolean = False): Integer; overload; virtual;
procedure Compress; virtual;
@@ -1001,7 +1001,7 @@
public
constructor Create(Volume0: TStream; AVolumeMaxSize: Int64 = 0;
AOwnVolume: Boolean = False); overload;
- constructor Create(const VolumeName: string; AVolumeMaxSize: Int64 = 0;
+ constructor Create(const VolumeFileName: TFileName; AVolumeMaxSize: Int64 = 0;
VolumeMask: Boolean = False); overload;
class function VolumeAccess: TJclStreamAccess; override;
class function ItemAccess: TJclStreamAccess; override;
@@ -1042,9 +1042,9 @@
procedure RegisterFormat(AClass: TJclCompressionArchiveClass);
procedure UnregisterFormat(AClass: TJclCompressionArchiveClass);
- function FindCompressFormat(const AFileName: string): TJclCompressArchiveClass;
- function FindDecompressFormat(const AFileName: string): TJclDecompressArchiveClass;
- function FindUpdateFormat(const AFileName: string): TJclUpdateArchiveClass;
+ function FindCompressFormat(const AFileName: TFileName): TJclCompressArchiveClass;
+ function FindDecompressFormat(const AFileName: TFileName): TJclDecompressArchiveClass;
+ function FindUpdateFormat(const AFileName: TFileName): TJclUpdateArchiveClass;
property CompressFormatCount: Integer read GetCompressFormatCount;
property CompressFormats[Index: Integer]: TJclCompressArchiveClass read GetCompressFormat;
@@ -1875,7 +1875,7 @@
inherited Destroy;
end;
-function TJclCompressionStreamFormats.FindCompressFormat(const AFileName: string): TJclCompressStreamClass;
+function TJclCompressionStreamFormats.FindCompressFormat(const AFileName: TFileName): TJclCompressStreamClass;
var
IndexFormat, IndexFilter: Integer;
Filters: TStrings;
@@ -1902,7 +1902,7 @@
end;
end;
-function TJclCompressionStreamFormats.FindDecompressFormat(const AFileName: string): TJclDecompressStreamClass;
+function TJclCompressionStreamFormats.FindDecompressFormat(const AFileName: TFileName): TJclDecompressStreamClass;
var
IndexFormat, IndexFilter: Integer;
Filters: TStrings;
@@ -3045,7 +3045,7 @@
{ Compress to a .gz file - one liner - NEW MARCH 2007 }
-function GZipFile(SourceFile, DestinationFile: string; CompressionLevel: Integer;
+function GZipFile(SourceFile, DestinationFile: TFileName; CompressionLevel: Integer;
ProgressCallback: TJclCompressStreamProgressCallback; UserData: Pointer): Boolean;
var
GZipStream: TJclGZIPCompressionStream;
@@ -3085,7 +3085,7 @@
{ Decompress a .gz file }
-function UnGZipFile(SourceFile, DestinationFile: string;
+function UnGZipFile(SourceFile, DestinationFile: TFileName;
ProgressCallback: TJclCompressStreamProgressCallback; UserData: Pointer): Boolean;
var
GZipStream: TJclGZIPDecompressionStream;
@@ -3152,7 +3152,7 @@
{ Compress to a .bz2 file - one liner }
-function BZip2File(SourceFile, DestinationFile: string; CompressionLevel: Integer;
+function BZip2File(SourceFile, DestinationFile: TFileName; CompressionLevel: Integer;
ProgressCallback: TJclCompressStreamProgressCallback; UserData: Pointer): Boolean;
var
BZip2Stream: TJclBZIP2CompressionStream;
@@ -3188,7 +3188,7 @@
{ Decompress a .bzip2 file }
-function UnBZip2File(SourceFile, DestinationFile: string;
+function UnBZip2File(SourceFile, DestinationFile: TFileName;
ProgressCallback: TJclCompressStreamProgressCallback; UserData: Pointer): Boolean;
var
BZip2Stream: TJclBZIP2DecompressionStream;
@@ -3737,7 +3737,7 @@
inherited Destroy;
end;
-function TJclCompressionArchiveFormats.FindCompressFormat(const AFileName: string): TJclCompressArchiveClass;
+function TJclCompressionArchiveFormats.FindCompressFormat(const AFileName: TFileName): TJclCompressArchiveClass;
var
IndexFormat, IndexFilter: Integer;
Filters: TStrings;
@@ -3764,7 +3764,7 @@
end;
end;
-function TJclCompressionArchiveFormats.FindDecompressFormat(const AFileName: string): TJclDecompressArchiveClass;
+function TJclCompressionArchiveFormats.FindDecompressFormat(const AFileName: TFileName): TJclDecompressArchiveClass;
var
IndexFormat, IndexFilter: Integer;
Filters: TStrings;
@@ -3791,7 +3791,7 @@
end;
end;
-function TJclCompressionArchiveFormats.FindUpdateFormat(const AFileName: string): TJclUpdateArchiveClass;
+function TJclCompressionArchiveFormats.FindUpdateFormat(const AFileName: TFileName): TJclUpdateArchiveClass;
var
IndexFormat, IndexFilter: Integer;
Filters: TStrings;
@@ -3919,7 +3919,7 @@
CreateCompressionObject;
end;
-constructor TJclCompressionArchive.Create(const VolumeName: string;
+constructor TJclCompressionArchive.Create(const VolumeFileName: TFileName;
AVolumeMaxSize: Int64 = 0; VolumeMask: Boolean = False);
begin
inherited Create;
@@ -3929,9 +3929,9 @@
FItems := TObjectList.Create(True);
FVolumes := TObjectList.Create(True);
if VolumeMask then
- FVolumeNameMask := VolumeName
+ FVolumeFileNameMask := VolumeFileName
else
- AddVolume(VolumeName, AVolumeMaxSize);
+ AddVolume(VolumeFileName, AVolumeMaxSize);
CreateCompressionObject;
end;
@@ -3960,10 +3960,10 @@
Result := '';
end;
-function TJclCompressionArchive.AddVolume(const VolumeName: string;
+function TJclCompressionArchive.AddVolume(const VolumeFileName: TFileName;
AVolumeMaxSize: Int64): Integer;
begin
- Result := FVolumes.Add(TJclCompressionVolume.Create(nil, True, VolumeName, AVolumeMaxSize));
+ Result := FVolumes.Add(TJclCompressionVolume.Create(nil, True, VolumeFileName, AVolumeMaxSize));
end;
procedure TJclCompressionArchive.CheckOperationSuccess;
@@ -4067,9 +4067,9 @@
if Index <> FVolumeIndex then
begin
- AOwnsStream := VolumeNameMask <> '';
+ AOwnsStream := VolumeFileNameMask <> '';
AVolume := nil;
- AFileName := Format(VolumeNameMask, [Index + VolumeIndexOffset]);
+ AFileName := Format(VolumeFileNameMask, [Index + VolumeIndexOffset]);
if (Index >= 0) and (Index < FVolumes.Count) then
begin
AVolume := TJclCompressionVolume(FVolumes.Items[Index]);
@@ -4092,7 +4092,7 @@
else
begin
while FVolumes.Count < Index do
- FVolumes.Add(TJclCompressionVolume.Create(nil, True, Format(VolumeNameMask, [Index + VolumeIndexOffset]), FVolumeMaxSize));
+ FVolumes.Add(TJclCompressionVolume.Create(nil, True, Format(VolumeFileNameMask, [Index + VolumeIndexOffset]), FVolumeMaxSize));
if not Assigned(Result) then
Result := InternalOpenVolume(AFileName);
if Assigned(Result) then
@@ -4142,17 +4142,17 @@
else
begin
while FVolumes.Count < Index do
- FVolumes.Add(TJclCompressionVolume.Create(nil, True, Format(VolumeNameMask, [Index + VolumeIndexOffset]), FVolumeMaxSize));
+ FVolumes.Add(TJclCompressionVolume.Create(nil, True, Format(VolumeFileNameMask, [Index + VolumeIndexOffset]), FVolumeMaxSize));
if Index < FVolumes.Count then
begin
AVolume := TJclCompressionVolume(FVolumes.Items[Index]);
- AVolume.FFileName := Format(VolumeNameMask, [Index + VolumeIndexOffset]);
+ AVolume.FFileName := Format(VolumeFileNameMask, [Index + VolumeIndexOffset]);
AVolume.FStream := nil;
AVolume.FOwnsStream := True;
AVolume.FVolumeMaxSize := FVolumeMaxSize;
end
else
- FVolumes.Add(TJclCompressionVolume.Create(nil, True, Format(VolumeNameMask, [Index + VolumeIndexOffset]), FVolumeMaxSize));
+ FVolumes.Add(TJclCompressionVolume.Create(nil, True, Format(VolumeFileNameMask, [Index + VolumeIndexOffset]), FVolumeMaxSize));
end;
end;
Result := FVolumeMaxSize;
@@ -4266,7 +4266,7 @@
end;
function TJclCompressArchive.AddFile(const PackedName: WideString;
- const FileName: string): Integer;
+ const FileName: TFileName): Integer;
var
AItem: TJclCompressionItem;
begin
@@ -4392,7 +4392,7 @@
procedure TJclCompressArchive.InternalAddFile(const Directory: string;
const FileInfo: TSearchRec);
var
- AFileName: string;
+ AFileName: TFileName;
AItem: TJclCompressionItem;
begin
AFileName := PathAddSeparator(Directory) + FileInfo.Name;
@@ -4550,9 +4550,9 @@
FDuplicateCheck := dcExisting;
end;
-constructor TJclUpdateArchive.Create(const VolumeName: string; AVolumeMaxSize: Int64; VolumeMask: Boolean);
+constructor TJclUpdateArchive.Create(const VolumeFileName: TFileName; AVolumeMaxSize: Int64; VolumeMask: Boolean);
begin
- inherited Create(VolumeName, AVolumeMaxSize, VolumeMask);
+ inherited Create(VolumeFileName, AVolumeMaxSize, VolumeMask);
FDuplicateCheck := dcExisting;
end;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ou...@us...> - 2009-02-20 16:51:31
|
Revision: 2656
http://jcl.svn.sourceforge.net/jcl/?rev=2656&view=rev
Author: outchy
Date: 2009-02-20 16:51:17 +0000 (Fri, 20 Feb 2009)
Log Message:
-----------
Force the release of volume reference after archive extraction, compression or update.
Modified Paths:
--------------
trunk/jcl/source/common/JclCompression.pas
Modified: trunk/jcl/source/common/JclCompression.pas
===================================================================
--- trunk/jcl/source/common/JclCompression.pas 2009-02-18 20:02:30 UTC (rev 2655)
+++ trunk/jcl/source/common/JclCompression.pas 2009-02-20 16:51:17 UTC (rev 2656)
@@ -41,7 +41,7 @@
{ }
{**************************************************************************************************}
{ }
-{ Last modified: $Date:: $ }
+{ Last modified: $Date:: $ }
{ Revision: $Rev:: $ }
{ Author: $Author:: $ }
{ }
@@ -681,6 +681,7 @@
constructor Create(AStream: TStream; AOwnsStream: Boolean; AFileName: TFileName;
AVolumeMaxSize: Int64);
destructor Destroy; override;
+ procedure ReleaseStreams;
property FileName: TFileName read FFileName;
property Stream: TStream read FStream;
property OwnsStream: Boolean read FOwnsStream;
@@ -718,6 +719,7 @@
procedure DoProgress(const Value, MaxValue: Int64);
function NeedVolume(Index: Integer): TStream;
function NeedVolumeMaxSize(Index: Integer): Int64;
+ procedure ReleaseVolumes;
function GetItemClass: TJclCompressionItemClass; virtual; abstract;
public
{ IInterface }
@@ -924,7 +926,7 @@
const FileName: string): Integer; overload; virtual;
function AddFile(const PackedName: WideString; AStream: TStream;
AOwnsStream: Boolean = False): Integer; overload; virtual;
- procedure Compress; virtual; abstract;
+ procedure Compress; virtual;
property DuplicateCheck: TJclCompressionDuplicateCheck read FDuplicateCheck write FDuplicateCheck;
property DuplicateAction: TJclCompressionDuplicateAction read FDuplicateAction write FDuplicateAction;
@@ -964,9 +966,9 @@
procedure ListFiles; virtual; abstract;
procedure ExtractSelected(const ADestinationDir: string = '';
- AAutoCreateSubDir: Boolean = True); virtual; abstract;
+ AAutoCreateSubDir: Boolean = True); virtual;
procedure ExtractAll(const ADestinationDir: string = '';
- AAutoCreateSubDir: Boolean = True); virtual; abstract;
+ AAutoCreateSubDir: Boolean = True); virtual;
property OnExtract: TJclCompressionExtractEvent read FOnExtract write FOnExtract;
property DestinationDir: string read FDestinationDir;
@@ -1006,9 +1008,9 @@
procedure ListFiles; virtual; abstract;
procedure ExtractSelected(const ADestinationDir: string = '';
- AAutoCreateSubDir: Boolean = True); virtual; abstract;
+ AAutoCreateSubDir: Boolean = True); virtual;
procedure ExtractAll(const ADestinationDir: string = '';
- AAutoCreateSubDir: Boolean = True); virtual; abstract;
+ AAutoCreateSubDir: Boolean = True); virtual;
procedure DeleteItem(Index: Integer); virtual; abstract;
procedure RemoveItem(const PackedName: WideString); virtual; abstract;
@@ -3891,9 +3893,14 @@
destructor TJclCompressionVolume.Destroy;
begin
+ ReleaseStreams;
+ inherited Destroy;
+end;
+
+procedure TJclCompressionVolume.ReleaseStreams;
+begin
if OwnsStream then
FStream.Free;
- inherited Destroy;
end;
//=== { TJclCompressionArchive } =============================================
@@ -4151,6 +4158,14 @@
Result := FVolumeMaxSize;
end;
+procedure TJclCompressionArchive.ReleaseVolumes;
+var
+ Index: Integer;
+begin
+ for Index := 0 to FVolumes.Count - 1 do
+ TJclCompressionVolume(FVolumes.Items[Index]).ReleaseStreams;
+end;
+
procedure TJclCompressionArchive.SelectAll;
var
Index: Integer;
@@ -4364,6 +4379,11 @@
raise EJclCompressionError.CreateRes(@RsCompressionCompressingError);
end;
+procedure TJclCompressArchive.Compress;
+begin
+ ReleaseVolumes;
+end;
+
procedure TJclCompressArchive.InternalAddDirectory(const Directory: string);
begin
AddDirectory(TranslateItemPath(Directory, FBaseDirName, FBaseRelName), Directory, False, FAddFilesInDir);
@@ -4433,6 +4453,18 @@
raise EJclCompressionError.CreateRes(@RsCompressionDecompressingError);
end;
+procedure TJclDecompressArchive.ExtractAll(const ADestinationDir: string;
+ AAutoCreateSubDir: Boolean);
+begin
+ ReleaseVolumes;
+end;
+
+procedure TJclDecompressArchive.ExtractSelected(const ADestinationDir: string;
+ AAutoCreateSubDir: Boolean);
+begin
+ ReleaseVolumes;
+end;
+
class function TJclDecompressArchive.ItemAccess: TJclStreamAccess;
begin
Result := saCreate;
@@ -4524,6 +4556,18 @@
FDuplicateCheck := dcExisting;
end;
+procedure TJclUpdateArchive.ExtractAll(const ADestinationDir: string;
+ AAutoCreateSubDir: Boolean);
+begin
+ ReleaseVolumes;
+end;
+
+procedure TJclUpdateArchive.ExtractSelected(const ADestinationDir: string;
+ AAutoCreateSubDir: Boolean);
+begin
+ ReleaseVolumes;
+end;
+
class function TJclUpdateArchive.ItemAccess: TJclStreamAccess;
begin
Result := saReadWrite;
@@ -5428,6 +5472,8 @@
SevenzipCheck(FOutArchive.UpdateItems(OutStream, ItemCount, UpdateCallback));
finally
FCompressing := False;
+ // release volumes and other finalizations
+ inherited Compress;
end;
end;
@@ -6265,6 +6311,8 @@
FDecompressing := False;
FExtractingAllIndex := -1;
AExtractCallback := nil;
+ // release volumes and other finalizations
+ inherited ExtractAll(ADestinationDir, AAutoCreateSubDir);
end;
end;
@@ -6309,6 +6357,8 @@
FDestinationDir := '';
FDecompressing := False;
AExtractCallback := nil;
+ // release volumes and other finalizations
+ inherited ExtractSelected(ADestinationDir, AAutoCreateSubDir);
end;
end;
@@ -7057,6 +7107,8 @@
SevenzipCheck(FOutArchive.UpdateItems(OutStream, ItemCount, UpdateCallback));
finally
FCompressing := False;
+ // release volumes and other finalizations
+ inherited Compress;
end;
end;
@@ -7142,6 +7194,8 @@
FDecompressing := False;
FExtractingAllIndex := -1;
AExtractCallback := nil;
+ // release volumes and other finalizations
+ inherited ExtractAll(ADestinationDir, AAutoCreateSubDir);
end;
end;
@@ -7187,6 +7241,8 @@
FDestinationDir := '';
FDecompressing := False;
AExtractCallback := nil;
+ // release volumes and other finalizations
+ inherited ExtractSelected(ADestinationDir, AAutoCreateSubDir);
end;
end;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ou...@us...> - 2009-02-17 14:39:30
|
Revision: 2652
http://jcl.svn.sourceforge.net/jcl/?rev=2652&view=rev
Author: outchy
Date: 2009-02-17 14:39:19 +0000 (Tue, 17 Feb 2009)
Log Message:
-----------
Conditional compilation statements style cleanup.
Modified Paths:
--------------
trunk/jcl/source/common/Jcl8087.pas
trunk/jcl/source/common/JclAnsiStrings.pas
trunk/jcl/source/common/JclBase.pas
trunk/jcl/source/common/JclBorlandTools.pas
trunk/jcl/source/common/JclComplex.pas
trunk/jcl/source/common/JclCompression.pas
trunk/jcl/source/common/JclCounter.pas
trunk/jcl/source/common/JclDateTime.pas
trunk/jcl/source/common/JclEDI.pas
trunk/jcl/source/common/JclEDISEF.pas
trunk/jcl/source/common/JclEDIXML.pas
trunk/jcl/source/common/JclEDI_ANSIX12.pas
trunk/jcl/source/common/JclEDI_UNEDIFACT.pas
trunk/jcl/source/common/JclFileUtils.pas
trunk/jcl/source/common/JclLogic.pas
trunk/jcl/source/common/JclMIDI.pas
trunk/jcl/source/common/JclMath.pas
trunk/jcl/source/common/JclMime.pas
trunk/jcl/source/common/JclRTTI.pas
trunk/jcl/source/common/JclSimpleXml.pas
trunk/jcl/source/common/JclStatistics.pas
trunk/jcl/source/common/JclStrHashMap.pas
trunk/jcl/source/common/JclStreams.pas
trunk/jcl/source/common/JclStringLists.pas
trunk/jcl/source/common/JclStrings.pas
trunk/jcl/source/common/JclSynch.pas
trunk/jcl/source/common/JclSysInfo.pas
trunk/jcl/source/common/JclSysUtils.pas
trunk/jcl/source/common/JclUnicode.pas
trunk/jcl/source/common/JclUnitConv.pas
trunk/jcl/source/common/JclUnitVersioning.pas
trunk/jcl/source/common/JclWideStrings.pas
trunk/jcl/source/common/pcre.pas
trunk/jcl/source/prototypes/JclWin32.pas
trunk/jcl/source/prototypes/win32api/LmCons.int
trunk/jcl/source/prototypes/win32api/Nb30.int
trunk/jcl/source/prototypes/win32api/WinBase.int
trunk/jcl/source/prototypes/win32api/WinUser.int
trunk/jcl/source/windows/JclConsole.pas
trunk/jcl/source/windows/JclHookExcept.pas
trunk/jcl/source/windows/JclMiscel.pas
trunk/jcl/source/windows/JclNTFS.pas
trunk/jcl/source/windows/JclRegistry.pas
trunk/jcl/source/windows/JclSecurity.pas
trunk/jcl/source/windows/JclSvcCtrl.pas
trunk/jcl/source/windows/JclWideFormat.pas
trunk/jcl/source/windows/JclWin32.pas
trunk/jcl/source/windows/Snmp.pas
Modified: trunk/jcl/source/common/Jcl8087.pas
===================================================================
--- trunk/jcl/source/common/Jcl8087.pas 2009-02-17 11:45:24 UTC (rev 2651)
+++ trunk/jcl/source/common/Jcl8087.pas 2009-02-17 14:39:19 UTC (rev 2652)
@@ -96,9 +96,9 @@
asm
{$IFDEF FPC}
SUB ESP, $2
- {$ELSE}
+ {$ELSE ~FPC}
SUB ESP, TYPE WORD
- {$ENDIF FPC}
+ {$ENDIF ~FPC}
FSTCW [ESP]
FWAIT
POP AX
@@ -161,17 +161,17 @@
FNCLEX
{$IFDEF FPC}
SUB ESP, $2
- {$ELSE}
+ {$ELSE ~FPC}
SUB ESP, TYPE WORD
- {$ENDIF FPC}
+ {$ENDIF ~FPC}
FSTCW [ESP]
XCHG [ESP], AX
FLDCW [ESP]
{$IFDEF FPC}
ADD ESP, $2
- {$ELSE}
+ {$ELSE ~FPC}
ADD ESP, TYPE WORD
- {$ENDIF FPC}
+ {$ENDIF ~FPC}
end;
function ClearPending8087Exceptions: T8087Exceptions;
@@ -191,9 +191,9 @@
asm
{$IFDEF FPC}
SUB ESP, $2
- {$ELSE}
+ {$ELSE ~FPC}
SUB ESP, TYPE WORD
- {$ENDIF FPC}
+ {$ENDIF ~FPC}
FSTCW [ESP]
FWAIT
POP AX
@@ -208,9 +208,9 @@
@1:
{$IFDEF FPC}
SUB ESP, $2
- {$ELSE}
+ {$ELSE ~FPC}
SUB ESP, TYPE WORD
- {$ENDIF FPC}
+ {$ENDIF ~FPC}
FSTCW [ESP]
FWAIT
AND AX, X87ExceptBits // mask exception mask bits 0..5
@@ -220,9 +220,9 @@
FLDCW [ESP]
{$IFDEF FPC}
ADD ESP, $2
- {$ELSE}
+ {$ELSE ~FPC}
ADD ESP, TYPE WORD
- {$ENDIF FPC}
+ {$ENDIF ~FPC}
MOV AX, DX
AND AX, X87ExceptBits
end;
Modified: trunk/jcl/source/common/JclAnsiStrings.pas
===================================================================
--- trunk/jcl/source/common/JclAnsiStrings.pas 2009-02-17 11:45:24 UTC (rev 2651)
+++ trunk/jcl/source/common/JclAnsiStrings.pas 2009-02-17 14:39:19 UTC (rev 2652)
@@ -473,7 +473,7 @@
CurrType := 0;
end;
{$DEFINE CHAR_TYPES_INITIALIZED}
- {$ELSE}
+ {$ELSE ~CLR}
{$IFDEF MSWINDOWS}
GetStringTypeExA(LOCALE_USER_DEFAULT, CT_CTYPE1, @CurrChar, SizeOf(AnsiChar), CurrType);
{$DEFINE CHAR_TYPES_INITIALIZED}
@@ -500,7 +500,7 @@
CurrType := CurrType or C1_ALPHA;
{$DEFINE CHAR_TYPES_INITIALIZED}
{$ENDIF LINUX}
- {$ENDIF CLR}
+ {$ENDIF ~CLR}
AnsiCharTypes[CurrChar] := CurrType;
{$IFNDEF CHAR_TYPES_INITIALIZED}
Implement case map initialization here
@@ -520,7 +520,7 @@
LoCaseChar := AnsiChar(System.Char.ToLower(Char(CurrChar)));
UpCaseChar := AnsiChar(System.Char.ToUpper(Char(CurrChar)));
{$DEFINE CASE_MAP_INITIALIZED}
- {$ELSE}
+ {$ELSE ~CLR}
{$IFDEF MSWINDOWS}
LoCaseChar := CurrChar;
UpCaseChar := CurrChar;
@@ -533,7 +533,7 @@
UpCaseChar := AnsiChar(toupper(Byte(CurrChar)));
{$DEFINE CASE_MAP_INITIALIZED}
{$ENDIF LINUX}
- {$ENDIF CLR}
+ {$ENDIF ~CLR}
{$IFNDEF CASE_MAP_INITIALIZED}
Implement case map initialization here
{$ENDIF ~CASE_MAP_INITIALIZED}
@@ -563,7 +563,7 @@
for I := 0 to Length(Str) - 1 do
Str[I + 1] := AnsiCaseMap[Offset + Ord(Str[I + 1])];
end;
-{$ELSE}
+{$ELSE ~CLR}
procedure StrCase(var Str: AnsiString; const Offset: Integer); register; assembler;
asm
// make sure that the string is not null
@@ -598,9 +598,9 @@
{$IFDEF PIC}
LEA EBX, [EBX][AnsiCaseMap + EDX]
- {$ELSE}
+ {$ELSE ~PIC}
LEA EBX, [AnsiCaseMap + EDX]
- {$ENDIF PIC}
+ {$ENDIF ~PIC}
MOV ESI, EAX
XOR EDX, EDX
XOR EAX, EAX
@@ -657,7 +657,7 @@
@@StrIsNull:
end;
-{$ENDIF CLR}
+{$ENDIF ~CLR}
{$IFNDEF CLR}
// Internal utility function
@@ -680,9 +680,9 @@
{$IFDEF PIC}
LEA EBX, [EBX][AnsiCaseMap + EDX]
- {$ELSE}
+ {$ELSE ~PIC}
LEA EBX, [AnsiCaseMap + EDX]
- {$ENDIF PIC}
+ {$ENDIF ~PIC}
MOV ESI, EAX
XOR EDX, EDX
XOR EAX, EAX
@@ -987,9 +987,9 @@
if Val > Ord(High(AnsiChar)) then
{$IFDEF CLR}
raise EJclAnsiStringError.Create(RsNumericConstantTooLarge);
- {$ELSE}
+ {$ELSE ~CLR}
raise EJclAnsiStringError.CreateRes(@RsNumericConstantTooLarge);
- {$ENDIF CLR}
+ {$ENDIF ~CLR}
Result := Result + AnsiChar(Val);
end;
@@ -1025,9 +1025,9 @@
if Val > Ord(High(AnsiChar)) then
{$IFDEF CLR}
raise EJclAnsiStringError.Create(RsNumericConstantTooLarge);
- {$ELSE}
+ {$ELSE ~CLR}
raise EJclAnsiStringError.CreateRes(@RsNumericConstantTooLarge);
- {$ENDIF CLR}
+ {$ENDIF ~CLR}
Result := Result + AnsiChar(Val);
end;
@@ -1096,7 +1096,7 @@
begin
StrCase(S, AnsiLoOffset);
end;
-{$ELSE}
+{$ELSE ~PIC}
assembler;
asm
// StrCase(S, AnsiLoOffset)
@@ -1104,7 +1104,7 @@
XOR EDX, EDX // MOV EDX, LoOffset
JMP StrCase
end;
-{$ENDIF PIC}
+{$ENDIF ~PIC}
{$IFNDEF CLR}
procedure StrLowerBuff(S: PAnsiChar);
@@ -1112,14 +1112,14 @@
begin
StrCaseBuff(S, AnsiLoOffset);
end;
-{$ELSE}
+{$ELSE ~PIC}
assembler;
asm
// StrCaseBuff(S, LoOffset)
XOR EDX, EDX // MOV EDX, LoOffset
JMP StrCaseBuff
end;
-{$ENDIF PIC}
+{$ENDIF ~PIC}
{$ENDIF ~CLR}
{$IFDEF CLR}
@@ -1150,9 +1150,9 @@
// Move
{$IFDEF CLR}
MoveAnsiString(Source, FromIndex, Dest, ToIndex, Count);
- {$ELSE}
+ {$ELSE ~CLR}
Move(Source[FromIndex], Dest[ToIndex], Count);
- {$ENDIF CLR}
+ {$ENDIF ~CLR}
end;
function StrPadLeft(const S: AnsiString; Len: Integer; C: AnsiChar): AnsiString;
@@ -1181,9 +1181,9 @@
begin
{$IFDEF CLR}
Result := AnsiUpperCase(S);
- {$ELSE}
+ {$ELSE ~CLR}
Result := StrLower(S);
- {$ENDIF CLR}
+ {$ENDIF ~CLR}
if Result <> '' then
Result[1] := UpCase(Result[1]);
end;
@@ -1232,7 +1232,7 @@
end;
SetLength(Result, Index);
end;
-{$ELSE}
+{$ELSE ~CLR}
var
Source, Dest: PAnsiChar;
Index, Len: Integer;
@@ -1253,7 +1253,7 @@
end;
SetLength(Result, Dest - PAnsiChar(Result));
end;
-{$ENDIF CLR}
+{$ENDIF ~CLR}
function StrKeepChars(const S: AnsiString; const Chars: TSysCharSet): AnsiString;
{$IFDEF CLR}
@@ -1270,7 +1270,7 @@
end;
SetLength(Result, Index);
end;
-{$ELSE}
+{$ELSE ~CLR}
var
Source, Dest: PAnsiChar;
Index, Len: Integer;
@@ -1291,7 +1291,7 @@
end;
SetLength(Result, Dest - PAnsiChar(Result));
end;
-{$ENDIF CLR}
+{$ENDIF ~CLR}
function StrRepeat(const S: AnsiString; Count: Integer): AnsiString;
{$IFDEF CLR}
@@ -1304,7 +1304,7 @@
for I := 1 to Count do
MoveAnsiString(S, 1, Result, I * Len, Len);
end;
-{$ELSE}
+{$ELSE ~CLR}
var
L: Integer;
P: PAnsiChar;
@@ -1322,7 +1322,7 @@
end;
end;
end;
-{$ENDIF CLR}
+{$ENDIF ~CLR}
function StrRepeatLength(const S: AnsiString; const L: Integer): AnsiString;
{$IFDEF CLR}
@@ -1350,7 +1350,7 @@
SetLength(Result, L);
end;
end;
-{$ELSE}
+{$ELSE ~CLR}
var
Count: Integer;
LenS: Integer;
@@ -1376,14 +1376,14 @@
SetLength(Result, L);
end;
end;
-{$ENDIF CLR}
+{$ENDIF ~CLR}
procedure StrReplace(var S: AnsiString; const Search, Replace: AnsiString; Flags: TReplaceFlags);
{$IFDEF CLR}
begin
S := StringReplace(S, Search, Replace, Flags); // !!! Convertion to System.String
end;
-{$ELSE}
+{$ELSE ~CLR}
var
SearchStr: AnsiString;
ResultStr: AnsiString; { result string }
@@ -1512,7 +1512,7 @@
S := ResultStr;
end;
end;
-{$ENDIF CLR}
+{$ENDIF ~CLR}
function StrReplaceChar(const S: AnsiString; const Source, Replace: AnsiChar): AnsiString;
var
@@ -1568,7 +1568,7 @@
Dec(EndI);
end;
end;
-{$ELSE}
+{$ELSE ~CLR}
var
P1, P2: PAnsiChar;
C: AnsiChar;
@@ -1585,7 +1585,7 @@
Dec(P2);
end;
end;
-{$ENDIF CLR}
+{$ENDIF ~CLR}
function StrSingleQuote(const S: AnsiString): AnsiString;
begin
@@ -1597,10 +1597,10 @@
{$IFDEF CLR}
Index: Integer;
LenS: Integer;
- {$ELSE}
+ {$ELSE ~CLR}
Source, Dest: PAnsiChar;
Index, Len: Integer;
- {$ENDIF CLR}
+ {$ENDIF ~CLR}
begin
Result := '';
if Delimiters = [] then
@@ -1618,7 +1618,7 @@
Result[Index + 1] := CharUpper(Result[Index + 1]);
Inc(Index);
end;
- {$ELSE}
+ {$ELSE ~CLR}
UniqueString(Result);
Len := Length(S);
@@ -1634,7 +1634,7 @@
Inc(Dest);
Inc(Source);
end;
- {$ENDIF CLR}
+ {$ENDIF ~CLR}
Result[1] := CharUpper(Result[1]);
end;
@@ -1801,13 +1801,13 @@
begin
StrCase(S, AnsiUpOffset);
end;
-{$ELSE}
+{$ELSE ~PIC}
asm
// StrCase(Str, AnsiUpOffset)
MOV EDX, AnsiUpOffset
JMP StrCase
end;
-{$ENDIF PIC}
+{$ENDIF ~PIC}
{$IFNDEF CLR}
procedure StrUpperBuff(S: PAnsiChar);
@@ -1815,13 +1815,13 @@
begin
StrCaseBuff(S, AnsiUpOffset);
end;
-{$ELSE}
+{$ELSE ~PIC}
asm
// StrCaseBuff(S, UpOffset)
MOV EDX, AnsiUpOffset
JMP StrCaseBuff
end;
-{$ENDIF PIC}
+{$ENDIF ~PIC}
{$ENDIF ~CLR}
{$IFDEF MSWINDOWS}
@@ -1978,7 +1978,7 @@
begin
Result := AnsiCompareStr(S1, S2);
end;
-{$ELSE}
+{$ELSE ~CLR}
{$IFDEF PIC}
function _StrCompare(const S1, S2: AnsiString): Integer; forward;
@@ -1988,9 +1988,9 @@
end;
function _StrCompare(const S1, S2: AnsiString): Integer; assembler;
-{$ELSE}
+{$ELSE ~PIC}
function StrCompare(const S1, S2: AnsiString): Integer; assembler;
-{$ENDIF PIC}
+{$ENDIF ~PIC}
asm
// check if pointers are equal
@@ -2128,14 +2128,14 @@
@@Equal:
XOR EAX, EAX
end;
-{$ENDIF CLR}
+{$ENDIF ~CLR}
{$IFDEF CLR}
function StrCompareRange(const S1, S2: AnsiString; const Index, Count: Integer): Integer;
begin
Result := System.String.Compare(S1, Index - 1, S2, Index - 1, Count, False);
end;
-{$ELSE}
+{$ELSE ~CLR}
function StrCompareRange(const S1, S2: AnsiString; const Index, Count: Integer): Integer; assembler;
asm
TEST EAX, EAX
@@ -2228,7 +2228,7 @@
@@Exit:
end;
-{$ENDIF CLR}
+{$ENDIF ~CLR}
function StrRepeatChar(C: AnsiChar; Count: Integer): AnsiString;
{$IFDEF CLR}
@@ -2240,20 +2240,20 @@
Dec(Count);
end;
end;
-{$ELSE}
+{$ELSE ~CLR}
begin
SetLength(Result, Count);
if Count > 0 then
FillChar(Result[1], Count, C);
end;
-{$ENDIF CLR}
+{$ENDIF ~CLR}
{$IFDEF CLR}
function StrFind(const Substr, S: AnsiString; const Index: Integer): Integer;
begin
Result := System.String(S).ToLower().IndexOf(System.String(SubStr).ToLower, Index - 1) + 1;
end;
-{$ELSE}
+{$ELSE ~CLR}
function StrFind(const Substr, S: AnsiString; const Index: Integer): Integer; assembler;
const
SearchChar: Byte = 0;
@@ -2425,7 +2425,7 @@
@@SubstrIsNull:
@@Exit:
end;
-{$ENDIF CLR}
+{$ENDIF ~CLR}
function StrHasPrefix(const S: AnsiString; const Prefixes: array of AnsiString): Boolean;
begin
@@ -2467,7 +2467,7 @@
begin
Result := System.String(S).LastIndexOf(SubStr) + 1;
end;
-{$ELSE}
+{$ELSE ~CLR}
var
Last, Current: PAnsiChar;
begin
@@ -2487,7 +2487,7 @@
if Last <> nil then
Result := Abs(PAnsiChar(S) - Last) + 1;
end;
-{$ENDIF CLR}
+{$ENDIF ~CLR}
// IMPORTANT NOTE: The StrMatch function does currently not work with the Asterix (*)
@@ -2857,7 +2857,7 @@
begin
Result := System.String(S).IndexOf(SubStr, Index - 1) + 1;
end;
-{$ELSE}
+{$ELSE ~CLR}
function StrSearch(const Substr, S: AnsiString; const Index: Integer): Integer; assembler;
asm
// make sure that strings are not null
@@ -3013,7 +3013,7 @@
@@SubstrIsNull:
@@Exit:
end;
-{$ENDIF CLR}
+{$ENDIF ~CLR}
//=== String Extraction ======================================================
@@ -3371,7 +3371,7 @@
Inc(Result);
end;
end;
-{$ELSE}
+{$ELSE ~CLR}
var
P: PAnsiChar;
Index, Len: Integer;
@@ -3393,7 +3393,7 @@
end;
end;
end;
-{$ENDIF CLR}
+{$ENDIF ~CLR}
{$IFNDEF CLR}
//=== MultiSz ================================================================
@@ -3666,9 +3666,9 @@
FS.ReadBuffer(Buf, Len);
Result := Buf;
end;
- {$ELSE}
+ {$ELSE ~CLR}
FS.ReadBuffer(Result[1], Len);
- {$ENDIF CLR}
+ {$ENDIF ~CLR}
finally
FS.Free;
end;
@@ -3690,9 +3690,9 @@
if Len > 0 then
{$IFDEF CLR}
FS.WriteBuffer(BytesOf(Contents), Len);
- {$ELSE}
+ {$ELSE ~CLR}
FS.WriteBuffer(Contents[1], Len);
- {$ENDIF CLR}
+ {$ENDIF ~CLR}
finally
FS.Free;
end;
Modified: trunk/jcl/source/common/JclBase.pas
===================================================================
--- trunk/jcl/source/common/JclBase.pas 2009-02-17 11:45:24 UTC (rev 2651)
+++ trunk/jcl/source/common/JclBase.pas 2009-02-17 14:39:19 UTC (rev 2652)
@@ -30,7 +30,7 @@
{ }
{**************************************************************************************************}
{ }
-{ Last modified: $Date:: $ }
+{ Last modified: $Date:: $ }
{ Revision: $Rev:: $ }
{ Author: $Author:: $ }
{ }
@@ -48,11 +48,11 @@
{$ENDIF UNITVERSIONING}
{$IFDEF CLR}
Classes, System.Reflection,
- {$ELSE}
+ {$ELSE ~CLR}
{$IFDEF MSWINDOWS}
Windows,
{$ENDIF MSWINDOWS}
- {$ENDIF CLR}
+ {$ENDIF ~CLR}
{$IFDEF SUPPORTS_GENERICS}
{$IFDEF CLR}
System.Collections.Generic,
@@ -117,12 +117,12 @@
type
{$IFDEF FPC}
Largeint = Int64;
- {$ELSE}
+ {$ELSE ~FPC}
PPointer = ^Pointer;
{$IFDEF RTL140_UP}
{$IFDEF CLR}
PJclByteArray = TBytes;
- {$ELSE}
+ {$ELSE ~CLR}
PByte = System.PByte;
Int8 = ShortInt;
Int16 = Smallint;
@@ -130,12 +130,12 @@
UInt8 = Byte;
UInt16 = Word;
UInt32 = LongWord;
- {$ENDIF CLR}
+ {$ENDIF ~CLR}
{$ELSE ~RTL140_UP}
PBoolean = ^Boolean;
PByte = Windows.PByte;
{$ENDIF ~RTL140_UP}
- {$ENDIF FPC}
+ {$ENDIF ~FPC}
PCardinal = ^Cardinal;
{$IFNDEF COMPILER7_UP}
UInt64 = Int64;
@@ -145,7 +145,7 @@
PPWideChar = ^JclBase.PWideChar;
PInt64 = type System.PInt64;
PPInt64 = ^JclBase.PInt64;
- {$ENDIF CLR}
+ {$ENDIF ~CLR}
// Interface compatibility
{$IFDEF SUPPORTS_INTERFACE}
@@ -175,7 +175,7 @@
{$IFDEF CLR}
type
TJclBytes = TBytes;
-{$ELSE}
+{$ELSE ~CLR}
// Redefinition of PByteArray to avoid range check exceptions.
type
TJclByteArray = array [0..MaxInt div SizeOf(Byte) - 1] of Byte;
@@ -477,7 +477,7 @@
List[FromIndex + I] := nil;
end;
end;
-{$ELSE}
+{$ELSE ~CLR}
begin
if Count > 0 then
begin
@@ -500,7 +500,7 @@
end;
end;
end;
-{$ENDIF CLR}
+{$ENDIF ~CLR}
{$IFNDEF CLR}
procedure MoveArray(var List: TDynStringArray; FromIndex, ToIndex, Count: Integer); overload;
@@ -637,7 +637,7 @@
List[FromIndex + I] := '';
end;
end;
-{$ELSE}
+{$ELSE ~CLR}
begin
if Count > 0 then
begin
@@ -660,8 +660,8 @@
end;
end;
end;
-{$ENDIF CLR}
-{$ENDIF FPC}
+{$ENDIF ~CLR}
+{$ENDIF ~FPC}
procedure MoveArray(var List: TDynWideStringArray; FromIndex, ToIndex, Count: Integer); overload;
{$IFDEF CLR}
@@ -696,7 +696,7 @@
List[FromIndex + I] := '';
end;
end;
-{$ELSE}
+{$ELSE ~CLR}
begin
if Count > 0 then
begin
@@ -719,7 +719,7 @@
end;
end;
end;
-{$ENDIF CLR}
+{$ENDIF ~CLR}
procedure MoveArray(var List: TDynObjectArray; FromIndex, ToIndex, Count: Integer); overload;
{$IFDEF CLR}
@@ -754,7 +754,7 @@
List[FromIndex + I] := nil;
end;
end;
-{$ELSE}
+{$ELSE ~CLR}
begin
if Count > 0 then
begin
@@ -777,7 +777,7 @@
end;
end;
end;
-{$ENDIF CLR}
+{$ENDIF ~CLR}
procedure MoveArray(var List: TDynSingleArray; FromIndex, ToIndex, Count: Integer); overload;
{$IFDEF CLR}
@@ -812,7 +812,7 @@
List[FromIndex + I] := 0.0;
end;
end;
-{$ELSE}
+{$ELSE ~CLR}
begin
if Count > 0 then
begin
@@ -835,7 +835,7 @@
end;
end;
end;
-{$ENDIF CLR}
+{$ENDIF ~CLR}
procedure MoveArray(var List: TDynDoubleArray; FromIndex, ToIndex, Count: Integer); overload;
{$IFDEF CLR}
@@ -870,7 +870,7 @@
List[FromIndex + I] := 0.0;
end;
end;
-{$ELSE}
+{$ELSE ~CLR}
begin
if Count > 0 then
begin
@@ -893,7 +893,7 @@
end;
end;
end;
-{$ENDIF CLR}
+{$ENDIF ~CLR}
{$IFNDEF FPC}
procedure MoveArray(var List: TDynExtendedArray; FromIndex, ToIndex, Count: Integer); overload;
@@ -929,7 +929,7 @@
List[FromIndex + I] := 0.0;
end;
end;
-{$ELSE}
+{$ELSE ~CLR}
begin
if Count > 0 then
begin
@@ -952,8 +952,8 @@
end;
end;
end;
-{$ENDIF CLR}
-{$ENDIF FPC}
+{$ENDIF ~CLR}
+{$ENDIF ~FPC}
procedure MoveArray(var List: TDynIntegerArray; FromIndex, ToIndex, Count: Integer); overload;
{$IFDEF CLR}
@@ -988,7 +988,7 @@
List[FromIndex + I] := 0;
end;
end;
-{$ELSE}
+{$ELSE ~CLR}
begin
if Count > 0 then
begin
@@ -1011,7 +1011,7 @@
end;
end;
end;
-{$ENDIF CLR}
+{$ENDIF ~CLR}
procedure MoveArray(var List: TDynCardinalArray; FromIndex, ToIndex, Count: Integer); overload;
{$IFDEF CLR}
@@ -1046,7 +1046,7 @@
List[FromIndex + I] := 0;
end;
end;
-{$ELSE}
+{$ELSE ~CLR}
begin
if Count > 0 then
begin
@@ -1069,7 +1069,7 @@
end;
end;
end;
-{$ENDIF CLR}
+{$ENDIF ~CLR}
procedure MoveArray(var List: TDynInt64Array; FromIndex, ToIndex, Count: Integer); overload;
{$IFDEF CLR}
@@ -1104,7 +1104,7 @@
List[FromIndex + I] := 0;
end;
end;
-{$ELSE}
+{$ELSE ~CLR}
begin
if Count > 0 then
begin
@@ -1127,7 +1127,7 @@
end;
end;
end;
-{$ENDIF CLR}
+{$ENDIF ~CLR}
procedure MoveChar(const Source: string; FromIndex: Integer;
var Dest: string; ToIndex, Count: Integer);
@@ -1144,14 +1144,14 @@
for I := Count - 1 downto 0 do
Buf[ToIndex + I] := Source[FromIndex + I];
Dest := System.String.Create(Buf);
-{$ELSE}
+end;
+{$ELSE ~CLR}
begin
Move(Source[FromIndex + 1], Dest[ToIndex + 1], Count * SizeOf(Char));
-{$ENDIF CLR}
end;
+{$ENDIF ~CLR}
{$IFDEF CLR}
-
function GetBytesEx(const Value): TBytes;
begin
if TObject(Value) is TBytes then
@@ -1287,7 +1287,7 @@
end;
end;
-{$ELSE}
+{$ELSE ~CLR}
function BytesOf(const Value: AnsiString): TBytes;
begin
@@ -1339,7 +1339,7 @@
Result := '';
end;
-{$ENDIF CLR}
+{$ENDIF ~CLR}
//== { EJclWin32Error } ======================================================
@@ -1379,9 +1379,9 @@
FLastErrorMsg := SysErrorMessage(FLastError);
{$IFDEF FPC}
inherited CreateFmt(ResStringRec^ + AnsiLineBreak + RsWin32Prefix, [FLastErrorMsg, FLastError]);
- {$ELSE}
+ {$ELSE ~FPC}
inherited CreateFmt(LoadResString(ResStringRec) + NativeLineBreak + RsWin32Prefix, [FLastErrorMsg, FLastError]);
- {$ENDIF FPC}
+ {$ENDIF ~FPC}
end;
{$ENDIF ~CLR}
@@ -1394,20 +1394,20 @@
{$IFDEF CLR}
LowPart := Cardinal(I and $00000000FFFFFFFF);
HighPart := Cardinal(I shr 32);
- {$ELSE}
+ {$ELSE ~CLR}
LowPart := TULargeInteger(I).LowPart;
HighPart := TULargeInteger(I).HighPart;
- {$ENDIF CLR}
+ {$ENDIF ~CLR}
end;
procedure CardinalsToI64(var I: Int64; const LowPart, HighPart: Cardinal);
begin
{$IFDEF CLR}
I := Int64(HighPart) shl 16 or LowPart;
- {$ELSE}
+ {$ELSE ~CLR}
TULargeInteger(I).LowPart := LowPart;
TULargeInteger(I).HighPart := HighPart;
- {$ENDIF CLR}
+ {$ENDIF ~CLR}
end;
// Cross Platform Compatibility
Modified: trunk/jcl/source/common/JclBorlandTools.pas
===================================================================
--- trunk/jcl/source/common/JclBorlandTools.pas 2009-02-17 11:45:24 UTC (rev 2651)
+++ trunk/jcl/source/common/JclBorlandTools.pas 2009-02-17 14:39:19 UTC (rev 2652)
@@ -78,9 +78,9 @@
TJclBorRADToolKind = (brDelphi, brCppBuilder, brBorlandDevStudio);
{$IFDEF KYLIX}
TJclBorRADToolEdition = (deOPEN, dePRO, deSVR);
- {$ELSE}
+ {$ELSE ~KYLIX}
TJclBorRADToolEdition = (deSTD, dePRO, deCSS, deARC);
- {$ENDIF KYLIX}
+ {$ENDIF ~KYLIX}
TJclBorRADToolPath = string;
const
@@ -1009,9 +1009,9 @@
{$IFDEF KYLIX}
RootDirValueName = 'DelphiRoot';
- {$ELSE}
+ {$ELSE ~KYLIX}
RootDirValueName = 'RootDir';
- {$ENDIF KYLIX}
+ {$ENDIF ~KYLIX}
EditionValueName = 'Edition';
VersionValueName = 'Version';
@@ -3131,9 +3131,9 @@
inherited Create(AInstallation);
{$IFDEF KYLIX}
FFileName := AInstallation.ConfigFileName('dro');
- {$ELSE}
+ {$ELSE ~KYLIX}
FFileName := AInstallation.BinFolderName + BorRADToolRepositoryFileName;
- {$ENDIF KYLIX}
+ {$ENDIF ~KYLIX}
FPages := TStringList.Create;
IniFile.ReadSection(BorRADToolRepositoryPagesSection, FPages);
CloseIniFile;
@@ -3615,7 +3615,7 @@
else
Result := RsServerDeveloper;
end;
- {$ELSE}
+ {$ELSE ~KYLIX}
Result := FEditionStr;
if Length(FEditionStr) = 3 then
case Edition of
@@ -3634,7 +3634,7 @@
deARC:
Result := RsArchitect;
end;
- {$ENDIF KYLIX}
+ {$ENDIF ~KYLIX}
end;
function TJclBorRADToolInstallation.GetEnvironmentVariables: TStrings;
@@ -3690,9 +3690,9 @@
{$IFDEF KYLIX}
{ TODO : determine Kylix IDE build # }
Result := '?';
- {$ELSE}
+ {$ELSE ~KYLIX}
Result := VersionFixedFileInfoString(IdeExeFileName, vfFull);
- {$ENDIF KYLIX}
+ {$ENDIF ~KYLIX}
end;
function TJclBorRADToolInstallation.GetIdePackages: TJclBorRADToolIdePackages;
@@ -3777,9 +3777,9 @@
begin
{$IFDEF KYLIX}
Result := True;
- {$ELSE}
+ {$ELSE ~KYLIX}
Result := (RadToolKind = brBorlandDevStudio) or (VersionNumber >= 6);
- {$ENDIF KYLIX}
+ {$ENDIF ~KYLIX}
end;
function TJclBorRADToolInstallation.GetUpdateNeeded: Boolean;
@@ -3942,9 +3942,9 @@
begin
{$IFDEF MSWINDOWS}
Result := InheritsFrom(TJclBDSInstallation);
- {$ELSE}
+ {$ELSE ~MSWINDOWS}
Result := False;
- {$ENDIF MSWINDOWS}
+ {$ENDIF ~MSWINDOWS}
end;
{$ENDIF KEEP_DEPRECATED}
@@ -4359,10 +4359,10 @@
begin
{$IFDEF KYLIX}
Result := True;
- {$ELSE}
+ {$ELSE ~KYLIX}
Result := (Edition <> deSTD) and (VersionNumber in [6, 7]) and (RadToolKind <> brBorlandDevStudio) and
(FileExists(LibFolderName + VisualClxDcp) or FileExists(ObjFolderName + VisualClxDcp));
- {$ENDIF KYLIX}
+ {$ENDIF ~KYLIX}
end;
function TJclBorRADToolInstallation.UninstallBCBExpert(const ProjectName, OutputDir: string): Boolean;
Modified: trunk/jcl/source/common/JclComplex.pas
===================================================================
--- trunk/jcl/source/common/JclComplex.pas 2009-02-17 11:45:24 UTC (rev 2651)
+++ trunk/jcl/source/common/JclComplex.pas 2009-02-17 14:39:19 UTC (rev 2652)
@@ -413,18 +413,18 @@
except
{$IFDEF CLR}
raise EJclMathError.Create(RsComplexInvalidString);
- {$ELSE}
+ {$ELSE ~CLR}
raise EJclMathError.CreateRes(@RsComplexInvalidString);
- {$ENDIF CLR}
+ {$ENDIF ~CLR}
end;
try
ImagPart := StrToFloat(Copy(StrToParse, SignPos, Length(StrToParse) - SignPos));
except
{$IFDEF CLR}
raise EJclMathError.Create(RsComplexInvalidString);
- {$ELSE}
+ {$ELSE ~CLR}
raise EJclMathError.CreateRes(@RsComplexInvalidString);
- {$ENDIF CLR}
+ {$ENDIF ~CLR}
end;
end
else
@@ -437,9 +437,9 @@
except
{$IFDEF CLR}
raise EJclMathError.Create(RsComplexInvalidString);
- {$ELSE}
+ {$ELSE ~CLR}
raise EJclMathError.CreateRes(@RsComplexInvalidString);
- {$ENDIF CLR}
+ {$ENDIF ~CLR}
end;
end
else
@@ -449,9 +449,9 @@
except
{$IFDEF CLR}
raise EJclMathError.Create(RsComplexInvalidString);
- {$ELSE}
+ {$ELSE ~CLR}
raise EJclMathError.CreateRes(@RsComplexInvalidString);
- {$ENDIF CLR}
+ {$ENDIF ~CLR}
end;
ImagPart := 0.0;
end;
@@ -466,40 +466,40 @@
begin
{$IFDEF CLR}
StrToParse := StrRemoveChars(StrToParse, CharIsSpace).toUpper;
- {$ELSE}
+ {$ELSE ~CLR}
StrToParse := AnsiUpperCase(StrRemoveChars(StrToParse, CharIsSpace));
- {$ENDIF CLR}
+ {$ENDIF ~CLR}
AstPos := Pos('*', StrToParse);
if AstPos = 0 then
{$IFDEF CLR}
raise EJclMathError.Create(RsComplexInvalidString);
- {$ELSE}
+ {$ELSE ~CLR}
raise EJclMathError.CreateRes(@RsComplexInvalidString);
- {$ENDIF CLR}
+ {$ENDIF ~CLR}
try
Radius := StrToFloat(StrLeft(StrToParse, AstPos - 1));
except
{$IFDEF CLR}
raise EJclMathError.Create(RsComplexInvalidString);
- {$ELSE}
+ {$ELSE ~CLR}
raise EJclMathError.CreateRes(@RsComplexInvalidString);
- {$ENDIF CLR}
+ {$ENDIF ~CLR}
end;
AstPos := Pos('(', StrToParse);
if AstPos = 0 then
{$IFDEF CLR}
raise EJclMathError.Create(RsComplexInvalidString);
- {$ELSE}
+ {$ELSE ~CLR}
raise EJclMathError.CreateRes(@RsComplexInvalidString);
- {$ENDIF CLR}
+ {$ENDIF ~CLR}
try
Angle := StrToFloat(Copy(StrToParse, AstPos + 1, Length(StrToParse) - AstPos - 1));
except
{$IFDEF CLR}
raise EJclMathError.Create(RsComplexInvalidString);
- {$ELSE}
+ {$ELSE ~CLR}
raise EJclMathError.CreateRes(@RsComplexInvalidString);
- {$ENDIF CLR}
+ {$ENDIF ~CLR}
end;
Assign(Radius, Angle, crPolar);
end;
Modified: trunk/jcl/source/common/JclCompression.pas
===================================================================
--- trunk/jcl/source/common/JclCompression.pas 2009-02-17 11:45:24 UTC (rev 2651)
+++ trunk/jcl/source/common/JclCompression.pas 2009-02-17 14:39:19 UTC (rev 2652)
@@ -4305,9 +4305,9 @@
FPackedNames.Sorted := True;
{$IFDEF UNIX}
FPackedNames.CaseSensitive := True;
- {$ELSE}
+ {$ELSE ~UNIX}
FPackedNames.CaseSensitive := False;
- {$ENDIF UNIX}
+ {$ENDIF ~UNIX}
FPackedNames.Duplicates := dupIgnore;
for I := ItemCount - 1 downto 0 do
FPackedNames.AddObject(Items[I].PackedName, Items[I]);
Modified: trunk/jcl/source/common/JclCounter.pas
===================================================================
--- trunk/jcl/source/common/JclCounter.pas 2009-02-17 11:45:24 UTC (rev 2651)
+++ trunk/jcl/source/common/JclCounter.pas 2009-02-17 14:39:19 UTC (rev 2652)
@@ -106,9 +106,9 @@
begin
{$IFDEF CLR}
raise EJclCounterError.Create(RsNoCounter);
- {$ELSE}
+ {$ELSE ~CLR}
raise EJclCounterError.CreateRes(@RsNoCounter);
- {$ENDIF CLR}
+ {$ENDIF ~CLR}
end;
constructor TJclCounter.Create(const Compensate: Boolean);
Modified: trunk/jcl/source/common/JclDateTime.pas
===================================================================
--- trunk/jcl/source/common/JclDateTime.pas 2009-02-17 11:45:24 UTC (rev 2651)
+++ trunk/jcl/source/common/JclDateTime.pas 2009-02-17 14:39:19 UTC (rev 2652)
@@ -65,11 +65,11 @@
{$IFDEF CLR20}
System.Runtime.InteropServices.ComTypes,
{$ENDIF CLR20}
- {$ELSE}
+ {$ELSE ~CLR}
{$IFDEF MSWINDOWS}
Windows,
{$ENDIF MSWINDOWS}
- {$ENDIF CLR}
+ {$ENDIF ~CLR}
{$IFDEF HAS_UNIT_TYPES}
Types,
{$ENDIF HAS_UNIT_TYPES}
@@ -356,9 +356,9 @@
if not Val then
{$IFDEF CLR}
raise EJclDateTimeError.Create(RsDateConversion);
- {$ELSE}
+ {$ELSE ~CLR}
raise EJclDateTimeError.CreateRes(@RsDateConversion);
- {$ENDIF CLR}
+ {$ENDIF ~CLR}
end;
function CenturyBaseYear(const DateTime: TDateTime): Integer;
@@ -687,7 +687,7 @@
begin
Result := System.TimeZone.CurrentTimeZone.ToLocalTime(DateTime);
end;
-{$ELSE}
+{$ELSE ~CLR}
var
TimeZoneInfo: TTimeZoneInformation;
begin
@@ -701,7 +701,7 @@
raise EJclDateTimeError.CreateRes(@RsMakeUTCTime);
end;
end;
-{$ENDIF CLR}
+{$ENDIF ~CLR}
{$ENDIF MSWINDOWS}
{$IFDEF UNIX}
@@ -718,9 +718,9 @@
UTCTime := gmtime(@TimeNow)^;
Local := localtime(@TimeNow)^;
Offset := difftime(mktime(UTCTime), mktime(Local));
- {$ELSE}
+ {$ELSE ~LINUX}
Offset := -TZSeconds;
- {$ENDIF LINUX}
+ {$ENDIF ~LINUX}
Result := ((DateTime * SecsPerDay) - Offset) / SecsPerDay;
end;
{$ENDIF UNIX}
@@ -731,7 +731,7 @@
begin
Result := System.TimeZone.CurrentTimeZone.ToUniversalTime(DateTime);
end;
-{$ELSE}
+{$ELSE ~CLR}
var
TimeZoneInfo: TTimeZoneInformation;
begin
@@ -745,7 +745,7 @@
raise EJclDateTimeError.CreateRes(@RsMakeUTCTime);
end;
end;
-{$ENDIF CLR}
+{$ENDIF ~CLR}
{$ENDIF MSWINDOWS}
{$IFDEF UNIX}
@@ -762,9 +762,9 @@
UTCTime := gmtime(@TimeNow)^;
Local := localtime(@TimeNow)^;
Offset := difftime(mktime(UTCTime), mktime(Local));
- {$ELSE}
+ {$ELSE ~LINUX}
Offset := -TZSeconds;
- {$ENDIF LINUX}
+ {$ENDIF ~LINUX}
Result := ((DateTime * SecsPerDay) + Offset) / SecsPerDay;
end;
{$ENDIF UNIX}
@@ -798,10 +798,10 @@
begin
{$IFDEF CLR}
Result := System.DateTime.FromFileTime(Int64(FileTime.dwHighDateTime) shl 32 or FileTime.dwLowDateTime);
- {$ELSE}
+ {$ELSE ~CLR}
Result := Int64(FileTime) / FileTimeStep;
Result := Result + FileTimeBase;
- {$ENDIF CLR}
+ {$ENDIF ~CLR}
end;
{$IFNDEF CLR}
@@ -838,9 +838,9 @@
{$IFDEF CLR}
Result.dwLowDateTime := F64 and $00000000FFFFFFFF;
Result.dwHighDateTime := F64 shr 32;
- {$ELSE}
+ {$ELSE ~CLR}
Result := TFileTime(F64);
- {$ENDIF CLR}
+ {$ENDIF ~CLR}
end;
{$IFNDEF CLR}
@@ -1191,9 +1191,9 @@
FT1 := Int64(FileTime1.dwHighDateTime) shl 32 or FileTime1.dwLowDateTime;
FT2 := Int64(FileTime2.dwHighDateTime) shl 32 or FileTime2.dwLowDateTime;
Result := FATDatesEqual(FT1, FT2);
- {$ELSE}
+ {$ELSE ~CLR}
Result := FATDatesEqual(Int64(FileTime1), Int64(FileTime2));
- {$ENDIF CLR}
+ {$ENDIF ~CLR}
end;
// Conversion Unix time <--> TDateTime / FileTime, constants
Modified: trunk/jcl/source/common/JclEDI.pas
===================================================================
--- trunk/jcl/source/common/JclEDI.pas 2009-02-17 11:45:24 UTC (rev 2651)
+++ trunk/jcl/source/common/JclEDI.pas 2009-02-17 14:39:19 UTC (rev 2652)
@@ -139,9 +139,9 @@
{$IFDEF CLR}
TCustomData = TObject;
- {$ELSE}
+ {$ELSE ~CLR}
TCustomData = Pointer; // backward compatibility
- {$ENDIF CLR}
+ {$ENDIF ~CLR}
TEDIDataObject = class(TEDIObject)
private
Modified: trunk/jcl/source/common/JclEDISEF.pas
===================================================================
--- trunk/jcl/source/common/JclEDISEF.pas 2009-02-17 11:45:24 UTC (rev 2651)
+++ trunk/jcl/source/common/JclEDISEF.pas 2009-02-17 14:39:19 UTC (rev 2652)
@@ -924,9 +924,9 @@
Element.Id := Temp.Names[0];
{$IFDEF COMPILER7_UP}
Temp.CommaText := Temp.ValueFromIndex[0];
- {$ELSE}
+ {$ELSE ~COMPILER7_UP}
Temp.CommaText := Temp.Values[Element.Id];
- {$ENDIF COMPILER7_UP}
+ {$ENDIF ~COMPILER7_UP}
if Temp.Count >= 1 then
Element.ElementType := Temp[0];
if Temp.Count >= 2 then
@@ -1466,12 +1466,12 @@
end;
Result := S;
end;
- {$ELSE}
+ {$ELSE ~CLR}
function ToPChar(const S: string): PChar;
begin
Result := PChar(S);
end;
- {$ENDIF CLR}
+ {$ENDIF ~CLR}
var
Temp: TStringList;
@@ -4079,10 +4079,10 @@
try
{$IFDEF CLR}
EDIFileStream.ReadStringAnsiBuffer(FData, EDIFileStream.Size);
- {$ELSE}
+ {$ELSE ~CLR}
SetLength(FData, EDIFileStream.Size);
EDIFileStream.Read(Pointer(FData)^, EDIFileStream.Size);
- {$ENDIF CLR}
+ {$ENDIF ~CLR}
finally
EDIFileStream.Free;
end;
@@ -4213,9 +4213,9 @@
INI.Clear;
{$IFDEF COMPILER6_UP}
INI.Delimiter := SEFDelimiter_Comma;
- {$ELSE}
+ {$ELSE ~COMPILER6_UP}
// TODO : (rom) ?
- {$ENDIF COMPILER6_UP}
+ {$ENDIF ~COMPILER6_UP}
SearchResult := StrSearch(SectionTag_INI, FData, 1);
if SearchResult > 0 then
begin
@@ -4303,9 +4303,9 @@
STD.Clear;
{$IFDEF COMPILER6_UP}
STD.Delimiter := SEFDelimiter_Comma;
- {$ELSE}
+ {$ELSE ~COMPILER6_UP}
// TODO : (rom) ?
- {$ENDIF COMPILER6_UP}
+ {$ENDIF ~COMPILER6_UP}
SearchResult := StrSearch(SectionTag_STD, FData, 1);
if SearchResult > 0 then
begin
@@ -4315,17 +4315,17 @@
begin
{$IFDEF COMPILER6_UP}
STD.DelimitedText := Copy(FData, SearchResult, SearchResult2 - SearchResult);
- {$ELSE}
+ {$ELSE ~COMPILER6_UP}
STD.Text := Copy(FData, SearchResult, SearchResult2 - SearchResult);
- {$ENDIF COMPILER6_UP}
+ {$ENDIF ~COMPILER6_UP}
end
else
begin
{$IFDEF COMPILER6_UP}
STD.DelimitedText := Copy(FData, SearchResult, (Length(FData) - SearchResult) + 1);
- {$ELSE}
+ {$ELSE ~COMPILER6_UP}
STD.Text := Copy(FData, SearchResult, (Length(FData) - SearchResult) + 1);
- {$ENDIF COMPILER6_UP}
+ {$ENDIF ~COMPILER6_UP}
end;
end;
end;
@@ -4365,9 +4365,9 @@
try
{$IFDEF CLR}
EDIFileStream.WriteStringAnsiBuffer(FData);
- {$ELSE}
+ {$ELSE ~CLR}
EDIFileStream.Write(Pointer(FData)^, Length(FData));
- {$ENDIF CLR}
+ {$ENDIF ~CLR}
finally
EDIFileStream.Free;
end;
Modified: trunk/jcl/source/common/JclEDIXML.pas
===================================================================
--- trunk/jcl/source/common/JclEDIXML.pas 2009-02-17 11:45:24 UTC (rev 2651)
+++ trunk/jcl/source/common/JclEDIXML.pas 2009-02-17 14:39:19 UTC (rev 2652)
@@ -37,7 +37,7 @@
{ }
{**************************************************************************************************}
{ }
-{ Last modified: $Date:: $ }
+{ Last modified: $Date:: $ }
{ Revision: $Rev:: $ }
{ Author: $Author:: $ }
{ }
@@ -582,10 +582,10 @@
{$IFDEF COMPILER7_UP}
J := StrSearch(FDelimiters.SingleQuote, FAttributes.ValueFromIndex[I]);
K := StrSearch(FDelimiters.DoubleQuote, FAttributes.ValueFromIndex[I]);
- {$ELSE}
+ {$ELSE ~COMPILER7_UP}
J := StrSearch(FDelimiters.SingleQuote, FAttributes.Values[FAttributes.Names[I]]);
K := StrSearch(FDelimiters.DoubleQuote, FAttributes.Values[FAttributes.Names[I]]);
- {$ENDIF COMPILER7_UP}
+ {$ENDIF ~COMPILER7_UP}
if J > K then
QuoteDelimiter := FDelimiters.SingleQuote
else
@@ -595,10 +595,10 @@
{$IFDEF COMPILER7_UP}
Result := Result + FAttributes.Names[I] + FDelimiters.AssignmentDelimiter +
QuoteDelimiter + FAttributes.ValueFromIndex[I] + QuoteDelimiter;
- {$ELSE}
+ {$ELSE ~COMPILER7_UP}
Result := Result + FAttributes.Names[I] + FDelimiters.AssignmentDelimiter +
QuoteDelimiter + FAttributes.Values[FAttributes.Names[I]] + QuoteDelimiter;
- {$ENDIF COMPILER7_UP}
+ {$ENDIF ~COMPILER7_UP}
end;
end;
@@ -2385,10 +2385,10 @@
try
{$IFDEF CLR}
EDIFileStream.ReadStringAnsiBuffer(FData, EDIFileStream.Size);
- {$ELSE}
+ {$ELSE ~CLR}
SetLength(FData, EDIFileStream.Size);
EDIFileStream.Read(Pointer(FData)^, EDIFileStream.Size);
- {$ENDIF CLR}
+ {$ENDIF ~CLR}
finally
EDIFileStream.Free;
end;
@@ -2420,9 +2420,9 @@
try
{$IFDEF CLR}
EDIFileStream.WriteStringAnsiBuffer(FData);
- {$ELSE}
+ {$ELSE ~CLR}
EDIFileStream.Write(Pointer(FData)^, Length(FData));
- {$ENDIF CLR}
+ {$ENDIF ~CLR}
finally
EDIFileStream.Free;
end;
@@ -2441,9 +2441,9 @@
try
{$IFDEF CLR}
EDIFileStream.WriteStringAnsiBuffer(FData);
- {$ELSE}
+ {$ELSE ~CLR}
EDIFileStream.Write(Pointer(FData)^, Length(FData));
- {$ENDIF CLR}
+ {$ENDIF ~CLR}
finally
EDIFileStream.Free;
end;
Modified: trunk/jcl/source/common/JclEDI_ANSIX12.pas
===================================================================
--- trunk/jcl/source/common/JclEDI_ANSIX12.pas 2009-02-17 11:45:24 UTC (rev 2651)
+++ trunk/jcl/source/common/JclEDI_ANSIX12.pas 2009-02-17 14:39:19 UTC (rev 2652)
@@ -33,7 +33,7 @@
{ }
{**************************************************************************************************}
{ }
-{ Last modified: $Date:: $ }
+{ Last modified: $Date:: $ }
{ Revision: $Rev:: $ }
{ Author: $Author:: $ }
{ }
@@ -742,9 +742,9 @@
for I := 0 to High(ElementArray) do
HelpArray[I] := TEDIDataObject(ElementArray[I]);
Result := AppendEDIDataObjects(HelpArray);
- {$ELSE}
+ {$ELSE ~CLR}
Result := AppendEDIDataObjects(TEDIDataObjectArray(ElementArray));
- {$ENDIF CLR}
+ {$ENDIF ~CLR}
end;
function TEDISegment.Assemble: string;
@@ -875,9 +875,9 @@
for I := 0 to High(ElementArray) do
HelpArray[I] := TEDIDataObject(ElementArray[I]);
Result := InsertEDIDataObjects(InsertIndex, HelpArray);
- {$ELSE}
+ {$ELSE ~CLR}
Result := InsertEDIDataObjects(InsertIndex, TEDIDataObjectArray(ElementArray));
- {$ENDIF CLR}
+ {$ENDIF ~CLR}
end;
function TEDISegment.InsertElements(InsertIndex, Count: Integer): Integer;
@@ -1034,9 +1034,9 @@
for I := 0 to High(SegmentArray) do
HelpArray[I] := TEDIDataObject(SegmentArray[I]);
Result := AppendEDIDataObjects(HelpArray);
- {$ELSE}
+ {$ELSE ~CLR}
Result := AppendEDIDataObjects(TEDIDataObjectArray(SegmentArray));
- {$ENDIF CLR}
+ {$ENDIF ~CLR}
end;
function TEDITransactionSet.Assemble: string;
@@ -1186,9 +1186,9 @@
for I := 0 to High(SegmentArray) do
HelpArray[I] := TEDIDataObject(SegmentArray[I]);
Result := InsertEDIDataObjects(InsertIndex, HelpArray);
- {$ELSE}
+ {$ELSE ~CLR}
Result := InsertEDIDataObjects(InsertIndex, TEDIDataObjectArray(SegmentArray));
- {$ENDIF CLR}
+ {$ENDIF ~CLR}
end;
function TEDITransactionSet.InternalAssignDelimiters: TEDIDelimiters;
@@ -1291,9 +1291,9 @@
for I := 0 to High(TransactionSetArray) do
HelpArray[I] := TEDIDataObject(TransactionSetArray[I]);
Result := AppendEDIDataObjects(HelpArray);
- {$ELSE}
+ {$ELSE ~CLR}
Result := AppendEDIDataObjects(TEDIDataObjectArray(TransactionSetArray));
- {$ENDIF CLR}
+ {$ENDIF ~CLR}
end;
function TEDIFunctionalGroup.Assemble: string;
@@ -1469,9 +1469,9 @@
for I := 0 to High(TransactionSetArray) do
HelpArray[I] := TEDIDataObject(TransactionSetArray[I]);
Result := InsertEDIDataObjects(InsertIndex, HelpArray);
- {$ELSE}
+ {$ELSE ~CLR}
Result := InsertEDIDataObjects(InsertIndex, TEDIDataObjectArray(TransactionSetArray));
- {$ENDIF CLR}
+ {$ENDIF ~CLR}
end;
function TEDIFunctionalGroup.InsertTransactionSets(InsertIndex, Count: Integer): Integer;
@@ -1577,9 +1577,9 @@
for I := 0 to High(FunctionalGroupArray) do
HelpArray[I] := TEDIDataObject(FunctionalGroupArray[I]);
Result := AppendEDIDataObjects(HelpArray);
- {$ELSE}
+ {$ELSE ~CLR}
Result := AppendEDIDataObjects(TEDIDataObjectArray(FunctionalGroupArray));
- {$ENDIF CLR}
+ {$ENDIF ~CLR}
end;
function TEDIInterchangeControl.Assemble: string;
@@ -1785,9 +1785,9 @@
for I := 0 to High(FunctionalGroupArray) do
HelpArray[I] := TEDIDataObject(FunctionalGroupArray[I]);
Result := InsertEDIDataObjects(InsertIndex, HelpArray);
- {$ELSE}
+ {$ELSE ~CLR}
Result := InsertEDIDataObjects(InsertIndex, TEDIDataObjectArray(FunctionalGroupArray));
- {$ENDIF CLR}
+ {$ENDIF ~CLR}
end;
procedure TEDIInterchangeControl.SetFunctionalGroup(Index: Integer;
@@ -1879,9 +1879,9 @@
for I := 0 to High(InterchangeControlArray) do
HelpArray[I] := TEDIDataObject(InterchangeControlArray[I]);
Result := AppendEDIDataObjects(HelpArray);
- {$ELSE}
+ {$ELSE ~CLR}
Result := AppendEDIDataObjects(TEDIDataObjectArray(InterchangeControlArray));
- {$ENDIF CLR}
+ {$ENDIF ~CLR}
end;
function TEDIFile.Assemble: string;
@@ -1938,21 +1938,21 @@
if foRemoveCrLf in FEDIFileOptions then
{$IFDEF OPTIMIZED_STRINGREPLACE}
FData := JclEDI.StringReplace(FData, NativeCrLf, '', [rfReplaceAll]);
- {$ELSE}
+ {$ELSE ~OPTIMIZED_STRINGREPLACE}
FData := SysUtils.StringReplace(FData, NativeCrLf, '', [rfReplaceAll]);
- {$ENDIF OPTIMIZED_STRINGREPLACE}
+ {$ENDIF ~OPTIMIZED_STRINGREPLACE}
if foRemoveCr in FEDIFileOptions then
{$IFDEF OPTIMIZED_STRINGREPLACE}
FData := JclEDI.StringReplace(FData, NativeCarriageReturn, '', [rfReplaceAll]);
- {$ELSE}
+ {$ELSE ~OPTIMIZED_STRINGREPLACE}
FData := SysUtils.StringReplace(FData, NativeCarriageReturn, '', [rfReplaceAll]);
- {$ENDIF OPTIMIZED_STRINGREPLACE}
+ {$ENDIF ~OPTIMIZED_STRINGREPLACE}
if foRemoveLf in FEDIFileOptions then
{$IFDEF OPTIMIZED_STRINGREPLACE}
FData := JclEDI.StringReplace(FData, NativeLineFeed, '', [rfReplaceAll]);
- {$ELSE}
+ {$ELSE ~OPTIMIZED_STRINGREPLACE}
FData := SysUtils.StringReplace(FData, NativeLineFeed, '', [rfReplaceAll]);
- {$ENDIF OPTIMIZED_STRINGREPLACE}
+ {$ENDIF ~OPTIMIZED_STRINGREPLACE}
StartPos := 1;
// Search for Interchange Control Header
@@ -2048,9 +2048,9 @@
for I := 0 to High(InterchangeControlArray) do
HelpArray[I] := TEDIDataObject(InterchangeControlArray[I]);
Result := InsertEDIDataObjects(InsertIndex, HelpArray);
- {$ELSE}
+ {$ELSE ~CLR}
Result := InsertEDIDataObjects(InsertIndex, TEDIDataObjectArray(InterchangeControlArray));
- {$ENDIF CLR}
+ {$ENDIF ~CLR}
end;
procedure TEDIFile.InternalLoadFromFile;
@@ -2069,10 +2069,10 @@
SetLength(Buf, EDIFileStream.Size);
EDIFileStream.Read(Buf, EDIFileStream.Size);
FData := StringOf(Buf);
- {$ELSE}
+ {$ELSE ~CLR}
SetLength(FData, EDIFileStream.Size);
EDIFileStream.Read(Pointer(FData)^, EDIFileStream.Size);
- {$ENDIF CLR}
+ {$ENDIF ~CLR}
finally
EDIFileStream.Free;
end;
@@ -2104,9 +2104,9 @@
try
{$IFDEF CLR}
EDIFileStream.Write(BytesOf(FData), Length(FData));
- {$ELSE}
+ {$ELSE ~CLR}
EDIFileStream.Write(Pointer(FData)^, Length(FData));
- {$ENDIF CLR}
+ {$ENDIF ~CLR}
finally
EDIFileStream.Free;
end;
@@ -2125,9 +2125,9 @@
try
{$IFDEF CLR}
EDIFileStream.Write(BytesOf(FData), Length(FData));
- {$ELSE}
+ {$ELSE ~CLR}
EDIFileStream.Write(Pointer(FData)^, Length(FData));
- {$ENDIF CLR}
+ {$ENDIF ~CLR}
finally
EDIFileStream.Free;
end;
Modified: trunk/jcl/source/common/JclEDI_UNEDIFACT.pas
===================================================================
--- trunk/jcl/source/common/JclEDI_UNEDIFACT.pas 2009-02-17 11:45:24 UTC (rev 2651)
+++ trunk/jcl/source/common/JclEDI_UNEDIFACT.pas 2009-02-17 14:39:19 UTC (rev 2652)
@@ -33,7 +33,7 @@
{ }
{**************************************************************************************************}
{ }
-{ Last modified: $Date:: $ }
+{ Last modified: $Date:: $ }
{ Revision: $Rev:: $ }
{ Author: $Author:: $ }
{ }
@@ -467,10 +467,10 @@
else
Result := nil;
end;
-{$ELSE}
+{$ELSE ~CLR}
type
AsEDIDataObjectArray = TEDIDataObjectArray;
-{$ENDIF CLR}
+{$ENDIF ~CLR}
//=== { TEDIElement } ========================================================
@@ -1767,21 +1767,21 @@
if foRemoveCrLf in FEDIFileOptions then
{$IFDEF OPTIMIZED_STRINGREPLACE}
FData := JclEDI.StringReplace(FData, NativeCrLf, '', [rfReplaceAll]);
- {$ELSE}
+ {$ELSE ~OPTIMIZED_STRINGREPLACE}
FData := SysUtils.StringReplace(FData, NativeCrLf, '', [rfReplaceAll]);
- {$ENDIF OPTIMIZED_INTERNAL_STRUCTURE}
+ {$ENDIF ~OPTIMIZED_STRINGREPLACE}
if foRemoveCr in FEDIFileOptions then
{$IFDEF OPTIMIZED_STRINGREPLACE}
FData := JclEDI.StringReplace(FData, NativeCarriageReturn, '', [rfReplaceAll]);
- {$ELSE}
+ {$ELSE ~OPTIMIZED_STRINGREPLACE}
FData := SysUtils.StringReplace(FData, NativeCarriageReturn, '', [rfReplaceAll]);
- {$ENDIF OPTIMIZED_STRINGREPLACE}
+ {$ENDIF ~OPTIMIZED_STRINGREPLACE}
if foRemoveLf in FEDIFileOptions then
{$IFDEF OPTIMIZED_STRINGREPLACE}
FData := JclEDI.StringReplace(FData, NativeLineFeed, '', [rfReplaceAll]);
- {$ELSE}
+ {$ELSE ~OPTIMIZED_STRINGREPLACE}
FData := SysUtils.StringReplace(FData, NativeLineFeed, '', [rfReplaceAll]);
- {$ENDIF OPTIMIZED_STRINGREPLACE}
+ {$ENDIF ~OPTIMIZED_STRINGREPLACE}
StartPos := 1;
if UNASegmentId = Copy(FData, StartPos, Length(UNASegmentId)) then
@@ -1895,10 +1895,10 @@
try
{$IFDEF CLR}
EDIFileStream.ReadStringAnsiBuffer(FData, EDIFileStream.Size);
- {$ELSE}
+ {$ELSE ~CLR}
SetLength(FData, EDIFileStream.Size);
EDIFileStream.Read(Pointer(FData)^, EDIFileStream.Size);
- {$ENDIF CLR}
+ {$ENDIF ~CLR}
finally
EDIFileStream.Free;
end;
@@ -1929,9 +1929,9 @@
try
{$IFDEF CLR}
EDIFileStream.WriteStringAnsiBuffer(FData);
- {$ELSE}
+ {$ELSE ~CLR}
EDIFileStream.Write(Pointer(FData)^, Length(FData));
- {$ENDIF CLR}
+ {$ENDIF ~CLR}
finally
EDIFileStream.Free;
end;
@@ -1950,9 +1950,9 @@
try
{$IFDEF CLR}
EDIFileStream.WriteStringAnsiBuffer(FData);
- {$ELSE}
+ {$ELSE ~CLR}
EDIFileStream.Write(Pointer(FData)^, Length(FData));
- {$ENDIF CLR}
+ {$ENDIF ~CLR}
finally
EDIFileStream.Free;
end;
Modified: trunk/jcl/source/common/JclFileUtils.pas
===================================================================
--- trunk/jcl/source/common/JclFileUtils.pas 2009-02-17 11:45:24 UTC (rev 2651)
+++ trunk/jcl/source/common/JclFileUtils.pas 2009-02-17 14:39:19 UTC (rev 2652)
@@ -51,7 +51,7 @@
{ }
{**************************************************************************************************}
{ }
-{ Last modified: $Date:: $ }
+{ Last modified: $Date:: $ }
{ Revision: $Rev:: $ }
{ Author: $Author:: $ }
{ }
@@ -2314,9 +2314,9 @@
else
{$IFDEF CLR}
raise EJclPathError.CreateFmt(RsPathInvalidDrive, [IntToStr(Drive)]);
- {$ELSE}
+ {$ELSE ~CLR}
raise EJclPathError.CreateResFmt(@RsPathInvalidDrive, [IntToStr(Drive)]);
- {$ENDIF}
+ {$ENDIF ~CLR}
{$ENDIF MSWINDOWS}
end;
@@ -2688,9 +2688,9 @@
begin
{$IFDEF MSWINDOWS} // case insensitive
Result := StrSame(Path1, Path2);
- {$ELSE} // case sensitive
+ {$ELSE ~MSWINDOWS} // case sensitive
Result := Path1 = Path2;
- {$ENDIF}
+ {$ENDIF ~MSWINDOWS}
end;
begin
@@ -2929,9 +2929,9 @@
var
{$IFDEF CLR}
Index, LenPath: Integer;
- {$ELSE}
+ {$ELSE ~CLR}
P: PChar;
- {$ENDIF}
+ {$ENDIF ~CLR}
function AbsorbSeparator: Boolean;
begin
@@ -3266,7 +3266,7 @@
end;
end;
-{$ELSE} // CLR => not CLR
+{$ELSE ~CLR}
function SHGetDisplayName(ShellFolder: IShellFolder; PIDL: PItemIDList; ForParsing: Boolean): string;
const
@@ -3436,9 +3436,9 @@
ParsePath := ParsePath + DirDelimiter + Name;
end;
end;
-{$ENDIF CLR}
+{$ENDIF ~CLR}
-{$ELSE} // MSWINDOWS => not MSWINDOWS
+{$ELSE ~MSWINDOWS}
function PathGetPhysicalPath(const LocalizedPath: string): string;
begin
Result := LocalizedPath;
@@ -3448,7 +3448,7 @@
begin
Result := PhysicalPath;
end;
-{$ENDIF MSWINDOWS}
+{$ENDIF ~MSWINDOWS}
//=== Files and Directories ==================================================
@@ -3874,10 +3874,10 @@
// FileGetSize is very slow, GetFileAttributes is much faster
Attr := GetFileAttributes(Pointer(Filename));
Result := (Attr <> $FFFFFFFF) and (Attr and FILE_ATTRIBUTE_DIRECTORY = 0);
- {$ELSE}
+ {$ELSE ~MSWINDOWS}
// Attempt to access the file, doesn't matter how, using FileGetSize is as good as anything else.
Result := FileGetSize(FileName) <> -1;
- {$ENDIF MSWINDOWS}
+ {$ENDIF ~MSWINDOWS}
{$ENDIF ~CLR}
end
else
@@ -4195,9 +4195,9 @@
if Length(Name) = 0 then
{$IFDEF CLR}
raise EJclFileUtilsError.Create(RsCannotCreateDir);
- {$ELSE}
+ {$ELSE ~CLR}
raise EJclFileUtilsError.CreateRes(@RsCannotCreateDir);
- {$ENDIF}
+ {$ENDIF ~CLR}
Name := PathRemoveSeparator(Name);
{$IFDEF MSWINDOWS}
ExtractPath := ExtractFilePath(Name);
@@ -4416,9 +4416,9 @@
begin
{$IFDEF CLR}
Result := &File.GetLastWriteTimeUtc(FileName);
- {$ELSE}
+ {$ELSE ~CLR}
Result := GetFileInformation(FileName).FindData.ftLastWriteTime;
- {$ENDIF}
+ {$ENDIF ~CLR}
end;
function GetFileLastWrite(const FileName: string; out LocalTime: TDateTime): Boolean;
@@ -4478,9 +4478,9 @@
begin
{$IFDEF CLR}
Result := &File.GetLastAccessTimeUtc(FileName);
- {$ELSE}
+ {$ELSE ~CLR}
Result := GetFileInformation(FileName).FindData.ftLastAccessTime;
- {$ENDIF}
+ {$ENDIF ~CLR}
end;
function GetFileLastAccess(const FileName: string; out LocalTime: TDateTime): Boolean;
@@ -4540,9 +4540,9 @@
begin
{$IFDEF CLR}
Result := &File.GetCreationTimeUtc(FileName);
- {$ELSE}
+ {$ELSE ~CLR}
Result := GetFileInformation(FileName).FindData.ftCreationTime;
- {$ENDIF}
+ {$ENDIF ~CLR}
end;
function GetFileCreation(const FileName: string; out LocalTime: TDateTime): Boolean;
@@ -4609,9 +4609,9 @@
{$IFDEF UNIX}
{$IFDEF FPC}
L := 0; // FIXME
- {$ELSE}
+ {$ELSE ~FPC}
L := GetModuleFileName(Module, Pointer(Result), L);
- {$ENDIF FPC}
+ {$ENDIF ~FPC}
{$ENDIF UNIX}
SetLength(Result, L);
end;
@@ -5033,9 +5033,9 @@
Fs.Write(ContentPtr{$IFNDEF CLR}[0]{$ENDIF}, N);
{$IFDEF CLR}
Fs.Handle.Flush;
- {$ELSE}
+ {$ELSE ~CLR}
FlushFileBuffers(Fs.Handle);
- {$ENDIF}
+ {$ENDIF ~CLR}
Dec(Times);
end;
finally
@@ -6020,9 +6020,9 @@
else
{$IFDEF CLR}
Result := StrMatches(Mask.ToUpper, FileName.ToUpper);
- {$ELSE}
+ {$ELSE ~CLR}
Result := StrMatches(AnsiUpperCase(Mask), AnsiUpperCase(FileName));
- {$ENDIF}
+ {$ENDIF ~CLR}
end;
// author: Robert Rossmair
@@ -6341,9 +6341,9 @@
{$IFDEF UNIX}
{$IFDEF FPC}
Priority := tpIdle;
- {$ELSE}
+ {$ELSE ~FPC}
Priority := 0;
- {$ENDIF FPC}
+ {$ENDIF ~FPC}
{$ENDIF UNIX}
{$ENDIF ~CLR}
FreeOnTerminate := True;
@@ -6925,9 +6925,9 @@
{$ELSE ~CLR}
Result := AnsiSameText(PathGetLongName(Path1), PathGetLongName(Path2));
{$ENDIF ~CLR}
- {$ELSE}
+ {$ELSE ~MSWINDOWS}
Result := Path1 = Path2;
- {$ENDIF}
+ {$ENDIF ~MSWINDOWS}
end;
// add items at the end
Modified: trunk/jcl/source/common/JclLogic.pas
===================================================================
--- trunk/jcl/source/common/JclLogic.pas 2009-02-17 11:45:24 UTC (rev 2651)
+++ trunk/jcl/source/common/JclLogic.pas 2009-02-17 14:39:19 UTC (rev 2652)
@@ -404,7 +404,7 @@
Exit;
Result := -1;
end;
-{$ELSE}
+{$ELSE ~CLR}
asm
MOV ECX, EAX
MOV EAX, -1
@@ -413,7 +413,7 @@
MOV EAX, -1
@@End:
end;
-{$ENDIF CLR}
+{$ENDIF ~CLR}
function BitsHighest(X: Integer): Integer;
{$IFDEF CLR}
@@ -423,7 +423,7 @@
Exit;
Result := -1;
end;
-{$ELSE}
+{$ELSE ~CLR}
asm
MOV ECX, EAX
MOV EAX, -1
@@ -432,7 +432,7 @@
MOV EAX, -1
@@End:
end;
-{$ENDIF CLR}
+{$ENDIF ~CLR}
function BitsHighest(X: Byte): Integer;
begin
@@ -461,12 +461,12 @@
if X and (Int64(1) shl Result) <> 0 then
Exit;
Result := -1;
- {$ELSE}
+ {$ELSE ~CLR}
if TULargeInteger(X).HighPart = 0 then
Result := BitsHighest(TULargeInteger(X).LowPart)
else
Result := BitsHighest(TULargeInteger(X).HighPart) + 32;
- {$ENDIF CLR}
+ {$ENDIF ~CLR}
end;
function BitsLowest(X: Cardinal): Integer;
@@ -477,7 +477,7 @@
Exit;
Result := -1;
end;
-{$ELSE}
+{$ELSE ~CLR}
asm
MOV ECX, EAX
MOV EAX, -1
@@ -486,7 +486,7 @@
MOV EAX, -1
@@End:
end;
-{$ENDIF CLR}
+{$ENDIF ~CLR}
function BitsLowest(X: Integer): Integer;
{$IFDEF CLR}
@@ -496,7 +496,7 @@
Exit;
Result := -1;
end;
-{$ELSE}
+{$ELSE ~CLR}
asm
MOV ECX, EAX
MOV EAX, -1
@@ -505,7 +505,7 @@
MOV EAX, -1
@@End:
end;
-{$ENDIF CLR}
+{$ENDIF ~CLR}
function BitsLowest(X: Byte): Integer;
begin
@@ -534,12 +534,12 @@
if X and (Int64(1) shl Result) <> 0 then
Exit;
Result := -1;
- {$ELSE}
+ {$ELSE ~CLR}
if TULargeInteger(X).LowPart = 0 then
Result := BitsLowest(TULargeInteger(X).HighPart) + 32
else
Result := BitsLowest(TULargeInteger(X).LowPart);
- {$ENDIF CLR}
+ {$ENDIF ~CLR}
end;
function ClearBit(const Value: Byte; const Bit: TBitRange): Byte;
@@ -547,70 +547,70 @@
begin
Result := Value and not (1 shl (Bit and (BitsPerByte - 1)));
end;
-{$ELSE CLR}
+{$ELSE ~CLR}
asm
AND EDX, BitsPerByte - 1 // modulo BitsPerByte
BTR EAX, EDX
end;
-{$ENDIF CLR}
+{$ENDIF ~CLR}
function ClearBit(const Value: Shortint; const Bit: TBitRange): Shortint;
{$IFDEF CLR}
begin
Result := Value and not (1 shl (Bit and (BitsPerShortint - 1)));
end;
-{$ELSE CLR}
+{$ELSE ~CLR}
asm
AND EDX, BitsPerShortint - 1 // modulo BitsPerShortint
BTR EAX, EDX
end;
-{$ENDIF CLR}
+{$ENDIF ~CLR}
function ClearBit(const Value: Smallint; const Bit: TBitRange): Smallint;
{$IFDEF CLR}
begin
Result := Value and not (1 shl (Bit and (BitsPerSmallint - 1)));
end;
-{$ELSE CLR}
+{$ELSE ~CLR}
asm
AND EDX, BitsPerSmallint - 1 // modulo BitsPerSmallint
BTR EAX, EDX
end;
-{$ENDIF CLR}
+{$ENDIF ~CLR}
function ClearBit(const Value: Word; const Bit: TBitRange): Word;
{$IFDEF CLR}
begin
Result := Value and not (1 shl (Bit and (BitsPerWord - 1)));
end;
-{$ELSE CLR}
+{$ELSE ~CLR}
asm
AND EDX, BitsPerWord - 1 // modulo BitsPerWord
BTR EAX, EDX
end;
-{$ENDIF CLR}
+{$ENDIF ~CLR}
function ClearBit(const Value: Cardinal; const Bit: TBitRange): Cardinal;
{$IFDEF CLR}
begin
Result := Value and not (1 shl (Bit and (BitsPerCardinal - 1)));
end;
-{$ELSE CLR}
+{$ELSE ~CLR}
asm
BTR EAX, EDX
end;
-{$ENDIF CLR}
+{$ENDIF ~CLR}
function ClearBit(const Value: Integer; const Bit: TBitRange): Integer;
{$IFDEF CLR}
begin
Result := Value and not (1 shl (Bit and (BitsPerInteger - 1)));
end;
-{$ELSE CLR}
+{$ELSE ~CLR}
asm
BTR EAX, EDX
end;
-{$ENDIF CLR}
+{$ENDIF ~CLR}
function ClearBit(const Value: Int64; const Bit: TBitRange): Int64;
begin
@@ -630,7 +630,7 @@
Bytes[Index] := ClearBit(Bytes[Index], BitOfs);
SetBytesEx(Value, Bytes);
end;
-{$ELSE CLR}
+{$ELSE ~CLR}
{$IFDEF PUREPASCAL}
var
P: PByte;
@@ -641,12 +641,12 @@
BitOfs := Bit mod 8;
P^ := ClearBit(P^, BitOfs);
end;
-{$ELSE PUREPASCAL}
+{$ELSE ~PUREPASCAL}
asm
BTR [Value], Bit
end;
-{$ENDIF PUREPASCAL}
-{$ENDIF CLR}
+{$ENDIF ~PUREPASCAL}
+{$ENDIF ~CLR}
const
BitSetPerNibble: array[0..15] of Byte = (0,1,1,2,1,2,2,3,1,2,2,3,2,3,3,4);
@@ -718,7 +718,7 @@
while Count > 0 do
begin
b := PByte(P)^;
-
+
// lower Nibble
Inc(Result, BitSetPerNibble[b and $0F]);
// upper Nibble
@@ -734,9 +734,9 @@
begin
{$IFDEF CLR}
Result := CountBitsSet(X and $00000000FFFFFFFF) + CountBitsSet(X shr 32);
- {$ELSE}
+ {$ELSE ~CLR}
Result := CountBitsSet(TULargeInteger(X).LowPart) + CountBitsSet(TULargeInteger(X).HighPart);
- {$ENDIF CLR}
+ {$ENDIF ~CLR}
end;
function CountBitsCleared(X: Byte): Integer;
@@ -808,7 +808,7 @@
for I := 1 to Count do
Result := (Result shl 1) or ((Result and Integer($80000000)) shr 7);
end;
-{$ELSE}
+{$ELSE ~CLR}
function LRot(const Value: Byte; const Count: TBitRange): Byte; assembler;
asm
MOV CL, Count
@@ -826,7 +826,7 @@
MOV CL, Count
ROL EAX, CL
end;
-{$ENDIF CLR}
+{$ENDIF ~CLR}
const
// Lookup table of bit reversed nibbles, used by simple overloads of ReverseBits
@@ -891,10 +891,10 @@
{$IFDEF CLR}
Result := (Int64(ReverseBits(Value shr 32)) shl 32) or
(ReverseBits(Value and $00000000FFFFFFFF));
- {$ELSE}
+ {$ELSE ~CLR}
TULargeInteger(Result).LowPart...
[truncated message content] |
|
From: <ou...@us...> - 2009-02-17 12:22:11
|
Revision: 2651
http://jcl.svn.sourceforge.net/jcl/?rev=2651&view=rev
Author: outchy
Date: 2009-02-17 11:45:24 +0000 (Tue, 17 Feb 2009)
Log Message:
-----------
Moved AWSuffix declaration from JclWin32.pas to JclBase.pas.
Replaced {$IFDEF UNICODE} by {$IFDEF SUPPORTS_UNICODE}.
Reworked imported function name declarations with Unicode or Ansi flavor.
Modified Paths:
--------------
trunk/jcl/source/common/JclBase.pas
trunk/jcl/source/common/JclFileUtils.pas
trunk/jcl/source/prototypes/JclWin32.pas
trunk/jcl/source/prototypes/win32api/WinNT.int
trunk/jcl/source/windows/JclMapi.pas
trunk/jcl/source/windows/JclShell.pas
trunk/jcl/source/windows/JclWin32.pas
Modified: trunk/jcl/source/common/JclBase.pas
===================================================================
--- trunk/jcl/source/common/JclBase.pas 2009-02-17 11:11:11 UTC (rev 2650)
+++ trunk/jcl/source/common/JclBase.pas 2009-02-17 11:45:24 UTC (rev 2651)
@@ -422,6 +422,13 @@
end;
{$ENDIF SUPPORTS_GENERICS}
+const
+ {$IFDEF SUPPORTS_UNICODE}
+ AWSuffix = 'W';
+ {$ELSE ~SUPPORTS_UNICODE}
+ AWSuffix = 'A';
+ {$ENDIF ~SUPPORTS_UNICODE}
+
{$IFDEF UNITVERSIONING}
const
UnitVersioning: TUnitVersionInfo = (
Modified: trunk/jcl/source/common/JclFileUtils.pas
===================================================================
--- trunk/jcl/source/common/JclFileUtils.pas 2009-02-17 11:11:11 UTC (rev 2650)
+++ trunk/jcl/source/common/JclFileUtils.pas 2009-02-17 11:45:24 UTC (rev 2651)
@@ -2554,7 +2554,7 @@
finally
CoTaskMemFree(PIDL);
end;
- {$ELSE}
+ {$ELSE ~SUPPORTS_UNICODE}
MultiByteToWideChar(CP_ACP, MB_PRECOMPOSED, PAnsiChar(Path), -1, WideName, MAX_PATH);
if Succeeded(Desktop.ParseDisplayName(0, nil, WideName, Eaten, PIDL, Attr)) then
try
@@ -2565,7 +2565,7 @@
finally
CoTaskMemFree(PIDL);
end;
- {$ENDIF SUPPORTS_UNICODE}
+ {$ENDIF ~SUPPORTS_UNICODE}
end;
end;
end;
@@ -2587,7 +2587,7 @@
begin
Result := Path;
if not Assigned(_GetLongPathName) then
- _GetLongPathName := GetModuleSymbol(Kernel32Handle, {$IFDEF UNICODE}'GetLongPathNameW'{$ELSE}'GetLongPathNameA'{$ENDIF UNICODE});
+ _GetLongPathName := GetModuleSymbol(Kernel32Handle, 'GetLongPathName' + AWSuffix);
if not Assigned(_GetLongPathName) then
Result := ShellGetLongPathName(Path)
else
Modified: trunk/jcl/source/prototypes/JclWin32.pas
===================================================================
--- trunk/jcl/source/prototypes/JclWin32.pas 2009-02-17 11:11:11 UTC (rev 2650)
+++ trunk/jcl/source/prototypes/JclWin32.pas 2009-02-17 11:45:24 UTC (rev 2651)
@@ -212,13 +212,6 @@
{$ENDIF ~CLR}
{$ENDIF MSWINDOWS}
-const
- {$IFDEF SUPPORTS_UNICODE}
- AWSuffix = 'W';
- {$ELSE ~SUPPORTS_UNICODE}
- AWSuffix = 'A';
- {$ENDIF ~SUPPORTS_UNICODE}
-
{$IFDEF UNITVERSIONING}
const
UnitVersioning: TUnitVersionInfo = (
Modified: trunk/jcl/source/prototypes/win32api/WinNT.int
===================================================================
--- trunk/jcl/source/prototypes/win32api/WinNT.int 2009-02-17 11:11:11 UTC (rev 2650)
+++ trunk/jcl/source/prototypes/win32api/WinNT.int 2009-02-17 11:45:24 UTC (rev 2651)
@@ -2553,7 +2553,7 @@
{$EXTERNALSYM PRTL_OSVERSIONINFOEXW}
TOSVersionInfoExW = _OSVERSIONINFOEXW;
-{$IFDEF UNICODE}
+{$IFDEF SUPPORTS_UNICODE}
OSVERSIONINFOEX = OSVERSIONINFOEXW;
{$EXTERNALSYM OSVERSIONINFOEX}
@@ -2563,7 +2563,7 @@
{$EXTERNALSYM LPOSVERSIONINFOEX}
TOSVersionInfoEx = TOSVersionInfoExW;
-{$ELSE}
+{$ELSE ~SUPPORTS_UNICODE}
OSVERSIONINFOEX = OSVERSIONINFOEXA;
{$EXTERNALSYM OSVERSIONINFOEX}
@@ -2573,7 +2573,7 @@
{$EXTERNALSYM LPOSVERSIONINFOEX}
TOSVersionInfoEx = TOSVersionInfoExA;
-{$ENDIF}
+{$ENDIF ~SUPPORTS_UNICODE}
//
// RtlVerifyVersionInfo() conditions
Modified: trunk/jcl/source/windows/JclMapi.pas
===================================================================
--- trunk/jcl/source/windows/JclMapi.pas 2009-02-17 11:11:11 UTC (rev 2650)
+++ trunk/jcl/source/windows/JclMapi.pas 2009-02-17 11:45:24 UTC (rev 2651)
@@ -28,7 +28,7 @@
{ }
{**************************************************************************************************}
{ }
-{ Last modified: $Date:: $ }
+{ Last modified: $Date:: $ }
{ Revision: $Rev:: $ }
{ Author: $Author:: $ }
{ }
@@ -987,13 +987,9 @@
if not AnyClientInstalled then
raise EJclMapiError.CreateRes(@RsMapiMailNoClient);
- {$IFDEF SUPPORTS_UNICODE}
- @GetDllDirectory := GetProcAddress(GetModuleHandle(kernel32), 'GetDllDirectoryW');
- @SetDllDirectory := GetProcAddress(GetModuleHandle(kernel32), 'SetDllDirectoryW');
- {$ELSE ~SUPPORTS_UNICODE}
- @GetDllDirectory := GetProcAddress(GetModuleHandle(kernel32), 'GetDllDirectoryA');
- @SetDllDirectory := GetProcAddress(GetModuleHandle(kernel32), 'SetDllDirectoryA');
- {$ENDIF ~SUPPORTS_UNICODE}
+ @GetDllDirectory := GetProcAddress(GetModuleHandle(kernel32), 'GetDllDirectory' + AWSuffix);
+ @SetDllDirectory := GetProcAddress(GetModuleHandle(kernel32), 'SetDllDirectory' + AWSuffix);
+
if Assigned(@GetDllDirectory) and Assigned(@SetDllDirectory) then
begin
GetDllDirectory(Length(DllDirectoryBuffer), @DllDirectoryBuffer);
Modified: trunk/jcl/source/windows/JclShell.pas
===================================================================
--- trunk/jcl/source/windows/JclShell.pas 2009-02-17 11:11:11 UTC (rev 2650)
+++ trunk/jcl/source/windows/JclShell.pas 2009-02-17 11:45:24 UTC (rev 2651)
@@ -37,7 +37,7 @@
{ }
{**************************************************************************************************}
{ }
-{ Last modified: $Date:: $ }
+{ Last modified: $Date:: $ }
{ Revision: $Rev:: $ }
{ Author: $Author:: $ }
{ }
@@ -55,7 +55,7 @@
{$ENDIF UNITVERSIONING}
Windows, SysUtils,
ShlObj,
- JclWin32, JclSysUtils;
+ JclBase, JclWin32, JclSysUtils;
// Files and Folders
type
@@ -187,14 +187,8 @@
INSTALLSTATE = Longint;
const
MSILIB = 'msi.dll';
- {$IFDEF SUPPORTS_UNICODE}
- GetShortcutTargetName = 'MsiGetShortcutTargetW';
- GetComponentPathName = 'MsiGetComponentPathW';
- {$ELSE ~SUPPORTS_UNICODE}
- GetShortcutTargetName = 'MsiGetShortcutTargetA';
- GetComponentPathName = 'MsiGetComponentPathA';
- {$ENDIF ~SUPPORTS_UNICODE}
-
+ GetShortcutTargetName = 'MsiGetShortcutTarget' + AWSuffix;
+ GetComponentPathName = 'MsiGetComponentPath' + AWSuffix;
var
// MSI.DLL functions can''t be converted to Unicode due to an internal compiler bug (F2084 Internal Error: URW1021)
RtdlMsiLibHandle: TModuleHandle = INVALID_MODULEHANDLE_VALUE;
Modified: trunk/jcl/source/windows/JclWin32.pas
===================================================================
--- trunk/jcl/source/windows/JclWin32.pas 2009-02-17 11:11:11 UTC (rev 2650)
+++ trunk/jcl/source/windows/JclWin32.pas 2009-02-17 11:45:24 UTC (rev 2651)
@@ -2683,7 +2683,7 @@
{$EXTERNALSYM PRTL_OSVERSIONINFOEXW}
TOSVersionInfoExW = _OSVERSIONINFOEXW;
-{$IFDEF UNICODE}
+{$IFDEF SUPPORTS_UNICODE}
OSVERSIONINFOEX = OSVERSIONINFOEXW;
{$EXTERNALSYM OSVERSIONINFOEX}
@@ -2693,7 +2693,7 @@
{$EXTERNALSYM LPOSVERSIONINFOEX}
TOSVersionInfoEx = TOSVersionInfoExW;
-{$ELSE}
+{$ELSE ~SUPPORTS_UNICODE}
OSVERSIONINFOEX = OSVERSIONINFOEXA;
{$EXTERNALSYM OSVERSIONINFOEX}
@@ -2703,7 +2703,7 @@
{$EXTERNALSYM LPOSVERSIONINFOEX}
TOSVersionInfoEx = TOSVersionInfoExA;
-{$ENDIF}
+{$ENDIF ~SUPPORTS_UNICODE}
//
// RtlVerifyVersionInfo() conditions
@@ -7339,13 +7339,6 @@
{$ENDIF ~CLR}
-const
- {$IFDEF SUPPORTS_UNICODE}
- AWSuffix = 'W';
- {$ELSE ~SUPPORTS_UNICODE}
- AWSuffix = 'A';
- {$ENDIF ~SUPPORTS_UNICODE}
-
{$IFDEF UNITVERSIONING}
const
UnitVersioning: TUnitVersionInfo = (
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ou...@us...> - 2009-02-17 11:11:15
|
Revision: 2650
http://jcl.svn.sourceforge.net/jcl/?rev=2650&view=rev
Author: outchy
Date: 2009-02-17 11:11:11 +0000 (Tue, 17 Feb 2009)
Log Message:
-----------
Mantis 4704: Multiple mail attachments duplicate the contents of the last file under Delphi 2009
Modified Paths:
--------------
trunk/jcl/source/windows/JclMapi.pas
Modified: trunk/jcl/source/windows/JclMapi.pas
===================================================================
--- trunk/jcl/source/windows/JclMapi.pas 2009-02-17 10:55:36 UTC (rev 2649)
+++ trunk/jcl/source/windows/JclMapi.pas 2009-02-17 11:11:11 UTC (rev 2650)
@@ -28,7 +28,7 @@
{ }
{**************************************************************************************************}
{ }
-{ Last modified: $Date:: $ }
+{ Last modified: $Date:: $ }
{ Revision: $Rev:: $ }
{ Author: $Author:: $ }
{ }
@@ -978,7 +978,7 @@
I: Integer;
MsgID: array [0..512] of AnsiChar;
AttachmentFileNames: array of AnsiString;
- AttachmentPathNames: array of string;
+ AttachmentPathNames: array of AnsiString;
HtmlBodyFileName: string;
SetDllDirectory: TSetDllDirectory;
GetDllDirectory: TGetDllDirectory;
@@ -987,13 +987,13 @@
if not AnyClientInstalled then
raise EJclMapiError.CreateRes(@RsMapiMailNoClient);
- {$IFDEF UNICODE}
+ {$IFDEF SUPPORTS_UNICODE}
@GetDllDirectory := GetProcAddress(GetModuleHandle(kernel32), 'GetDllDirectoryW');
@SetDllDirectory := GetProcAddress(GetModuleHandle(kernel32), 'SetDllDirectoryW');
- {$ELSE}
+ {$ELSE ~SUPPORTS_UNICODE}
@GetDllDirectory := GetProcAddress(GetModuleHandle(kernel32), 'GetDllDirectoryA');
@SetDllDirectory := GetProcAddress(GetModuleHandle(kernel32), 'SetDllDirectoryA');
- {$ENDIF UNICODE}
+ {$ENDIF ~SUPPORTS_UNICODE}
if Assigned(@GetDllDirectory) and Assigned(@SetDllDirectory) then
begin
GetDllDirectory(Length(DllDirectoryBuffer), @DllDirectoryBuffer);
@@ -1022,16 +1022,16 @@
if (AttachmentFiles.Count > I) and (AttachmentFiles[I] <> '') then
begin
AttachmentFileNames[I] := AnsiString(Attachments[I]); // OF TStrings to AnsiString
- AttachmentPathNames[I] := SysUtils.ExpandFileName(AttachmentFiles[I]);
+ AttachmentPathNames[I] := AnsiString(SysUtils.ExpandFileName(AttachmentFiles[I]));
end
else
begin
AttachmentFileNames[I] := AnsiString(ExtractFileName(AnsiString(Attachments[I]))); // OF TStrings to AnsiString
- AttachmentPathNames[I] := SysUtils.ExpandFileName(Attachments[I]);
+ AttachmentPathNames[I] := AnsiString(SysUtils.ExpandFileName(Attachments[I]));
end;
- AttachArray[I].lpszFileName := PAnsiChar(AnsiString(AttachmentFileNames[I]));
- AttachArray[I].lpszPathName := PAnsiChar(AnsiString(AttachmentPathNames[I]));
- if not FileExists(AttachmentPathNames[I]) then
+ AttachArray[I].lpszFileName := PAnsiChar(AttachmentFileNames[I]);
+ AttachArray[I].lpszPathName := PAnsiChar(AttachmentPathNames[I]);
+ if not FileExists(string(AttachmentPathNames[I])) then
MapiCheck(MAPI_E_ATTACHMENT_NOT_FOUND, False);
end;
end
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ou...@us...> - 2009-02-17 10:55:42
|
Revision: 2649
http://jcl.svn.sourceforge.net/jcl/?rev=2649&view=rev
Author: outchy
Date: 2009-02-17 10:55:36 +0000 (Tue, 17 Feb 2009)
Log Message:
-----------
New button to save the email.
Modified Paths:
--------------
trunk/jcl/examples/windows/mapi/MapiDemoMain.dfm
trunk/jcl/examples/windows/mapi/MapiDemoMain.pas
Modified: trunk/jcl/examples/windows/mapi/MapiDemoMain.dfm
===================================================================
--- trunk/jcl/examples/windows/mapi/MapiDemoMain.dfm 2009-02-17 10:51:05 UTC (rev 2648)
+++ trunk/jcl/examples/windows/mapi/MapiDemoMain.dfm 2009-02-17 10:55:36 UTC (rev 2649)
@@ -183,8 +183,8 @@
TabOrder = 3
end
object SendBtn: TButton
- Left = 605
- Top = 8
+ Left = 603
+ Top = 4
Width = 75
Height = 25
Anchors = [akTop, akRight]
@@ -194,7 +194,7 @@
end
object AttachmentBtn: TButton
Left = 605
- Top = 40
+ Top = 58
Width = 75
Height = 25
Anchors = [akTop, akRight]
@@ -203,16 +203,16 @@
OnClick = AttachmentBtnClick
end
object ToAddressEdit: TEdit
- Left = 248
+ Left = 247
Top = 8
- Width = 333
+ Width = 269
Height = 21
Anchors = [akLeft, akTop, akRight]
TabOrder = 1
end
object DialogCheckBox: TCheckBox
- Left = 604
- Top = 72
+ Left = 603
+ Top = 35
Width = 81
Height = 17
Anchors = [akTop, akRight]
@@ -249,6 +249,16 @@
Caption = 'HTML message'
TabOrder = 10
end
+ object SaveBtn: TButton
+ Left = 522
+ Top = 4
+ Width = 75
+ Height = 25
+ Anchors = [akTop, akRight]
+ Caption = 'Sa&ve'
+ TabOrder = 11
+ OnClick = SaveBtnClick
+ end
object OpenDialog1: TOpenDialog
Title = 'Select attachment'
Left = 472
Modified: trunk/jcl/examples/windows/mapi/MapiDemoMain.pas
===================================================================
--- trunk/jcl/examples/windows/mapi/MapiDemoMain.pas 2009-02-17 10:51:05 UTC (rev 2648)
+++ trunk/jcl/examples/windows/mapi/MapiDemoMain.pas 2009-02-17 10:55:36 UTC (rev 2649)
@@ -32,6 +32,7 @@
AttachmentPaintBox: TPaintBox;
ProfilesListView: TListView;
HtmlCheckBox: TCheckBox;
+ SaveBtn: TButton;
procedure FormCreate(Sender: TObject);
procedure ClientsListViewSelectItem(Sender: TObject; Item: TListItem;
Selected: Boolean);
@@ -44,6 +45,7 @@
procedure AttachmentPaintBoxPaint(Sender: TObject);
procedure ProfilesListViewCustomDrawItem(Sender: TCustomListView;
Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean);
+ procedure SaveBtnClick(Sender: TObject);
private
procedure BuildClientList;
procedure BuildProfilesList;
@@ -165,6 +167,28 @@
Sender.Canvas.Font.Style := [fsBold];
end;
+procedure TMainForm.SaveBtnClick(Sender: TObject);
+begin
+ if not DialogCheckBox.Checked then
+ Application.MessageBox('The message will be inserted to Draft folder.',
+ PChar(Caption), MB_OK or MB_ICONWARNING);
+
+{ // Simple message creating, using TJclEmail.SimpleSendMail class method
+ JclSimpleSendMail(ToAddressEdit.Text, ToNameEdit.Text, SubjectEdit.Text,
+ BodyEdit.Text, OpenDialog1.FileName, DialogCheckBox.Checked);}
+
+ // Creating message using TJclEmail object, it is more flexible, but you have
+ // to create an instance (SimpleMapiMail variable in this example) of the class
+ SimpleMapiMail.Clear;
+ SimpleMapiMail.Recipients.Add(AnsiString(ToAddressEdit.Text), AnsiString(ToNameEdit.Text));
+ SimpleMapiMail.Subject := AnsiString(SubjectEdit.Text);
+ SimpleMapiMail.Body := AnsiString(BodyEdit.Text);
+ SimpleMapiMail.HtmlBody := HtmlCheckBox.Checked;
+ if OpenDialog1.FileName <> '' then
+ SimpleMapiMail.Attachments.Add(OpenDialog1.FileName);
+ SimpleMapiMail.Save;
+end;
+
procedure TMainForm.SendBtnClick(Sender: TObject);
begin
if not DialogCheckBox.Checked then
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ou...@us...> - 2009-02-17 10:51:11
|
Revision: 2648
http://jcl.svn.sourceforge.net/jcl/?rev=2648&view=rev
Author: outchy
Date: 2009-02-17 10:51:05 +0000 (Tue, 17 Feb 2009)
Log Message:
-----------
Mantis 917: MapiSaveMail not working when resaving (wrong SeedMessageID)
Modified Paths:
--------------
trunk/jcl/source/windows/JclMapi.pas
Modified: trunk/jcl/source/windows/JclMapi.pas
===================================================================
--- trunk/jcl/source/windows/JclMapi.pas 2009-02-17 09:39:34 UTC (rev 2647)
+++ trunk/jcl/source/windows/JclMapi.pas 2009-02-17 10:51:05 UTC (rev 2648)
@@ -1095,7 +1095,7 @@
if Save then
begin
StrPLCopy(MsgID, SeedMessageID, Length(MsgID) - 1);
- Res := MapiSaveMail(FSessionHandle, ParentWND, MapiMessage, Flags, 0, @MsgID[0]);
+ Res := MapiSaveMail(FSessionHandle, ParentWND, MapiMessage, Flags, MAPI_LONG_MSGID, @MsgID[0]);
if Res = SUCCESS_SUCCESS then
SeedMessageID := MsgID;
end
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ou...@us...> - 2009-02-17 09:39:40
|
Revision: 2647
http://jcl.svn.sourceforge.net/jcl/?rev=2647&view=rev
Author: outchy
Date: 2009-02-17 09:39:34 +0000 (Tue, 17 Feb 2009)
Log Message:
-----------
Mantis 4680: Range check error in the JclSysInfo.GetCPUSpeed().
Modified Paths:
--------------
trunk/jcl/source/common/JclSysInfo.pas
Modified: trunk/jcl/source/common/JclSysInfo.pas
===================================================================
--- trunk/jcl/source/common/JclSysInfo.pas 2009-02-16 09:23:35 UTC (rev 2646)
+++ trunk/jcl/source/common/JclSysInfo.pas 2009-02-17 09:39:34 UTC (rev 2647)
@@ -443,10 +443,10 @@
end;
TFreqInfo = record
- RawFreq: Cardinal;
- NormFreq: Cardinal;
- InCycles: Cardinal;
- ExTicks: Cardinal;
+ RawFreq: Int64;
+ NormFreq: Int64;
+ InCycles: Int64;
+ ExTicks: Int64;
end;
const
@@ -1339,6 +1339,7 @@
uses
SysUtils,
+ Math,
{$IFNDEF CLR}
{$IFDEF MSWINDOWS}
Messages, Winsock, Snmp,
@@ -4301,7 +4302,7 @@
TotalCycles := TotalCycles + Cycles;
// avoid division by zero
- if Ticks = 0 then
+ if Math.IsZero(Ticks) then
Freq := High(Freq)
else
Freq := Round(Cycles / Ticks);
@@ -4310,7 +4311,7 @@
end;
// avoid division by zero
- if TotalTicks = 0 then
+ if Math.IsZero(TotalTicks) then
begin
Freq3 := High(Freq3);
Freq2 := High(Freq2);
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ou...@us...> - 2009-02-16 09:23:39
|
Revision: 2646
http://jcl.svn.sourceforge.net/jcl/?rev=2646&view=rev
Author: outchy
Date: 2009-02-16 09:23:35 +0000 (Mon, 16 Feb 2009)
Log Message:
-----------
Fixed InternalLoadVolume behavior when a volume does not exist: force FVolume and FVolumeIndex synchronized.
Modified Paths:
--------------
trunk/jcl/source/common/JclStreams.pas
Modified: trunk/jcl/source/common/JclStreams.pas
===================================================================
--- trunk/jcl/source/common/JclStreams.pas 2009-02-16 02:04:51 UTC (rev 2645)
+++ trunk/jcl/source/common/JclStreams.pas 2009-02-16 09:23:35 UTC (rev 2646)
@@ -464,7 +464,7 @@
function GetVolumeMaxSize(Index: Integer): Int64; virtual; abstract;
function GetSize: Int64; {$IFDEF SIZE64}override;{$ENDIF SIZE64}
procedure SetSize({$IFNDEF CLR}const{$ENDIF ~CLR} NewSize: Int64); override;
- procedure InternalLoadVolume(Index: Integer);
+ function InternalLoadVolume(Index: Integer): Boolean;
public
constructor Create(AForcePosition: Boolean = False);
@@ -2453,8 +2453,7 @@
try
FVolumeIndex := -1;
repeat
- InternalLoadVolume(FVolumeIndex + 1);
- if not Assigned(FVolume) then
+ if not InternalLoadVolume(FVolumeIndex + 1) then
Break;
Result := Result + FVolume.Size;
until FVolume.Size = 0;
@@ -2466,19 +2465,41 @@
end;
end;
-procedure TJclSplitStream.InternalLoadVolume(Index: Integer);
+function TJclSplitStream.InternalLoadVolume(Index: Integer): Boolean;
+var
+ OldVolumeIndex: Integer;
+ OldVolumeMaxSize: Int64;
+ OldVolumePosition: Int64;
+ OldVolume: TStream;
begin
if Index = -1 then
Index := 0;
if Index <> FVolumeIndex then
begin
+ // save current pointers
+ OldVolumeIndex := FVolumeIndex;
+ OldVolumeMaxSize := FVolumeMaxSize;
+ OldVolumePosition := FVolumePosition;
+ OldVolume := FVolume;
+
FVolumeIndex := Index;
FVolumePosition := 0;
FVolume := GetVolume(Index);
FVolumeMaxSize := GetVolumeMaxSize(Index);
- if Assigned(FVolume) then
- StreamSeek(FVolume, 0, soBeginning);
- end;
+ Result := Assigned(FVolume);
+ if Result then
+ StreamSeek(FVolume, 0, soBeginning)
+ else
+ begin
+ // restore old pointers if volume load failed
+ FVolumeIndex := OldVolumeIndex;
+ FVolumeMaxSize := OldVolumeMaxSize;
+ FVolumePosition := OldVolumePosition;
+ FVolume := OldVolume;
+ end;
+ end
+ else
+ Result := Assigned(FVolume);
end;
{$IFDEF CLR}
@@ -2494,8 +2515,7 @@
begin
Result := 0;
- InternalLoadVolume(FVolumeIndex);
- if not Assigned(FVolume) then
+ if not InternalLoadVolume(FVolumeIndex) then
Exit;
{$IFNDEF CLR}
@@ -2527,8 +2547,7 @@
{$ELSE ~CLR}
Inc(Data, Result);
{$ENDIF ~CLR}
- InternalLoadVolume(FVolumeIndex + 1);
- if not Assigned(FVolume) then
+ if not InternalLoadVolume(FVolumeIndex + 1) then
Break;
until False;
end;
@@ -2555,8 +2574,7 @@
RemainingOffset := ExpectedPosition - FPosition;
Result := FPosition;
repeat
- InternalLoadVolume(FVolumeIndex);
- if not Assigned(FVolume) then
+ if not InternalLoadVolume(FVolumeIndex) then
Break;
if RemainingOffset < 0 then
@@ -2581,8 +2599,7 @@
FPosition := Result;
FVolumePosition := StreamSeek(FVolume, 0, soBeginning);
// load previous volume
- InternalLoadVolume(FVolumeIndex - 1);
- if not Assigned(FVolume) then
+ if not InternalLoadVolume(FVolumeIndex - 1) then
Break;
Result := Result - FVolume.Size;
FPosition := Result;
@@ -2606,8 +2623,7 @@
RemainingOffset := RemainingOffset - FVolumeMaxSize + FVolumePosition;
Result := Result + FVolumeMaxSize - FVolumePosition;
FPosition := Result;
- InternalLoadVolume(FVolumeIndex + 1);
- if not Assigned(FVolume) then
+ if not InternalLoadVolume(FVolumeIndex + 1) then
Break;
end;
end;
@@ -2627,8 +2643,7 @@
try
FVolumeIndex := 0;
repeat
- InternalLoadVolume(FVolumeIndex);
- if not Assigned(FVolume) then
+ if not InternalLoadVolume(FVolumeIndex) then
Break;
if (FVolumeMaxSize > 0) and (RemainingSize > FVolumeMaxSize) then
VolumeSize := FVolumeMaxSize
@@ -2660,8 +2675,7 @@
begin
Result := 0;
- InternalLoadVolume(FVolumeIndex);
- if not Assigned(FVolume) then
+ if not InternalLoadVolume(FVolumeIndex) then
Exit;
{$IFNDEF CLR}
@@ -2698,8 +2712,7 @@
{$ELSE ~CLR}
Inc(Data, LoopWritten);
{$ENDIF ~CLR}
- InternalLoadVolume(FVolumeIndex + 1);
- if not Assigned(FVolume) then
+ if not InternalLoadVolume(FVolumeIndex + 1) then
Break;
until False;
end;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <jg...@us...> - 2009-02-16 03:01:19
|
Revision: 2645
http://jcl.svn.sourceforge.net/jcl/?rev=2645&view=rev
Author: jgsoft
Date: 2009-02-16 02:04:51 +0000 (Mon, 16 Feb 2009)
Log Message:
-----------
Improper use of PChar caused TJclGZIPDecompressionStream to fail with Delphi 2009. Changing this to PByte did not work with Delphi 2007 and earlier. Changed to PAnsiChar.
Modified Paths:
--------------
trunk/jcl/source/common/JclCompression.pas
Modified: trunk/jcl/source/common/JclCompression.pas
===================================================================
--- trunk/jcl/source/common/JclCompression.pas 2009-02-15 15:40:39 UTC (rev 2644)
+++ trunk/jcl/source/common/JclCompression.pas 2009-02-16 02:04:51 UTC (rev 2645)
@@ -2677,8 +2677,8 @@
function TJclGZIPDecompressionStream.ReadCompressedData(Sender: TObject; var Buffer;
Count: Longint): Longint;
var
- BufferAddr: PByte;
- FooterAddr: PByte;
+ BufferAddr: PAnsiChar;
+ FooterAddr: PAnsiChar;
begin
if (Count = 0) or FDataEnded then
begin
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ou...@us...> - 2009-02-15 15:40:43
|
Revision: 2644
http://jcl.svn.sourceforge.net/jcl/?rev=2644&view=rev
Author: outchy
Date: 2009-02-15 15:40:39 +0000 (Sun, 15 Feb 2009)
Log Message:
-----------
Added report of automatic file names.
Modified Paths:
--------------
trunk/jcl/examples/windows/compression/archive/UMain.pas
Modified: trunk/jcl/examples/windows/compression/archive/UMain.pas
===================================================================
--- trunk/jcl/examples/windows/compression/archive/UMain.pas 2009-02-15 15:38:09 UTC (rev 2643)
+++ trunk/jcl/examples/windows/compression/archive/UMain.pas 2009-02-15 15:40:39 UTC (rev 2644)
@@ -517,7 +517,7 @@
if ipPackedExtension in CompressionItem.ValidProperties then
Item.SubItems.Add('(Extension)' + CompressionItem.PackedExtension)
else
- Item.SubItems.Add('');
+ Item.SubItems.Add('(Auto)');
if ipFileSize in CompressionItem.ValidProperties then
Item.SubItems.Add(IntToStr(CompressionItem.FileSize))
else
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ou...@us...> - 2009-02-15 15:38:13
|
Revision: 2643
http://jcl.svn.sourceforge.net/jcl/?rev=2643&view=rev
Author: outchy
Date: 2009-02-15 15:38:09 +0000 (Sun, 15 Feb 2009)
Log Message:
-----------
Variants that contain numerical values can be converted to string.
Some items have neither a packed name nor a packed extension although other properties are valid (for instance, the unique item inside .GZ and .BZ2 archive formats).
Modified Paths:
--------------
trunk/jcl/source/common/JclCompression.pas
Modified: trunk/jcl/source/common/JclCompression.pas
===================================================================
--- trunk/jcl/source/common/JclCompression.pas 2009-02-15 15:15:45 UTC (rev 2642)
+++ trunk/jcl/source/common/JclCompression.pas 2009-02-15 15:38:09 UTC (rev 2643)
@@ -4840,6 +4840,46 @@
Setter(Value.bstrVal);
SysFreeString(Value.bstrVal);
end;
+ VT_I1:
+ begin
+ Result := True;
+ Setter(IntToStr(Value.iVal));
+ end;
+ VT_I2:
+ begin
+ Result := True;
+ Setter(IntToStr(Value.iVal));
+ end;
+ VT_INT, VT_I4:
+ begin
+ Result := True;
+ Setter(IntToStr(Value.lVal));
+ end;
+ VT_I8:
+ begin
+ Result := True;
+ Setter(IntToStr(Value.hVal.QuadPart));
+ end;
+ VT_UI1:
+ begin
+ Result := True;
+ Setter(IntToStr(Value.bVal));
+ end;
+ VT_UI2:
+ begin
+ Result := True;
+ Setter(IntToStr(Value.uiVal));
+ end;
+ VT_UINT, VT_UI4:
+ begin
+ Result := True;
+ Setter(IntToStr(Value.ulVal));
+ end;
+ VT_UI8:
+ begin
+ Result := True;
+ Setter(IntToStr(Value.uhVal.QuadPart));
+ end;
else
raise EJclCompressionError.CreateResFmt(@RsCompression7zUnknownValueType, [Value.vt, PropID]);
end;
@@ -4941,35 +4981,35 @@
end;
end;
-// TODO: Are changes for UTF-8 filenames (>= 4.58 beta) necessary?
+// TODO: Are changes for UTF-8 filenames (>= 4.58 beta) necessary?
procedure Load7zFileAttribute(AInArchive: IInArchive; ItemIndex: Integer;
AItem: TJclCompressionItem);
begin
AItem.FValidProperties := [];
- if Get7zWideStringProp(AInArchive, ItemIndex, kpidPath, AItem.SetPackedName) or
- Get7zWideStringProp(AInArchive, ItemIndex, kpidExtension, AItem.SetPackedExtension) then
- begin
- AItem.FPackedIndex := ItemIndex;
- AItem.FileName := '';
- AItem.Stream := nil;
- AItem.OwnsStream := False;
- Get7zCardinalProp(AInArchive, ItemIndex, kpidAttrib, AItem.SetAttributes);
- Get7zInt64Prop(AInArchive, ItemIndex, kpidSize, AItem.SetFileSize);
- 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);
- Get7zWideStringProp(AInArchive, ItemIndex, kpidUser, AItem.SetUser);
- Get7zWideStringProp(AInArchive, ItemIndex, kpidGroup, AItem.SetGroup);
- Get7zCardinalProp(AInArchive, ItemIndex, kpidCRC, AItem.SetCRC);
- Get7zWideStringProp(AInArchive, ItemIndex, kpidMethod, AItem.SetMethod);
+ AItem.FPackedIndex := ItemIndex;
+ AItem.FileName := '';
+ AItem.Stream := nil;
+ AItem.OwnsStream := False;
- // reset modified flags
- AItem.ModifiedProperties := [];
- end;
+ // sometimes, items have neither names nor extension although other properties may succeed
+ Get7zWideStringProp(AInArchive, ItemIndex, kpidPath, AItem.SetPackedName);
+ Get7zWideStringProp(AInArchive, ItemIndex, kpidExtension, AItem.SetPackedExtension);
+ Get7zCardinalProp(AInArchive, ItemIndex, kpidAttrib, AItem.SetAttributes);
+ Get7zInt64Prop(AInArchive, ItemIndex, kpidSize, AItem.SetFileSize);
+ 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);
+ Get7zWideStringProp(AInArchive, ItemIndex, kpidUser, AItem.SetUser);
+ Get7zWideStringProp(AInArchive, ItemIndex, kpidGroup, AItem.SetGroup);
+ Get7zCardinalProp(AInArchive, ItemIndex, kpidCRC, AItem.SetCRC);
+ Get7zWideStringProp(AInArchive, ItemIndex, kpidMethod, AItem.SetMethod);
+
+ // reset modified flags
+ AItem.ModifiedProperties := [];
end;
procedure GetSevenzipArchiveCompressionProperties(AJclArchive: IInterface; ASevenzipArchive: IInterface);
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ou...@us...> - 2009-02-15 15:15:50
|
Revision: 2642
http://jcl.svn.sourceforge.net/jcl/?rev=2642&view=rev
Author: outchy
Date: 2009-02-15 15:15:45 +0000 (Sun, 15 Feb 2009)
Log Message:
-----------
Fixed bound check for Delphi 5's and C++Builder 5's StreamSeek.
Modified Paths:
--------------
trunk/jcl/source/common/JclStreams.pas
Modified: trunk/jcl/source/common/JclStreams.pas
===================================================================
--- trunk/jcl/source/common/JclStreams.pas 2009-02-15 15:11:49 UTC (rev 2641)
+++ trunk/jcl/source/common/JclStreams.pas 2009-02-15 15:15:45 UTC (rev 2642)
@@ -630,7 +630,7 @@
if Stream is TJclStream then
Result := TJclStream(Stream).Seek(Offset, Origin)
else
- if (Offset <= MaxLongint) or (Offset > -MaxLongint) then
+ if (Offset > -MaxLongint) and (Offset <= MaxLongint) then
Result := Stream.Seek(Longint(Offset), Ord(Origin))
else
Result := -1;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ou...@us...> - 2009-02-15 15:11:53
|
Revision: 2641
http://jcl.svn.sourceforge.net/jcl/?rev=2641&view=rev
Author: outchy
Date: 2009-02-15 15:11:49 +0000 (Sun, 15 Feb 2009)
Log Message:
-----------
Fixed wrong arithmetic computations for the position while seeking to the end of a split stream.
Modified Paths:
--------------
trunk/jcl/source/common/JclStreams.pas
Modified: trunk/jcl/source/common/JclStreams.pas
===================================================================
--- trunk/jcl/source/common/JclStreams.pas 2009-02-15 14:43:52 UTC (rev 2640)
+++ trunk/jcl/source/common/JclStreams.pas 2009-02-15 15:11:49 UTC (rev 2641)
@@ -2544,7 +2544,7 @@
soCurrent:
ExpectedPosition := FPosition + Offset;
soEnd:
- ExpectedPosition := Size - Offset;
+ ExpectedPosition := Size + Offset;
else
{$IFDEF CLR}
raise EJclStreamError.Create(RsStreamsSeekError);
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ou...@us...> - 2009-02-15 14:43:56
|
Revision: 2640
http://jcl.svn.sourceforge.net/jcl/?rev=2640&view=rev
Author: outchy
Date: 2009-02-15 14:43:52 +0000 (Sun, 15 Feb 2009)
Log Message:
-----------
TJclSevenzipDecompressArchive.ExtractAll and TJclSevenzipUpdateArchive.ExtractAll failed with some archive formats (such as RPM): the array of indices shall not be null.
Modified Paths:
--------------
trunk/jcl/source/common/JclCompression.pas
Modified: trunk/jcl/source/common/JclCompression.pas
===================================================================
--- trunk/jcl/source/common/JclCompression.pas 2009-02-15 13:56:48 UTC (rev 2639)
+++ trunk/jcl/source/common/JclCompression.pas 2009-02-15 14:43:52 UTC (rev 2640)
@@ -41,7 +41,7 @@
{ }
{**************************************************************************************************}
{ }
-{ Last modified: $Date:: $ }
+{ Last modified: $Date:: $ }
{ Revision: $Rev:: $ }
{ Author: $Author:: $ }
{ }
@@ -6188,12 +6188,15 @@
AAutoCreateSubDir: Boolean);
var
AExtractCallback: IArchiveExtractCallback;
+ Indices: array of Cardinal;
+ NbIndices: Cardinal;
+ Index: Integer;
begin
CheckNotDecompressing;
FDestinationDir := ADestinationDir;
FAutoCreateSubDir := AAutoCreateSubDir;
-
+
if FDestinationDir <> '' then
FDestinationDir := PathAddSeparator(FDestinationDir);
@@ -6203,7 +6206,19 @@
try
OpenArchive;
- SevenzipCheck(FInArchive.Extract(nil, $FFFFFFFF, 0, AExtractCallback));
+ // seems buggy: first param "indices" is dereferenced without
+ // liveness checks inside Sevenzip code
+ //SevenzipCheck(FInArchive.Extract(nil, $FFFFFFFF, 0, AExtractCallback));
+
+ NbIndices := ItemCount;
+ SetLength(Indices, NbIndices);
+ for Index := 0 to NbIndices - 1 do
+ begin
+ Items[Index].Selected := True;
+ Indices[Index] := Index;
+ end;
+ SevenzipCheck(FInArchive.Extract(@Indices[0], NbIndices, 0, AExtractCallback));
+
CheckOperationSuccess;
finally
FDestinationDir := '';
@@ -7049,6 +7064,9 @@
AAutoCreateSubDir: Boolean);
var
AExtractCallback: IArchiveExtractCallback;
+ Indices: array of Cardinal;
+ NbIndices: Cardinal;
+ Index: Integer;
begin
CheckNotDecompressing;
CheckNotCompressing;
@@ -7065,7 +7083,19 @@
try
OpenArchive;
- SevenzipCheck(FInArchive.Extract(nil, $FFFFFFFF, 0, AExtractCallback));
+ // seems buggy: first param "indices" is dereferenced without
+ // liveness checks inside Sevenzip code
+ //SevenzipCheck(FInArchive.Extract(nil, $FFFFFFFF, 0, AExtractCallback));
+
+ NbIndices := ItemCount;
+ SetLength(Indices, NbIndices);
+ for Index := 0 to NbIndices - 1 do
+ begin
+ Items[Index].Selected := True;
+ Indices[Index] := Index;
+ end;
+ SevenzipCheck(FInArchive.Extract(@Indices[0], NbIndices, 0, AExtractCallback));
+
CheckOperationSuccess;
finally
FDestinationDir := '';
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ou...@us...> - 2009-02-15 13:56:52
|
Revision: 2639
http://jcl.svn.sourceforge.net/jcl/?rev=2639&view=rev
Author: outchy
Date: 2009-02-15 13:56:48 +0000 (Sun, 15 Feb 2009)
Log Message:
-----------
Added support for RPM, MUB and DMG archive formats. The packed item names are not stored inside the archive and have to be computed given archive filename and a specific filename extension retrieved through property named kpidExtension.
Modified Paths:
--------------
trunk/jcl/examples/windows/compression/archive/UMain.pas
trunk/jcl/source/common/JclCompression.pas
Modified: trunk/jcl/examples/windows/compression/archive/UMain.pas
===================================================================
--- trunk/jcl/examples/windows/compression/archive/UMain.pas 2009-02-15 02:48:03 UTC (rev 2638)
+++ trunk/jcl/examples/windows/compression/archive/UMain.pas 2009-02-15 13:56:48 UTC (rev 2639)
@@ -514,6 +514,9 @@
if ipPackedName in CompressionItem.ValidProperties then
Item.SubItems.Add(CompressionItem.PackedName)
else
+ if ipPackedExtension in CompressionItem.ValidProperties then
+ Item.SubItems.Add('(Extension)' + CompressionItem.PackedExtension)
+ else
Item.SubItems.Add('');
if ipFileSize in CompressionItem.ValidProperties then
Item.SubItems.Add(IntToStr(CompressionItem.FileSize))
Modified: trunk/jcl/source/common/JclCompression.pas
===================================================================
--- trunk/jcl/source/common/JclCompression.pas 2009-02-15 02:48:03 UTC (rev 2638)
+++ trunk/jcl/source/common/JclCompression.pas 2009-02-15 13:56:48 UTC (rev 2639)
@@ -41,7 +41,7 @@
{ }
{**************************************************************************************************}
{ }
-{ Last modified: $Date:: $ }
+{ Last modified: $Date:: $ }
{ Revision: $Rev:: $ }
{ Author: $Author:: $ }
{ }
@@ -543,9 +543,10 @@
var AVolumeMaxSize: Int64) of object;
TJclCompressionProgressEvent = procedure(Sender: TObject; const Value, MaxValue: Int64) of object;
- TJclCompressionItemProperty = (ipPackedName, ipPackedSize, ipFileSize,
- ipFileName, ipAttributes, ipCreationTime, ipLastAccessTime, ipLastWriteTime,
- ipComment, ipHostOS, ipHostFS, ipUser, ipGroup, ipCRC, ipStream, ipMethod);
+ TJclCompressionItemProperty = (ipPackedName, ipPackedSize, ipPackedExtension,
+ ipFileSize, ipFileName, ipAttributes, ipCreationTime, ipLastAccessTime,
+ ipLastWriteTime, ipComment, ipHostOS, ipHostFS, ipUser, ipGroup, ipCRC,
+ ipStream, ipMethod);
TJclCompressionItemProperties = set of TJclCompressionItemProperty;
TJclCompressionItemKind = (ikFile, ikDirectory);
@@ -576,6 +577,7 @@
FPackedSize: Int64;
FFileSize: Int64;
FAttributes: Cardinal;
+ FPackedExtension: WideString;
FCreationTime: TFileTime;
FLastAccessTime: TFileTime;
FLastWriteTime: TFileTime;
@@ -607,6 +609,7 @@
function GetLastAccessTime: TFileTime;
function GetLastWriteTime: TFileTime;
function GetMethod: WideString;
+ function GetPackedExtension: WideString;
function GetPackedName: WideString;
function GetPackedSize: Int64;
function GetStream: TStream;
@@ -624,6 +627,7 @@
procedure SetLastAccessTime(const Value: TFileTime);
procedure SetLastWriteTime(const Value: TFileTime);
procedure SetMethod(const Value: WideString);
+ procedure SetPackedExtension(const Value: WideString);
procedure SetPackedName(const Value: WideString);
procedure SetPackedSize(const Value: Int64);
procedure SetStream(const Value: TStream);
@@ -646,6 +650,7 @@
property LastAccessTime: TFileTime read GetLastAccessTime write SetLastAccessTime;
property LastWriteTime: TFileTime read GetLastWriteTime write SetLastWriteTime;
property Method: WideString read GetMethod write SetMethod;
+ property PackedExtension: WideString read GetPackedExtension write SetPackedExtension;
property PackedName: WideString read GetPackedName write SetPackedName;
property PackedSize: Int64 read GetPackedSize write SetPackedSize;
property User: WideString read GetUser write SetUser;
@@ -3371,6 +3376,35 @@
Result := FMethod;
end;
+function TJclCompressionItem.GetPackedExtension: WideString;
+var
+ Index: Integer;
+begin
+ CheckGetProperty(ipPackedExtension);
+ if FPackedName = '' then
+ Result := FPackedExtension
+ else
+ begin
+ Result := '';
+
+ // Unicode version of ExtractFileExt
+ for Index := Length(FPackedName) downto 1 do
+ begin
+ case FPackedName[Index] of
+ '.':
+ begin
+ Result := Copy(FPackedName, Index, Length(FPackedName) - Index + 1);
+ Break;
+ end;
+ DirSeparator,
+ DirDelimiter:
+ // no extension
+ Break;
+ end;
+ end;
+ end;
+end;
+
function TJclCompressionItem.GetPackedName: WideString;
begin
CheckGetProperty(ipPackedName);
@@ -3526,6 +3560,18 @@
Include(FValidProperties, ipMethod);
end;
+procedure TJclCompressionItem.SetPackedExtension(const Value: WideString);
+begin
+ CheckSetProperty(ipPackedExtension);
+ if (Value <> '') and (Value[1] <> '.') then
+ // force heading '.'
+ FPackedExtension := '.' + Value
+ else
+ FPackedExtension := Value;
+ Include(FModifiedProperties, ipPackedExtension);
+ Include(FValidProperties, ipPackedExtension);
+end;
+
procedure TJclCompressionItem.SetPackedName(const Value: WideString);
var
PackedNamesIndex: Integer;
@@ -4394,13 +4440,25 @@
function TJclDecompressArchive.ValidateExtraction(Index: Integer;
var FileName: TFileName; var AStream: TStream; var AOwnsStream: Boolean): Boolean;
+var
+ AItem: TJclCompressionItem;
+ PackedName: TFileName;
begin
if FExtractingAllIndex <> -1 then
// extracting all
FExtractingAllIndex := Index;
+ AItem := Items[Index];
+
if FileName = '' then
- FileName := PathGetRelativePath(FDestinationDir, Items[Index].PackedName);
+ begin
+ PackedName := AItem.PackedName;
+
+ if PackedName = '' then
+ PackedName := ChangeFileExt(ExtractFileName(Volumes[0].FileName), AItem.PackedExtension);
+
+ FileName := PathGetRelativePath(FDestinationDir, PackedName);
+ end;
Result := True;
if Assigned(FOnExtract) then
@@ -4408,7 +4466,7 @@
if Result and not Assigned(AStream) and AutoCreateSubDir then
begin
- if (Items[Index].Attributes and faDirectory) <> 0 then
+ if (AItem.Attributes and faDirectory) <> 0 then
ForceDirectories(FileName)
else
ForceDirectories(ExtractFilePath(FileName));
@@ -4474,13 +4532,25 @@
function TJclUpdateArchive.ValidateExtraction(Index: Integer;
var FileName: TFileName; var AStream: TStream;
var AOwnsStream: Boolean): Boolean;
+var
+ AItem: TJclCompressionItem;
+ PackedName: TFileName;
begin
if FExtractingAllIndex <> -1 then
// extracting all
FExtractingAllIndex := Index;
+ AItem := Items[Index];
+
if FileName = '' then
- FileName := PathGetRelativePath(FDestinationDir, Items[Index].PackedName);
+ begin
+ PackedName := AItem.PackedName;
+
+ if PackedName = '' then
+ PackedName := ChangeFileExt(ExtractFileName(Volumes[0].FileName), AItem.PackedExtension);
+
+ FileName := PathGetRelativePath(FDestinationDir, PackedName);
+ end;
Result := True;
if Assigned(FOnExtract) then
@@ -4488,7 +4558,7 @@
if Result and not Assigned(AStream) and AutoCreateSubDir then
begin
- if (Items[Index].Attributes and faDirectory) <> 0 then
+ if (AItem.Attributes and faDirectory) <> 0 then
ForceDirectories(FileName)
else
ForceDirectories(ExtractFilePath(FileName));
@@ -4876,7 +4946,8 @@
AItem: TJclCompressionItem);
begin
AItem.FValidProperties := [];
- if Get7zWideStringProp(AInArchive, ItemIndex, kpidPath, AItem.SetPackedName) then
+ if Get7zWideStringProp(AInArchive, ItemIndex, kpidPath, AItem.SetPackedName) or
+ Get7zWideStringProp(AInArchive, ItemIndex, kpidExtension, AItem.SetPackedExtension) then
begin
AItem.FPackedIndex := ItemIndex;
AItem.FileName := '';
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.
