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-11-05 16:03:36
|
Revision: 3067
http://jcl.svn.sourceforge.net/jcl/?rev=3067&view=rev
Author: outchy
Date: 2009-11-05 16:03:26 +0000 (Thu, 05 Nov 2009)
Log Message:
-----------
move the thread var to the implementation section: it is not emitted to HPP files and that makes BCB6 happy.
use getter/setter to access the JclRegWOW64Access thread variable.
Modified Paths:
--------------
trunk/jcl/source/windows/JclRegistry.pas
Modified: trunk/jcl/source/windows/JclRegistry.pas
===================================================================
--- trunk/jcl/source/windows/JclRegistry.pas 2009-11-05 08:17:06 UTC (rev 3066)
+++ trunk/jcl/source/windows/JclRegistry.pas 2009-11-05 16:03:26 UTC (rev 3067)
@@ -347,12 +347,10 @@
}
TJclRegWOW64Access = (raDefault, raNative, ra32Key, ra64Key);
-{$IFDEF BCB6}
-var
-{$ELSE}
-threadvar
-{$ENDIF BCB6}
- JclRegWOW64Access: TJclRegWOW64Access {= raDefault};
+// cannot access variable JclRegWOW64Access from outside package
+// so these helper functions can be used.
+function RegGetWOW64AccessMode: TJclRegWOW64Access;
+procedure RegSetWOW64AccessMode(Access: TJclRegWOW64Access);
{$IFDEF UNITVERSIONING}
const
@@ -390,6 +388,19 @@
var
CachedIsWindows64: Integer = -1;
+threadvar
+ JclRegWOW64Access: TJclRegWOW64Access {= raDefault};
+
+function RegGetWOW64AccessMode: TJclRegWOW64Access;
+begin
+ Result := JclRegWOW64Access;
+end;
+
+procedure RegSetWOW64AccessMode(Access: TJclRegWOW64Access);
+begin
+ JclRegWOW64Access := Access;
+end;
+
//=== Internal helper routines ===============================================
function GetWOW64AccessMode(samDesired: REGSAM): REGSAM;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ou...@us...> - 2009-11-05 08:17:13
|
Revision: 3066
http://jcl.svn.sourceforge.net/jcl/?rev=3066&view=rev
Author: outchy
Date: 2009-11-05 08:17:06 +0000 (Thu, 05 Nov 2009)
Log Message:
-----------
style cleaning.
new assignment source and target.
TJclAnsiStrings.GetValueFromIndex speedup.
TJclAnsiStringList.AddObject speedup when Duplicates = dupAccept.
Modified Paths:
--------------
trunk/jcl/source/common/JclAnsiStrings.pas
Modified: trunk/jcl/source/common/JclAnsiStrings.pas
===================================================================
--- trunk/jcl/source/common/JclAnsiStrings.pas 2009-11-04 20:20:51 UTC (rev 3065)
+++ trunk/jcl/source/common/JclAnsiStrings.pas 2009-11-05 08:17:06 UTC (rev 3066)
@@ -639,8 +639,9 @@
end;
{$IFDEF SUPPORTS_UNICODE}
-{ TJclAnsiStrings }
+//=== { TJclAnsiStrings } ====================================================
+
constructor TJclAnsiStrings.Create;
begin
inherited Create;
@@ -650,26 +651,32 @@
end;
procedure TJclAnsiStrings.Assign(Source: TPersistent);
+var
+ StringsSource: TStrings;
+ I: Integer;
begin
- if Source is TJclAnsiStrings then
+ if Source is TStrings then
begin
+ StringsSource := TStrings(Source);
BeginUpdate;
try
Clear;
- FNameValueSeparator := TJclAnsiStrings(Source).FNameValueSeparator;
- FDelimiter := TJclAnsiStrings(Source).FDelimiter;
- AddStrings(TJclAnsiStrings(Source));
+ FDelimiter := AnsiChar(StringsSource.Delimiter);
+ FNameValueSeparator := AnsiChar(StringsSource.NameValueSeparator);
+ for I := 0 to StringsSource.Count - 1 do
+ AddObject(AnsiString(StringsSource.Strings[I]), StringsSource.Objects[I]);
finally
EndUpdate;
end;
- Exit;
- end;
- inherited Assign(Source);
+ end
+ else
+ inherited Assign(Source);
end;
procedure TJclAnsiStrings.AssignTo(Dest: TPersistent);
var
StringsDest: TStrings;
+ AnsiStringsDest: TJclAnsiStrings;
I: Integer;
begin
if Dest is TStrings then
@@ -685,7 +692,24 @@
finally
StringsDest.EndUpdate;
end;
- end;
+ end
+ else
+ if Dest is TJclAnsiStrings then
+ begin
+ AnsiStringsDest := TJclAnsiStrings(Dest);
+ BeginUpdate;
+ try
+ AnsiStringsDest.Clear;
+ AnsiStringsDest.FNameValueSeparator := FNameValueSeparator;
+ AnsiStringsDest.FDelimiter := FDelimiter;
+ for I := 0 to Count - 1 do
+ AnsiStringsDest.AddObject(Strings[I], Objects[I]);
+ finally
+ EndUpdate;
+ end;
+ end
+ else
+ inherited AssignTo(Dest);
end;
function TJclAnsiStrings.Add(const S: AnsiString): Integer;
@@ -719,7 +743,8 @@
function TJclAnsiStrings.IndexOf(const S: AnsiString): Integer;
begin
for Result := 0 to Count - 1 do
- if CompareStrings(Strings[Result], S) = 0 then Exit;
+ if CompareStrings(Strings[Result], S) = 0 then
+ Exit;
Result := -1;
end;
@@ -728,19 +753,21 @@
P: Integer;
S: AnsiString;
begin
- for Result := 0 to GetCount - 1 do
+ for Result := 0 to Count - 1 do
begin
- S := GetString(Result);
+ S := Strings[Result];
P := AnsiPos(NameValueSeparator, S);
- if (P <> 0) and (CompareStrings(Copy(S, 1, P - 1), Name) = 0) then Exit;
+ if (P > 0) and (CompareStrings(Copy(S, 1, P - 1), Name) = 0) then
+ Exit;
end;
Result := -1;
end;
function TJclAnsiStrings.IndexOfObject(AObject: TObject): Integer;
begin
- for Result := 0 to GetCount - 1 do
- if GetObject(Result) = AObject then Exit;
+ for Result := 0 to Count - 1 do
+ if Objects[Result] = AObject then
+ Exit;
Result := -1;
end;
@@ -813,23 +840,20 @@
begin
Clear;
Len := Length(Value);
- if Len > 0 then
+ Index := 1;
+ while Index <= Len do
begin
- Index := 1;
- while Index <= Len do
- begin
- Start := Index;
- while (Index <= Len) and not (Value[Index] in [#10, #13]) do
- Inc(Index);
+ Start := Index;
+ while (Index <= Len) and not CharIsReturn(Value[Index]) do
+ Inc(Index);
- S := Copy(Value, Start, Index - Start);
- Add(S);
+ S := Copy(Value, Start, Index - Start);
+ Add(S);
- if (Index <= Len) and (Value[Index] = #13) then
- Inc(Index);
- if (Index <= Len) and (Value[Index] = #10) then
- Inc(Index);
- end;
+ if (Index <= Len) and (Value[Index] = AnsiCarriageReturn) then
+ Inc(Index);
+ if (Index <= Len) and (Value[Index] = AnsiLineFeed) then
+ Inc(Index);
end;
end;
@@ -872,7 +896,7 @@
try
Size := Stream.Size - Stream.Position;
System.SetString(S, nil, Size);
- Stream.Read(Pointer(S)^, Size);
+ Stream.Read(PAnsiChar(S)^, Size);
SetText(S);
finally
EndUpdate;
@@ -896,7 +920,7 @@
S: AnsiString;
begin
S := GetText;
- Stream.WriteBuffer(Pointer(S)^, Length(S));
+ Stream.WriteBuffer(PAnsiChar(S)^, Length(S));
end;
function TJclAnsiStrings.ExtractName(const S: AnsiString): AnsiString;
@@ -905,15 +929,15 @@
begin
Result := S;
P := AnsiPos(NameValueSeparator, Result);
- if P <> 0 then
- SetLength(Result, P-1)
+ if P > 0 then
+ SetLength(Result, P - 1)
else
SetLength(Result, 0);
end;
function TJclAnsiStrings.GetName(Index: Integer): AnsiString;
begin
- Result := ExtractName(GetString(Index));
+ Result := ExtractName(Strings[Index]);
end;
function TJclAnsiStrings.GetValue(const Name: AnsiString): AnsiString;
@@ -946,9 +970,19 @@
end;
function TJclAnsiStrings.GetValueFromIndex(Index: Integer): AnsiString;
+var
+ S: AnsiString;
+ P: Integer;
begin
if Index >= 0 then
- Result := Copy(GetString(Index), Length(Names[Index]) + 2, MaxInt)
+ begin
+ S := Strings[Index];
+ P := AnsiPos(NameValueSeparator, S);
+ if P > 0 then
+ Result := Copy(S, P + 1, Length(S) - P)
+ else
+ Result := '';
+ end
else
Result := '';
end;
@@ -957,16 +991,18 @@
begin
if Value <> '' then
begin
- if Index < 0 then Index := Add('');
+ if Index < 0 then
+ Index := Add('');
SetString(Index, Names[Index] + NameValueSeparator + Value);
end
else
begin
- if Index >= 0 then Delete(Index);
+ if Index >= 0 then
+ Delete(Index);
end;
end;
-{ TJclAnsiStringList }
+//=== { TJclAnsiStringList } =================================================
procedure TJclAnsiStringList.Grow;
var
@@ -1059,11 +1095,15 @@
end
else
begin
- if Find(S, Result) then
- case Duplicates of
- dupIgnore: Exit;
- dupError: Error(@SDuplicateString, 0);
- end;
+ case Duplicates of
+ dupAccept: ;
+ dupIgnore:
+ if Find(S, Result) then
+ Exit;
+ dupError:
+ if Find(S, Result) then
+ Error(@SDuplicateString, 0);
+ end;
end;
InsertObject(Result, S, AObject);
@@ -1107,13 +1147,16 @@
begin
I := (L + H) shr 1;
C := CompareStrings(FStrings[I].Str, S);
- if C < 0 then L := I + 1 else
+ if C < 0 then
+ L := I + 1
+ else
begin
H := I - 1;
if C = 0 then
begin
Result := True;
- if Duplicates <> dupAccept then L := I;
+ if Duplicates <> dupAccept then
+ L := I;
end;
end;
end;
@@ -1146,21 +1189,25 @@
J := R;
P := (L + R) shr 1;
repeat
- while SCompare(Self, I, P) < 0 do Inc(I);
- while SCompare(Self, J, P) > 0 do Dec(J);
+ while SCompare(Self, I, P) < 0 do
+ Inc(I);
+ while SCompare(Self, J, P) > 0 do
+ Dec(J);
if I <= J then
begin
if I <> J then
Exchange(I, J);
if P = I then
P := J
- else if P = J then
+ else
+ if P = J then
P := I;
Inc(I);
Dec(J);
end;
until I > J;
- if L < J then QuickSort(L, J, SCompare);
+ if L < J then
+ QuickSort(L, J, SCompare);
L := I;
until I >= R;
end;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ou...@us...> - 2009-11-04 20:21:09
|
Revision: 3065
http://jcl.svn.sourceforge.net/jcl/?rev=3065&view=rev
Author: outchy
Date: 2009-11-04 20:20:51 +0000 (Wed, 04 Nov 2009)
Log Message:
-----------
messages for JCL 2.1.
Modified Paths:
--------------
trunk/jcl/Install.txt
trunk/jcl/docs/Experts.html
trunk/jcl/docs/Readme.html
trunk/jcl/docs/Readme.txt
Modified: trunk/jcl/Install.txt
===================================================================
--- trunk/jcl/Install.txt 2009-11-04 12:12:24 UTC (rev 3064)
+++ trunk/jcl/Install.txt 2009-11-04 20:20:51 UTC (rev 3065)
@@ -1,4 +1,4 @@
-JEDI Code Library v 2.0 Installation
+JEDI Code Library v 2.1 Installation
Supported development tools versions:
@@ -61,4 +61,4 @@
>install d6
--------------------------------
-Document last updated 2009-06-28
+Document last updated 2009-11-05
Modified: trunk/jcl/docs/Experts.html
===================================================================
--- trunk/jcl/docs/Experts.html 2009-11-04 12:12:24 UTC (rev 3064)
+++ trunk/jcl/docs/Experts.html 2009-11-04 20:20:51 UTC (rev 3065)
@@ -1,7 +1,7 @@
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
<html lang="en-us">
<head>
- <title>JEDI Code Library Release 1.105</title>
+ <title>JEDI Code Library Release 2.1</title>
<meta content="text/html;charset=ISO-8859-1" http-equiv="Content-Type">
<link rel="stylesheet" type="text/css" href="styles/default.css">
<meta content="Project JEDI" name="author">
@@ -10,9 +10,9 @@
<body>
<hr><br>
<h1>JEDI Code Library</h1>
-<p>Release 1.105<br>
-Build 3400<br>
-22-June-2009</p>
+<p>Release 2.1<br>
+Build 3536<br>
+05-November-2009</p>
<hr><br>
<h3>Content of this file</h3>
<ul>
Modified: trunk/jcl/docs/Readme.html
===================================================================
--- trunk/jcl/docs/Readme.html 2009-11-04 12:12:24 UTC (rev 3064)
+++ trunk/jcl/docs/Readme.html 2009-11-04 20:20:51 UTC (rev 3065)
@@ -1,7 +1,7 @@
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
<html lang="en-us">
<head>
- <title>JEDI Code Library Release 2.0</title>
+ <title>JEDI Code Library Release 2.1</title>
<meta content="text/html;charset=ISO-8859-1" http-equiv="Content-Type">
@@ -18,9 +18,9 @@
<h1>JEDI Code Library</h1>
-<p>Release 2.0<br>
-Build 3449
-10-August-2010</p>
+<p>Release 2.1<br>
+Build 3536<br>
+05-November-2009</p>
<hr><br>
@@ -53,11 +53,12 @@
<hr><br>
<h3><a name="about">About this release</a></h3>
-<p>JCL release 2.0 provides basic support for RAD Studio 2010 (including
+<p>JCL release 2.0 provides improved support for RAD Studio 2010 (including
Delphi 2010 and C++Builder 2010) an updated support for all targets.</p>
-<p>As always, multiple bugs have been fixed; for detailed change logs,
-use the facilities of our Subversion repository at Sourceforge.net
+<p>This new version of the JCL is mainly a bugfix release. Multiple bugs have been
+fixed; for detailed change logs, use the facilities of our Subversion repository
+at Sourceforge.net
<a href="http://sourceforge.net/projects/jcl/">http://sourceforge.net/projects/jcl/</a>
, see below.</p>
@@ -66,18 +67,14 @@
<ul>
- <li>improved Unicode support for Delphi 2009, C++Builder 2009 and newer;</li>
- <li>new expert for displaying improved stack traces in the debugger, these stack traces can be serialized to XML files;</li>
- <li>support for 32 bit FPC;</li>
- <li>support for 64 bit FPC (experimental);</li>
- <li>support for Delphi 2005 is back;</li>
- <li>removal of support for Delphi 5, C++Builder 5, Delphi.net and Kylix;</li>
- <li>added 7-zip 9.4.0 archive formats in JclCompression (.xz, .lzma86, ntfs, fat...);</li>
- <li>simple log: new option to release the log files between two accesses;</li>
- <li>PCRE (http://www.pcre.org/) precompiled object files updated to PCRE 7.9;</li>
- <li>exception dialog: the log can be saved to any arbitrary location;</li>
- <li>exception dialog: new option to disable integrated exception tracking when a debugger is attached;</li>
- <li>exception dialog: new option to select which thread to report to log;</li>
+ <li>fix major issues in JclAnsiStrings: wrong index arithmetics in StrSearch, flawed implementation of TJclAnsiStrings...</li>
+ <li>fix issue in JclRegistry: wrong exceptions were raised under some rare circumstances;</li>
+ <li>experts: the compilation of projects with type library was not possible, fixed wrong MAP file name computations...</li>
+ <li>debug information from MAP file: better handling of the MAP files generated by C++Builder;</li>
+ <li>all resources are now loaded using LoadResString;</li>
+ <li>streams: TJclBufferedStream wipes data on append;</li>
+ <li>open and save dialog hooks: moved to runtime code (they can now be added to any application);</li>
+ <li>compression: new 7z 9.7.0 compression classes.</li>
</ul>
Modified: trunk/jcl/docs/Readme.txt
===================================================================
--- trunk/jcl/docs/Readme.txt 2009-11-04 12:12:24 UTC (rev 3064)
+++ trunk/jcl/docs/Readme.txt 2009-11-04 20:20:51 UTC (rev 3065)
@@ -1,9 +1,9 @@
--------------------------------------------------------------------------------
JEDI Code Library
-Release 2.0
-Build 3449
-10-August-2010
+Release 2.1
+Build 3536
+05-November-2009
--------------------------------------------------------------------------------
@@ -22,30 +22,28 @@
--------------------------------------------------------------------------------
About this release
-JCL release 2.0 provides basic support for RAD Studio 2010 (including
+JCL release 2.0 provides improved support for RAD Studio 2010 (including
Delphi 2010 and C++Builder 2010) an updated support for all targets.
-As always, multiple bugs have been fixed; for detailed change logs, use the
-facilities of our Subversion repository at Sourceforge.net
-http://sourceforge.net/projects/jcl/, see below.
+This new version of the JCL is mainly a bugfix release. Multiple bugs have been
+fixed; for detailed change logs, use the facilities of our Subversion repository
+at Sourceforge.net http://sourceforge.net/projects/jcl/, see below.
Head changes:
+ - fix major issues in JclAnsiStrings: wrong index arithmetics in StrSearch,
+ flawed implementation of TJclAnsiStrings...
+ - fix issue in JclRegistry: wrong exceptions were raised under some rare
+ circumstances;
+ - experts: the compilation of projects with type library was not possible,
+ fixed wrong MAP file name computations...
+ - debug information from MAP file: better handling of the MAP files generated
+ by C++Builder;
+ - all resources are now loaded using LoadResString;
+ - streams: TJclBufferedStream wipes data on append;
+ - open and save dialog hooks: moved to runtime code (they can now be added to
+ any application);
+ - compression: new 7z 9.7.0 compression classes.
- - improved Unicode support for Delphi 2009, C++Builder 2009 and newer;
- - new expert for displaying improved stack traces in the debugger, these stack
- traces can be serialized to XML files;
- - support for 32 bit FPC;
- - support for 64 bit FPC (experimental);
- - support for Delphi 2005 is back;
- - removal of support for Delphi 5, C++Builder 5, Delphi.net and Kylix;
- - added 7-zip 9.4.0 archive formats in JclCompression (.xz, .lzma86, ntfs,
- fat...);
- - simple log: new option to release the log files between two accesses;
- - PCRE (http://www.pcre.org/) precompiled object files updated to PCRE 7.9;
- - exception dialog: the log can be saved to any arbitrary location;
- - exception dialog: new option to disable integrated exception tracking when
- a debugger is attached;
- - exception dialog: new option to select which thread to report to log;
Important:
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ou...@us...> - 2009-11-04 12:16:37
|
Revision: 3064
http://jcl.svn.sourceforge.net/jcl/?rev=3064&view=rev
Author: outchy
Date: 2009-11-04 12:12:24 +0000 (Wed, 04 Nov 2009)
Log Message:
-----------
fix compiler warnings complaining about uninitialized variables C4P and C8P.
Modified Paths:
--------------
trunk/jcl/source/windows/JclDebug.pas
Modified: trunk/jcl/source/windows/JclDebug.pas
===================================================================
--- trunk/jcl/source/windows/JclDebug.pas 2009-11-04 10:00:17 UTC (rev 3063)
+++ trunk/jcl/source/windows/JclDebug.pas 2009-11-04 12:12:24 UTC (rev 3064)
@@ -5042,82 +5042,82 @@
C8P := PDWORD(CodeAddr - 8);
C4P := PDWORD(CodeAddr - 4);
Result := ValidCodeAddr(TJclAddr(C8P), FModuleInfoList) and not IsBadReadPtr(C8P, 8);
- end;
- // Now check to see if the instruction preceding the return address
- // could be a valid CALL instruction
- if Result then
- begin
- try
- CodeDWORD8 := PDWORD(C8P)^;
- CodeDWORD4 := PDWORD(C4P)^;
- // CodeDWORD8 = (ReturnAddr-5):(ReturnAddr-6):(ReturnAddr-7):(ReturnAddr-8)
- // CodeDWORD4 = (ReturnAddr-1):(ReturnAddr-2):(ReturnAddr-3):(ReturnAddr-4)
+ // Now check to see if the instruction preceding the return address
+ // could be a valid CALL instruction
+ if Result then
+ begin
+ try
+ CodeDWORD8 := PDWORD(C8P)^;
+ CodeDWORD4 := PDWORD(C4P)^;
+ // CodeDWORD8 = (ReturnAddr-5):(ReturnAddr-6):(ReturnAddr-7):(ReturnAddr-8)
+ // CodeDWORD4 = (ReturnAddr-1):(ReturnAddr-2):(ReturnAddr-3):(ReturnAddr-4)
- // ModR/M bytes contain the following bits:
- // Mod = (76)
- // Reg/Opcode = (543)
- // R/M = (210)
- RM1 := (CodeDWORD4 shr 24) and $7;
- RM2 := (CodeDWORD4 shr 16) and $7;
- //RM3 := (CodeDWORD4 shr 8) and $7;
- //RM4 := CodeDWORD4 and $7;
- RM5 := (CodeDWORD8 shr 24) and $7;
- //RM6 := (CodeDWORD8 shr 16) and $7;
- //RM7 := (CodeDWORD8 shr 8) and $7;
+ // ModR/M bytes contain the following bits:
+ // Mod = (76)
+ // Reg/Opcode = (543)
+ // R/M = (210)
+ RM1 := (CodeDWORD4 shr 24) and $7;
+ RM2 := (CodeDWORD4 shr 16) and $7;
+ //RM3 := (CodeDWORD4 shr 8) and $7;
+ //RM4 := CodeDWORD4 and $7;
+ RM5 := (CodeDWORD8 shr 24) and $7;
+ //RM6 := (CodeDWORD8 shr 16) and $7;
+ //RM7 := (CodeDWORD8 shr 8) and $7;
- // Check the instruction prior to the potential call site.
- // We consider it a valid call site if we find a CALL instruction there
- // Check the most common CALL variants first
- if ((CodeDWORD8 and $FF000000) = $E8000000) then
- // 5 bytes, "CALL NEAR REL32" (E8 cd)
- CallInstructionSize := 5
- else
- if ((CodeDWORD4 and $F8FF0000) = $10FF0000) and not (RM1 in [4, 5]) then
- // 2 bytes, "CALL NEAR [EAX]" (FF /2) where Reg = 010, Mod = 00, R/M <> 100 (1 extra byte)
- // and R/M <> 101 (4 extra bytes)
- CallInstructionSize := 2
- else
- if ((CodeDWORD4 and $F8FF0000) = $D0FF0000) then
- // 2 bytes, "CALL NEAR EAX" (FF /2) where Reg = 010 and Mod = 11
- CallInstructionSize := 2
- else
- if ((CodeDWORD4 and $00FFFF00) = $0014FF00) then
- // 3 bytes, "CALL NEAR [EAX+EAX*i]" (FF /2) where Reg = 010, Mod = 00 and RM = 100
- // SIB byte not validated
- CallInstructionSize := 3
- else
- if ((CodeDWORD4 and $00F8FF00) = $0050FF00) and (RM2 <> 4) then
- // 3 bytes, "CALL NEAR [EAX+$12]" (FF /2) where Reg = 010, Mod = 01 and RM <> 100 (1 extra byte)
- CallInstructionSize := 3
- else
- if ((CodeDWORD4 and $0000FFFF) = $000054FF) then
- // 4 bytes, "CALL NEAR [EAX+EAX+$12]" (FF /2) where Reg = 010, Mod = 01 and RM = 100
- // SIB byte not validated
- CallInstructionSize := 4
- else
- if ((CodeDWORD8 and $FFFF0000) = $15FF0000) then
- // 6 bytes, "CALL NEAR [$12345678]" (FF /2) where Reg = 010, Mod = 00 and RM = 101
- CallInstructionSize := 6
- else
- if ((CodeDWORD8 and $F8FF0000) = $90FF0000) and (RM5 <> 4) then
- // 6 bytes, "CALL NEAR [EAX+$12345678]" (FF /2) where Reg = 010, Mod = 10 and RM <> 100 (1 extra byte)
- CallInstructionSize := 6
- else
- if ((CodeDWORD8 and $00FFFF00) = $0094FF00) then
- // 7 bytes, "CALL NEAR [EAX+EAX+$1234567]" (FF /2) where Reg = 010, Mod = 10 and RM = 100
- CallInstructionSize := 7
- else
- if ((CodeDWORD8 and $0000FF00) = $00009A00) then
- // 7 bytes, "CALL FAR $1234:12345678" (9A ptr16:32)
- CallInstructionSize := 7
- else
+ // Check the instruction prior to the potential call site.
+ // We consider it a valid call site if we find a CALL instruction there
+ // Check the most common CALL variants first
+ if ((CodeDWORD8 and $FF000000) = $E8000000) then
+ // 5 bytes, "CALL NEAR REL32" (E8 cd)
+ CallInstructionSize := 5
+ else
+ if ((CodeDWORD4 and $F8FF0000) = $10FF0000) and not (RM1 in [4, 5]) then
+ // 2 bytes, "CALL NEAR [EAX]" (FF /2) where Reg = 010, Mod = 00, R/M <> 100 (1 extra byte)
+ // and R/M <> 101 (4 extra bytes)
+ CallInstructionSize := 2
+ else
+ if ((CodeDWORD4 and $F8FF0000) = $D0FF0000) then
+ // 2 bytes, "CALL NEAR EAX" (FF /2) where Reg = 010 and Mod = 11
+ CallInstructionSize := 2
+ else
+ if ((CodeDWORD4 and $00FFFF00) = $0014FF00) then
+ // 3 bytes, "CALL NEAR [EAX+EAX*i]" (FF /2) where Reg = 010, Mod = 00 and RM = 100
+ // SIB byte not validated
+ CallInstructionSize := 3
+ else
+ if ((CodeDWORD4 and $00F8FF00) = $0050FF00) and (RM2 <> 4) then
+ // 3 bytes, "CALL NEAR [EAX+$12]" (FF /2) where Reg = 010, Mod = 01 and RM <> 100 (1 extra byte)
+ CallInstructionSize := 3
+ else
+ if ((CodeDWORD4 and $0000FFFF) = $000054FF) then
+ // 4 bytes, "CALL NEAR [EAX+EAX+$12]" (FF /2) where Reg = 010, Mod = 01 and RM = 100
+ // SIB byte not validated
+ CallInstructionSize := 4
+ else
+ if ((CodeDWORD8 and $FFFF0000) = $15FF0000) then
+ // 6 bytes, "CALL NEAR [$12345678]" (FF /2) where Reg = 010, Mod = 00 and RM = 101
+ CallInstructionSize := 6
+ else
+ if ((CodeDWORD8 and $F8FF0000) = $90FF0000) and (RM5 <> 4) then
+ // 6 bytes, "CALL NEAR [EAX+$12345678]" (FF /2) where Reg = 010, Mod = 10 and RM <> 100 (1 extra byte)
+ CallInstructionSize := 6
+ else
+ if ((CodeDWORD8 and $00FFFF00) = $0094FF00) then
+ // 7 bytes, "CALL NEAR [EAX+EAX+$1234567]" (FF /2) where Reg = 010, Mod = 10 and RM = 100
+ CallInstructionSize := 7
+ else
+ if ((CodeDWORD8 and $0000FF00) = $00009A00) then
+ // 7 bytes, "CALL FAR $1234:12345678" (9A ptr16:32)
+ CallInstructionSize := 7
+ else
+ Result := False;
+ // Because we're not doing a complete disassembly, we will potentially report
+ // false positives. If there is odd code that uses the CALL 16:32 format, we
+ // can also get false negatives.
+ except
Result := False;
- // Because we're not doing a complete disassembly, we will potentially report
- // false positives. If there is odd code that uses the CALL 16:32 format, we
- // can also get false negatives.
- except
- Result := False;
+ end;
end;
end;
end;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ah...@us...> - 2009-11-04 10:00:29
|
Revision: 3063
http://jcl.svn.sourceforge.net/jcl/?rev=3063&view=rev
Author: ahuser
Date: 2009-11-04 10:00:17 +0000 (Wed, 04 Nov 2009)
Log Message:
-----------
Fixed: Debug-DCUs are compiled with RangeChecks => EIntOverflow in JclDebug
Modified Paths:
--------------
trunk/jcl/source/windows/JclDebug.pas
Modified: trunk/jcl/source/windows/JclDebug.pas
===================================================================
--- trunk/jcl/source/windows/JclDebug.pas 2009-11-02 19:25:11 UTC (rev 3062)
+++ trunk/jcl/source/windows/JclDebug.pas 2009-11-04 10:00:17 UTC (rev 3063)
@@ -5036,9 +5036,13 @@
// todo: 64 bit version
// First check that the address is within range of our code segment!
- C8P := PDWORD(CodeAddr - 8);
- C4P := PDWORD(CodeAddr - 4);
- Result := (CodeAddr > 8) and ValidCodeAddr(TJclAddr(C8P), FModuleInfoList) and not IsBadReadPtr(C8P, 8);
+ Result := CodeAddr > 8;
+ if Result then
+ begin
+ C8P := PDWORD(CodeAddr - 8);
+ C4P := PDWORD(CodeAddr - 4);
+ Result := ValidCodeAddr(TJclAddr(C8P), FModuleInfoList) and not IsBadReadPtr(C8P, 8);
+ end;
// Now check to see if the instruction preceding the return address
// could be a valid CALL instruction
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ob...@us...> - 2009-11-02 19:25:22
|
Revision: 3062
http://jcl.svn.sourceforge.net/jcl/?rev=3062&view=rev
Author: obones
Date: 2009-11-02 19:25:11 +0000 (Mon, 02 Nov 2009)
Log Message:
-----------
Mantis 4990: Avoid reading out of bounds
Modified Paths:
--------------
trunk/jcl/source/common/JclAnsiStrings.pas
Modified: trunk/jcl/source/common/JclAnsiStrings.pas
===================================================================
--- trunk/jcl/source/common/JclAnsiStrings.pas 2009-10-29 21:49:26 UTC (rev 3061)
+++ trunk/jcl/source/common/JclAnsiStrings.pas 2009-11-02 19:25:11 UTC (rev 3062)
@@ -825,9 +825,9 @@
S := Copy(Value, Start, Index - Start);
Add(S);
- if Value[Index] = #13 then
+ if (Index <= Len) and (Value[Index] = #13) then
Inc(Index);
- if Value[Index] = #10 then
+ if (Index <= Len) and (Value[Index] = #10) then
Inc(Index);
end;
end;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ob...@us...> - 2009-10-29 21:49:38
|
Revision: 3061
http://jcl.svn.sourceforge.net/jcl/?rev=3061&view=rev
Author: obones
Date: 2009-10-29 21:49:26 +0000 (Thu, 29 Oct 2009)
Log Message:
-----------
Think, Olivier, Think. If it does not like threadvar, just use a regular var...
Modified Paths:
--------------
trunk/jcl/source/windows/JclRegistry.pas
Modified: trunk/jcl/source/windows/JclRegistry.pas
===================================================================
--- trunk/jcl/source/windows/JclRegistry.pas 2009-10-29 20:53:47 UTC (rev 3060)
+++ trunk/jcl/source/windows/JclRegistry.pas 2009-10-29 21:49:26 UTC (rev 3061)
@@ -347,11 +347,12 @@
}
TJclRegWOW64Access = (raDefault, raNative, ra32Key, ra64Key);
+{$IFDEF BCB6}
+var
+{$ELSE}
threadvar
+{$ENDIF BCB6}
JclRegWOW64Access: TJclRegWOW64Access {= raDefault};
- {$IFNDEF CBUILDER6}
- {$EXTERNALSYM JclRegWOW64Access}
- {$ENDIF ~CBUILDER6}
{$IFDEF UNITVERSIONING}
const
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ob...@us...> - 2009-10-29 20:53:53
|
Revision: 3060
http://jcl.svn.sourceforge.net/jcl/?rev=3060&view=rev
Author: obones
Date: 2009-10-29 20:53:47 +0000 (Thu, 29 Oct 2009)
Log Message:
-----------
C6 generates an invalid HPP file with the threadvar
Modified Paths:
--------------
trunk/jcl/source/windows/JclRegistry.pas
Modified: trunk/jcl/source/windows/JclRegistry.pas
===================================================================
--- trunk/jcl/source/windows/JclRegistry.pas 2009-10-27 05:39:27 UTC (rev 3059)
+++ trunk/jcl/source/windows/JclRegistry.pas 2009-10-29 20:53:47 UTC (rev 3060)
@@ -349,6 +349,9 @@
threadvar
JclRegWOW64Access: TJclRegWOW64Access {= raDefault};
+ {$IFNDEF CBUILDER6}
+ {$EXTERNALSYM JclRegWOW64Access}
+ {$ENDIF ~CBUILDER6}
{$IFDEF UNITVERSIONING}
const
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <SF...@us...> - 2009-10-27 05:39:38
|
Revision: 3059
http://jcl.svn.sourceforge.net/jcl/?rev=3059&view=rev
Author: SFarrow
Date: 2009-10-27 05:39:27 +0000 (Tue, 27 Oct 2009)
Log Message:
-----------
Moved the TJclFileVersionInfo.GetCustomFieldValue function from protected to public as this being a protected function prevented the function being called.
Modified Paths:
--------------
trunk/jcl/source/common/JclFileUtils.pas
Modified: trunk/jcl/source/common/JclFileUtils.pas
===================================================================
--- trunk/jcl/source/common/JclFileUtils.pas 2009-10-26 18:31:16 UTC (rev 3058)
+++ trunk/jcl/source/common/JclFileUtils.pas 2009-10-27 05:39:27 UTC (rev 3059)
@@ -623,7 +623,6 @@
procedure ExtractFlags;
function GetBinFileVersion: string;
function GetBinProductVersion: string;
- function GetCustomFieldValue(const FieldName: string): string;
function GetFileOS: DWORD;
function GetFileSubType: DWORD;
function GetFileType: DWORD;
@@ -648,6 +647,7 @@
constructor Create(const Module: HMODULE); overload;
{$ENDIF MSWINDOWS}
destructor Destroy; override;
+ function GetCustomFieldValue(const FieldName: string): string;
class function VersionLanguageId(const LangIdRec: TLangIdRec): string;
class function VersionLanguageName(const LangId: Word): string;
function TranslationMatchesLanguages(Exact: Boolean = True): Boolean;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ob...@us...> - 2009-10-26 18:31:22
|
Revision: 3058
http://jcl.svn.sourceforge.net/jcl/?rev=3058&view=rev
Author: obones
Date: 2009-10-26 18:31:16 +0000 (Mon, 26 Oct 2009)
Log Message:
-----------
Much better when it actually compiles...
Modified Paths:
--------------
trunk/jcl/source/common/JclAnsiStrings.pas
Modified: trunk/jcl/source/common/JclAnsiStrings.pas
===================================================================
--- trunk/jcl/source/common/JclAnsiStrings.pas 2009-10-26 08:00:46 UTC (rev 3057)
+++ trunk/jcl/source/common/JclAnsiStrings.pas 2009-10-26 18:31:16 UTC (rev 3058)
@@ -1079,7 +1079,7 @@
for I := Index to Count - 2 do
FStrings[I] := FStrings[I + 1];
- SetLength(FStrings[FCount - 1], 0); // the last string is no longer useful
+ SetLength(FStrings[FCount - 1].Str, 0); // the last string is no longer useful
Dec(FCount);
end;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ob...@us...> - 2009-10-26 08:00:54
|
Revision: 3057
http://jcl.svn.sourceforge.net/jcl/?rev=3057&view=rev
Author: obones
Date: 2009-10-26 08:00:46 +0000 (Mon, 26 Oct 2009)
Log Message:
-----------
Mantis 4975: Now actually shifts down the entries when deleting them...
Modified Paths:
--------------
trunk/jcl/source/common/JclAnsiStrings.pas
Modified: trunk/jcl/source/common/JclAnsiStrings.pas
===================================================================
--- trunk/jcl/source/common/JclAnsiStrings.pas 2009-10-25 19:09:49 UTC (rev 3056)
+++ trunk/jcl/source/common/JclAnsiStrings.pas 2009-10-26 08:00:46 UTC (rev 3057)
@@ -1077,7 +1077,11 @@
Error(@SListIndexError, Index);
for I := Index to Count - 2 do
- FStrings[Index] := FStrings[Index + 1];
+ FStrings[I] := FStrings[I + 1];
+
+ SetLength(FStrings[FCount - 1], 0); // the last string is no longer useful
+
+ Dec(FCount);
end;
procedure TJclAnsiStringList.Clear;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ah...@us...> - 2009-10-25 19:10:00
|
Revision: 3056
http://jcl.svn.sourceforge.net/jcl/?rev=3056&view=rev
Author: ahuser
Date: 2009-10-25 19:09:49 +0000 (Sun, 25 Oct 2009)
Log Message:
-----------
Fixed RangeCheck Error that occurs in Delphi 2010
Modified Paths:
--------------
trunk/jcl/source/windows/JclDebug.pas
Modified: trunk/jcl/source/windows/JclDebug.pas
===================================================================
--- trunk/jcl/source/windows/JclDebug.pas 2009-10-25 18:42:41 UTC (rev 3055)
+++ trunk/jcl/source/windows/JclDebug.pas 2009-10-25 19:09:49 UTC (rev 3056)
@@ -1669,7 +1669,7 @@
// only one segment of code
// after Delphi 2005: segments started at code base address (module base address + $10000)
// 2 segments of code
- if (Length(FSegmentClasses) > 0) and (FSegmentClasses[0].Addr > 0) then
+ if (Length(FSegmentClasses) > 0) and (FSegmentClasses[0].Addr > 0) and (Addr > 0) then
// Delphi 2005 and later
// The first segment should be code starting at module base address + $10000
Result := Addr - FSegmentClasses[0].Addr
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ah...@us...> - 2009-10-25 18:42:55
|
Revision: 3055
http://jcl.svn.sourceforge.net/jcl/?rev=3055&view=rev
Author: ahuser
Date: 2009-10-25 18:42:41 +0000 (Sun, 25 Oct 2009)
Log Message:
-----------
Fixed Delphi 6-2007 compilation
Modified Paths:
--------------
trunk/jcl/source/windows/JclRegistry.pas
Modified: trunk/jcl/source/windows/JclRegistry.pas
===================================================================
--- trunk/jcl/source/windows/JclRegistry.pas 2009-10-25 15:59:10 UTC (rev 3054)
+++ trunk/jcl/source/windows/JclRegistry.pas 2009-10-25 18:42:41 UTC (rev 3055)
@@ -511,7 +511,7 @@
end;
function InternalRegOpenKeyEx(Key: HKEY; SubKey: PWideChar;
- ulOptions: DWORD; samDesired: REGSAM; var RegKey: HKEY): Longint;
+ ulOptions: DWORD; samDesired: REGSAM; var RegKey: HKEY): Longint; overload;
var
RelKey: AnsiString;
begin
@@ -524,6 +524,15 @@
end;
end;
+function InternalRegOpenKeyEx(Key: HKEY; SubKey: PAnsiChar;
+ ulOptions: DWORD; samDesired: REGSAM; var RegKey: HKEY): Longint; overload;
+begin
+ if Win32Platform = VER_PLATFORM_WIN32_NT then
+ Result := RegOpenKeyExA(Key, RelativeKey(Key, SubKey), ulOptions, GetWOW64AccessMode(samDesired), RegKey)
+ else
+ Result := RegOpenKeyExA(Key, RelativeKey(Key, SubKey), ulOptions, samDesired, RegKey);
+end;
+
function InternalRegQueryValueEx(Key: HKEY; ValueName: PWideChar;
lpReserved: Pointer; lpType: PDWORD; lpData: Pointer; lpcbData: PDWORD): Longint;
var
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ah...@us...> - 2009-10-25 15:59:24
|
Revision: 3054
http://jcl.svn.sourceforge.net/jcl/?rev=3054&view=rev
Author: ahuser
Date: 2009-10-25 15:59:10 +0000 (Sun, 25 Oct 2009)
Log Message:
-----------
JclRegistry now has a global JclRegWOW64Access threadvar that controls if the Reg* functions should work on the 64bit or 32bit registry node (Software vs. Software\Wow6432Node).
This is a requirement for Mantis #4982: ProductID property is Empty on Windows Seven
Modified Paths:
--------------
trunk/jcl/source/windows/JclRegistry.pas
Modified: trunk/jcl/source/windows/JclRegistry.pas
===================================================================
--- trunk/jcl/source/windows/JclRegistry.pas 2009-10-22 16:22:16 UTC (rev 3053)
+++ trunk/jcl/source/windows/JclRegistry.pas 2009-10-25 15:59:10 UTC (rev 3054)
@@ -335,6 +335,21 @@
(Key: HKDD; AnsiName: HKDDShortName; WideName: HKDDShortName)
);
+type
+ { clRegWOW64Access allows the user to switch all registry functions to the 64 bit registry
+ key on a 64bit system.
+
+ OS/Application 32bit/32bit 64bit/32bit 64bit/64bit
+ raDefault Software Wow6432Node Software
+ raNative Software Software Software
+ ra32Key Software Wow6432Node Wow6432Node
+ ra64Key Software Software Software
+ }
+ TJclRegWOW64Access = (raDefault, raNative, ra32Key, ra64Key);
+
+threadvar
+ JclRegWOW64Access: TJclRegWOW64Access {= raDefault};
+
{$IFDEF UNITVERSIONING}
const
UnitVersioning: TUnitVersionInfo = (
@@ -357,7 +372,7 @@
AccCtrl,
JclSysUtils,
{$ENDIF ~FPC}
- JclResources, JclWin32,
+ JclResources, JclWin32, JclSysInfo,
JclAnsiStrings, JclWideStrings;
type
@@ -368,8 +383,34 @@
cItems = 'Items';
cRegBinKinds = [REG_SZ..REG_QWORD]; // all types
+var
+ CachedIsWindows64: Integer = -1;
+
//=== Internal helper routines ===============================================
+function GetWOW64AccessMode(samDesired: REGSAM): REGSAM;
+const
+ KEY_WOW64_32KEY = $0200;
+ KEY_WOW64_64KEY = $0100;
+ KEY_WOW64_RES = $0300;
+ RegWOW64Accesses: array[Boolean, TJclRegWOW64Access] of HKEY = (
+ (HKEY(0), HKEY(0), HKEY(0), HKEY(0)),
+ (HKEY(0), KEY_WOW64_64KEY, KEY_WOW64_32KEY, KEY_WOW64_64KEY)
+ );
+begin
+ Result := samDesired;
+ if (Win32Platform = VER_PLATFORM_WIN32_NT) and (samDesired and KEY_WOW64_RES = 0) then
+ begin
+ if CachedIsWindows64 = -1 then
+ if IsWindows64 then
+ CachedIsWindows64 := 1
+ else
+ CachedIsWindows64 := 0;
+
+ Result := Result or RegWOW64Accesses[CachedIsWindows64 = 1, JclRegWOW64Access];
+ end;
+end;
+
function RootKeyName(const RootKey: THandle): string;
begin
case RootKey of
@@ -380,12 +421,12 @@
HKPD : Result := HKPDLongName;
HKCC : Result := HKCCLongName;
HKDD : Result := HKDDLongName;
- else
+ else
{$IFDEF DELPHICOMPILER}
- Result := Format('$%.8x', [RootKey]);
+ Result := Format('$%.8x', [RootKey]);
{$ENDIF DELPHICOMPILER}
{$IFDEF BCB}
- Result := Format('0x%.8x', [RootKey]);
+ Result := Format('0x%.8x', [RootKey]);
{$ENDIF BCB}
end;
end;
@@ -475,7 +516,7 @@
RelKey: AnsiString;
begin
if Win32Platform = VER_PLATFORM_WIN32_NT then
- Result := RegOpenKeyExW(Key, RelativeKey(Key, SubKey), ulOptions, samDesired, RegKey)
+ Result := RegOpenKeyExW(Key, RelativeKey(Key, SubKey), ulOptions, GetWOW64AccessMode(samDesired), RegKey)
else
begin
RelKey := AnsiString(WideString(RelativeKey(Key, SubKey)));
@@ -739,7 +780,8 @@
RegKey: HKEY;
begin
RegKey := 0;
- Result := Windows.RegCreateKey(RootKey, RelativeKey(RootKey, PChar(Key)), RegKey);
+ Result := Windows.RegCreateKeyEx(RootKey, RelativeKey(RootKey, PChar(Key)), 0, nil, 0,
+ GetWOW64AccessMode(KEY_ALL_ACCESS), nil, RegKey, nil);
if Result = ERROR_SUCCESS then
RegCloseKey(RegKey);
end;
@@ -755,7 +797,7 @@
begin
Result := False;
RegKey := 0;
- if RegOpenKeyEx(RootKey, RelativeKey(RootKey, PChar(Key)), 0, KEY_SET_VALUE, RegKey) = ERROR_SUCCESS then
+ if InternalRegOpenKeyEx(RootKey, RelativeKey(RootKey, PChar(Key)), 0, KEY_SET_VALUE, RegKey) = ERROR_SUCCESS then
begin
Result := RegDeleteValue(RegKey, PChar(Name)) = ERROR_SUCCESS;
RegCloseKey(RegKey);
@@ -776,7 +818,7 @@
KeyName: string;
begin
RegKey := 0;
- Result := RegOpenKeyEx(RootKey, RelativeKey(RootKey, PChar(Key)), 0, KEY_ALL_ACCESS, RegKey) = ERROR_SUCCESS;
+ Result := InternalRegOpenKeyEx(RootKey, RelativeKey(RootKey, PChar(Key)), 0, KEY_ALL_ACCESS, RegKey) = ERROR_SUCCESS;
if Result then
begin
RegQueryInfoKey(RegKey, nil, nil, nil, @NumSubKeys, @MaxSubKeyLen, nil, nil, nil, nil, nil, nil);
@@ -806,7 +848,7 @@
begin
DataSize := 0;
RegKey := 0;
- Result := RegOpenKeyEx(RootKey, RelativeKey(RootKey, PChar(Key)), 0, KEY_READ, RegKey) = ERROR_SUCCESS;
+ Result := InternalRegOpenKeyEx(RootKey, RelativeKey(RootKey, PChar(Key)), 0, KEY_READ, RegKey) = ERROR_SUCCESS;
if Result then
begin
Result := RegQueryValueEx(RegKey, PChar(Name), nil, nil, nil, @DataSize) = ERROR_SUCCESS;
@@ -821,7 +863,7 @@
begin
DataType := REG_NONE;
RegKey := 0;
- Result := RegOpenKeyEx(RootKey, RelativeKey(RootKey, PChar(Key)), 0, KEY_READ, RegKey) = ERROR_SUCCESS;
+ Result := InternalRegOpenKeyEx(RootKey, RelativeKey(RootKey, PChar(Key)), 0, KEY_READ, RegKey) = ERROR_SUCCESS;
if Result then
begin
Result := RegQueryValueEx(RegKey, PChar(Name), nil, @DataType, nil, nil) = ERROR_SUCCESS;
@@ -1796,7 +1838,7 @@
try
List.Clear;
RegKey := 0;
- if RegOpenKeyEx(RootKey, RelativeKey(RootKey, PChar(Key)), 0, KEY_READ, RegKey) = ERROR_SUCCESS then
+ if InternalRegOpenKeyEx(RootKey, RelativeKey(RootKey, PChar(Key)), 0, KEY_READ, RegKey) = ERROR_SUCCESS then
begin
if RegQueryInfoKey(RegKey, nil, nil, nil, @NumSubKeys, nil, nil,
@NumSubValues, @MaxSubValueLen, nil, nil, nil) = ERROR_SUCCESS then
@@ -1834,7 +1876,7 @@
try
List.Clear;
RegKey := 0;
- if RegOpenKeyEx(RootKey, RelativeKey(RootKey, PChar(Key)), 0, KEY_READ, RegKey) = ERROR_SUCCESS then
+ if InternalRegOpenKeyEx(RootKey, RelativeKey(RootKey, PChar(Key)), 0, KEY_READ, RegKey) = ERROR_SUCCESS then
begin
if RegQueryInfoKey(RegKey, nil, nil, nil,
@NumSubKeys, @MaxSubKeyLen, nil, nil, nil, nil, nil, nil) = ERROR_SUCCESS then
@@ -1893,7 +1935,7 @@
begin
Result := False;
RegKey := 0;
- if RegOpenKeyEx(RootKey, RelativeKey(RootKey, PChar(Key)), 0, KEY_READ, RegKey) = ERROR_SUCCESS then
+ if InternalRegOpenKeyEx(RootKey, RelativeKey(RootKey, PChar(Key)), 0, KEY_READ, RegKey) = ERROR_SUCCESS then
begin
RegQueryInfoKey(RegKey, nil, nil, nil, @NumSubKeys, nil, nil, nil, nil, nil, nil, nil);
Result := NumSubKeys <> 0;
@@ -1908,7 +1950,7 @@
RegKey: HKEY;
begin
RegKey := 0;
- Result := (RegOpenKeyEx(RootKey, RelativeKey(RootKey, PChar(Key)), 0, KEY_READ, RegKey) = ERROR_SUCCESS);
+ Result := (InternalRegOpenKeyEx(RootKey, RelativeKey(RootKey, PChar(Key)), 0, KEY_READ, RegKey) = ERROR_SUCCESS);
if Result then
RegCloseKey(RegKey);
end;
@@ -1918,7 +1960,7 @@
RegKey: HKEY;
begin
RegKey := 0;
- Result := (RegOpenKeyEx(RootKey, RelativeKey(RootKey, PChar(Key)), 0, KEY_READ, RegKey) = ERROR_SUCCESS);
+ Result := (InternalRegOpenKeyEx(RootKey, RelativeKey(RootKey, PChar(Key)), 0, KEY_READ, RegKey) = ERROR_SUCCESS);
if Result then
begin
Result := RegQueryValueEx(RegKey, PChar(Name), nil, nil, nil, nil) = ERROR_SUCCESS;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <rro...@us...> - 2009-10-22 16:22:25
|
Revision: 3053
http://jcl.svn.sourceforge.net/jcl/?rev=3053&view=rev
Author: rrossmair
Date: 2009-10-22 16:22:16 +0000 (Thu, 22 Oct 2009)
Log Message:
-----------
Mantis ID 0004991 resolved
Modified Paths:
--------------
trunk/jcl/source/common/JclArrayLists.pas
Modified: trunk/jcl/source/common/JclArrayLists.pas
===================================================================
--- trunk/jcl/source/common/JclArrayLists.pas 2009-10-22 16:13:01 UTC (rev 3052)
+++ trunk/jcl/source/common/JclArrayLists.pas 2009-10-22 16:22:16 UTC (rev 3053)
@@ -1530,7 +1530,7 @@
try
{$ENDIF THREADSAFE}
Result := nil;
- if (Index >= 0) or (Index < FSize) then
+ if (Index >= 0) and (Index < FSize) then
Result := FElementData[Index]
else
if not FReturnDefaultElements then
@@ -2349,7 +2349,7 @@
try
{$ENDIF THREADSAFE}
Result := '';
- if (Index >= 0) or (Index < FSize) then
+ if (Index >= 0) and (Index < FSize) then
Result := FElementData[Index]
else
if not FReturnDefaultElements then
@@ -3168,7 +3168,7 @@
try
{$ENDIF THREADSAFE}
Result := '';
- if (Index >= 0) or (Index < FSize) then
+ if (Index >= 0) and (Index < FSize) then
Result := FElementData[Index]
else
if not FReturnDefaultElements then
@@ -3988,7 +3988,7 @@
try
{$ENDIF THREADSAFE}
Result := '';
- if (Index >= 0) or (Index < FSize) then
+ if (Index >= 0) and (Index < FSize) then
Result := FElementData[Index]
else
if not FReturnDefaultElements then
@@ -4809,7 +4809,7 @@
try
{$ENDIF THREADSAFE}
Result := 0.0;
- if (Index >= 0) or (Index < FSize) then
+ if (Index >= 0) and (Index < FSize) then
Result := FElementData[Index]
else
if not FReturnDefaultElements then
@@ -5628,7 +5628,7 @@
try
{$ENDIF THREADSAFE}
Result := 0.0;
- if (Index >= 0) or (Index < FSize) then
+ if (Index >= 0) and (Index < FSize) then
Result := FElementData[Index]
else
if not FReturnDefaultElements then
@@ -6447,7 +6447,7 @@
try
{$ENDIF THREADSAFE}
Result := 0.0;
- if (Index >= 0) or (Index < FSize) then
+ if (Index >= 0) and (Index < FSize) then
Result := FElementData[Index]
else
if not FReturnDefaultElements then
@@ -7266,7 +7266,7 @@
try
{$ENDIF THREADSAFE}
Result := 0;
- if (Index >= 0) or (Index < FSize) then
+ if (Index >= 0) and (Index < FSize) then
Result := FElementData[Index]
else
if not FReturnDefaultElements then
@@ -8085,7 +8085,7 @@
try
{$ENDIF THREADSAFE}
Result := 0;
- if (Index >= 0) or (Index < FSize) then
+ if (Index >= 0) and (Index < FSize) then
Result := FElementData[Index]
else
if not FReturnDefaultElements then
@@ -8904,7 +8904,7 @@
try
{$ENDIF THREADSAFE}
Result := 0;
- if (Index >= 0) or (Index < FSize) then
+ if (Index >= 0) and (Index < FSize) then
Result := FElementData[Index]
else
if not FReturnDefaultElements then
@@ -9723,7 +9723,7 @@
try
{$ENDIF THREADSAFE}
Result := nil;
- if (Index >= 0) or (Index < FSize) then
+ if (Index >= 0) and (Index < FSize) then
Result := FElementData[Index]
else
if not FReturnDefaultElements then
@@ -10542,7 +10542,7 @@
try
{$ENDIF THREADSAFE}
Result := nil;
- if (Index >= 0) or (Index < FSize) then
+ if (Index >= 0) and (Index < FSize) then
Result := FElementData[Index]
else
if not FReturnDefaultElements then
@@ -11363,7 +11363,7 @@
try
{$ENDIF THREADSAFE}
Result := Default(T);
- if (Index >= 0) or (Index < FSize) then
+ if (Index >= 0) and (Index < FSize) then
Result := FElementData[Index]
else
if not FReturnDefaultElements then
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <rro...@us...> - 2009-10-22 16:13:09
|
Revision: 3052
http://jcl.svn.sourceforge.net/jcl/?rev=3052&view=rev
Author: rrossmair
Date: 2009-10-22 16:13:01 +0000 (Thu, 22 Oct 2009)
Log Message:
-----------
Mantis ID 0004991 resolved
Modified Paths:
--------------
trunk/jcl/source/prototypes/containers/JclArrayLists.imp
Modified: trunk/jcl/source/prototypes/containers/JclArrayLists.imp
===================================================================
--- trunk/jcl/source/prototypes/containers/JclArrayLists.imp 2009-10-20 08:37:29 UTC (rev 3051)
+++ trunk/jcl/source/prototypes/containers/JclArrayLists.imp 2009-10-22 16:13:01 UTC (rev 3052)
@@ -384,7 +384,7 @@
begin
{$JPPEXPANDMACRO READBEGIN}
Result := DEFAULTVALUE;
- if (Index >= 0) or (Index < FSize) then
+ if (Index >= 0) and (Index < FSize) then
Result := FElementData[Index]
else
if not FReturnDefaultElements then
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ou...@us...> - 2009-10-20 08:37:41
|
Revision: 3051
http://jcl.svn.sourceforge.net/jcl/?rev=3051&view=rev
Author: outchy
Date: 2009-10-20 08:37:29 +0000 (Tue, 20 Oct 2009)
Log Message:
-----------
move internal classes declaration to unit interface.
Modified Paths:
--------------
trunk/jcl/source/common/JclCompression.pas
Modified: trunk/jcl/source/common/JclCompression.pas
===================================================================
--- trunk/jcl/source/common/JclCompression.pas 2009-10-19 18:50:06 UTC (rev 3050)
+++ trunk/jcl/source/common/JclCompression.pas 2009-10-20 08:37:29 UTC (rev 3051)
@@ -57,7 +57,7 @@
JclUnitVersioning,
{$ENDIF UNITVERSIONING}
{$IFDEF MSWINDOWS}
- Windows, Sevenzip,
+ Windows, Sevenzip, ActiveX,
{$ENDIF MSWINDOWS}
{$IFDEF UNIX}
Types,
@@ -1927,6 +1927,131 @@
class function ArchiveName: string; override;
end;
+// internal sevenzip stuff, do not use it directly
+type
+ TJclSevenzipOutStream = class(TInterfacedObject, ISequentialOutStream,
+ IOutStream, IUnknown)
+ private
+ FArchive: TJclCompressionArchive;
+ FItemIndex: Integer;
+ FStream: TStream;
+ FOwnsStream: Boolean;
+ FTruncateOnRelease: Boolean;
+ FMaximumPosition: Int64;
+ procedure NeedStream;
+ procedure ReleaseStream;
+ public
+ constructor Create(AArchive: TJclCompressionArchive; AItemIndex: Integer); overload;
+ constructor Create(AStream: TStream; AOwnsStream: Boolean; ATruncateOnRelease: Boolean); overload;
+ destructor Destroy; override;
+ // ISequentialOutStream
+ function Write(Data: Pointer; Size: Cardinal; ProcessedSize: PCardinal): HRESULT; stdcall;
+ // IOutStream
+ function Seek(Offset: Int64; SeekOrigin: Cardinal; NewPosition: PInt64): HRESULT; stdcall;
+ function SetSize(NewSize: Int64): HRESULT; stdcall;
+ end;
+
+ TJclSevenzipInStream = class(TInterfacedObject, ISequentialInStream,
+ IInStream, IStreamGetSize, IUnknown)
+ private
+ FArchive: TJclCompressionArchive;
+ FItemIndex: Integer;
+ FStream: TStream;
+ FOwnsStream: Boolean;
+ procedure NeedStream;
+ procedure ReleaseStream;
+ public
+ constructor Create(AArchive: TJclCompressionArchive; AItemIndex: Integer); overload;
+ constructor Create(AStream: TStream; AOwnsStream: Boolean); overload;
+ destructor Destroy; override;
+ // ISequentialInStream
+ function Read(Data: Pointer; Size: Cardinal; ProcessedSize: PCardinal): HRESULT; stdcall;
+ // IInStream
+ function Seek(Offset: Int64; SeekOrigin: Cardinal; NewPosition: PInt64): HRESULT; stdcall;
+ // IStreamGetSize
+ function GetSize(Size: PInt64): HRESULT; stdcall;
+ end;
+
+ TJclSevenzipOpenCallback = class(TInterfacedObject, IArchiveOpenCallback,
+ ICryptoGetTextPassword, IUnknown)
+ private
+ FArchive: TJclCompressionArchive;
+ public
+ constructor Create(AArchive: TJclCompressionArchive);
+ // IArchiveOpenCallback
+ function SetCompleted(Files: PInt64; Bytes: PInt64): HRESULT; stdcall;
+ function SetTotal(Files: PInt64; Bytes: PInt64): HRESULT; stdcall;
+ // ICryptoGetTextPassword
+ function CryptoGetTextPassword(password: PBStr): HRESULT; stdcall;
+ end;
+
+ TJclSevenzipExtractCallback = class(TInterfacedObject, IUnknown, IProgress,
+ IArchiveExtractCallback, ICryptoGetTextPassword)
+ private
+ FArchive: TJclCompressionArchive;
+ FLastStream: Cardinal;
+ public
+ constructor Create(AArchive: TJclCompressionArchive);
+ // IArchiveExtractCallback
+ function GetStream(Index: Cardinal; out OutStream: ISequentialOutStream;
+ askExtractMode: Cardinal): HRESULT; stdcall;
+ function PrepareOperation(askExtractMode: Cardinal): HRESULT; stdcall;
+ function SetOperationResult(resultEOperationResult: Integer): HRESULT; stdcall;
+ // IProgress
+ function SetCompleted(CompleteValue: PInt64): HRESULT; stdcall;
+ function SetTotal(Total: Int64): HRESULT; stdcall;
+ // ICryptoGetTextPassword
+ function CryptoGetTextPassword(password: PBStr): HRESULT; stdcall;
+ end;
+
+ TJclSevenzipUpdateCallback = class(TInterfacedObject, IUnknown, IProgress,
+ IArchiveUpdateCallback, IArchiveUpdateCallback2, ICryptoGetTextPassword2)
+ private
+ FArchive: TJclCompressionArchive;
+ FLastStream: Cardinal;
+ public
+ constructor Create(AArchive: TJclCompressionArchive);
+ // IProgress
+ function SetCompleted(CompleteValue: PInt64): HRESULT; stdcall;
+ function SetTotal(Total: Int64): HRESULT; stdcall;
+ // IArchiveUpdateCallback
+ function GetProperty(Index: Cardinal; PropID: Cardinal; out Value: tagPROPVARIANT): HRESULT; stdcall;
+ function GetStream(Index: Cardinal; out InStream: ISequentialInStream): HRESULT; stdcall;
+ function GetUpdateItemInfo(Index: Cardinal; NewData: PInteger;
+ NewProperties: PInteger; IndexInArchive: PCardinal): HRESULT; stdcall;
+ function SetOperationResult(OperationResult: Integer): HRESULT; stdcall;
+ // IArchiveUpdateCallback2
+ function GetVolumeSize(Index: Cardinal; Size: PInt64): HRESULT; stdcall;
+ function GetVolumeStream(Index: Cardinal;
+ out VolumeStream: ISequentialOutStream): HRESULT; stdcall;
+ // ICryptoGetTextPassword2
+ function CryptoGetTextPassword2(PasswordIsDefined: PInteger;
+ Password: PBStr): HRESULT; stdcall;
+ end;
+
+type
+ TWideStringSetter = procedure (const Value: WideString) of object;
+ TCardinalSetter = procedure (Value: Cardinal) of object;
+ TInt64Setter = procedure (const Value: Int64) of object;
+ TFileTimeSetter = procedure (const Value: TFileTime) of object;
+ TBoolSetter = procedure (const Value: Boolean) of object;
+
+procedure SevenzipCheck(Value: HRESULT);
+function Get7zWideStringProp(const AArchive: IInArchive; ItemIndex: Integer;
+ PropID: Cardinal; const Setter: TWideStringSetter): Boolean;
+function Get7zCardinalProp(const AArchive: IInArchive; ItemIndex: Integer;
+ PropID: Cardinal; const Setter: TCardinalSetter): Boolean;
+function Get7zInt64Prop(const AArchive: IInArchive; ItemIndex: Integer;
+ PropID: Cardinal; const Setter: TInt64Setter): Boolean;
+function Get7zFileTimeProp(const AArchive: IInArchive; ItemIndex: Integer;
+ PropID: Cardinal; const Setter: TFileTimeSetter): Boolean;
+function Get7zBoolProp(const AArchive: IInArchive; ItemIndex: Integer;
+ PropID: Cardinal; const Setter: TBoolSetter): Boolean;
+procedure Load7zFileAttribute(AInArchive: IInArchive; ItemIndex: Integer;
+ AItem: TJclCompressionItem);
+procedure GetSevenzipArchiveCompressionProperties(AJclArchive: IInterface; ASevenzipArchive: IInterface);
+procedure SetSevenzipArchiveCompressionProperties(AJclArchive: IInterface; ASevenzipArchive: IInterface);
+
{$ENDIF MSWINDOWS}
{$IFDEF UNITVERSIONING}
@@ -1944,9 +2069,6 @@
implementation
uses
- {$IFDEF MSWINDOWS}
- ActiveX,
- {$ENDIF MSWINDOWS}
JclUnicode, // WideSameText
JclDateTime, JclFileUtils, JclResources, JclStrings, JclSysUtils;
@@ -5053,29 +5175,6 @@
//=== { TJclSevenzipOutStream } ==============================================
-type
- TJclSevenzipOutStream = class(TInterfacedObject, ISequentialOutStream,
- IOutStream, IUnknown)
- private
- FArchive: TJclCompressionArchive;
- FItemIndex: Integer;
- FStream: TStream;
- FOwnsStream: Boolean;
- FTruncateOnRelease: Boolean;
- FMaximumPosition: Int64;
- procedure NeedStream;
- procedure ReleaseStream;
- public
- constructor Create(AArchive: TJclCompressionArchive; AItemIndex: Integer); overload;
- constructor Create(AStream: TStream; AOwnsStream: Boolean; ATruncateOnRelease: Boolean); overload;
- destructor Destroy; override;
- // ISequentialOutStream
- function Write(Data: Pointer; Size: Cardinal; ProcessedSize: PCardinal): HRESULT; stdcall;
- // IOutStream
- function Seek(Offset: Int64; SeekOrigin: Cardinal; NewPosition: PInt64): HRESULT; stdcall;
- function SetSize(NewSize: Int64): HRESULT; stdcall;
- end;
-
constructor TJclSevenzipOutStream.Create(AArchive: TJclCompressionArchive; AItemIndex: Integer);
begin
inherited Create;
@@ -5177,28 +5276,6 @@
//=== { TJclSevenzipInStream } ===============================================
-type
- TJclSevenzipInStream = class(TInterfacedObject, ISequentialInStream,
- IInStream, IStreamGetSize, IUnknown)
- private
- FArchive: TJclCompressionArchive;
- FItemIndex: Integer;
- FStream: TStream;
- FOwnsStream: Boolean;
- procedure NeedStream;
- procedure ReleaseStream;
- public
- constructor Create(AArchive: TJclCompressionArchive; AItemIndex: Integer); overload;
- constructor Create(AStream: TStream; AOwnsStream: Boolean); overload;
- destructor Destroy; override;
- // ISequentialInStream
- function Read(Data: Pointer; Size: Cardinal; ProcessedSize: PCardinal): HRESULT; stdcall;
- // IInStream
- function Seek(Offset: Int64; SeekOrigin: Cardinal; NewPosition: PInt64): HRESULT; stdcall;
- // IStreamGetSize
- function GetSize(Size: PInt64): HRESULT; stdcall;
- end;
-
constructor TJclSevenzipInStream.Create(AArchive: TJclCompressionArchive; AItemIndex: Integer);
begin
inherited Create;
@@ -5289,13 +5366,6 @@
raise EJclCompressionError.CreateResFmt(@RsCompression7zReturnError, [Value, SysErrorMessage(Value)]);
end;
-type
- TWideStringSetter = procedure (const Value: WideString) of object;
- TCardinalSetter = procedure (Value: Cardinal) of object;
- TInt64Setter = procedure (const Value: Int64) of object;
- TFileTimeSetter = procedure (const Value: TFileTime) of object;
- TBoolSetter = procedure (const Value: Boolean) of object;
-
function Get7zWideStringProp(const AArchive: IInArchive; ItemIndex: Integer;
PropID: Cardinal; const Setter: TWideStringSetter): Boolean;
var
@@ -5661,32 +5731,6 @@
//=== { TJclSevenzipOutputCallback } =========================================
-type
- TJclSevenzipUpdateCallback = class(TInterfacedObject, IUnknown, IProgress,
- IArchiveUpdateCallback, IArchiveUpdateCallback2, ICryptoGetTextPassword2)
- private
- FArchive: TJclCompressionArchive;
- FLastStream: Cardinal;
- public
- constructor Create(AArchive: TJclCompressionArchive);
- // IProgress
- function SetCompleted(CompleteValue: PInt64): HRESULT; stdcall;
- function SetTotal(Total: Int64): HRESULT; stdcall;
- // IArchiveUpdateCallback
- function GetProperty(Index: Cardinal; PropID: Cardinal; out Value: tagPROPVARIANT): HRESULT; stdcall;
- function GetStream(Index: Cardinal; out InStream: ISequentialInStream): HRESULT; stdcall;
- function GetUpdateItemInfo(Index: Cardinal; NewData: PInteger;
- NewProperties: PInteger; IndexInArchive: PCardinal): HRESULT; stdcall;
- function SetOperationResult(OperationResult: Integer): HRESULT; stdcall;
- // IArchiveUpdateCallback2
- function GetVolumeSize(Index: Cardinal; Size: PInt64): HRESULT; stdcall;
- function GetVolumeStream(Index: Cardinal;
- out VolumeStream: ISequentialOutStream): HRESULT; stdcall;
- // ICryptoGetTextPassword2
- function CryptoGetTextPassword2(PasswordIsDefined: PInteger;
- Password: PBStr): HRESULT; stdcall;
- end;
-
constructor TJclSevenzipUpdateCallback.Create(
AArchive: TJclCompressionArchive);
begin
@@ -6616,20 +6660,6 @@
//=== { TJclSevenzipOpenCallback } ===========================================
-type
- TJclSevenzipOpenCallback = class(TInterfacedObject, IArchiveOpenCallback,
- ICryptoGetTextPassword, IUnknown)
- private
- FArchive: TJclCompressionArchive;
- public
- constructor Create(AArchive: TJclCompressionArchive);
- // IArchiveOpenCallback
- function SetCompleted(Files: PInt64; Bytes: PInt64): HRESULT; stdcall;
- function SetTotal(Files: PInt64; Bytes: PInt64): HRESULT; stdcall;
- // ICryptoGetTextPassword
- function CryptoGetTextPassword(password: PBStr): HRESULT; stdcall;
- end;
-
constructor TJclSevenzipOpenCallback.Create(
AArchive: TJclCompressionArchive);
begin
@@ -6661,26 +6691,6 @@
//=== { TJclSevenzipExtractCallback } ========================================
-type
- TJclSevenzipExtractCallback = class(TInterfacedObject, IUnknown, IProgress,
- IArchiveExtractCallback, ICryptoGetTextPassword)
- private
- FArchive: TJclCompressionArchive;
- FLastStream: Cardinal;
- public
- constructor Create(AArchive: TJclCompressionArchive);
- // IArchiveExtractCallback
- function GetStream(Index: Cardinal; out OutStream: ISequentialOutStream;
- askExtractMode: Cardinal): HRESULT; stdcall;
- function PrepareOperation(askExtractMode: Cardinal): HRESULT; stdcall;
- function SetOperationResult(resultEOperationResult: Integer): HRESULT; stdcall;
- // IProgress
- function SetCompleted(CompleteValue: PInt64): HRESULT; stdcall;
- function SetTotal(Total: Int64): HRESULT; stdcall;
- // ICryptoGetTextPassword
- function CryptoGetTextPassword(password: PBStr): HRESULT; stdcall;
- end;
-
constructor TJclSevenzipExtractCallback.Create(
AArchive: TJclCompressionArchive);
begin
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ou...@us...> - 2009-10-19 18:50:15
|
Revision: 3050
http://jcl.svn.sourceforge.net/jcl/?rev=3050&view=rev
Author: outchy
Date: 2009-10-19 18:50:06 +0000 (Mon, 19 Oct 2009)
Log Message:
-----------
Insert a delay after the help files are compiled. This makes the process AV friendly.
Modified Paths:
--------------
trunk/thirdparty/makedist/JclTesting.xml
trunk/thirdparty/makedist/MakeDistActions.pas
Modified: trunk/thirdparty/makedist/JclTesting.xml
===================================================================
--- trunk/thirdparty/makedist/JclTesting.xml 2009-10-19 14:28:24 UTC (rev 3049)
+++ trunk/thirdparty/makedist/JclTesting.xml 2009-10-19 18:50:06 UTC (rev 3050)
@@ -219,6 +219,9 @@
<configuration index="3" caption="Valid exit codes" value="0;20;30"/>
<configuration index="4" caption="Result file" value=""/>
</action>
+ <action classname="TDelay">
+ <configuration index="0" caption="Delay" value="60"/>
+ </action>
<action classname="TArchiveMaker">
<configuration index="0" caption="Directory" value="sandbox\jcl"/>
<configuration index="1" caption="Filter" value="*help*"/>
@@ -343,6 +346,9 @@
<configuration index="3" caption="Valid exit codes" value="0;20;30"/>
<configuration index="4" caption="Result file" value=""/>
</action>
+ <action classname="TDelay">
+ <configuration index="0" caption="Delay" value="60"/>
+ </action>
<action classname="TFileRemover">
<configuration index="0" caption="Directory" value="sandbox\jcl\help"/>
<configuration index="1" caption="Filter" value="*.html;*.css;*.js;*.gif;*.jpg;*.png;*.c;*.h;*.inc;*.log"/>
@@ -472,6 +478,9 @@
<configuration index="3" caption="Valid exit codes" value="0;20;30"/>
<configuration index="4" caption="Result file" value=""/>
</action>
+ <action classname="TDelay">
+ <configuration index="0" caption="Delay" value="60"/>
+ </action>
<action classname="TFileRemover">
<configuration index="0" caption="Directory" value="sandbox\jcl\help"/>
<configuration index="1" caption="Filter" value="*.html;*.css;*.js;*.gif;*.jpg;*.png;*.c;*.h;*.inc"/>
Modified: trunk/thirdparty/makedist/MakeDistActions.pas
===================================================================
--- trunk/thirdparty/makedist/MakeDistActions.pas 2009-10-19 14:28:24 UTC (rev 3049)
+++ trunk/thirdparty/makedist/MakeDistActions.pas 2009-10-19 18:50:06 UTC (rev 3050)
@@ -337,19 +337,34 @@
function Execute(const AMessageHandler: TTextHandler): Boolean; override;
end;
+ // arbitrary delay
+ TDelay = class(TDistAction)
+ private
+ FDelay: string;
+ protected
+ function GetCaption: string; override;
+ function GetConfigCount: Integer; override;
+ function GetConfigCaption(Index: Integer): string; override;
+ function GetConfigValue(Index: Integer): string; override;
+ procedure SetConfigValue(Index: Integer; const Value: string); override;
+ public
+ class function GetDescription: string; override;
+ function Execute(const AMessageHandler: TTextHandler): Boolean; override;
+ end;
+
implementation
uses
DateUtils, JclDateTime, JclStrings, JclFileUtils, JclSysInfo, JclSimpleXml, JclCompression;
const
- StdActionsClasses: array [0..17] of TDistActionClass =
+ StdActionsClasses: array [0..18] of TDistActionClass =
( TBuildCalculator, TConstantParser,
TVariableReader, TVariableSetter, TVariableWriter,
TDirectoryCreator, TDirectoryRemover, TEolConverter,
TFileCopier, TFileCreator, TFileMover, TFileRemover, TFileTouch,
TXmlGetter, TCommandLineCaller, TArchiveMaker,
- TLogSaver, TLogCleaner );
+ TLogSaver, TLogCleaner, TDelay );
procedure RegisterStandardActions;
var
@@ -2105,6 +2120,73 @@
end;
end;
+//=== { TDelay } =============================================================
+
+function TDelay.Execute(const AMessageHandler: TTextHandler): Boolean;
+var
+ Delay: string;
+ DelayInt: Integer;
+begin
+ Delay := FDelay;
+ ExpandEnvironmentVar(Delay);
+ Result := TryStrToInt(Delay, DelayInt);
+ if Result then
+ begin
+ AMessageHandler(Format('Sleep for %d s', [DelayInt]));
+ while DelayInt > 0 do
+ begin
+ Sleep(1000);
+ Dec(DelayInt);
+ end;
+ end
+ else
+ AMessageHandler('invalid numeric value');
+end;
+
+function TDelay.GetCaption: string;
+var
+ Delay: string;
+begin
+ Delay := FDelay;
+ ExpandEnvironmentVar(Delay);
+ Result := Format('Sleep for %s s', [Delay]);
+end;
+
+function TDelay.GetConfigCaption(Index: Integer): string;
+begin
+ case Index of
+ 0: Result := 'Delay';
+ else
+ Result := '';
+ end;
+end;
+
+function TDelay.GetConfigCount: Integer;
+begin
+ Result := 1;
+end;
+
+function TDelay.GetConfigValue(Index: Integer): string;
+begin
+ case Index of
+ 0: Result := FDelay;
+ else
+ Result := '';
+ end;
+end;
+
+class function TDelay.GetDescription: string;
+begin
+ Result := 'Sleep for an arbitrary delay';
+end;
+
+procedure TDelay.SetConfigValue(Index: Integer; const Value: string);
+begin
+ case Index of
+ 0: FDelay := Value;
+ end;
+end;
+
initialization
RegisterStandardActions;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ou...@us...> - 2009-10-19 14:28:43
|
Revision: 3049
http://jcl.svn.sourceforge.net/jcl/?rev=3049&view=rev
Author: outchy
Date: 2009-10-19 14:28:24 +0000 (Mon, 19 Oct 2009)
Log Message:
-----------
7z.dll exports the function SetLargePageMode.
Modified Paths:
--------------
trunk/jcl/source/windows/sevenzip.pas
Modified: trunk/jcl/source/windows/sevenzip.pas
===================================================================
--- trunk/jcl/source/windows/sevenzip.pas 2009-10-17 08:47:26 UTC (rev 3048)
+++ trunk/jcl/source/windows/sevenzip.pas 2009-10-19 14:28:24 UTC (rev 3049)
@@ -598,15 +598,18 @@
TCreateObjectFunc = function (ClsID: PGUID; IID: PGUID; out Obj): HRESULT; stdcall;
TGetNumberOfFormatsFunc = function (NumFormats: PCardinal): HRESULT; stdcall;
TGetNumberOfMethodsFunc = function (NumMethods: PCardinal): HRESULT; stdcall;
+ TSetLargePageMode = function: HRESULT; stdcall;
var
CreateObject: TCreateObjectFunc = nil;
GetNumberOfFormats: TGetNumberOfFormatsFunc = nil;
GetNumberOfMethods: TGetNumberOfMethodsFunc = nil;
+ SetLargePageMode: TSetLargePageMode = nil;
{$ELSE ~7ZIP_LINKONREQUEST}
function CreateObject(ClsID: PGUID; IID: PGUID; out Obj): HRESULT; stdcall;
function GetNumberOfFormats(NumFormats: PCardinal): HRESULT; stdcall;
function GetNumberOfMethods(NumMethods: PCardinal): HRESULT; stdcall;
+function SetLargePageMode: HRESULT; stdcall;
{$ENDIF ~7ZIP_LINKONREQUEST}
function Load7Zip: Boolean;
@@ -628,12 +631,14 @@
CreateObjectExportName = 'CreateObject';
GetNumberOfFormatsExportName = 'GetNumberOfFormats';
GetNumberOfMethodsExportName = 'GetNumberOfMethods';
+ SetLargePageModeExportName = 'SetLargePageMode';
INVALID_MODULEHANDLE_VALUE = TModuleHandle(0);
{$IFDEF 7ZIP_LINKDLL}
function CreateObject; external sz7Zip name CreateObjectExportName;
function GetNumberOfFormats; external sz7Zip name GetNumberOfFormatsExportName;
function GetNumberOfMethods; external sz7Zip name GetNumberOfMethodsExportName;
+function SetLargePageMode; external sz7Zip name SetLargePageModeExportName;
{$ENDIF 7ZIP_LINKDLL}
{$IFDEF 7ZIP_LINKONREQUEST}
@@ -668,6 +673,9 @@
@CreateObject := GetSymbol(CreateObjectExportName);
@GetNumberOfFormats := GetSymbol(GetNumberOfFormatsExportName);
@GetNumberOfMethods := GetSymbol(GetNumberOfMethodsExportName);
+ @SetLargePageMode := GetSymbol(SetLargePageModeExportName);
+ Result := Assigned(@CreateObject) and Assigned(@GetNumberOfFormats) and
+ Assigned(@GetNumberOfMethods) and Assigned(@SetLargePageMode);
end;
end;
end;
@@ -689,6 +697,10 @@
procedure Unload7Zip;
begin
{$IFDEF 7ZIP_LINKONREQUEST}
+ @CreateObject := nil;
+ @GetNumberOfFormats := nil;
+ @GetNumberOfMethods := nil;
+ @SetLargePageMode := nil;
if SevenzipLib <> INVALID_MODULEHANDLE_VALUE then
{$IFDEF MSWINDOWS}
FreeLibrary(SevenzipLib);
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ou...@us...> - 2009-10-17 08:47:39
|
Revision: 3048
http://jcl.svn.sourceforge.net/jcl/?rev=3048&view=rev
Author: outchy
Date: 2009-10-17 08:47:26 +0000 (Sat, 17 Oct 2009)
Log Message:
-----------
Mantis 4970: Application crashes when attempting to compress file without share permissions.
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-10-16 20:37:26 UTC (rev 3047)
+++ trunk/jcl/source/common/JclCompression.pas 2009-10-17 08:47:26 UTC (rev 3048)
@@ -3477,6 +3477,13 @@
if FileName <> '' then
Result := TFileStream.Create(FileName, fmCreate);
end;
+ if not Assigned(Result) then
+ begin
+ if FileName = '' then
+ raise EJclCompressionError.CreateRes(@RsCompressionNoFileName)
+ else
+ RaiseLastOSError;
+ end;
end;
//=== { TJclCompressionItem } ================================================
Modified: trunk/jcl/source/common/JclResources.pas
===================================================================
--- trunk/jcl/source/common/JclResources.pas 2009-10-16 20:37:26 UTC (rev 3047)
+++ trunk/jcl/source/common/JclResources.pas 2009-10-17 08:47:26 UTC (rev 3048)
@@ -1074,6 +1074,7 @@
RsCompressionUnavailableProperty = 'Property is not available';
RsCompressionCompressingError = 'Operation is not supported while compressing';
RsCompressionDecompressingError = 'Operation is not supported while decompressing';
+ RsCompressionNoFileName = 'File name not supplied';
RsCompressionUnsupportedMethod = 'Unsupported method';
RsCompressionDataError = 'Data error';
RsCompressionCRCError = 'CRC error';
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ou...@us...> - 2009-10-16 20:37:32
|
Revision: 3047
http://jcl.svn.sourceforge.net/jcl/?rev=3047&view=rev
Author: outchy
Date: 2009-10-16 20:37:26 +0000 (Fri, 16 Oct 2009)
Log Message:
-----------
Do not disable overflow and range checks in unit JclDebug.pas.
Modified Paths:
--------------
trunk/jcl/source/windows/JclDebug.pas
Modified: trunk/jcl/source/windows/JclDebug.pas
===================================================================
--- trunk/jcl/source/windows/JclDebug.pas 2009-10-16 20:35:47 UTC (rev 3046)
+++ trunk/jcl/source/windows/JclDebug.pas 2009-10-16 20:37:26 UTC (rev 3047)
@@ -45,8 +45,6 @@
interface
{$I jcl.inc}
-{$RANGECHECKS OFF}
-{$OVERFLOWCHECKS OFF}
uses
{$IFDEF UNITVERSIONING}
@@ -2299,6 +2297,8 @@
inherited Destroy;
end;
+{$OVERFLOWCHECKS OFF}
+
function TJclBinDebugGenerator.CalculateCheckSum: Boolean;
var
Header: PJclDbgHeader;
@@ -2323,6 +2323,10 @@
end;
end;
+{$IFDEF OVERFLOWCHECKS_ON}
+{$OVERFLOWCHECKS ON}
+{$ENDIF OVERFLOWCHECKS_ON}
+
procedure TJclBinDebugGenerator.CreateData;
var
WordList: TStringList;
@@ -2582,6 +2586,8 @@
end;
end;
+{$OVERFLOWCHECKS OFF}
+
procedure TJclBinDebugScanner.CheckFormat;
var
CheckSum: Integer;
@@ -2607,6 +2613,10 @@
end;
end;
+{$IFDEF OVERFLOWCHECKS_ON}
+{$OVERFLOWCHECKS ON}
+{$ENDIF OVERFLOWCHECKS_ON}
+
function TJclBinDebugScanner.DataToStr(A: Integer): string;
var
P: PAnsiChar;
@@ -4506,7 +4516,10 @@
IgnoreLevels := Cardinal(-1); // because of the "IgnoreLevels + 1" in TJclStackInfoList.StoreToList()
if OSException then
begin
- Inc(IgnoreLevels); // => HandleAnyException
+ if IgnoreLevels = Cardinal(-1) then
+ IgnoreLevels := 0
+ else
+ Inc(IgnoreLevels); // => HandleAnyException
FirstCaller := ExceptAddr;
end
else
@@ -4828,7 +4841,8 @@
var
Item: TJclStackInfoItem;
begin
- if StackInfo.Level > IgnoreLevels + 1 then
+ if ((IgnoreLevels = Cardinal(-1)) and (StackInfo.Level > 0)) or
+ (StackInfo.Level > (IgnoreLevels + 1)) then
begin
Item := TJclStackInfoItem.Create;
Item.FStackInfo := StackInfo;
@@ -5171,6 +5185,8 @@
AnalyseExceptFrame(AExcDesc);
end;
+{$RANGECHECKS OFF}
+
procedure TJclExceptFrame.AnalyseExceptFrame(AExcDesc: PExcDesc);
var
Dest: Pointer;
@@ -5234,6 +5250,10 @@
end;
end;
+{$IFDEF RANGECHECKS_ON}
+{$RANGECHECKS ON}
+{$ENDIF RANGECHECKS_ON}
+
function TJclExceptFrame.Handles(ExceptObj: TObject): Boolean;
var
Handler: Pointer;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ou...@us...> - 2009-10-16 20:35:54
|
Revision: 3046
http://jcl.svn.sourceforge.net/jcl/?rev=3046&view=rev
Author: outchy
Date: 2009-10-16 20:35:47 +0000 (Fri, 16 Oct 2009)
Log Message:
-----------
Mantis 4929: some exception during frame dump after exception.
Modified Paths:
--------------
trunk/jcl/source/windows/JclDebug.pas
Modified: trunk/jcl/source/windows/JclDebug.pas
===================================================================
--- trunk/jcl/source/windows/JclDebug.pas 2009-10-16 20:33:16 UTC (rev 3045)
+++ trunk/jcl/source/windows/JclDebug.pas 2009-10-16 20:35:47 UTC (rev 3046)
@@ -5139,9 +5139,10 @@
JclCreateExceptFrameList(4);
end;
+{$OVERFLOWCHECKS OFF}
+
function GetJmpDest(Jmp: PJmpInstruction): Pointer;
begin
- {$OVERFLOWCHECKS OFF}
// TODO : 64 bit version
if Jmp^.opCode = $E9 then
Result := Pointer(TJclAddr(Jmp) + TJclAddr(Jmp^.distance) + 5)
@@ -5153,11 +5154,12 @@
if (Result <> nil) and (PJmpTable(Result).OPCode = $25FF) then
if not IsBadReadPtr(PJmpTable(Result).Ptr, SizeOf(Pointer)) then
Result := Pointer(PJclAddr(PJmpTable(Result).Ptr)^);
- {$IFDEF OVERFLOWCHECKS_ON}
- {$OVERFLOWCHECKS ON}
- {$ENDIF OVERFLOWCHECKS_ON}
end;
+{$IFDEF OVERFLOWCHECKS_ON}
+{$OVERFLOWCHECKS ON}
+{$ENDIF OVERFLOWCHECKS_ON}
+
//=== { TJclExceptFrame } ====================================================
constructor TJclExceptFrame.Create(AFrameLocation: Pointer; AExcDesc: PExcDesc);
@@ -5239,6 +5241,8 @@
Result := HandlerInfo(ExceptObj, Handler);
end;
+{$OVERFLOWCHECKS OFF}
+
function TJclExceptFrame.HandlerInfo(ExceptObj: TObject; out HandlerAt: Pointer): Boolean;
var
I: Integer;
@@ -5255,7 +5259,6 @@
Result := FExcTab[I].VTable = nil;
while (not Result) and (VTable <> nil) do
begin
- {$OVERFLOWCHECKS OFF}
Result := (FExcTab[I].VTable = VTable) or
(PShortString(PPointer(PJclAddr(FExcTab[I].VTable)^ + TJclAddr(vmtClassName))^)^ =
PShortString(PPointer(TJclAddr(VTable) + TJclAddr(vmtClassName))^)^);
@@ -5269,9 +5272,6 @@
else
VTable := ParentVTable;
end;
- {$IFDEF OVERFLOWCHECKS_ON}
- {$OVERFLOWCHECKS ON}
- {$ENDIF OVERFLOWCHECKS_ON}
end;
if Result then
Break;
@@ -5284,6 +5284,10 @@
HandlerAt := nil;
end;
+{$IFDEF OVERFLOWCHECKS_ON}
+{$OVERFLOWCHECKS ON}
+{$ENDIF OVERFLOWCHECKS_ON}
+
//=== { TJclExceptFrameList } ================================================
constructor TJclExceptFrameList.Create(AIgnoreLevels: Integer);
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ou...@us...> - 2009-10-16 20:33:31
|
Revision: 3045
http://jcl.svn.sourceforge.net/jcl/?rev=3045&view=rev
Author: outchy
Date: 2009-10-16 20:33:16 +0000 (Fri, 16 Oct 2009)
Log Message:
-----------
The segment offset is an pointer size unsigned value.
Modified Paths:
--------------
trunk/jcl/source/windows/JclDebug.pas
Modified: trunk/jcl/source/windows/JclDebug.pas
===================================================================
--- trunk/jcl/source/windows/JclDebug.pas 2009-10-16 17:11:39 UTC (rev 3044)
+++ trunk/jcl/source/windows/JclDebug.pas 2009-10-16 20:33:16 UTC (rev 3045)
@@ -116,7 +116,7 @@
PJclMapAddress = ^TJclMapAddress;
TJclMapAddress = packed record
Segment: Word;
- Offset: Integer;
+ Offset: TJclAddr;
end;
PJclMapString = PAnsiChar;
@@ -1750,7 +1750,7 @@
if (FSegmentClasses[SegIndex].Segment = Address.Segment)
and (DWORD(Address.Offset) < FSegmentClasses[SegIndex].Len) then
begin
- VA := AddrToVA(TJclAddr(Address.Offset) + FSegmentClasses[SegIndex].Addr);
+ VA := AddrToVA(Address.Offset + FSegmentClasses[SegIndex].Addr);
{ Starting with Delphi 2005, "empty" units are listes with the last line and
the VA 0001:00000000. When we would accept 0 VAs here, System.pas functions
could be mapped to other units and line numbers. Discaring such items should
@@ -1855,7 +1855,7 @@
if FProcNamesCnt mod 256 = 0 then
SetLength(FProcNames, FProcNamesCnt + 256);
FProcNames[FProcNamesCnt].Segment := FSegmentClasses[SegIndex].Segment;
- FProcNames[FProcNamesCnt].VA := AddrToVA(TJclAddr(Address.Offset) + FSegmentClasses[SegIndex].Addr);
+ FProcNames[FProcNamesCnt].VA := AddrToVA(Address.Offset + FSegmentClasses[SegIndex].Addr);
FProcNames[FProcNamesCnt].ProcName := Name;
Inc(FProcNamesCnt);
Break;
@@ -1902,7 +1902,7 @@
if (FSegmentClasses[SegIndex].Segment = Address.Segment)
and (DWORD(Address.Offset) < FSegmentClasses[SegIndex].Len) then
begin
- VA := AddrToVA(TJclAddr(Address.Offset) + FSegmentClasses[SegIndex].Addr);
+ VA := AddrToVA(Address.Offset + FSegmentClasses[SegIndex].Addr);
if FSegmentCnt mod 16 = 0 then
SetLength(FSegments, FSegmentCnt + 16);
FSegments[FSegmentCnt].Segment := FSegmentClasses[SegIndex].Segment;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ou...@us...> - 2009-10-16 17:11:47
|
Revision: 3044
http://jcl.svn.sourceforge.net/jcl/?rev=3044&view=rev
Author: outchy
Date: 2009-10-16 17:11:39 +0000 (Fri, 16 Oct 2009)
Log Message:
-----------
When an exception is raised within a JCL expert, it is not raised anymore.
The JCL exception dialog now displays the detailed (raw) stack trace.
Modified Paths:
--------------
trunk/jcl/experts/common/JclOtaExceptionForm.pas
trunk/jcl/experts/common/JclOtaUtils.pas
trunk/jcl/experts/debug/converter/JclDebugIdeImpl.pas
trunk/jcl/experts/debug/simdview/JclSIMDModifyForm.pas
trunk/jcl/experts/debug/simdview/JclSIMDView.pas
trunk/jcl/experts/debug/simdview/JclSIMDViewForm.pas
trunk/jcl/experts/favfolders/IdeOpenDlgFavoriteUnit.pas
trunk/jcl/experts/projectanalyzer/ProjAnalyzerImpl.pas
trunk/jcl/experts/repository/JclOtaRepositoryReg.pas
trunk/jcl/experts/repository/JclOtaRepositoryUtils.pas
trunk/jcl/experts/stacktraceviewer/JclStackTraceViewerImpl.pas
trunk/jcl/experts/versioncontrol/JclVersionControlImpl.pas
Modified: trunk/jcl/experts/common/JclOtaExceptionForm.pas
===================================================================
--- trunk/jcl/experts/common/JclOtaExceptionForm.pas 2009-10-11 16:54:42 UTC (rev 3043)
+++ trunk/jcl/experts/common/JclOtaExceptionForm.pas 2009-10-16 17:11:39 UTC (rev 3044)
@@ -111,6 +111,7 @@
procedure TJclExpertExceptionForm.ShowException(AExceptionObj: TObject);
var
AStackInfoList: TJclStackInfoList;
+ AJclExpertException: EJclExpertException;
begin
MemoCallStack.Lines.Clear;
@@ -121,25 +122,23 @@
if AExceptionObj is Exception then
begin
MemoCallStack.Lines.Add(Format(LoadResString(@RsDetailsExceptionMessage), [Exception(AExceptionObj).Message]));
-{$IFDEF MSWINDOWS}
if (AExceptionObj is EJclExpertException) then
- with EJclExpertException(AExceptionObj) do
- if Assigned(StackInfo) then
begin
- StackInfo.AddToStrings(MemoCallStack.Lines, True, True, True, True);
- Exit;
+ AJclExpertException := EJclExpertException(AExceptionObj);
+ if Assigned(AJclExpertException.StackInfo) then
+ begin
+ AJclExpertException.StackInfo.AddToStrings(MemoCallStack.Lines, True, True, True, True);
+ Exit;
+ end;
end;
-{$ENDIF MSWINDOWS}
end;
-{$IFDEF MSWINDOWS}
- AStackInfoList := JclCreateStackList(False, 0, nil);
+ AStackInfoList := JclCreateStackList(True, 0, nil, False);
try
AStackInfoList.AddToStrings(MemoCallStack.Lines, True, True, True, True);
finally
AStackInfoList.Free;
end;
-{$ENDIF MSWINDOWS}
except
MemoCallStack.Lines.Add(LoadResString(@RsErrorWhileFormatting));
end;
Modified: trunk/jcl/experts/common/JclOtaUtils.pas
===================================================================
--- trunk/jcl/experts/common/JclOtaUtils.pas 2009-10-11 16:54:42 UTC (rev 3043)
+++ trunk/jcl/experts/common/JclOtaUtils.pas 2009-10-16 17:11:39 UTC (rev 3044)
@@ -70,7 +70,6 @@
// on ExceptionObj: TObject do
// begin
// JclExpertShowExceptionDialog(ExceptionObj);
-// raise;
// end;
// end;
// entry points for experts are usually:
@@ -338,8 +337,8 @@
Index: Integer;
TestAction: TCustomAction;
begin
+ Result := nil;
try
- Result := nil;
if Assigned(GlobalActionList) then
for Index := 0 to GlobalActionList.Count-1 do
begin
@@ -351,7 +350,6 @@
on ExceptionObj: TObject do
begin
JclExpertShowExceptionDialog(ExceptionObj);
- raise;
end;
end;
end;
@@ -665,7 +663,7 @@
procedure EJclExpertException.AfterConstruction;
begin
inherited AfterConstruction;
- FStackInfo := JclCreateStackList(False, 0, nil, False);
+ FStackInfo := JclCreateStackList(True, 0, nil, False);
end;
destructor EJclExpertException.Destroy;
@@ -871,7 +869,6 @@
on ExceptionObj: TObject do
begin
JclExpertShowExceptionDialog(ExceptionObj);
- raise;
end;
end;
end;
@@ -884,7 +881,6 @@
on ExceptionObj: TObject do
begin
JclExpertShowExceptionDialog(ExceptionObj);
- raise;
end;
end;
end;
@@ -1791,7 +1787,6 @@
on ExceptionObj: TObject do
begin
JclExpertShowExceptionDialog(ExceptionObj);
- raise;
end;
end;
@@ -1811,7 +1806,6 @@
on ExceptionObj: TObject do
begin
JclExpertShowExceptionDialog(ExceptionObj);
- raise;
end;
end;
Modified: trunk/jcl/experts/debug/converter/JclDebugIdeImpl.pas
===================================================================
--- trunk/jcl/experts/debug/converter/JclDebugIdeImpl.pas 2009-10-11 16:54:42 UTC (rev 3043)
+++ trunk/jcl/experts/debug/converter/JclDebugIdeImpl.pas 2009-10-16 17:11:39 UTC (rev 3044)
@@ -243,7 +243,6 @@
on ExceptionObj: TObject do
begin
JclExpertShowExceptionDialog(ExceptionObj);
- raise;
end;
end;
end;
@@ -656,7 +655,6 @@
on ExceptionObj: TObject do
begin
JclExpertShowExceptionDialog(ExceptionObj);
- raise;
end;
end;
end;
@@ -800,7 +798,6 @@
on ExceptionObj: TObject do
begin
JclExpertShowExceptionDialog(ExceptionObj);
- raise;
end;
end;
end;
@@ -925,7 +922,6 @@
on ExceptionObj: TObject do
begin
JclExpertShowExceptionDialog(ExceptionObj);
- raise;
end;
end;
end;
@@ -1110,7 +1106,6 @@
on ExceptionObj: TObject do
begin
JclExpertShowExceptionDialog(ExceptionObj);
- raise;
end;
end;
end;
@@ -1577,7 +1572,6 @@
on ExceptionObj: TObject do
begin
JclExpertShowExceptionDialog(ExceptionObj);
- raise;
end;
end;
end;
@@ -1591,7 +1585,6 @@
on ExceptionObj: TObject do
begin
JclExpertShowExceptionDialog(ExceptionObj);
- //raise; Do not lock out the user from compiling anything
end;
end;
end;
@@ -1715,7 +1708,6 @@
on ExceptionObj: TObject do
begin
JclExpertShowExceptionDialog(ExceptionObj);
- raise;
end;
end;
end;
@@ -1749,7 +1741,6 @@
on ExceptionObj: TObject do
begin
JclExpertShowExceptionDialog(ExceptionObj);
- raise;
end;
end;
end;
@@ -1886,7 +1877,7 @@
on ExceptionObj: TObject do
begin
JclExpertShowExceptionDialog(ExceptionObj);
- raise;
+ Result := nil;
end;
end;
end;
@@ -1912,7 +1903,6 @@
on ExceptionObj: TObject do
begin
JclExpertShowExceptionDialog(ExceptionObj);
- raise;
end;
end;
end;
@@ -1933,7 +1923,6 @@
on ExceptionObj: TObject do
begin
JclExpertShowExceptionDialog(ExceptionObj);
- raise;
end;
end;
end;
@@ -1954,7 +1943,6 @@
on ExceptionObj: TObject do
begin
JclExpertShowExceptionDialog(ExceptionObj);
- raise;
end;
end;
end;
Modified: trunk/jcl/experts/debug/simdview/JclSIMDModifyForm.pas
===================================================================
--- trunk/jcl/experts/debug/simdview/JclSIMDModifyForm.pas 2009-10-11 16:54:42 UTC (rev 3043)
+++ trunk/jcl/experts/debug/simdview/JclSIMDModifyForm.pas 2009-10-16 17:11:39 UTC (rev 3044)
@@ -433,7 +433,6 @@
on ExceptionObj: TObject do
begin
JclExpertShowExceptionDialog(ExceptionObj);
- raise;
end;
end;
end;
@@ -447,7 +446,6 @@
on ExceptionObj: TObject do
begin
JclExpertShowExceptionDialog(ExceptionObj);
- raise;
end;
end;
end;
@@ -499,7 +497,6 @@
on ExceptionObj: TObject do
begin
JclExpertShowExceptionDialog(ExceptionObj);
- //raise; no exception throw message handler
end;
end;
end;
@@ -658,7 +655,6 @@
on ExceptionObj: TObject do
begin
JclExpertShowExceptionDialog(ExceptionObj);
- raise;
end;
end;
end;
Modified: trunk/jcl/experts/debug/simdview/JclSIMDView.pas
===================================================================
--- trunk/jcl/experts/debug/simdview/JclSIMDView.pas 2009-10-11 16:54:42 UTC (rev 3043)
+++ trunk/jcl/experts/debug/simdview/JclSIMDView.pas 2009-10-16 17:11:39 UTC (rev 3044)
@@ -153,7 +153,6 @@
on ExceptObj: TObject do
begin
JclExpertShowExceptionDialog(ExceptObj);
- raise;
end;
end;
end;
@@ -234,7 +233,6 @@
on ExceptObj: TObject do
begin
JclExpertShowExceptionDialog(ExceptObj);
- raise;
end;
end;
end;
@@ -262,12 +260,11 @@
AAction.Enabled := False;
end
else
- AAction.Enabled := False
+ AAction.Enabled := False;
except
on ExceptObj: TObject do
begin
JclExpertShowExceptionDialog(ExceptObj);
- raise;
end;
end;
end;
@@ -468,7 +465,6 @@
on ExceptObj: TObject do
begin
JclExpertShowExceptionDialog(ExceptObj);
- raise;
end;
end;
end;
@@ -521,7 +517,6 @@
on ExceptObj: TObject do
begin
JclExpertShowExceptionDialog(ExceptObj);
- raise;
end;
end;
end;
@@ -558,7 +553,6 @@
on ExceptObj: TObject do
begin
JclExpertShowExceptionDialog(ExceptObj);
- raise;
end;
end;
end;
@@ -591,7 +585,6 @@
on ExceptObj: TObject do
begin
JclExpertShowExceptionDialog(ExceptObj);
- raise;
end;
end;
end;
@@ -612,7 +605,6 @@
on ExceptObj: TObject do
begin
JclExpertShowExceptionDialog(ExceptObj);
- raise;
end;
end;
end;
@@ -625,7 +617,6 @@
on ExceptObj: TObject do
begin
JclExpertShowExceptionDialog(ExceptObj);
- raise;
end;
end;
end;
Modified: trunk/jcl/experts/debug/simdview/JclSIMDViewForm.pas
===================================================================
--- trunk/jcl/experts/debug/simdview/JclSIMDViewForm.pas 2009-10-11 16:54:42 UTC (rev 3043)
+++ trunk/jcl/experts/debug/simdview/JclSIMDViewForm.pas 2009-10-16 17:11:39 UTC (rev 3044)
@@ -277,7 +277,6 @@
on ExceptionObj: TObject do
begin
JclExpertShowExceptionDialog(ExceptionObj);
- raise;
end;
end;
end;
@@ -329,7 +328,6 @@
on ExceptionObj: TObject do
begin
JclExpertShowExceptionDialog(ExceptionObj);
- raise;
end;
end;
end;
@@ -374,7 +372,6 @@
on ExceptionObj: TObject do
begin
JclExpertShowExceptionDialog(ExceptionObj);
- raise;
end;
end;
end;
@@ -631,7 +628,6 @@
on ExceptionObj: TObject do
begin
JclExpertShowExceptionDialog(ExceptionObj);
- raise;
end;
end;
end;
@@ -676,7 +672,6 @@
on ExceptionObj: TObject do
begin
JclExpertShowExceptionDialog(ExceptionObj);
- raise;
end;
end;
end;
@@ -791,7 +786,6 @@
on ExceptionObj: TObject do
begin
JclExpertShowExceptionDialog(ExceptionObj);
- raise;
end;
end;
end;
@@ -846,7 +840,6 @@
on ExceptionObj: TObject do
begin
JclExpertShowExceptionDialog(ExceptionObj);
- raise;
end;
end;
end;
@@ -860,7 +853,6 @@
on ExceptionObj: TObject do
begin
JclExpertShowExceptionDialog(ExceptionObj);
- raise;
end;
end;
end;
@@ -877,7 +869,6 @@
on ExceptionObj: TObject do
begin
JclExpertShowExceptionDialog(ExceptionObj);
- raise;
end;
end;
end;
@@ -893,7 +884,6 @@
on ExceptionObj: TObject do
begin
JclExpertShowExceptionDialog(ExceptionObj);
- raise;
end;
end;
end;
@@ -920,7 +910,6 @@
on ExceptionObj: TObject do
begin
JclExpertShowExceptionDialog(ExceptionObj);
- raise;
end;
end;
end;
@@ -984,7 +973,6 @@
on ExceptionObj: TObject do
begin
JclExpertShowExceptionDialog(ExceptionObj);
- raise;
end;
end;
end;
@@ -1009,7 +997,6 @@
on ExceptionObj: TObject do
begin
JclExpertShowExceptionDialog(ExceptionObj);
- raise;
end;
end;
end;
@@ -1029,7 +1016,6 @@
on ExceptionObj: TObject do
begin
JclExpertShowExceptionDialog(ExceptionObj);
- raise;
end;
end;
end;
@@ -1052,7 +1038,6 @@
on ExceptionObj: TObject do
begin
JclExpertShowExceptionDialog(ExceptionObj);
- raise;
end;
end;
end;
@@ -1071,7 +1056,6 @@
on ExceptionObj: TObject do
begin
JclExpertShowExceptionDialog(ExceptionObj);
- raise;
end;
end;
end;
@@ -1084,7 +1068,6 @@
on ExceptionObj: TObject do
begin
JclExpertShowExceptionDialog(ExceptionObj);
- raise;
end;
end;
end;
@@ -1110,7 +1093,6 @@
on ExceptionObj: TObject do
begin
JclExpertShowExceptionDialog(ExceptionObj);
- raise;
end;
end;
end;
@@ -1130,7 +1112,6 @@
on ExceptionObj: TObject do
begin
JclExpertShowExceptionDialog(ExceptionObj);
- raise;
end;
end;
end;
Modified: trunk/jcl/experts/favfolders/IdeOpenDlgFavoriteUnit.pas
===================================================================
--- trunk/jcl/experts/favfolders/IdeOpenDlgFavoriteUnit.pas 2009-10-11 16:54:42 UTC (rev 3043)
+++ trunk/jcl/experts/favfolders/IdeOpenDlgFavoriteUnit.pas 2009-10-16 17:11:39 UTC (rev 3044)
@@ -83,7 +83,6 @@
on ExceptionObj: TObject do
begin
JclExpertShowExceptionDialog(ExceptionObj);
- raise;
end;
end;
end;
Modified: trunk/jcl/experts/projectanalyzer/ProjAnalyzerImpl.pas
===================================================================
--- trunk/jcl/experts/projectanalyzer/ProjAnalyzerImpl.pas 2009-10-11 16:54:42 UTC (rev 3043)
+++ trunk/jcl/experts/projectanalyzer/ProjAnalyzerImpl.pas 2009-10-16 17:11:39 UTC (rev 3044)
@@ -120,7 +120,6 @@
on ExceptionObj: TObject do
begin
JclExpertShowExceptionDialog(ExceptionObj);
- raise;
end;
end;
end;
@@ -187,7 +186,6 @@
on ExceptionObj: TObject do
begin
JclExpertShowExceptionDialog(ExceptionObj);
- raise;
end;
end;
end;
@@ -211,7 +209,6 @@
on ExceptionObj: TObject do
begin
JclExpertShowExceptionDialog(ExceptionObj);
- raise;
end;
end;
end;
@@ -463,7 +460,6 @@
on ExceptionObj: TObject do
begin
JclExpertShowExceptionDialog(ExceptionObj);
- raise;
end;
end;
end;
@@ -504,7 +500,7 @@
on ExceptionObj: TObject do
begin
JclExpertShowExceptionDialog(ExceptionObj);
- raise;
+ Result := nil;
end;
end;
end;
@@ -525,7 +521,6 @@
on ExceptionObj: TObject do
begin
JclExpertShowExceptionDialog(ExceptionObj);
- raise;
end;
end;
end;
Modified: trunk/jcl/experts/repository/JclOtaRepositoryReg.pas
===================================================================
--- trunk/jcl/experts/repository/JclOtaRepositoryReg.pas 2009-10-11 16:54:42 UTC (rev 3043)
+++ trunk/jcl/experts/repository/JclOtaRepositoryReg.pas 2009-10-16 17:11:39 UTC (rev 3044)
@@ -120,7 +120,6 @@
on ExceptionObj: TObject do
begin
JclExpertShowExceptionDialog(ExceptionObj);
- raise;
end;
end;
end;
Modified: trunk/jcl/experts/repository/JclOtaRepositoryUtils.pas
===================================================================
--- trunk/jcl/experts/repository/JclOtaRepositoryUtils.pas 2009-10-11 16:54:42 UTC (rev 3043)
+++ trunk/jcl/experts/repository/JclOtaRepositoryUtils.pas 2009-10-16 17:11:39 UTC (rev 3044)
@@ -245,7 +245,6 @@
on ExceptionObj: TObject do
begin
JclExpertShowExceptionDialog(ExceptionObj);
- raise;
end;
end;
end;
@@ -278,7 +277,6 @@
on ExceptionObj: TObject do
begin
JclExpertShowExceptionDialog(ExceptionObj);
- raise;
end;
end;
end;
@@ -312,7 +310,6 @@
on ExceptionObj: TObject do
begin
JclExpertShowExceptionDialog(ExceptionObj);
- raise;
end;
end;
end;
@@ -337,7 +334,7 @@
on ExceptionObj: TObject do
begin
JclExpertShowExceptionDialog(ExceptionObj);
- raise;
+ Result := False;
end;
end;
end;
@@ -355,7 +352,7 @@
on ExceptionObj: TObject do
begin
JclExpertShowExceptionDialog(ExceptionObj);
- raise;
+ Result := False;
end;
end;
end;
Modified: trunk/jcl/experts/stacktraceviewer/JclStackTraceViewerImpl.pas
===================================================================
--- trunk/jcl/experts/stacktraceviewer/JclStackTraceViewerImpl.pas 2009-10-11 16:54:42 UTC (rev 3043)
+++ trunk/jcl/experts/stacktraceviewer/JclStackTraceViewerImpl.pas 2009-10-16 17:11:39 UTC (rev 3044)
@@ -116,7 +116,6 @@
on ExceptionObj: TObject do
begin
JclExpertShowExceptionDialog(ExceptionObj);
- raise;
end;
end;
end;
@@ -192,7 +191,6 @@
on ExceptionObj: TObject do
begin
JclExpertShowExceptionDialog(ExceptionObj);
- raise;
end;
end;
end;
Modified: trunk/jcl/experts/versioncontrol/JclVersionControlImpl.pas
===================================================================
--- trunk/jcl/experts/versioncontrol/JclVersionControlImpl.pas 2009-10-11 16:54:42 UTC (rev 3043)
+++ trunk/jcl/experts/versioncontrol/JclVersionControlImpl.pas 2009-10-16 17:11:39 UTC (rev 3044)
@@ -192,7 +192,6 @@
on ExceptionObj: TObject do
begin
JclExpertShowExceptionDialog(ExceptionObj);
- raise;
end;
end;
end;
@@ -394,7 +393,6 @@
on ExceptionObj: TObject do
begin
JclExpertShowExceptionDialog(ExceptionObj);
- raise;
end;
end;
end;
@@ -491,7 +489,6 @@
on ExceptionObj: TObject do
begin
JclExpertShowExceptionDialog(ExceptionObj);
- raise;
end;
end;
end;
@@ -612,7 +609,6 @@
on ExceptionObj: TObject do
begin
JclExpertShowExceptionDialog(ExceptionObj);
- raise;
end;
end;
end;
@@ -739,7 +735,6 @@
on ExceptionObj: TObject do
begin
JclExpertShowExceptionDialog(ExceptionObj);
- raise;
end;
end;
end;
@@ -830,7 +825,6 @@
on ExceptionObj: TObject do
begin
JclExpertShowExceptionDialog(ExceptionObj);
- raise;
end;
end;
end;
@@ -1158,7 +1152,6 @@
on ExceptionObj: TObject do
begin
JclExpertShowExceptionDialog(ExceptionObj);
- raise;
end;
end;
end;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <tw...@us...> - 2009-10-11 16:54:48
|
Revision: 3043
http://jcl.svn.sourceforge.net/jcl/?rev=3043&view=rev
Author: twm
Date: 2009-10-11 16:54:42 +0000 (Sun, 11 Oct 2009)
Log Message:
-----------
Bugfix: PathCanonicalize did not work for unc paths
Modified Paths:
--------------
trunk/jcl/source/common/JclFileUtils.pas
Modified: trunk/jcl/source/common/JclFileUtils.pas
===================================================================
--- trunk/jcl/source/common/JclFileUtils.pas 2009-10-08 04:55:10 UTC (rev 3042)
+++ trunk/jcl/source/common/JclFileUtils.pas 2009-10-11 16:54:42 UTC (rev 3043)
@@ -2257,7 +2257,10 @@
I := Pos(':', Path); // for Windows' sake
K := Pos(DirDelimiter, Path);
IsAbsolute := K - I = 1;
- if not IsAbsolute then
+ if IsAbsolute then begin
+ if Copy(Path, 1, Length(PathUncPrefix)) = PathUncPrefix then // UNC path
+ K := 2;
+ end else
K := I;
if K = 0 then
S := Path
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.
