Menu
▾
▴
jcl-checkins-diff
|
From: <ou...@us...> - 2008-08-23 17:40:45
|
Revision: 2438
http://jcl.svn.sourceforge.net/jcl/?rev=2438&view=rev
Author: outchy
Date: 2008-08-23 17:40:43 +0000 (Sat, 23 Aug 2008)
Log Message:
-----------
Mantis 4425: wrong DynArrayCompareCardinal
Also fixed possible overflow in DynArrayCompareInt64.
Modified Paths:
--------------
trunk/jcl/source/common/JclSysUtils.pas
Modified: trunk/jcl/source/common/JclSysUtils.pas
===================================================================
--- trunk/jcl/source/common/JclSysUtils.pas 2008-08-23 10:05:36 UTC (rev 2437)
+++ trunk/jcl/source/common/JclSysUtils.pas 2008-08-23 17:40:43 UTC (rev 2438)
@@ -1335,12 +1335,24 @@
function DynArrayCompareCardinal(Item1, Item2: Pointer): Integer;
begin
- Result := PInteger(Item1)^ - PInteger(Item2)^;
+ if PCardinal(Item1)^ < PCardinal(Item2)^ then
+ Result := -1
+ else
+ if PCardinal(Item1)^ > PCardinal(Item2)^ then
+ Result := 1
+ else
+ Result := 0;
end;
function DynArrayCompareInt64(Item1, Item2: Pointer): Integer;
begin
- Result := PInt64(Item1)^ - PInt64(Item2)^;
+ if PInt64(Item1)^ < PInt64(Item2)^ then
+ Result := -1
+ else
+ if PInt64(Item1)^ > PInt64(Item2)^ then
+ Result := 1
+ else
+ Result := 0;
end;
function DynArrayCompareSingle(Item1, Item2: Pointer): Integer;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ou...@us...> - 2009-01-08 18:16:25
|
Revision: 2586
http://jcl.svn.sourceforge.net/jcl/?rev=2586&view=rev
Author: outchy
Date: 2009-01-08 18:16:21 +0000 (Thu, 08 Jan 2009)
Log Message:
-----------
Mantis 4649: GetImplementorOfInterface() should use PByte rather than PChar.
Modified Paths:
--------------
trunk/jcl/source/common/JclSysUtils.pas
Modified: trunk/jcl/source/common/JclSysUtils.pas
===================================================================
--- trunk/jcl/source/common/JclSysUtils.pas 2009-01-08 18:01:49 UTC (rev 2585)
+++ trunk/jcl/source/common/JclSysUtils.pas 2009-01-08 18:16:21 UTC (rev 2586)
@@ -1948,9 +1948,9 @@
QueryInterfaceThunk := TInterfaceRef(I)^.QueryInterfaceThunk;
case QueryInterfaceThunk.AddInstruction of
AddByte:
- Inc(PChar(Result), QueryInterfaceThunk.AdjustmentByte);
+ Inc(PByte(Result), QueryInterfaceThunk.AdjustmentByte);
AddLong:
- Inc(PChar(Result), QueryInterfaceThunk.AdjustmentLong);
+ Inc(PByte(Result), QueryInterfaceThunk.AdjustmentLong);
else
Result := nil;
end;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ou...@us...> - 2009-01-08 18:20:57
|
Revision: 2587
http://jcl.svn.sourceforge.net/jcl/?rev=2587&view=rev
Author: outchy
Date: 2009-01-08 18:20:51 +0000 (Thu, 08 Jan 2009)
Log Message:
-----------
PByte should be used for typing arithmetic operations on pointers.
Modified Paths:
--------------
trunk/jcl/source/common/JclSysUtils.pas
Modified: trunk/jcl/source/common/JclSysUtils.pas
===================================================================
--- trunk/jcl/source/common/JclSysUtils.pas 2009-01-08 18:16:21 UTC (rev 2586)
+++ trunk/jcl/source/common/JclSysUtils.pas 2009-01-08 18:20:51 UTC (rev 2587)
@@ -670,7 +670,7 @@
if APointer <> nil then
begin
U := APointer;
- U := PUsed(PChar(U) - SizeOf(TUsed));
+ U := PUsed(PByte(U) - SizeOf(TUsed));
if (U.SizeFlags and cThisUsedFlag) <> 0 then
Result := (U.SizeFlags) and (not cFlags - SizeOf(TUsed));
end;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ou...@us...> - 2009-01-08 18:22:58
|
Revision: 2588
http://jcl.svn.sourceforge.net/jcl/?rev=2588&view=rev
Author: outchy
Date: 2009-01-08 18:22:54 +0000 (Thu, 08 Jan 2009)
Log Message:
-----------
Revision 2587 did not compile.
Revision Links:
--------------
http://jcl.svn.sourceforge.net/jcl/?rev=2587&view=rev
Modified Paths:
--------------
trunk/jcl/source/common/JclSysUtils.pas
Modified: trunk/jcl/source/common/JclSysUtils.pas
===================================================================
--- trunk/jcl/source/common/JclSysUtils.pas 2009-01-08 18:20:51 UTC (rev 2587)
+++ trunk/jcl/source/common/JclSysUtils.pas 2009-01-08 18:22:54 UTC (rev 2588)
@@ -670,7 +670,7 @@
if APointer <> nil then
begin
U := APointer;
- U := PUsed(PByte(U) - SizeOf(TUsed));
+ U := PUsed(Cardinal(U) - SizeOf(TUsed));
if (U.SizeFlags and cThisUsedFlag) <> 0 then
Result := (U.SizeFlags) and (not cFlags - SizeOf(TUsed));
end;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <usc...@us...> - 2009-03-15 10:22:18
|
Revision: 2685
http://jcl.svn.sourceforge.net/jcl/?rev=2685&view=rev
Author: uschuster
Date: 2009-03-15 10:22:16 +0000 (Sun, 15 Mar 2009)
Log Message:
-----------
fixed Execute for D2009 (CreateProcessW requires a writeable commandline parameter otherwise an access violation will occur)
Modified Paths:
--------------
trunk/jcl/source/common/JclSysUtils.pas
Modified: trunk/jcl/source/common/JclSysUtils.pas
===================================================================
--- trunk/jcl/source/common/JclSysUtils.pas 2009-03-14 15:06:08 UTC (rev 2684)
+++ trunk/jcl/source/common/JclSysUtils.pas 2009-03-15 10:22:16 UTC (rev 2685)
@@ -2523,6 +2523,7 @@
ProcessInfo: TProcessInformation;
SecurityAttr: TSecurityAttributes;
PipeRead, PipeWrite: THandle;
+ WriteableCommandLine: array [0..1024] of Char;
begin
Result := $FFFFFFFF;
SecurityAttr.nLength := SizeOf(SecurityAttr);
@@ -2540,7 +2541,8 @@
StartupInfo.hStdInput := GetStdHandle(STD_INPUT_HANDLE);
StartupInfo.hStdOutput := PipeWrite;
StartupInfo.hStdError := PipeWrite;
- if CreateProcess(nil, PChar(CommandLine), nil, nil, True, NORMAL_PRIORITY_CLASS,
+ StrPCopy(WriteableCommandLine, CommandLine);
+ if CreateProcess(nil, @WriteableCommandLine, nil, nil, True, NORMAL_PRIORITY_CLASS,
nil, nil, StartupInfo, ProcessInfo) then
begin
CloseHandle(PipeWrite);
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ah...@us...> - 2009-03-16 16:50:07
|
Revision: 2692
http://jcl.svn.sourceforge.net/jcl/?rev=2692&view=rev
Author: ahuser
Date: 2009-03-16 16:50:01 +0000 (Mon, 16 Mar 2009)
Log Message:
-----------
Fixed memory overwrite when command line exceeds 1024 chars.
Modified Paths:
--------------
trunk/jcl/source/common/JclSysUtils.pas
Modified: trunk/jcl/source/common/JclSysUtils.pas
===================================================================
--- trunk/jcl/source/common/JclSysUtils.pas 2009-03-15 20:48:11 UTC (rev 2691)
+++ trunk/jcl/source/common/JclSysUtils.pas 2009-03-16 16:50:01 UTC (rev 2692)
@@ -2475,7 +2475,7 @@
SetLength(Result, OutPos - 1);
end;
-function InternalExecute(const CommandLine: string; var Output: string; OutputLineCallback: TTextHandler;
+function InternalExecute(CommandLine: string; var Output: string; OutputLineCallback: TTextHandler;
RawOutput: Boolean; AbortPtr: PBoolean): Cardinal;
const
BufferSize = 255;
@@ -2523,7 +2523,6 @@
ProcessInfo: TProcessInformation;
SecurityAttr: TSecurityAttributes;
PipeRead, PipeWrite: THandle;
- WriteableCommandLine: array [0..1024] of Char;
begin
Result := $FFFFFFFF;
SecurityAttr.nLength := SizeOf(SecurityAttr);
@@ -2541,8 +2540,8 @@
StartupInfo.hStdInput := GetStdHandle(STD_INPUT_HANDLE);
StartupInfo.hStdOutput := PipeWrite;
StartupInfo.hStdError := PipeWrite;
- StrPCopy(WriteableCommandLine, CommandLine);
- if CreateProcess(nil, @WriteableCommandLine, nil, nil, True, NORMAL_PRIORITY_CLASS,
+ UniqueString(CommandLine); // CommandLine must be in a writable memory block
+ if CreateProcess(nil, PChar(CommandLine), nil, nil, True, NORMAL_PRIORITY_CLASS,
nil, nil, StartupInfo, ProcessInfo) then
begin
CloseHandle(PipeWrite);
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ou...@us...> - 2009-05-30 15:00:54
|
Revision: 2784
http://jcl.svn.sourceforge.net/jcl/?rev=2784&view=rev
Author: outchy
Date: 2009-05-30 15:00:45 +0000 (Sat, 30 May 2009)
Log Message:
-----------
Mantis 4775: TJclSysUtils.TJclSimplelog.TimeWrite is not "unicoded".
Modified Paths:
--------------
trunk/jcl/source/common/JclSysUtils.pas
Modified: trunk/jcl/source/common/JclSysUtils.pas
===================================================================
--- trunk/jcl/source/common/JclSysUtils.pas 2009-05-30 14:48:01 UTC (rev 2783)
+++ trunk/jcl/source/common/JclSysUtils.pas 2009-05-30 15:00:45 UTC (rev 2784)
@@ -3211,6 +3211,7 @@
procedure TJclSimpleLog.TimeWrite(const Text: string; Indent: Integer = 0);
var
S: string;
+ UTF8S: TUTF8String;
SL: TStringList;
I: Integer;
begin
@@ -3222,7 +3223,8 @@
for I := 0 to SL.Count - 1 do
begin
S := DateTimeToStr(Now)+' : '+StringOfChar(' ', Indent) + StrEnsureSuffix(NativeLineBreak, TrimRight(SL[I]));
- FileWrite(FLogFileHandle, Pointer(S)^, Length(S));
+ UTF8S := StringToUTF8(S);
+ FileWrite(FLogFileHandle, UTF8S[1], Length(UTF8S));
end;
finally
SL.Free;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ah...@us...> - 2009-06-06 16:15:06
|
Revision: 2793
http://jcl.svn.sourceforge.net/jcl/?rev=2793&view=rev
Author: ahuser
Date: 2009-06-06 16:15:05 +0000 (Sat, 06 Jun 2009)
Log Message:
-----------
Fixed UnitVersioning crash on program termination caused by JclSysUtils.finalization
Modified Paths:
--------------
trunk/jcl/source/common/JclSysUtils.pas
Modified: trunk/jcl/source/common/JclSysUtils.pas
===================================================================
--- trunk/jcl/source/common/JclSysUtils.pas 2009-06-06 10:04:54 UTC (rev 2792)
+++ trunk/jcl/source/common/JclSysUtils.pas 2009-06-06 16:15:05 UTC (rev 2793)
@@ -143,7 +143,7 @@
{ SharedGetMem return ERROR_ALREADY_EXISTS if the shared memory is already
allocated, otherwise it returns 0.
Throws ESharedMemError if the Name is invalid. }
-function SharedGetMem(var p{: Pointer}; const Name: string; Size: Cardinal;
+function SharedGetMem(var P{: Pointer}; const Name: string; Size: Cardinal;
DesiredAccess: Cardinal = FILE_MAP_ALL_ACCESS): Integer;
{ SharedAllocMem calls SharedGetMem and then fills the memory with zero if
@@ -153,7 +153,7 @@
DesiredAccess: Cardinal = FILE_MAP_ALL_ACCESS): Pointer;
{ SharedFreeMem releases the shared memory if it was the last reference. }
-function SharedFreeMem(var p{: Pointer}): Boolean;
+function SharedFreeMem(var P{: Pointer}): Boolean;
// Functions for the shared memory user
@@ -161,7 +161,7 @@
SharedGetMem or SharedAllocMem. Otherwise it returns False.
Throws ESharedMemError if the Name is invalid. }
-function SharedOpenMem(var p{: Pointer}; const Name: string;
+function SharedOpenMem(var P{: Pointer}; const Name: string;
DesiredAccess: Cardinal = FILE_MAP_ALL_ACCESS): Boolean; overload;
{ SharedOpenMem return nil if the shared memory was not already allocated
@@ -171,7 +171,7 @@
DesiredAccess: Cardinal = FILE_MAP_ALL_ACCESS): Pointer; overload;
{ SharedCloseMem releases the shared memory if it was the last reference. }
-function SharedCloseMem(var p{: Pointer}): Boolean;
+function SharedCloseMem(var P{: Pointer}): Boolean;
{$ENDIF MSWINDOWS}
@@ -983,22 +983,35 @@
var
MMFHandleList: PMMFHandleList = nil;
+ MMFFinalized: Boolean = False;
{$IFDEF THREADSAFE}
GlobalMMFHandleListCS: TJclIntfCriticalSection = nil;
{$ENDIF THREADSAGE}
{$IFDEF THREADSAFE}
function GetAccessToHandleList: IInterface;
+var
+ OldValue: Pointer;
+ CS: TJclIntfCriticalSection;
begin
- if not Assigned(GlobalMMFHandleListCS) then
- GlobalMMFHandleListCS := TJclIntfCriticalSection.Create;
+ if not Assigned(GlobalMMFHandleListCS) and not MMFFinalized then
+ begin
+ CS := TJclIntfCriticalSection.Create;
+ {$IFDEF RTL185_UP}
+ OldValue := InterlockedCompareExchangePointer(Pointer(GlobalMMFHandleListCS), Pointer(CS), nil);
+ {$ELSE}
+ OldValue := Pointer(InterlockedCompareExchange(Integer(GlobalMMFHandleListCS), Integer(CS), 0));
+ {$ENDIF RTL185_UP}
+ if OldValue <> nil then
+ CS.Free;
+ end;
Result := GlobalMMFHandleListCS;
end;
{$ENDIF THREADSAFE}
{$IFDEF MSWINDOWS}
-function SharedGetMem(var p{: Pointer}; const Name: string; Size: Cardinal;
+function SharedGetMem(var P{: Pointer}; const Name: string; Size: Cardinal;
DesiredAccess: Cardinal = FILE_MAP_ALL_ACCESS): Integer;
var
FileMappingHandle: THandle;
@@ -1009,11 +1022,10 @@
{$ENDIF THREADSAFE}
begin
Result := 0;
- Pointer(p) := nil;
+ Pointer(P) := nil;
- if (GetWindowsVersion in [wvUnknown..wvWinNT4]) and
- ((Name = '') or (Pos('\', Name) > 0)) then
- raise ESharedMemError.CreateResFmt(@RsInvalidMMFName, [Name]);
+ if (GetWindowsVersion in [wvUnknown..wvWinNT4]) and ((Name = '') or (Pos('\', Name) > 0)) then
+ raise ESharedMemError.CreateResFmt(@RsInvalidMMFName, [Name]);
{$IFDEF THREADSAFE}
HandleListAccess := GetAccessToHandleList;
@@ -1026,7 +1038,7 @@
if CompareText(Iterate^.Name, Name) = 0 then
begin
Inc(Iterate^.References);
- Pointer(p) := Iterate^.Memory;
+ Pointer(P) := Iterate^.Memory;
Result := ERROR_ALREADY_EXISTS;
Exit;
end;
@@ -1041,8 +1053,7 @@
raise ESharedMemError.CreateResFmt(@RsInvalidMMFEmpty, [Name]);
Protect := PAGE_READWRITE;
- if (Win32Platform = VER_PLATFORM_WIN32_WINDOWS) and
- (DesiredAccess = FILE_MAP_COPY) then
+ if (Win32Platform = VER_PLATFORM_WIN32_WINDOWS) and (DesiredAccess = FILE_MAP_COPY) then
Protect := PAGE_WRITECOPY;
FileMappingHandle := CreateFileMapping(INVALID_HANDLE_VALUE, nil, Protect,
@@ -1051,10 +1062,10 @@
else
Result := ERROR_ALREADY_EXISTS;
- case GetLastError of
- ERROR_ALREADY_EXISTS:
- Result := ERROR_ALREADY_EXISTS;
+ if GetLastError = ERROR_ALREADY_EXISTS then
+ Result := ERROR_ALREADY_EXISTS
else
+ begin
if FileMappingHandle = 0 then
{$IFDEF COMPILER6_UP}
RaiseLastOSError;
@@ -1064,8 +1075,8 @@
end;
// map view
- Pointer(p) := MapViewOfFile(FileMappingHandle, DesiredAccess, 0, 0, Size);
- if Pointer(p) = nil then
+ Pointer(P) := MapViewOfFile(FileMappingHandle, DesiredAccess, 0, 0, Size);
+ if Pointer(P) = nil then
begin
try
{$IFDEF COMPILER6_UP}
@@ -1083,7 +1094,7 @@
New(NewListItem);
NewListItem^.Name := Name;
NewListItem^.Handle := FileMappingHandle;
- NewListItem^.Memory := Pointer(p);
+ NewListItem^.Memory := Pointer(P);
NewListItem^.References := 1;
NewListItem^.Next := MMFHandleList;
@@ -1099,29 +1110,29 @@
FillChar(Pointer(Result)^, Size, 0);
end;
-function SharedFreeMem(var p{: Pointer}): Boolean;
+function SharedFreeMem(var P{: Pointer}): Boolean;
var
- n, Iterate: PMMFHandleListItem;
+ N, Iterate: PMMFHandleListItem;
{$IFDEF THREADSAFE}
HandleListAccess: IInterface;
{$ENDIF THREADSAFE}
begin
- if Pointer(p) <> nil then
+ if Pointer(P) <> nil then
begin
Result := False;
{$IFDEF THREADSAFE}
HandleListAccess := GetAccessToHandleList;
{$ENDIF THREADSAFE}
Iterate := MMFHandleList;
- n := nil;
+ N := nil;
while Iterate <> nil do
begin
- if Iterate^.Memory = Pointer(p) then
+ if Iterate^.Memory = Pointer(P) then
begin
if Iterate^.References > 1 then
begin
Dec(Iterate^.References);
- Pointer(p) := nil;
+ Pointer(P) := nil;
Result := True;
Exit;
end;
@@ -1129,17 +1140,17 @@
UnmapViewOfFile(Iterate^.Memory);
CloseHandle(Iterate^.Handle);
- if n = nil then
+ if N = nil then
MMFHandleList := Iterate^.Next
else
- n^.Next := Iterate^.Next;
+ N^.Next := Iterate^.Next;
Dispose(Iterate);
- Pointer(p) := nil;
+ Pointer(P) := nil;
Result := True;
Break;
end;
- n := Iterate;
+ N := Iterate;
Iterate := Iterate^.Next;
end;
end
@@ -1147,10 +1158,10 @@
Result := True;
end;
-function SharedOpenMem(var p{: Pointer}; const Name: string;
+function SharedOpenMem(var P{: Pointer}; const Name: string;
DesiredAccess: Cardinal = FILE_MAP_ALL_ACCESS): Boolean;
begin
- Result := SharedGetMem(p, Name, 0, DesiredAccess) = ERROR_ALREADY_EXISTS;
+ Result := SharedGetMem(P, Name, 0, DesiredAccess) = ERROR_ALREADY_EXISTS;
end;
function SharedOpenMem(const Name: string;
@@ -1159,33 +1170,11 @@
SharedGetMem(Result, Name, 0, DesiredAccess);
end;
-function SharedCloseMem(var p{: Pointer}): Boolean;
+function SharedCloseMem(var P{: Pointer}): Boolean;
begin
- Result := SharedFreeMem(p);
+ Result := SharedFreeMem(P);
end;
-procedure FinalizeMMFHandleList;
-var
- NextItem, Iterate: PMMFHandleList;
- {$IFDEF THREADSAFE}
- HandleListAccess: IInterface;
- {$ENDIF THREADSAFE}
-begin
- {$IFDEF THREADSAFE}
- HandleListAccess := GetAccessToHandleList;
- {$ENDIF THREADSAFE}
- Iterate := MMFHandleList;
- while Iterate <> nil do
- begin
- UnmapViewOfFile(Iterate^.Memory);
- CloseHandle(Iterate^.Handle);
-
- NextItem := Iterate^.Next;
- Dispose(Iterate);
- Iterate := NextItem;
- end;
-end;
-
{$ENDIF MSWINDOWS}
//=== Binary search ==========================================================
@@ -3265,12 +3254,6 @@
initialization
{$IFNDEF CLR}
SimpleLog := nil;
- {$IFDEF MSWINDOWS}
- {$IFDEF THREADSAFE}
- if not Assigned(GlobalMMFHandleListCS) then
- GlobalMMFHandleListCS := TJclIntfCriticalSection.Create;
- {$ENDIF THREADSAFE}
- {$ENDIF MSWINDOWS}
{$ENDIF ~CLR}
{$IFDEF UNITVERSIONING}
RegisterUnitVersion(HInstance, UnitVersioning);
@@ -3282,8 +3265,11 @@
{$ENDIF UNITVERSIONING}
{$IFNDEF CLR}
{$IFDEF MSWINDOWS}
- FinalizeMMFHandleList;
{$IFDEF THREADSAFE}
+ // The user must release shared memory blocks himself. We don't clean up his
+ // memory leaks and make it impossible to release the shared memory in other
+ // unit's finalization blocks.
+ MMFFinalized := True;
FreeAndNil(GlobalMMFHandleListCS);
{$ENDIF THREADSAFE}
{$ENDIF MSWINDOWS}
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ah...@us...> - 2009-06-06 16:27:17
|
Revision: 2794
http://jcl.svn.sourceforge.net/jcl/?rev=2794&view=rev
Author: ahuser
Date: 2009-06-06 16:27:16 +0000 (Sat, 06 Jun 2009)
Log Message:
-----------
Fixed Delphi 6 support
Modified Paths:
--------------
trunk/jcl/source/common/JclSysUtils.pas
Modified: trunk/jcl/source/common/JclSysUtils.pas
===================================================================
--- trunk/jcl/source/common/JclSysUtils.pas 2009-06-06 16:15:05 UTC (rev 2793)
+++ trunk/jcl/source/common/JclSysUtils.pas 2009-06-06 16:27:16 UTC (rev 2794)
@@ -997,10 +997,14 @@
if not Assigned(GlobalMMFHandleListCS) and not MMFFinalized then
begin
CS := TJclIntfCriticalSection.Create;
- {$IFDEF RTL185_UP}
+ {$IFDEF RTL200_UP} // Delphi 2009+
OldValue := InterlockedCompareExchangePointer(Pointer(GlobalMMFHandleListCS), Pointer(CS), nil);
{$ELSE}
- OldValue := Pointer(InterlockedCompareExchange(Integer(GlobalMMFHandleListCS), Integer(CS), 0));
+ {$IFDEF RTL160_UP} // Delphi 7-2007
+ OldValue := Pointer(InterlockedCompareExchange(Longint(GlobalMMFHandleListCS), Longint(CS), 0));
+ {$ELSE} // Delphi 5, 6
+ OldValue := InterlockedCompareExchange(Pointer(GlobalMMFHandleListCS), Pointer(CS), 0);
+ {$ENDIF RTL180_UP}
{$ENDIF RTL185_UP}
if OldValue <> nil then
CS.Free;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ou...@us...> - 2009-06-22 17:30:03
|
Revision: 2819
http://jcl.svn.sourceforge.net/jcl/?rev=2819&view=rev
Author: outchy
Date: 2009-06-22 17:29:52 +0000 (Mon, 22 Jun 2009)
Log Message:
-----------
Make Doc-o-matic happy.
Modified Paths:
--------------
trunk/jcl/source/common/JclSysUtils.pas
Modified: trunk/jcl/source/common/JclSysUtils.pas
===================================================================
--- trunk/jcl/source/common/JclSysUtils.pas 2009-06-22 17:04:44 UTC (rev 2818)
+++ trunk/jcl/source/common/JclSysUtils.pas 2009-06-22 17:29:52 UTC (rev 2819)
@@ -109,7 +109,8 @@
function GuardGetMem(Size: Cardinal; out SafeGuard: ISafeGuard): Pointer;
function GuardAllocMem(Size: Cardinal; out SafeGuard: ISafeGuard): Pointer;
-{$IFDEF SUPPORTS_GENERICS_}
+(*
+{$IFDEF SUPPORTS_GENERICS}
type
ISafeGuard<T: class> = interface
function ReleaseItem: T;
@@ -130,7 +131,8 @@
public
class function New(Instance: T): ISafeGuard<T>; static;
end;
-{$ENDIF SUPPORTS_GENERICS_}
+{$ENDIF SUPPORTS_GENERICS}
+*)
{ Shared memory between processes functions }
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <jfu...@us...> - 2009-08-04 19:40:18
|
Revision: 2910
http://jcl.svn.sourceforge.net/jcl/?rev=2910&view=rev
Author: jfudickar
Date: 2009-08-04 19:40:10 +0000 (Tue, 04 Aug 2009)
Log Message:
-----------
Slightly improved TJclSimpleLog
Modified Paths:
--------------
trunk/jcl/source/common/JclSysUtils.pas
Modified: trunk/jcl/source/common/JclSysUtils.pas
===================================================================
--- trunk/jcl/source/common/JclSysUtils.pas 2009-08-04 17:34:37 UTC (rev 2909)
+++ trunk/jcl/source/common/JclSysUtils.pas 2009-08-04 19:40:10 UTC (rev 2910)
@@ -563,8 +563,10 @@
type
TJclSimpleLog = class (TObject)
private
+ FDateTimeFormatStr: String;
FLogFileHandle: Integer;
FLogFileName: string;
+ FLoggingActive: Boolean;
FLogWasEmpty: Boolean;
function GetLogOpen: Boolean;
protected
@@ -575,18 +577,23 @@
procedure ClearLog;
procedure CloseLog;
procedure OpenLog;
- procedure Write(const Text: string; Indent: Integer = 0); overload;
- procedure Write(Strings: TStrings; Indent: Integer = 0); overload;
+ procedure Write(const Text: string; Indent: Integer = 0; KeepOpen: Boolean = true); overload;
+ procedure Write(Strings: TStrings; Indent: Integer = 0; KeepOpen: Boolean = true); overload;
//Writes a line to the log file. The current timestamp is written before the line.
- procedure TimeWrite(const Text: string; Indent: Integer = 0); overload;
- procedure TimeWrite(Strings: TStrings; Indent: Integer = 0); overload;
- procedure WriteStamp(SeparatorLen: Integer = 0);
+ procedure TimeWrite(const Text: string; Indent: Integer = 0; KeepOpen: Boolean = true); overload;
+ procedure TimeWrite(Strings: TStrings; Indent: Integer = 0; KeepOpen: Boolean = true); overload;
+ procedure WriteStamp(SeparatorLen: Integer = 0; KeepOpen: Boolean = true);
+ // DateTimeFormatStr property assumes the values described in "FormatDateTime Function" in Delphi Help
+ property DateTimeFormatStr: String read FDateTimeFormatStr write FDateTimeFormatStr;
property LogFileName: string read FLogFileName;
+ //1 Property to activate / deactivate the logging
+ property LoggingActive: Boolean read FLoggingActive write FLoggingActive default True;
property LogOpen: Boolean read GetLogOpen;
+ published
end;
// Procedure to initialize the SimpleLog Variable
-procedure InitSimpleLog (const ALogFileName: string = '');
+procedure InitSimpleLog(const ALogFileName: string = ''; AOpenLog: Boolean = true);
// Global Variable to make it easier for an application wide log handling.
// Must be initialized with InitSimpleLog before using
@@ -3087,13 +3094,14 @@
INVALID_HANDLE_VALUE = 0;
{$ENDIF LINUX}
-constructor TJclSimpleLog.Create(const ALogFileName: string);
+constructor TJclSimpleLog.Create(const ALogFileName: string = '');
begin
if ALogFileName = '' then
FLogFileName := CreateDefaultFileName
else
FLogFileName := ALogFileName;
DWORD_PTR(FLogFileHandle) := INVALID_HANDLE_VALUE;
+ FLoggingActive := True;
end;
function TJclSimpleLog.CreateDefaultFileName: string;
@@ -3109,10 +3117,15 @@
end;
procedure TJclSimpleLog.ClearLog;
+var
+ WasOpen: Boolean;
begin
+ WasOpen := LogOpen;
CloseLog;
FLogFileHandle := FileCreate(FLogFileName);
FLogWasEmpty := True;
+ if Not WasOpen then
+ CloseLog;
end;
procedure TJclSimpleLog.CloseLog;
@@ -3149,88 +3162,124 @@
FLogWasEmpty := False;
end;
-procedure TJclSimpleLog.Write(const Text: string; Indent: Integer);
+procedure TJclSimpleLog.Write(const Text: string; Indent: Integer = 0; KeepOpen: Boolean = true);
var
S: string;
UTF8S: TUTF8String;
SL: TStringList;
I: Integer;
+ WasOpen: Boolean;
begin
- if LogOpen then
+ if LoggingActive then
begin
- SL := TStringList.Create;
- try
- SL.Text := Text;
- for I := 0 to SL.Count - 1 do
- begin
- S := StringOfChar(' ', Indent) + StrEnsureSuffix(NativeLineBreak, TrimRight(SL[I]));
- UTF8S := StringToUTF8(S);
- FileWrite(FLogFileHandle, UTF8S[1], Length(UTF8S));
+ WasOpen := LogOpen;
+ if not WasOpen then
+ OpenLog;
+ if LogOpen then
+ begin
+ SL := TStringList.Create;
+ try
+ SL.Text := Text;
+ for I := 0 to SL.Count - 1 do
+ begin
+ S := StringOfChar(' ', Indent) + StrEnsureSuffix(NativeLineBreak, TrimRight(SL[I]));
+ UTF8S := StringToUTF8(S);
+ FileWrite(FLogFileHandle, UTF8S[1], Length(UTF8S));
+ end;
+ finally
+ SL.Free;
end;
- finally
- SL.Free;
+ // Keep the logfile Open when it was opened before and the KeepOpen is active
+ if Not (WasOpen and KeepOpen) then
+ CloseLog;
end;
end;
end;
-procedure TJclSimpleLog.Write(Strings: TStrings; Indent: Integer);
-var
- I: Integer;
+procedure TJclSimpleLog.Write(Strings: TStrings; Indent: Integer = 0; KeepOpen: Boolean = true);
begin
- for I := 0 to Strings.Count - 1 do
- Write(Strings[I], Indent);
+ if Assigned(Strings) then
+ Write(Strings.Text, Indent, KeepOpen);
end;
-procedure TJclSimpleLog.TimeWrite(const Text: string; Indent: Integer = 0);
+procedure TJclSimpleLog.TimeWrite(const Text: string; Indent: Integer = 0; KeepOpen: Boolean = true);
var
S: string;
UTF8S: TUTF8String;
SL: TStringList;
I: Integer;
+ WasOpen: Boolean;
begin
- if LogOpen then
+ if LoggingActive then
begin
- SL := TStringList.Create;
- try
- SL.Text := Text;
- for I := 0 to SL.Count - 1 do
- begin
- S := DateTimeToStr(Now)+' : '+StringOfChar(' ', Indent) + StrEnsureSuffix(NativeLineBreak, TrimRight(SL[I]));
- UTF8S := StringToUTF8(S);
- FileWrite(FLogFileHandle, UTF8S[1], Length(UTF8S));
+ WasOpen := LogOpen;
+ if not LogOpen then
+ OpenLog;
+ if LogOpen then
+ begin
+ SL := TStringList.Create;
+ try
+ SL.Text := Text;
+ for I := 0 to SL.Count - 1 do
+ begin
+ if DateTimeFormatStr = '' then
+ S := DateTimeToStr(Now)+' : '+StringOfChar(' ', Indent) + StrEnsureSuffix(NativeLineBreak, TrimRight(SL[I]))
+ else
+ S := FormatDateTime( DateTimeFormatStr, Now)+' : '+StringOfChar(' ', Indent) + StrEnsureSuffix(NativeLineBreak, TrimRight(SL[I]));
+ UTF8S := StringToUTF8(S);
+ FileWrite(FLogFileHandle, UTF8S[1], Length(UTF8S));
+ end;
+ finally
+ SL.Free;
end;
- finally
- SL.Free;
+ if Not WasOpen and Not KeepOpen then
+ CloseLog;
end;
end;
end;
-procedure TJclSimpleLog.TimeWrite(Strings: TStrings; Indent: Integer = 0);
-var
- I: Integer;
+procedure TJclSimpleLog.TimeWrite(Strings: TStrings; Indent: Integer = 0; KeepOpen: Boolean = true);
begin
- for I := 0 to Strings.Count - 1 do
- TimeWrite(Strings[I], Indent);
+ if Assigned(Strings) then
+ TimeWrite(Strings.Text, Indent, KeepOpen);
end;
-procedure TJclSimpleLog.WriteStamp(SeparatorLen: Integer);
+procedure TJclSimpleLog.WriteStamp(SeparatorLen: Integer = 0; KeepOpen: Boolean = true);
+var
+ WasOpen: Boolean;
begin
- if SeparatorLen = 0 then
+ if SeparatorLen <= 0 then
SeparatorLen := 40;
- OpenLog;
- if not FLogWasEmpty then
- Write(NativeLineBreak);
- Write(StrRepeat('=', SeparatorLen));
- Write(Format('= %-*s =', [SeparatorLen - 4, DateTimeToStr(Now)]));
- Write(StrRepeat('=', SeparatorLen));
+ if LoggingActive then
+ begin
+ WasOpen := LogOpen;
+ if not LogOpen then
+ begin
+ OpenLog;
+ if LogOpen and not FLogWasEmpty then
+ Write(NativeLineBreak);
+ end;
+ if LogOpen then
+ begin
+ Write(StrRepeat('=', SeparatorLen), 0, True);
+ if DateTimeFormatStr = '' then
+ Write(Format('= %-*s =', [SeparatorLen - 4, DateTimeToStr(Now)]), 0, True)
+ else
+ Write(Format('= %-*s =', [SeparatorLen - 4, FormatDateTime( DateTimeFormatStr, Now)]), 0, True);
+ Write(StrRepeat('=', SeparatorLen), 0, True);
+ if Not WasOpen and Not KeepOpen then
+ CloseLog;
+ end;
+ end;
end;
-procedure InitSimpleLog (const ALogFileName: string = '');
+procedure InitSimpleLog(const ALogFileName: string = ''; AOpenLog: Boolean = true);
begin
if Assigned(SimpleLog) then
FreeAndNil(SimpleLog);
SimpleLog := TJclSimpleLog.Create(ALogFileName);
- SimpleLog.OpenLog;
+ if AOpenLog then
+ SimpleLog.OpenLog;
end;
initialization
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <jfu...@us...> - 2009-08-04 20:19:02
|
Revision: 2911
http://jcl.svn.sourceforge.net/jcl/?rev=2911&view=rev
Author: jfudickar
Date: 2009-08-04 20:18:56 +0000 (Tue, 04 Aug 2009)
Log Message:
-----------
TJclSimpleLog.ClearLog only creates a file when the file exists before
Modified Paths:
--------------
trunk/jcl/source/common/JclSysUtils.pas
Modified: trunk/jcl/source/common/JclSysUtils.pas
===================================================================
--- trunk/jcl/source/common/JclSysUtils.pas 2009-08-04 19:40:10 UTC (rev 2910)
+++ trunk/jcl/source/common/JclSysUtils.pas 2009-08-04 20:18:56 UTC (rev 2911)
@@ -3121,7 +3121,10 @@
WasOpen: Boolean;
begin
WasOpen := LogOpen;
- CloseLog;
+ if WasOpen then
+ CloseLog;
+ if not FileExists(FlogFileName) then
+ Exit;
FLogFileHandle := FileCreate(FLogFileName);
FLogWasEmpty := True;
if Not WasOpen then
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ou...@us...> - 2009-08-05 10:16:01
|
Revision: 2913
http://jcl.svn.sourceforge.net/jcl/?rev=2913&view=rev
Author: outchy
Date: 2009-08-05 10:15:53 +0000 (Wed, 05 Aug 2009)
Log Message:
-----------
the keyword "published" force RTTI information to be created, this is not required in this class.
Modified Paths:
--------------
trunk/jcl/source/common/JclSysUtils.pas
Modified: trunk/jcl/source/common/JclSysUtils.pas
===================================================================
--- trunk/jcl/source/common/JclSysUtils.pas 2009-08-05 10:14:34 UTC (rev 2912)
+++ trunk/jcl/source/common/JclSysUtils.pas 2009-08-05 10:15:53 UTC (rev 2913)
@@ -589,7 +589,6 @@
//1 Property to activate / deactivate the logging
property LoggingActive: Boolean read FLoggingActive write FLoggingActive default True;
property LogOpen: Boolean read GetLogOpen;
- published
end;
// Procedure to initialize the SimpleLog Variable
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ou...@us...> - 2009-08-09 16:29:06
|
Revision: 2928
http://jcl.svn.sourceforge.net/jcl/?rev=2928&view=rev
Author: outchy
Date: 2009-08-09 16:29:00 +0000 (Sun, 09 Aug 2009)
Log Message:
-----------
always close the pipes and terminate the process when an exception is raised from the callback event.
Modified Paths:
--------------
trunk/jcl/source/common/JclSysUtils.pas
Modified: trunk/jcl/source/common/JclSysUtils.pas
===================================================================
--- trunk/jcl/source/common/JclSysUtils.pas 2009-08-09 16:27:13 UTC (rev 2927)
+++ trunk/jcl/source/common/JclSysUtils.pas 2009-08-09 16:29:00 UTC (rev 2928)
@@ -2527,47 +2527,49 @@
function InternalExecute(CommandLine: string; var Output: string; OutputLineCallback: TTextHandler;
RawOutput: Boolean; AbortPtr: PBoolean): Cardinal;
+
const
BufferSize = 255;
-var
- Buffer: array [0..BufferSize] of AnsiChar;
- TempOutput: string;
- PipeBytesRead: Cardinal;
+type
+ TBuffer = array [0..BufferSize] of AnsiChar;
- procedure ProcessLine(LineEnd: Integer);
+ procedure ProcessLine(const Line: string; LineEnd: Integer);
begin
- if RawOutput or (TempOutput[LineEnd] <> NativeCarriageReturn) then
+ if RawOutput or (Line[LineEnd] <> NativeCarriageReturn) then
begin
- while (LineEnd > 0) and CharIsReturn(TempOutput[LineEnd]) do
+ while (LineEnd > 0) and CharIsReturn(Line[LineEnd]) do
Dec(LineEnd);
- OutputLineCallback(Copy(TempOutput, 1, LineEnd));
+ OutputLineCallback(Copy(Line, 1, LineEnd));
end;
end;
- procedure ProcessBuffer;
+ procedure ProcessBuffer(var Buffer: TBuffer; var Line: string; PipeBytesRead: Cardinal);
var
CR, LF: Integer;
begin
Buffer[PipeBytesRead] := #0;
- TempOutput := TempOutput + string(Buffer);
+ Line := Line + string(Buffer);
if Assigned(OutputLineCallback) then
repeat
- CR := Pos(NativeCarriageReturn, TempOutput);
- if CR = Length(TempOutput) then
+ CR := Pos(NativeCarriageReturn, Line);
+ if CR = Length(Line) then
CR := 0; // line feed at CR + 1 might be missing
- LF := Pos(NativeLineFeed, TempOutput);
+ LF := Pos(NativeLineFeed, Line);
if (CR > 0) and ((LF > CR + 1) or (LF = 0)) then
LF := CR; // accept CR as line end
if LF > 0 then
begin
- ProcessLine(LF);
- Delete(TempOutput, 1, LF);
+ ProcessLine(Line, LF);
+ Delete(Line, 1, LF);
end;
until LF = 0;
end;
+var
+ Buffer: TBuffer;
+ Line: string;
+ PipeBytesRead: Cardinal;
{$IFDEF MSWINDOWS}
-// "outsourced" from Win32ExecAndRedirectOutput
var
StartupInfo: TStartupInfo;
ProcessInfo: TProcessInformation;
@@ -2580,6 +2582,8 @@
SecurityAttr.bInheritHandle := True;
PipeWrite := 0;
PipeRead := 0;
+ Line := '';
+ ResetMemory(Buffer, SizeOf(Buffer));
if not CreatePipe(PipeRead, PipeWrite, @SecurityAttr, 0) then
begin
Result := GetLastError;
@@ -2594,31 +2598,54 @@
StartupInfo.hStdError := PipeWrite;
UniqueString(CommandLine); // CommandLine must be in a writable memory block
ProcessInfo.dwProcessId := 0;
- if CreateProcess(nil, PChar(CommandLine), nil, nil, True, NORMAL_PRIORITY_CLASS,
- nil, nil, StartupInfo, ProcessInfo) then
- begin
- CloseHandle(PipeWrite);
- if AbortPtr <> nil then
- {$IFDEF FPC}
- AbortPtr^ := 0;
- {$ELSE ~FPC}
- AbortPtr^ := False;
- {$ENDIF ~FPC}
- PipeBytesRead := 0;
- while ((AbortPtr = nil) or not LongBool(AbortPtr^)) and
- ReadFile(PipeRead, Buffer, BufferSize, PipeBytesRead, nil) and (PipeBytesRead > 0) do
- ProcessBuffer;
- if (AbortPtr <> nil) and LongBool(AbortPtr^) then
+ try
+ if CreateProcess(nil, PChar(CommandLine), nil, nil, True, NORMAL_PRIORITY_CLASS,
+ nil, nil, StartupInfo, ProcessInfo) then
+ begin
+ CloseHandle(PipeWrite);
+ PipeWrite := 0;
+ if AbortPtr <> nil then
+ {$IFDEF FPC}
+ AbortPtr^ := 0;
+ {$ELSE ~FPC}
+ AbortPtr^ := False;
+ {$ENDIF ~FPC}
+ PipeBytesRead := 0;
+ while ((AbortPtr = nil) or not LongBool(AbortPtr^)) and
+ ReadFile(PipeRead, Buffer, BufferSize, PipeBytesRead, nil) and (PipeBytesRead > 0) do
+ ProcessBuffer(Buffer, Line, PipeBytesRead);
+ if (AbortPtr <> nil) and LongBool(AbortPtr^) then
+ TerminateProcess(ProcessInfo.hProcess, Cardinal(ABORT_EXIT_CODE));
+ if (WaitForSingleObject(ProcessInfo.hProcess, INFINITE) = WAIT_OBJECT_0) and
+ not GetExitCodeProcess(ProcessInfo.hProcess, Result) then
+ Result := $FFFFFFFF;
+ CloseHandle(ProcessInfo.hThread);
+ ProcessInfo.hThread := 0;
+ CloseHandle(ProcessInfo.hProcess);
+ ProcessInfo.hProcess := 0;
+ end
+ else
+ begin
+ CloseHandle(PipeWrite);
+ PipeWrite := 0;
+ end;
+ CloseHandle(PipeRead);
+ PipeRead := 0;
+ finally
+ if PipeRead <> 0 then
+ CloseHandle(PipeRead);
+ if PipeWrite <> 0 then
+ CloseHandle(PipeWrite);
+ if ProcessInfo.hThread <> 0 then
+ CloseHandle(ProcessInfo.hThread);
+ if ProcessInfo.hProcess <> 0 then
+ begin
TerminateProcess(ProcessInfo.hProcess, Cardinal(ABORT_EXIT_CODE));
- if (WaitForSingleObject(ProcessInfo.hProcess, INFINITE) = WAIT_OBJECT_0) and
- not GetExitCodeProcess(ProcessInfo.hProcess, Result) then
- Result := $FFFFFFFF;
- CloseHandle(ProcessInfo.hThread);
- CloseHandle(ProcessInfo.hProcess);
- end
- else
- CloseHandle(PipeWrite);
- CloseHandle(PipeRead);
+ WaitForSingleObject(ProcessInfo.hProcess, INFINITE);
+ GetExitCodeProcess(ProcessInfo.hProcess, Result);
+ CloseHandle(ProcessInfo.hProcess);
+ end;
+ end;
{$ENDIF MSWINDOWS}
{$IFDEF UNIX}
var
@@ -2626,26 +2653,34 @@
Cmd: string;
begin
Cmd := Format('%s 2>&1', [CommandLine]);
- Pipe := Libc.popen(PChar(Cmd), 'r');
- { TODO : handle Abort }
- repeat
- PipeBytesRead := fread_unlocked(@Buffer, 1, BufferSize, Pipe);
- if PipeBytesRead > 0 then
- ProcessBuffer;
- until PipeBytesRead = 0;
- Result := pclose(Pipe);
- wait(nil);
+ Pipe := nil;
+ try
+ Pipe := Libc.popen(PChar(Cmd), 'r');
+ { TODO : handle Abort }
+ repeat
+ PipeBytesRead := fread_unlocked(@Buffer, 1, BufferSize, Pipe);
+ if PipeBytesRead > 0 then
+ ProcessBuffer(Buffer, Line, PipeBytesRead);
+ until PipeBytesRead = 0;
+ Result := pclose(Pipe);
+ Pipe := nil;
+ wait(nil);
+ finally
+ if Pipe <> nil then
+ pclose(Pipe);
+ wait(nil);
+ end;
{$ENDIF UNIX}
- if TempOutput <> '' then
+ if Line <> '' then
if Assigned(OutputLineCallback) then
// output wasn't terminated by a line feed...
// (shouldn't happen, but you never know)
- ProcessLine(Length(TempOutput))
+ ProcessLine(Line, Length(Line))
else
if RawOutput then
- Output := Output + TempOutput
+ Output := Output + Line
else
- Output := Output + MuteCRTerminatedLines(TempOutput);
+ Output := Output + MuteCRTerminatedLines(Line);
end;
{ TODO -cHelp :
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ou...@us...> - 2009-10-03 09:35:06
|
Revision: 3034
http://jcl.svn.sourceforge.net/jcl/?rev=3034&view=rev
Author: outchy
Date: 2009-10-03 09:34:58 +0000 (Sat, 03 Oct 2009)
Log Message:
-----------
C++Builder has the same problem as Delphi regarding FileOpen's handle type.
Modified Paths:
--------------
trunk/jcl/source/common/JclSysUtils.pas
Modified: trunk/jcl/source/common/JclSysUtils.pas
===================================================================
--- trunk/jcl/source/common/JclSysUtils.pas 2009-10-03 09:32:18 UTC (rev 3033)
+++ trunk/jcl/source/common/JclSysUtils.pas 2009-10-03 09:34:58 UTC (rev 3034)
@@ -617,7 +617,7 @@
TJclSimpleLog = class (TObject)
private
FDateTimeFormatStr: String;
- FLogFileHandle: {$IFDEF DELPHI}Integer{$ELSE}THandle{$ENDIF};
+ FLogFileHandle: {$IFDEF BORLAND}Integer{$ELSE}THandle{$ENDIF};
FLogFileName: string;
FLoggingActive: Boolean;
FLogWasEmpty: Boolean;
@@ -3245,11 +3245,11 @@
FLogFileName := CreateDefaultFileName
else
FLogFileName := ALogFileName;
- {$IFDEF DELPHI}
+ {$IFDEF BORLAND}
FLogFileHandle := Integer(INVALID_HANDLE_VALUE);
- {$ELSE ~DELPHI}
+ {$ELSE ~BORLAND}
FLogFileHandle := INVALID_HANDLE_VALUE;
- {$ENDIF ~DELPHI}
+ {$ENDIF ~BORLAND}
FLoggingActive := True;
end;
@@ -3285,11 +3285,11 @@
if LogOpen then
begin
FileClose(FLogFileHandle);
- {$IFDEF DELPHI}
+ {$IFDEF BORLAND}
FLogFileHandle := Integer(INVALID_HANDLE_VALUE);
- {$ELSE ~DELPHI}
+ {$ELSE ~BORLAND}
FLogFileHandle := INVALID_HANDLE_VALUE;
- {$ENDIF ~DELPHI}
+ {$ENDIF ~BORLAND}
FLogWasEmpty := False;
end;
end;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ou...@us...> - 2009-10-03 09:53:47
|
Revision: 3033
http://jcl.svn.sourceforge.net/jcl/?rev=3033&view=rev
Author: outchy
Date: 2009-10-03 09:32:18 +0000 (Sat, 03 Oct 2009)
Log Message:
-----------
SysUtils' FileOpen, FileCreate and FileClose functions have integer typed handles.
Modified Paths:
--------------
trunk/jcl/source/common/JclSysUtils.pas
Modified: trunk/jcl/source/common/JclSysUtils.pas
===================================================================
--- trunk/jcl/source/common/JclSysUtils.pas 2009-10-03 09:21:03 UTC (rev 3032)
+++ trunk/jcl/source/common/JclSysUtils.pas 2009-10-03 09:32:18 UTC (rev 3033)
@@ -617,7 +617,7 @@
TJclSimpleLog = class (TObject)
private
FDateTimeFormatStr: String;
- FLogFileHandle: THandle;
+ FLogFileHandle: {$IFDEF DELPHI}Integer{$ELSE}THandle{$ENDIF};
FLogFileName: string;
FLoggingActive: Boolean;
FLogWasEmpty: Boolean;
@@ -3245,7 +3245,11 @@
FLogFileName := CreateDefaultFileName
else
FLogFileName := ALogFileName;
+ {$IFDEF DELPHI}
+ FLogFileHandle := Integer(INVALID_HANDLE_VALUE);
+ {$ELSE ~DELPHI}
FLogFileHandle := INVALID_HANDLE_VALUE;
+ {$ENDIF ~DELPHI}
FLoggingActive := True;
end;
@@ -3281,7 +3285,11 @@
if LogOpen then
begin
FileClose(FLogFileHandle);
+ {$IFDEF DELPHI}
+ FLogFileHandle := Integer(INVALID_HANDLE_VALUE);
+ {$ELSE ~DELPHI}
FLogFileHandle := INVALID_HANDLE_VALUE;
+ {$ENDIF ~DELPHI}
FLogWasEmpty := False;
end;
end;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ah...@us...> - 2010-12-02 08:39:19
|
Revision: 3422
http://jcl.svn.sourceforge.net/jcl/?rev=3422&view=rev
Author: ahuser
Date: 2010-12-02 08:39:13 +0000 (Thu, 02 Dec 2010)
Log Message:
-----------
Don't depend on known Windows versions. Just check for greater equal Windows 2000, so an application doesn't fail if there is a new Windows version and you haven't recompiled your project with a new JCL, like all legacy applications.
Modified Paths:
--------------
trunk/jcl/source/common/JclSysUtils.pas
Modified: trunk/jcl/source/common/JclSysUtils.pas
===================================================================
--- trunk/jcl/source/common/JclSysUtils.pas 2010-11-26 19:51:21 UTC (rev 3421)
+++ trunk/jcl/source/common/JclSysUtils.pas 2010-12-02 08:39:13 UTC (rev 3422)
@@ -1090,7 +1090,7 @@
Result := 0;
Pointer(P) := nil;
- if (GetWindowsVersion in [wvUnknown..wvWinNT4]) and ((Name = '') or (Pos('\', Name) > 0)) then
+ if not CheckWin32Version(5, 0) and ((Name = '') or (Pos('\', Name) > 0)) then
raise ESharedMemError.CreateResFmt(@RsInvalidMMFName, [Name]);
{$IFDEF THREADSAFE}
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <jfu...@us...> - 2010-12-29 12:20:00
|
Revision: 3451
http://jcl.svn.sourceforge.net/jcl/?rev=3451&view=rev
Author: jfudickar
Date: 2010-12-29 12:19:53 +0000 (Wed, 29 Dec 2010)
Log Message:
-----------
TJclFormatSettings to prevent {$IFDEF RTL220_UP}FormatSettings.{$ENDIF} - Updated
Modified Paths:
--------------
trunk/jcl/source/common/JclSysUtils.pas
Modified: trunk/jcl/source/common/JclSysUtils.pas
===================================================================
--- trunk/jcl/source/common/JclSysUtils.pas 2010-12-29 11:24:04 UTC (rev 3450)
+++ trunk/jcl/source/common/JclSysUtils.pas 2010-12-29 12:19:53 UTC (rev 3451)
@@ -663,55 +663,70 @@
type
TJclFormatSettings = class
private
- function GetLongDayNames(AIndex: Integer): string; {$IFDEF DELPHI2005_UP} inline; {$ENDIF}
- function GetLongMonthNames(AIndex: Integer): string; {$IFDEF DELPHI2005_UP} inline; {$ENDIF}
- function GetShortDayNames(AIndex: Integer): string; {$IFDEF DELPHI2005_UP} inline; {$ENDIF}
- function GetShortMonthNames(AIndex: Integer): string; {$IFDEF DELPHI2005_UP} inline; {$ENDIF}
function GetCurrencyDecimals: Byte; {$IFDEF DELPHI2005_UP} inline; {$ENDIF}
function GetCurrencyFormat: Byte; {$IFDEF DELPHI2005_UP} inline; {$ENDIF}
function GetCurrencyString: string; {$IFDEF DELPHI2005_UP} inline; {$ENDIF}
function GetDateSeparator: Char; {$IFDEF DELPHI2005_UP} inline; {$ENDIF}
+ function GetDayNamesHighIndex: Integer; {$IFDEF DELPHI2005_UP} inline; {$ENDIF}
+ function GetDayNamesLowIndex: Integer; {$IFDEF DELPHI2005_UP} inline; {$ENDIF}
function GetDecimalSeparator: Char; {$IFDEF DELPHI2005_UP} inline; {$ENDIF}
function GetListSeparator: Char; {$IFDEF DELPHI2005_UP} inline; {$ENDIF}
function GetLongDateFormat: string; {$IFDEF DELPHI2005_UP} inline; {$ENDIF}
+ function GetLongDayNames(AIndex: Integer): string; {$IFDEF DELPHI2005_UP} inline; {$ENDIF}
+ function GetLongMonthNames(AIndex: Integer): string; {$IFDEF DELPHI2005_UP} inline; {$ENDIF}
function GetLongTimeFormat: string; {$IFDEF DELPHI2005_UP} inline; {$ENDIF}
+ function GetMonthNamesHighIndex: Integer; {$IFDEF DELPHI2005_UP} inline; {$ENDIF}
+ function GetMonthNamesLowIndex: Integer; {$IFDEF DELPHI2005_UP} inline; {$ENDIF}
function GetNegCurrFormat: Byte; {$IFDEF DELPHI2005_UP} inline; {$ENDIF}
function GetShortDateFormat: string; {$IFDEF DELPHI2005_UP} inline; {$ENDIF}
+ function GetShortDayNames(AIndex: Integer): string; {$IFDEF DELPHI2005_UP} inline; {$ENDIF}
+ function GetShortMonthNames(AIndex: Integer): string; {$IFDEF DELPHI2005_UP} inline; {$ENDIF}
function GetShortTimeFormat: string; {$IFDEF DELPHI2005_UP} inline; {$ENDIF}
function GetThousandSeparator: Char; {$IFDEF DELPHI2005_UP} inline; {$ENDIF}
function GetTimeAMString: string; {$IFDEF DELPHI2005_UP} inline; {$ENDIF}
function GetTimePMString: string; {$IFDEF DELPHI2005_UP} inline; {$ENDIF}
function GetTimeSeparator: Char; {$IFDEF DELPHI2005_UP} inline; {$ENDIF}
function GetTwoDigitYearCenturyWindow: Word; {$IFDEF DELPHI2005_UP} inline; {$ENDIF}
- procedure SetThousandSeparator(AValue: Char); {$IFDEF DELPHI2005_UP} inline; {$ENDIF}
- procedure SetDecimalSeparator(AValue: Char); {$IFDEF DELPHI2005_UP} inline; {$ENDIF}
procedure SetCurrencyDecimals(AValue: Byte); {$IFDEF DELPHI2005_UP} inline; {$ENDIF}
+ procedure SetCurrencyFormat(const AValue: Byte); {$IFDEF DELPHI2005_UP} inline; {$ENDIF}
procedure SetCurrencyString(AValue: string); {$IFDEF DELPHI2005_UP} inline; {$ENDIF}
+ procedure SetDateSeparator(const AValue: Char); {$IFDEF DELPHI2005_UP} inline; {$ENDIF}
+ procedure SetDecimalSeparator(AValue: Char); {$IFDEF DELPHI2005_UP} inline; {$ENDIF}
+ procedure SetListSeparator(const AValue: Char); {$IFDEF DELPHI2005_UP} inline; {$ENDIF}
procedure SetLongDateFormat(const AValue: string); {$IFDEF DELPHI2005_UP} inline; {$ENDIF}
procedure SetLongTimeFormat(const AValue: string); {$IFDEF DELPHI2005_UP} inline; {$ENDIF}
+ procedure SetNegCurrFormat(const AValue: Byte); {$IFDEF DELPHI2005_UP} inline; {$ENDIF}
procedure SetShortDateFormat(AValue: string); {$IFDEF DELPHI2005_UP} inline; {$ENDIF}
procedure SetShortTimeFormat(const AValue: string); {$IFDEF DELPHI2005_UP} inline; {$ENDIF}
- procedure SetTwoDigitYearCenturyWindow(const AValue: Word);
+ procedure SetThousandSeparator(AValue: Char); {$IFDEF DELPHI2005_UP} inline; {$ENDIF}
+ procedure SetTimeAMString(const AValue: string); {$IFDEF DELPHI2005_UP} inline; {$ENDIF}
+ procedure SetTimePMString(const AValue: string); {$IFDEF DELPHI2005_UP} inline; {$ENDIF}
+ procedure SetTimeSeparator(const AValue: Char); {$IFDEF DELPHI2005_UP} inline; {$ENDIF}
+ procedure SetTwoDigitYearCenturyWindow(const AValue: Word); {$IFDEF DELPHI2005_UP} inline; {$ENDIF}
public
- property CurrencyFormat: Byte read GetCurrencyFormat;
- property NegCurrFormat: Byte read GetNegCurrFormat;
- property ThousandSeparator: Char read GetThousandSeparator write SetThousandSeparator;
- property DecimalSeparator: Char read GetDecimalSeparator write SetDecimalSeparator;
property CurrencyDecimals: Byte read GetCurrencyDecimals write SetCurrencyDecimals;
- property DateSeparator: Char read GetDateSeparator;
- property TimeSeparator: Char read GetTimeSeparator;
- property ListSeparator: Char read GetListSeparator;
+ property CurrencyFormat: Byte read GetCurrencyFormat write SetCurrencyFormat;
property CurrencyString: string read GetCurrencyString write SetCurrencyString;
- property ShortDateFormat: string read GetShortDateFormat write SetShortDateFormat;
+ property DateSeparator: Char read GetDateSeparator write SetDateSeparator;
+ property DayNamesHighIndex: Integer read GetDayNamesHighIndex;
+ property DayNamesLowIndex: Integer read GetDayNamesLowIndex;
+ property DecimalSeparator: Char read GetDecimalSeparator write SetDecimalSeparator;
+ property ListSeparator: Char read GetListSeparator write SetListSeparator;
property LongDateFormat: string read GetLongDateFormat write SetLongDateFormat;
- property TimeAMString: string read GetTimeAMString;
- property TimePMString: string read GetTimePMString;
- property ShortTimeFormat: string read GetShortTimeFormat write SetShortTimeFormat;
+ property LongDayNames[AIndex: Integer]: string read GetLongDayNames;
+ property LongMonthNames[AIndex: Integer]: string read GetLongMonthNames;
property LongTimeFormat: string read GetLongTimeFormat write SetLongTimeFormat;
+ property MonthNamesHighIndex: Integer read GetMonthNamesHighIndex;
+ property MonthNamesLowIndex: Integer read GetMonthNamesLowIndex;
+ property NegCurrFormat: Byte read GetNegCurrFormat write SetNegCurrFormat;
+ property ShortDateFormat: string read GetShortDateFormat write SetShortDateFormat;
+ property ShortDayNames[AIndex: Integer]: string read GetShortDayNames;
property ShortMonthNames[AIndex: Integer]: string read GetShortMonthNames;
- property LongMonthNames[AIndex: Integer]: string read GetLongMonthNames;
- property ShortDayNames[AIndex: Integer]: string read GetShortDayNames;
- property LongDayNames[AIndex: Integer]: string read GetLongDayNames;
+ property ShortTimeFormat: string read GetShortTimeFormat write SetShortTimeFormat;
+ property ThousandSeparator: Char read GetThousandSeparator write SetThousandSeparator;
+ property TimeAMString: string read GetTimeAMString write SetTimeAMString;
+ property TimePMString: string read GetTimePMString write SetTimePMString;
+ property TimeSeparator: Char read GetTimeSeparator write SetTimeSeparator;
property TwoDigitYearCenturyWindow: Word read GetTwoDigitYearCenturyWindow write SetTwoDigitYearCenturyWindow;
end;
@@ -3553,104 +3568,104 @@
SimpleLog.OpenLog;
end;
-{ TJclFormatSettings }
-
-function TJclFormatSettings.GetLongDayNames(AIndex: Integer): string;
+function TJclFormatSettings.GetCurrencyDecimals: Byte;
begin
{$IFDEF RTL220_UP}
- Result := FormatSettings.LongDayNames[AIndex];
+ Result := FormatSettings.CurrencyDecimals;
{$ELSE}
- Result := SysUtils.LongDayNames[AIndex];
+ Result := SysUtils.CurrencyDecimals;
{$ENDIF}
end;
-function TJclFormatSettings.GetLongMonthNames(AIndex: Integer): string;
+function TJclFormatSettings.GetCurrencyFormat: Byte;
begin
{$IFDEF RTL220_UP}
- Result := FormatSettings.LongMonthNames[AIndex];
+ Result := FormatSettings.CurrencyFormat;
{$ELSE}
- Result := SysUtils.LongMonthNames[AIndex];
+ Result := SysUtils.CurrencyFormat;
{$ENDIF}
end;
-function TJclFormatSettings.GetShortDayNames(AIndex: Integer): string;
+function TJclFormatSettings.GetCurrencyString: string;
begin
{$IFDEF RTL220_UP}
- Result := FormatSettings.ShortDayNames[AIndex];
+ Result := FormatSettings.CurrencyString;
{$ELSE}
- Result := SysUtils.ShortDayNames[AIndex];
+ Result := SysUtils.CurrencyString;
{$ENDIF}
end;
-function TJclFormatSettings.GetShortMonthNames(AIndex: Integer): string;
+function TJclFormatSettings.GetDateSeparator: Char;
begin
{$IFDEF RTL220_UP}
- Result := FormatSettings.ShortMonthNames[AIndex];
+ Result := FormatSettings.DateSeparator;
{$ELSE}
- Result := SysUtils.ShortMonthNames[AIndex];
+ Result := SysUtils.DateSeparator;
{$ENDIF}
end;
-function TJclFormatSettings.GetCurrencyDecimals: Byte;
+function TJclFormatSettings.GetDayNamesHighIndex: Integer;
begin
{$IFDEF RTL220_UP}
- Result := FormatSettings.CurrencyDecimals;
+ Result := High(FormatSettings.LongDayNames);
{$ELSE}
- Result := SysUtils.CurrencyDecimals;
+ Result := High(SysUtils.LongDayNames);
{$ENDIF}
end;
-function TJclFormatSettings.GetCurrencyFormat: Byte;
+function TJclFormatSettings.GetDayNamesLowIndex: Integer;
begin
{$IFDEF RTL220_UP}
- Result := FormatSettings.CurrencyFormat;
+ Result := Low(FormatSettings.LongDayNames);
{$ELSE}
- Result := SysUtils.CurrencyFormat;
+ Result := Low(SysUtils.LongDayNames);
{$ENDIF}
end;
-function TJclFormatSettings.GetCurrencyString: string;
+function TJclFormatSettings.GetDecimalSeparator: Char;
begin
{$IFDEF RTL220_UP}
- Result := FormatSettings.CurrencyString;
+ Result := FormatSettings.DecimalSeparator;
{$ELSE}
- Result := SysUtils.CurrencyString;
+ Result := SysUtils.DecimalSeparator;
{$ENDIF}
end;
-function TJclFormatSettings.GetDateSeparator: Char;
+function TJclFormatSettings.GetListSeparator: Char;
begin
{$IFDEF RTL220_UP}
- Result := FormatSettings.DateSeparator;
+ Result := FormatSettings.ListSeparator;
{$ELSE}
- Result := SysUtils.DateSeparator;
+ Result := SysUtils.ListSeparator;
{$ENDIF}
end;
-function TJclFormatSettings.GetDecimalSeparator: Char;
+function TJclFormatSettings.GetLongDateFormat: string;
begin
{$IFDEF RTL220_UP}
- Result := FormatSettings.DecimalSeparator;
+ Result := FormatSettings.LongDateFormat;
{$ELSE}
- Result := SysUtils.DecimalSeparator;
+ Result := SysUtils.LongDateFormat;
{$ENDIF}
end;
-function TJclFormatSettings.GetListSeparator: Char;
+{ TJclFormatSettings }
+
+function TJclFormatSettings.GetLongDayNames(AIndex: Integer): string;
begin
{$IFDEF RTL220_UP}
- Result := FormatSettings.ListSeparator;
+ Result := FormatSettings.LongDayNames[AIndex];
{$ELSE}
- Result := SysUtils.ListSeparator;
+ Result := SysUtils.LongDayNames[AIndex];
{$ENDIF}
end;
-function TJclFormatSettings.GetLongDateFormat: string;
+function TJclFormatSettings.GetLongMonthNames(AIndex: Integer): string;
begin
{$IFDEF RTL220_UP}
- Result := FormatSettings.LongDateFormat;
+ Result := FormatSettings.LongMonthNames[AIndex];
{$ELSE}
- Result := SysUtils.LongDateFormat;
+ Result := SysUtils.LongMonthNames[AIndex];
{$ENDIF}
end;
@@ -3663,6 +3678,24 @@
{$ENDIF}
end;
+function TJclFormatSettings.GetMonthNamesHighIndex: Integer;
+begin
+{$IFDEF RTL220_UP}
+ Result := High(FormatSettings.LongMonthNames);
+{$ELSE}
+ Result := High(SysUtils.LongMonthNames);
+{$ENDIF}
+end;
+
+function TJclFormatSettings.GetMonthNamesLowIndex: Integer;
+begin
+{$IFDEF RTL220_UP}
+ Result := Low(FormatSettings.LongMonthNames);
+{$ELSE}
+ Result := Low(SysUtils.LongMonthNames);
+{$ENDIF}
+end;
+
function TJclFormatSettings.GetNegCurrFormat: Byte;
begin
{$IFDEF RTL220_UP}
@@ -3681,6 +3714,24 @@
{$ENDIF}
end;
+function TJclFormatSettings.GetShortDayNames(AIndex: Integer): string;
+begin
+{$IFDEF RTL220_UP}
+ Result := FormatSettings.ShortDayNames[AIndex];
+{$ELSE}
+ Result := SysUtils.ShortDayNames[AIndex];
+{$ENDIF}
+end;
+
+function TJclFormatSettings.GetShortMonthNames(AIndex: Integer): string;
+begin
+{$IFDEF RTL220_UP}
+ Result := FormatSettings.ShortMonthNames[AIndex];
+{$ELSE}
+ Result := SysUtils.ShortMonthNames[AIndex];
+{$ENDIF}
+end;
+
function TJclFormatSettings.GetShortTimeFormat: string;
begin
{$IFDEF RTL220_UP}
@@ -3735,42 +3786,60 @@
{$ENDIF}
end;
-procedure TJclFormatSettings.SetThousandSeparator(AValue: Char);
+procedure TJclFormatSettings.SetCurrencyDecimals(AValue: Byte);
begin
{$IFDEF RTL220_UP}
- FormatSettings.TimeSeparator := AValue;
+ FormatSettings.CurrencyDecimals := AValue;
{$ELSE}
- SysUtils.TimeSeparator := AValue;
+ SysUtils.CurrencyDecimals := AValue;
{$ENDIF}
end;
-procedure TJclFormatSettings.SetDecimalSeparator(AValue: Char);
+procedure TJclFormatSettings.SetCurrencyFormat(const AValue: Byte);
begin
{$IFDEF RTL220_UP}
- FormatSettings.DecimalSeparator := AValue;
+ FormatSettings.CurrencyFormat := AValue;
{$ELSE}
- SysUtils.DecimalSeparator := AValue;
+ SysUtils.CurrencyFormat := AValue;
{$ENDIF}
end;
-procedure TJclFormatSettings.SetCurrencyDecimals(AValue: Byte);
+procedure TJclFormatSettings.SetCurrencyString(AValue: string);
begin
{$IFDEF RTL220_UP}
- FormatSettings.CurrencyDecimals := AValue;
+ FormatSettings.CurrencyString := AValue;
{$ELSE}
- SysUtils.CurrencyDecimals := AValue;
+ SysUtils.CurrencyString := AValue;
{$ENDIF}
end;
-procedure TJclFormatSettings.SetCurrencyString(AValue: string);
+procedure TJclFormatSettings.SetDateSeparator(const AValue: Char);
begin
{$IFDEF RTL220_UP}
- FormatSettings.CurrencyString := AValue;
+ FormatSettings.DateSeparator := AValue;
{$ELSE}
- SysUtils.CurrencyString := AValue;
+ SysUtils.DateSeparator := AValue;
{$ENDIF}
end;
+procedure TJclFormatSettings.SetDecimalSeparator(AValue: Char);
+begin
+{$IFDEF RTL220_UP}
+ FormatSettings.DecimalSeparator := AValue;
+{$ELSE}
+ SysUtils.DecimalSeparator := AValue;
+{$ENDIF}
+end;
+
+procedure TJclFormatSettings.SetListSeparator(const AValue: Char);
+begin
+{$IFDEF RTL220_UP}
+ FormatSettings.ListSeparator := AValue;
+{$ELSE}
+ SysUtils.ListSeparator := AValue;
+{$ENDIF}
+end;
+
procedure TJclFormatSettings.SetLongDateFormat(const AValue: string);
begin
{$IFDEF RTL220_UP}
@@ -3789,6 +3858,15 @@
{$ENDIF}
end;
+procedure TJclFormatSettings.SetNegCurrFormat(const AValue: Byte);
+begin
+{$IFDEF RTL220_UP}
+ FormatSettings.NegCurrFormat := AValue;
+{$ELSE}
+ SysUtils.NegCurrFormat := AValue;
+{$ENDIF}
+end;
+
procedure TJclFormatSettings.SetShortDateFormat(AValue: string);
begin
{$IFDEF RTL220_UP}
@@ -3807,6 +3885,42 @@
{$ENDIF}
end;
+procedure TJclFormatSettings.SetThousandSeparator(AValue: Char);
+begin
+{$IFDEF RTL220_UP}
+ FormatSettings.TimeSeparator := AValue;
+{$ELSE}
+ SysUtils.TimeSeparator := AValue;
+{$ENDIF}
+end;
+
+procedure TJclFormatSettings.SetTimeAMString(const AValue: string);
+begin
+{$IFDEF RTL220_UP}
+ FormatSettings.TimeAMString := AValue;
+{$ELSE}
+ SysUtils.TimeAMString := AValue;
+{$ENDIF}
+end;
+
+procedure TJclFormatSettings.SetTimePMString(const AValue: string);
+begin
+{$IFDEF RTL220_UP}
+ FormatSettings.TimePMString := AValue;
+{$ELSE}
+ SysUtils.TimePMString := AValue;
+{$ENDIF}
+end;
+
+procedure TJclFormatSettings.SetTimeSeparator(const AValue: Char);
+begin
+{$IFDEF RTL220_UP}
+ FormatSettings.TimeSeparator := AValue;
+{$ELSE}
+ SysUtils.TimeSeparator := AValue;
+{$ENDIF}
+end;
+
procedure TJclFormatSettings.SetTwoDigitYearCenturyWindow(const AValue: Word);
begin
{$IFDEF RTL220_UP}
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <jfu...@us...> - 2010-12-29 20:12:58
|
Revision: 3452
http://jcl.svn.sourceforge.net/jcl/?rev=3452&view=rev
Author: jfudickar
Date: 2010-12-29 20:12:51 +0000 (Wed, 29 Dec 2010)
Log Message:
-----------
TJclFormatSettings to prevent {$IFDEF RTL220_UP}FormatSettings.{$ENDIF} - Switched to {$IFDEF SUPPORTS_INLINE}
Modified Paths:
--------------
trunk/jcl/source/common/JclSysUtils.pas
Modified: trunk/jcl/source/common/JclSysUtils.pas
===================================================================
--- trunk/jcl/source/common/JclSysUtils.pas 2010-12-29 12:19:53 UTC (rev 3451)
+++ trunk/jcl/source/common/JclSysUtils.pas 2010-12-29 20:12:51 UTC (rev 3452)
@@ -663,46 +663,46 @@
type
TJclFormatSettings = class
private
- function GetCurrencyDecimals: Byte; {$IFDEF DELPHI2005_UP} inline; {$ENDIF}
- function GetCurrencyFormat: Byte; {$IFDEF DELPHI2005_UP} inline; {$ENDIF}
- function GetCurrencyString: string; {$IFDEF DELPHI2005_UP} inline; {$ENDIF}
- function GetDateSeparator: Char; {$IFDEF DELPHI2005_UP} inline; {$ENDIF}
- function GetDayNamesHighIndex: Integer; {$IFDEF DELPHI2005_UP} inline; {$ENDIF}
- function GetDayNamesLowIndex: Integer; {$IFDEF DELPHI2005_UP} inline; {$ENDIF}
- function GetDecimalSeparator: Char; {$IFDEF DELPHI2005_UP} inline; {$ENDIF}
- function GetListSeparator: Char; {$IFDEF DELPHI2005_UP} inline; {$ENDIF}
- function GetLongDateFormat: string; {$IFDEF DELPHI2005_UP} inline; {$ENDIF}
- function GetLongDayNames(AIndex: Integer): string; {$IFDEF DELPHI2005_UP} inline; {$ENDIF}
- function GetLongMonthNames(AIndex: Integer): string; {$IFDEF DELPHI2005_UP} inline; {$ENDIF}
- function GetLongTimeFormat: string; {$IFDEF DELPHI2005_UP} inline; {$ENDIF}
- function GetMonthNamesHighIndex: Integer; {$IFDEF DELPHI2005_UP} inline; {$ENDIF}
- function GetMonthNamesLowIndex: Integer; {$IFDEF DELPHI2005_UP} inline; {$ENDIF}
- function GetNegCurrFormat: Byte; {$IFDEF DELPHI2005_UP} inline; {$ENDIF}
- function GetShortDateFormat: string; {$IFDEF DELPHI2005_UP} inline; {$ENDIF}
- function GetShortDayNames(AIndex: Integer): string; {$IFDEF DELPHI2005_UP} inline; {$ENDIF}
- function GetShortMonthNames(AIndex: Integer): string; {$IFDEF DELPHI2005_UP} inline; {$ENDIF}
- function GetShortTimeFormat: string; {$IFDEF DELPHI2005_UP} inline; {$ENDIF}
- function GetThousandSeparator: Char; {$IFDEF DELPHI2005_UP} inline; {$ENDIF}
- function GetTimeAMString: string; {$IFDEF DELPHI2005_UP} inline; {$ENDIF}
- function GetTimePMString: string; {$IFDEF DELPHI2005_UP} inline; {$ENDIF}
- function GetTimeSeparator: Char; {$IFDEF DELPHI2005_UP} inline; {$ENDIF}
- function GetTwoDigitYearCenturyWindow: Word; {$IFDEF DELPHI2005_UP} inline; {$ENDIF}
- procedure SetCurrencyDecimals(AValue: Byte); {$IFDEF DELPHI2005_UP} inline; {$ENDIF}
- procedure SetCurrencyFormat(const AValue: Byte); {$IFDEF DELPHI2005_UP} inline; {$ENDIF}
- procedure SetCurrencyString(AValue: string); {$IFDEF DELPHI2005_UP} inline; {$ENDIF}
- procedure SetDateSeparator(const AValue: Char); {$IFDEF DELPHI2005_UP} inline; {$ENDIF}
- procedure SetDecimalSeparator(AValue: Char); {$IFDEF DELPHI2005_UP} inline; {$ENDIF}
- procedure SetListSeparator(const AValue: Char); {$IFDEF DELPHI2005_UP} inline; {$ENDIF}
- procedure SetLongDateFormat(const AValue: string); {$IFDEF DELPHI2005_UP} inline; {$ENDIF}
- procedure SetLongTimeFormat(const AValue: string); {$IFDEF DELPHI2005_UP} inline; {$ENDIF}
- procedure SetNegCurrFormat(const AValue: Byte); {$IFDEF DELPHI2005_UP} inline; {$ENDIF}
- procedure SetShortDateFormat(AValue: string); {$IFDEF DELPHI2005_UP} inline; {$ENDIF}
- procedure SetShortTimeFormat(const AValue: string); {$IFDEF DELPHI2005_UP} inline; {$ENDIF}
- procedure SetThousandSeparator(AValue: Char); {$IFDEF DELPHI2005_UP} inline; {$ENDIF}
- procedure SetTimeAMString(const AValue: string); {$IFDEF DELPHI2005_UP} inline; {$ENDIF}
- procedure SetTimePMString(const AValue: string); {$IFDEF DELPHI2005_UP} inline; {$ENDIF}
- procedure SetTimeSeparator(const AValue: Char); {$IFDEF DELPHI2005_UP} inline; {$ENDIF}
- procedure SetTwoDigitYearCenturyWindow(const AValue: Word); {$IFDEF DELPHI2005_UP} inline; {$ENDIF}
+ function GetCurrencyDecimals: Byte; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
+ function GetCurrencyFormat: Byte; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
+ function GetCurrencyString: string; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
+ function GetDateSeparator: Char; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
+ function GetDayNamesHighIndex: Integer; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
+ function GetDayNamesLowIndex: Integer; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
+ function GetDecimalSeparator: Char; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
+ function GetListSeparator: Char; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
+ function GetLongDateFormat: string; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
+ function GetLongDayNames(AIndex: Integer): string; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
+ function GetLongMonthNames(AIndex: Integer): string; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
+ function GetLongTimeFormat: string; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
+ function GetMonthNamesHighIndex: Integer; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
+ function GetMonthNamesLowIndex: Integer; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
+ function GetNegCurrFormat: Byte; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
+ function GetShortDateFormat: string; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
+ function GetShortDayNames(AIndex: Integer): string; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
+ function GetShortMonthNames(AIndex: Integer): string; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
+ function GetShortTimeFormat: string; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
+ function GetThousandSeparator: Char; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
+ function GetTimeAMString: string; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
+ function GetTimePMString: string; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
+ function GetTimeSeparator: Char; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
+ function GetTwoDigitYearCenturyWindow: Word; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
+ procedure SetCurrencyDecimals(AValue: Byte); {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
+ procedure SetCurrencyFormat(const AValue: Byte); {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
+ procedure SetCurrencyString(AValue: string); {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
+ procedure SetDateSeparator(const AValue: Char); {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
+ procedure SetDecimalSeparator(AValue: Char); {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
+ procedure SetListSeparator(const AValue: Char); {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
+ procedure SetLongDateFormat(const AValue: string); {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
+ procedure SetLongTimeFormat(const AValue: string); {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
+ procedure SetNegCurrFormat(const AValue: Byte); {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
+ procedure SetShortDateFormat(AValue: string); {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
+ procedure SetShortTimeFormat(const AValue: string); {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
+ procedure SetThousandSeparator(AValue: Char); {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
+ procedure SetTimeAMString(const AValue: string); {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
+ procedure SetTimePMString(const AValue: string); {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
+ procedure SetTimeSeparator(const AValue: Char); {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
+ procedure SetTwoDigitYearCenturyWindow(const AValue: Word); {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
public
property CurrencyDecimals: Byte read GetCurrencyDecimals write SetCurrencyDecimals;
property CurrencyFormat: Byte read GetCurrencyFormat write SetCurrencyFormat;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <jfu...@us...> - 2011-03-16 20:00:45
|
Revision: 3512
http://jcl.svn.sourceforge.net/jcl/?rev=3512&view=rev
Author: jfudickar
Date: 2011-03-16 20:00:39 +0000 (Wed, 16 Mar 2011)
Log Message:
-----------
function VarIsNullEmpty + function VarIsNullEmptyBlank added
Modified Paths:
--------------
trunk/jcl/source/common/JclSysUtils.pas
Modified: trunk/jcl/source/common/JclSysUtils.pas
===================================================================
--- trunk/jcl/source/common/JclSysUtils.pas 2011-03-15 15:07:53 UTC (rev 3511)
+++ trunk/jcl/source/common/JclSysUtils.pas 2011-03-16 20:00:39 UTC (rev 3512)
@@ -741,6 +741,13 @@
var
SimpleLog : TJclSimpleLog;
+
+// Validates if then variant value is null or is empty
+function VarIsNullEmpty(const V: Variant): Boolean;
+// Validates if then variant value is null or is empty or VarToStr is a blank string
+function VarIsNullEmptyBlank(const V: Variant): Boolean;
+
+
{$IFDEF UNITVERSIONING}
const
UnitVersioning: TUnitVersionInfo = (
@@ -767,7 +774,7 @@
{$IFDEF HAS_UNIT_ANSISTRINGS}
AnsiStrings,
{$ENDIF HAS_UNIT_ANSISTRINGS}
- JclFileUtils, JclMath, JclResources, JclStrings, JclStringConversions, JclSysInfo;
+ JclFileUtils, JclMath, JclResources, JclStrings, JclStringConversions, JclSysInfo, Variants;
// memory initialization
procedure ResetMemory(out P; Size: Longint);
@@ -3930,6 +3937,18 @@
{$ENDIF}
end;
+function VarIsNullEmpty(const V: Variant): Boolean;
+begin
+ Result := VarIsNull(V) or VarIsEmpty(V);
+end;
+
+function VarIsNullEmptyBlank(const V: Variant): Boolean;
+begin
+ Result := VarIsNull(V) or VarIsEmpty(V) or (VarToStr(V) = '');
+end;
+
+
+
initialization
SimpleLog := nil;
{$IFDEF UNITVERSIONING}
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ou...@us...> - 2011-04-04 08:49:12
|
Revision: 3517
http://jcl.svn.sourceforge.net/jcl/?rev=3517&view=rev
Author: outchy
Date: 2011-04-04 08:49:05 +0000 (Mon, 04 Apr 2011)
Log Message:
-----------
Mantis 5473: add ErrorOutput for stderr as extra string output to Execute().
Modified Paths:
--------------
trunk/jcl/source/common/JclSysUtils.pas
Modified: trunk/jcl/source/common/JclSysUtils.pas
===================================================================
--- trunk/jcl/source/common/JclSysUtils.pas 2011-04-01 20:21:53 UTC (rev 3516)
+++ trunk/jcl/source/common/JclSysUtils.pas 2011-04-04 08:49:05 UTC (rev 3517)
@@ -61,7 +61,7 @@
Windows,
{$ENDIF MSWINDOWS}
SysUtils, Classes, TypInfo, SyncObjs,
- JclBase;
+ JclBase, JclSynch;
// memory initialization
// first parameter is "out" to make FPC happy with uninitialized values
@@ -492,9 +492,22 @@
function Execute(const CommandLine: string; OutputLineCallback: TTextHandler; RawOutput: Boolean = False;
AbortPtr: PBoolean = nil): Cardinal; overload;
+function Execute(const CommandLine: string; AbortEvent: TJclEvent;
+ OutputLineCallback: TTextHandler; RawOutput: Boolean = False): Cardinal; overload;
function Execute(const CommandLine: string; var Output: string; RawOutput: Boolean = False;
AbortPtr: PBoolean = nil): Cardinal; overload;
+function Execute(const CommandLine: string; AbortEvent: TJclEvent;
+ var Output: string; RawOutput: Boolean = False): Cardinal; overload;
+function Execute(const CommandLine: string; OutputLineCallback, ErrorLineCallback: TTextHandler;
+ RawOutput: Boolean = False; RawError: Boolean = False; AbortPtr: PBoolean = nil): Cardinal; overload;
+function Execute(const CommandLine: string; AbortEvent: TJclEvent;
+ OutputLineCallback, ErrorLineCallback: TTextHandler; RawOutput: Boolean = False; RawError: Boolean = False): Cardinal; overload;
+function Execute(const CommandLine: string; var Output, Error: string;
+ RawOutput: Boolean = False; RawError: Boolean = False; AbortPtr: PBoolean = nil): Cardinal; overload;
+function Execute(const CommandLine: string; AbortEvent: TJclEvent;
+ var Output, Error: string; RawOutput: Boolean = False; RawError: Boolean = False): Cardinal; overload;
+
type
{$HPPEMIT 'namespace Jclsysutils'}
{$HPPEMIT '{'}
@@ -2622,9 +2635,24 @@
//=== Child processes ========================================================
+const
+ BufferSize = 255;
+type
+ TBuffer = array [0..BufferSize] of AnsiChar;
+
+ TPipeInfo = record
+ PipeRead, PipeWrite: THandle;
+ Buffer: TBuffer;
+ Line: string;
+ TextHandler: TTextHandler;
+ RawOutput: Boolean;
+ Event: TJclEvent;
+ end;
+ PPipeInfo = ^TPipeInfo;
+
// MuteCRTerminatedLines was "outsourced" from Win32ExecAndRedirectOutput
-function MuteCRTerminatedLines(const RawOutput: string): string;
+function InternalExecuteMuteCRTerminatedLines(const RawOutput: string): string;
const
Delta = 1024;
var
@@ -2662,117 +2690,242 @@
SetLength(Result, OutPos - 1);
end;
-function InternalExecute(CommandLine: string; var Output: string; OutputLineCallback: TTextHandler;
- RawOutput: Boolean; AbortPtr: PBoolean): Cardinal;
+procedure InternalExecuteProcessLine(const PipeInfo: TPipeInfo; LineEnd: Integer);
+begin
+ if PipeInfo.RawOutput or (PipeInfo.Line[LineEnd] <> NativeCarriageReturn) then
+ begin
+ while (LineEnd > 0) and CharIsReturn(PipeInfo.Line[LineEnd]) do
+ Dec(LineEnd);
+ PipeInfo.TextHandler(Copy(PipeInfo.Line, 1, LineEnd));
+ end;
+end;
-const
- BufferSize = 255;
-type
- TBuffer = array [0..BufferSize] of AnsiChar;
+procedure InternalExecuteProcessBuffer(var PipeInfo: TPipeInfo; PipeBytesRead: Cardinal);
+var
+ CR, LF: Integer;
+begin
+ PipeInfo.Buffer[PipeBytesRead] := #0;
+ PipeInfo.Line := PipeInfo.Line + string(PipeInfo.Buffer);
+ if Assigned(PipeInfo.TextHandler) then
+ repeat
+ CR := Pos(NativeCarriageReturn, PipeInfo.Line);
+ if CR = Length(PipeInfo.Line) then
+ CR := 0; // line feed at CR + 1 might be missing
+ LF := Pos(NativeLineFeed, PipeInfo.Line);
+ if (CR > 0) and ((LF > CR + 1) or (LF = 0)) then
+ LF := CR; // accept CR as line end
+ if LF > 0 then
+ begin
+ InternalExecuteProcessLine(PipeInfo, LF);
+ Delete(PipeInfo.Line, 1, LF);
+ end;
+ until LF = 0;
+end;
- procedure ProcessLine(const Line: string; LineEnd: Integer);
+procedure InternalExecuteReadPipe(var PipeInfo: TPipeInfo; var Overlapped: TOverlapped);
+var
+ NullDWORD: PDWORD;
+ Res: DWORD;
+begin
+ NullDWORD := nil;
+ if not ReadFile(PipeInfo.PipeRead, PipeInfo.Buffer[0], BufferSize, NullDWORD^, @Overlapped) then
begin
- if RawOutput or (Line[LineEnd] <> NativeCarriageReturn) then
+ Res := GetLastError;
+ if Res = ERROR_BROKEN_PIPE then
begin
- while (LineEnd > 0) and CharIsReturn(Line[LineEnd]) do
- Dec(LineEnd);
- OutputLineCallback(Copy(Line, 1, LineEnd));
- end;
+ CloseHandle(PipeInfo.PipeRead);
+ PipeInfo.PipeRead := 0;
+ end
+ else
+ RaiseLastOSError(Res);
end;
+end;
- procedure ProcessBuffer(var Buffer: TBuffer; var Line: string; PipeBytesRead: Cardinal);
- var
- CR, LF: Integer;
+procedure InternalExecuteFlushPipe(var PipeInfo: TPipeInfo; var Overlapped: TOverlapped);
+var
+ PipeBytesRead: DWORD;
+begin
+ CancelIo(PipeInfo.PipeRead);
+ GetOverlappedResult(PipeInfo.PipeRead, Overlapped, PipeBytesRead, True);
+ if PipeBytesRead > 0 then
+ InternalExecuteProcessBuffer(PipeInfo, PipeBytesRead);
+ while PeekNamedPipe(PipeInfo.PipeRead, nil, 0, nil, @PipeBytesRead, nil) and (PipeBytesRead > 0) do
begin
- Buffer[PipeBytesRead] := #0;
- Line := Line + string(Buffer);
- if Assigned(OutputLineCallback) then
- repeat
- CR := Pos(NativeCarriageReturn, Line);
- if CR = Length(Line) then
- CR := 0; // line feed at CR + 1 might be missing
- LF := Pos(NativeLineFeed, Line);
- if (CR > 0) and ((LF > CR + 1) or (LF = 0)) then
- LF := CR; // accept CR as line end
- if LF > 0 then
- begin
- ProcessLine(Line, LF);
- Delete(Line, 1, LF);
- end;
- until LF = 0;
+ if PipeBytesRead > BufferSize then
+ PipeBytesRead := BufferSize;
+ if not ReadFile(PipeInfo.PipeRead, PipeInfo.Buffer[0], PipeBytesRead, PipeBytesRead, nil) then
+ RaiseLastOSError;
+ InternalExecuteProcessBuffer(PipeInfo, PipeBytesRead);
end;
+end;
+function InternalExecute(CommandLine: string; AbortPtr: PBoolean; AbortEvent: TJclEvent;
+ var Output: string; OutputLineCallback: TTextHandler; RawOutput: Boolean;
+ MergeError: Boolean; var Error: string; ErrorLineCallback: TTextHandler; RawError: Boolean): Cardinal;
var
- Buffer: TBuffer;
- Line: string;
- PipeBytesRead: Cardinal;
+ OutPipeInfo, ErrorPipeInfo: TPipeInfo;
+ Index, PipeBytesRead: Cardinal;
{$IFDEF MSWINDOWS}
var
StartupInfo: TStartupInfo;
ProcessInfo: TProcessInformation;
SecurityAttr: TSecurityAttributes;
- PipeRead, PipeWrite: THandle;
+ OutOverlapped, ErrorOverlapped: TOverlapped;
+ ProcessEvent: TJclDispatcherObject;
+ WaitEvents: array of TJclDispatcherObject;
+ InternalAbort: Boolean;
begin
+ // hack to pass a null reference to the parameter lpNumberOfBytesRead of ReadFile
Result := $FFFFFFFF;
SecurityAttr.nLength := SizeOf(SecurityAttr);
SecurityAttr.lpSecurityDescriptor := nil;
SecurityAttr.bInheritHandle := True;
- PipeWrite := 0;
- PipeRead := 0;
- Line := '';
- ResetMemory(Buffer, SizeOf(Buffer));
- if not CreatePipe(PipeRead, PipeWrite, @SecurityAttr, 0) then
+ ResetMemory(OutPipeInfo, SizeOf(OutPipeInfo));
+ OutPipeInfo.TextHandler := OutputLineCallback;
+ OutPipeInfo.RawOutput := RawOutput;
+ if not CreatePipe(OutPipeInfo.PipeRead, OutPipeInfo.PipeWrite, @SecurityAttr, 0) then
begin
Result := GetLastError;
Exit;
end;
+ OutPipeInfo.Event := TJclEvent.Create(@SecurityAttr, False {automatic reset}, False {not flagged}, '' {anonymous});
+ ResetMemory(ErrorPipeInfo, SizeOf(ErrorPipeInfo));
+ if not MergeError then
+ begin
+ ErrorPipeInfo.TextHandler := ErrorLineCallback;
+ ErrorPipeInfo.RawOutput := RawError;
+ if not CreatePipe(ErrorPipeInfo.PipeRead, ErrorPipeInfo.PipeWrite, @SecurityAttr, 0) then
+ begin
+ Result := GetLastError;
+ Exit;
+ end;
+ ErrorPipeInfo.Event := TJclEvent.Create(@SecurityAttr, False {automatic reset}, False {not flagged}, '' {anonymous});
+ end;
ResetMemory(StartupInfo, SizeOf(TStartupInfo));
StartupInfo.cb := SizeOf(TStartupInfo);
StartupInfo.dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;
StartupInfo.wShowWindow := SW_HIDE;
StartupInfo.hStdInput := GetStdHandle(STD_INPUT_HANDLE);
- StartupInfo.hStdOutput := PipeWrite;
- StartupInfo.hStdError := PipeWrite;
+ StartupInfo.hStdOutput := OutPipeInfo.PipeWrite;
+ if MergeError then
+ StartupInfo.hStdError := OutPipeInfo.PipeWrite
+ else
+ StartupInfo.hStdError := ErrorPipeInfo.PipeWrite;
UniqueString(CommandLine); // CommandLine must be in a writable memory block
ProcessInfo.dwProcessId := 0;
+ ProcessEvent := nil;
try
if CreateProcess(nil, PChar(CommandLine), nil, nil, True, NORMAL_PRIORITY_CLASS,
nil, nil, StartupInfo, ProcessInfo) then
begin
- CloseHandle(PipeWrite);
- PipeWrite := 0;
+ // init out and error events
+ CloseHandle(OutPipeInfo.PipeWrite);
+ OutPipeInfo.PipeWrite := 0;
+ if not MergeError then
+ begin
+ CloseHandle(ErrorPipeInfo.PipeWrite);
+ ErrorPipeInfo.PipeWrite := 0;
+ end;
+ InternalAbort := False;
if AbortPtr <> nil then
- {$IFDEF FPC}
- AbortPtr^ := 0;
- {$ELSE ~FPC}
- AbortPtr^ := False;
- {$ENDIF ~FPC}
- PipeBytesRead := 0;
- while ((AbortPtr = nil) or not LongBool(AbortPtr^)) and
- ReadFile(PipeRead, Buffer, BufferSize, PipeBytesRead, nil) and (PipeBytesRead > 0) do
- ProcessBuffer(Buffer, Line, PipeBytesRead);
- if (AbortPtr <> nil) and LongBool(AbortPtr^) then
- TerminateProcess(ProcessInfo.hProcess, Cardinal(ABORT_EXIT_CODE));
- if (WaitForSingleObject(ProcessInfo.hProcess, INFINITE) = WAIT_OBJECT_0) and
- not GetExitCodeProcess(ProcessInfo.hProcess, Result) then
- Result := $FFFFFFFF;
+ AbortPtr^ := False
+ else
+ AbortPtr := @InternalAbort;
+ // init the array of events to wait for
+ ProcessEvent := TJclDispatcherObject.Attach(ProcessInfo.hProcess);
+ ProcessInfo.hProcess := 0; // ProcessEvent now "owns" the handle
+ SetLength(WaitEvents, 2);
+ // add the process first
+ WaitEvents[0] := ProcessEvent;
+ // add the output event
+ WaitEvents[1] := OutPipeInfo.Event;
+ // add the error event
+ if not MergeError then
+ begin
+ SetLength(WaitEvents, 3);
+ WaitEvents[2] := ErrorPipeInfo.Event;
+ end;
+ // add the abort event if any
+ if AbortEvent <> nil then
+ begin
+ AbortEvent.ResetEvent;
+ Index := Length(WaitEvents);
+ SetLength(WaitEvents, Index + 1);
+ WaitEvents[Index] := AbortEvent;
+ end;
+ // init the asynchronous reads
+ OutOverlapped.Internal := 0;
+ OutOverlapped.InternalHigh := 0;
+ OutOverlapped.Offset := 0;
+ OutOverlapped.OffsetHigh := 0;
+ OutOverlapped.hEvent := OutPipeInfo.Event.Handle;
+ InternalExecuteReadPipe(OutPipeInfo, OutOverlapped);
+ if not MergeError then
+ begin
+ ErrorOverlapped.Internal := 0;
+ ErrorOverlapped.InternalHigh := 0;
+ ErrorOverlapped.Offset := 0;
+ ErrorOverlapped.OffsetHigh := 0;
+ ErrorOverlapped.hEvent := ErrorPipeInfo.Event.Handle;
+ InternalExecuteReadPipe(ErrorPipeInfo, ErrorOverlapped);
+ end;
+ // event based loop
+ while not AbortPtr^ do
+ begin
+ Index := WaitAlertableForMultipleObjects(WaitEvents, False, INFINITE);
+ if Index = WAIT_OBJECT_0 then
+ // the subprocess has ended
+ Break
+ else
+ if Index = (WAIT_OBJECT_0 + 1) then
+ begin
+ // event on output
+ if not GetOverlappedResult(OutPipeInfo.PipeRead, OutOverlapped, PipeBytesRead, False) then
+ RaiseLastOSError;
+ InternalExecuteProcessBuffer(OutPipeInfo, PipeBytesRead);
+ // automatically launch the next read
+ InternalExecuteReadPipe(OutpipeInfo, OutOverlapped);
+ end
+ else
+ if (Index = (WAIT_OBJECT_0 + 2)) and not MergeError then
+ begin
+ // event on error
+ if not GetOverlappedResult(ErrorPipeInfo.PipeRead, ErrorOverlapped, PipeBytesRead, False) then
+ RaiseLastOSError;
+ InternalExecuteProcessBuffer(ErrorPipeInfo, PipeBytesRead);
+ // automatically launch the next read
+ InternalExecuteReadPipe(ErrorPipeInfo, ErrorOverlapped);
+ end
+ else
+ if ((Index = (WAIT_OBJECT_0 + 2)) and MergeError) or
+ ((Index = (WAIT_OBJECT_0 + 3)) and not MergeError) then
+ // event on abort
+ AbortPtr^ := True
+ else
+ RaiseLastOSError(Index);
+ end;
+ if AbortPtr^ then
+ TerminateProcess(ProcessEvent.Handle, Cardinal(ABORT_EXIT_CODE));
+ if (ProcessEvent.WaitForever = wrSignaled) and not GetExitCodeProcess(ProcessEvent.Handle, Result) then
+ Result := $FFFFFFFF;
CloseHandle(ProcessInfo.hThread);
ProcessInfo.hThread := 0;
- CloseHandle(ProcessInfo.hProcess);
- ProcessInfo.hProcess := 0;
- end
- else
- begin
- CloseHandle(PipeWrite);
- PipeWrite := 0;
+ if OutPipeInfo.PipeRead <> 0 then
+ // read data remaining in output pipe
+ InternalExecuteFlushPipe(OutPipeinfo, OutOverlapped);
+ if (not MergeError) and (ErrorPipeInfo.PipeRead <> 0) then
+ // read data remaining in error pipe
+ InternalExecuteFlushPipe(ErrorPipeInfo, ErrorOverlapped);
end;
- CloseHandle(PipeRead);
- PipeRead := 0;
finally
- if PipeRead <> 0 then
- CloseHandle(PipeRead);
- if PipeWrite <> 0 then
- CloseHandle(PipeWrite);
+ if OutPipeInfo.PipeRead <> 0 then
+ CloseHandle(OutPipeInfo.PipeRead);
+ if OutPipeInfo.PipeWrite <> 0 then
+ CloseHandle(OutPipeInfo.PipeWrite);
+ if ErrorPipeInfo.PipeRead <> 0 then
+ CloseHandle(ErrorPipeInfo.PipeRead);
+ if ErrorPipeInfo.PipeWrite <> 0 then
+ CloseHandle(ErrorPipeInfo.PipeWrite);
if ProcessInfo.hThread <> 0 then
CloseHandle(ProcessInfo.hThread);
if ProcessInfo.hProcess <> 0 then
@@ -2782,6 +2935,9 @@
GetExitCodeProcess(ProcessInfo.hProcess, Result);
CloseHandle(ProcessInfo.hProcess);
end;
+ ProcessEvent.Free; // this calls CloseHandle(ProcessInfo.hProcess)
+ OutPipeInfo.Event.Free;
+ ErrorPipeInfo.Event.Free;
end;
{$ENDIF MSWINDOWS}
{$IFDEF UNIX}
@@ -2795,9 +2951,9 @@
Pipe := Libc.popen(PChar(Cmd), 'r');
{ TODO : handle Abort }
repeat
- PipeBytesRead := fread_unlocked(@Buffer, 1, BufferSize, Pipe);
+ PipeBytesRead := fread_unlocked(@OutBuffer, 1, BufferSize, Pipe);
if PipeBytesRead > 0 then
- ProcessBuffer(Buffer, Line, PipeBytesRead);
+ ProcessBuffer(OutBuffer, OutLine, PipeBytesRead);
until PipeBytesRead = 0;
Result := pclose(Pipe);
Pipe := nil;
@@ -2808,41 +2964,112 @@
wait(nil);
end;
{$ENDIF UNIX}
- if Line <> '' then
- if Assigned(OutputLineCallback) then
+ if OutPipeInfo.Line <> '' then
+ if Assigned(OutPipeInfo.TextHandler) then
// output wasn't terminated by a line feed...
// (shouldn't happen, but you never know)
- ProcessLine(Line, Length(Line))
+ InternalExecuteProcessLine(OutPipeInfo, Length(OutPipeInfo.Line))
else
if RawOutput then
- Output := Output + Line
+ Output := Output + OutPipeInfo.Line
else
- Output := Output + MuteCRTerminatedLines(Line);
+ Output := Output + InternalExecuteMuteCRTerminatedLines(OutPipeInfo.Line);
+ if ErrorPipeInfo.Line <> '' then
+ if Assigned(ErrorPipeInfo.TextHandler) then
+ // error wasn't terminated by a line feed...
+ // (shouldn't happen, but you never know)
+ InternalExecuteProcessLine(ErrorPipeInfo, Length(ErrorPipeInfo.Line))
+ else
+ if RawError then
+ Error := Error + ErrorPipeInfo.Line
+ else
+ Error := Error + InternalExecuteMuteCRTerminatedLines(ErrorPipeInfo.Line);
end;
{ TODO -cHelp :
RawOutput: Do not process isolated carriage returns (#13).
That is, for RawOutput = False, lines not terminated by a line feed (#10) are deleted from Output. }
-function Execute(const CommandLine: string; var Output: string; RawOutput: Boolean = False;
- AbortPtr: PBoolean = nil): Cardinal;
+function Execute(const CommandLine: string; var Output: string; RawOutput: Boolean;
+ AbortPtr: PBoolean): Cardinal;
+var
+ Error: string;
begin
- Result := InternalExecute(CommandLine, Output, nil, RawOutput, AbortPtr);
+ Error := '';
+ Result := InternalExecute(CommandLine, AbortPtr, nil, Output, nil, RawOutput, True, Error, nil, False);
end;
+function Execute(const CommandLine: string; AbortEvent: TJclEvent; var Output: string; RawOutput: Boolean): Cardinal;
+var
+ Error: string;
+begin
+ Error := '';
+ Result := InternalExecute(CommandLine, nil, AbortEvent, Output, nil, RawOutput, True, Error, nil, False);
+end;
+
{ TODO -cHelp :
Author: Robert Rossmair
OutputLineCallback called once per line of output. }
-function Execute(const CommandLine: string; OutputLineCallback: TTextHandler; RawOutput: Boolean = False;
- AbortPtr: PBoolean = nil): Cardinal; overload;
+function Execute(const CommandLine: string; OutputLineCallback: TTextHandler; RawOutput: Boolean;
+ AbortPtr: PBoolean): Cardinal;
var
- Dummy: string;
+ Output, Error: string;
begin
- Dummy := '';
- Result := InternalExecute(CommandLine, Dummy, OutputLineCallback, RawOutput, AbortPtr);
+ Output := '';
+ Error := '';
+ Result := InternalExecute(CommandLine, AbortPtr, nil, Output, OutputLineCallback, RawOutput, True, Error, nil, False);
end;
+function Execute(const CommandLine: string; AbortEvent: TJclEvent; OutputLineCallback: TTextHandler; RawOutput: Boolean): Cardinal;
+var
+ Output, Error: string;
+begin
+ Output := '';
+ Error := '';
+ Result := InternalExecute(CommandLine, nil, AbortEvent, Output, OutputLineCallback, RawOutput, True, Error, nil, False);
+end;
+
+{ TODO -cHelp :
+RawOutput: Do not process isolated carriage returns (#13).
+That is, for RawOutput = False, lines not terminated by a line feed (#10) are deleted from Output. }
+
+function Execute(const CommandLine: string; var Output, Error: string; RawOutput, RawError: Boolean;
+ AbortPtr: PBoolean): Cardinal;
+begin
+ Result := InternalExecute(CommandLine, AbortPtr, nil, Output, nil, RawOutput, True, Error, nil, RawError);
+end;
+
+function Execute(const CommandLine: string; AbortEvent: TJclEvent; var Output, Error: string;
+ RawOutput, RawError: Boolean): Cardinal;
+begin
+ Result := InternalExecute(CommandLine, nil, AbortEvent, Output, nil, RawOutput, True, Error, nil, RawError);
+end;
+
+{ TODO -cHelp :
+Author: Robert Rossmair
+OutputLineCallback called once per line of output. }
+
+function Execute(const CommandLine: string; OutputLineCallback, ErrorLineCallback: TTextHandler;
+ RawOutput, RawError: Boolean; AbortPtr: PBoolean): Cardinal;
+var
+ Output, Error: string;
+begin
+ Output := '';
+ Error := '';
+ Result := InternalExecute(CommandLine, AbortPtr, nil, Output, OutputLineCallback, RawOutput, True, Error, ErrorLineCallback, RawError);
+end;
+
+function Execute(const CommandLine: string; AbortEvent: TJclEvent; OutputLineCallback, ErrorLineCallback: TTextHandler;
+ RawOutput, RawError: Boolean): Cardinal;
+var
+ Output, Error: string;
+begin
+ Output := '';
+ Error := '';
+ Result := InternalExecute(CommandLine, nil, AbortEvent, Output, OutputLineCallback, RawOutput, True, Error, ErrorLineCallback, RawError);
+end;
+
//=== { TJclCommandLineTool } ================================================
constructor TJclCommandLineTool.Create(const AExeName: string);
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <sf...@us...> - 2011-04-09 12:54:38
|
Revision: 3518
http://jcl.svn.sourceforge.net/jcl/?rev=3518&view=rev
Author: sfarrow
Date: 2011-04-09 12:54:32 +0000 (Sat, 09 Apr 2011)
Log Message:
-----------
Ensure that JclSysUtils compiles in Delphi 7 by changing the call to RaiseLastOSError to use the version of the procedure appropriate to the Delphi version, i.e use the procedure taking a parameter in delphi 11 and above otherwise use the procedure that requests the error from the operating system in delphi 10 and below.
Modified Paths:
--------------
trunk/jcl/source/common/JclSysUtils.pas
Modified: trunk/jcl/source/common/JclSysUtils.pas
===================================================================
--- trunk/jcl/source/common/JclSysUtils.pas 2011-04-04 08:49:05 UTC (rev 3517)
+++ trunk/jcl/source/common/JclSysUtils.pas 2011-04-09 12:54:32 UTC (rev 3518)
@@ -2737,7 +2737,11 @@
PipeInfo.PipeRead := 0;
end
else
+ {$IFDEF DELPHI11_UP}
RaiseLastOSError(Res);
+ {$ELSE}
+ RaiseLastOSError;
+ {$ENDIF DELPHI11_UP}
end;
end;
@@ -2902,7 +2906,11 @@
// event on abort
AbortPtr^ := True
else
+ {$IFDEF DELPHI11_UP}
RaiseLastOSError(Index);
+ {$ELSE}
+ RaiseLastOSError;
+ {$ENDIF DELPHI11_UP}
end;
if AbortPtr^ then
TerminateProcess(ProcessEvent.Handle, Cardinal(ABORT_EXIT_CODE));
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <usc...@us...> - 2011-12-04 14:31:55
|
Revision: 3644
http://jcl.svn.sourceforge.net/jcl/?rev=3644&view=rev
Author: uschuster
Date: 2011-12-04 14:31:49 +0000 (Sun, 04 Dec 2011)
Log Message:
-----------
Fixed SortDynArray and SearchDynArray for 64-bit (Mantis #5720; patch from Patrick van Logchem)
The following snippet lead to an access violation on Win64
function CompareNativeInt(Item1, Item2: Pointer): Integer;
begin
Result := PNativeInt(Item1)^ - PNativeInt(Item2)^;
end;
procedure TestSortDynArray;
var
A: array of NativeInt;
I: Integer;
begin
SetLength(A, 5);
for I := 0 to High(A) do
A[I] := High(A) - I;
SortDynArray(A, SizeOf(NativeInt), CompareNativeInt);
end;
Modified Paths:
--------------
trunk/jcl/source/common/JclSysUtils.pas
Modified: trunk/jcl/source/common/JclSysUtils.pas
===================================================================
--- trunk/jcl/source/common/JclSysUtils.pas 2011-12-04 13:52:33 UTC (rev 3643)
+++ trunk/jcl/source/common/JclSysUtils.pas 2011-12-04 14:31:49 UTC (rev 3644)
@@ -243,7 +243,7 @@
procedure SortDynArray(const ArrayPtr: Pointer; ElementSize: Cardinal; SortFunc: TDynArraySortCompare);
// Usage: SortDynArray(Array, SizeOf(Array[0]), SortFunction);
function SearchDynArray(const ArrayPtr: Pointer; ElementSize: Cardinal; SortFunc: TDynArraySortCompare;
- ValuePtr: Pointer; Nearest: Boolean = False): Integer;
+ ValuePtr: Pointer; Nearest: Boolean = False): SizeInt;
// Usage: SearchDynArray(Array, SizeOf(Array[0]), SortFunction, @SearchedValue);
{ Various compare functions for basic types }
@@ -1433,14 +1433,14 @@
var
TempBuf: TDynByteArray;
- function ArrayItemPointer(Item: Integer): Pointer;
+ function ArrayItemPointer(Item: SizeInt): Pointer;
begin
- Result := Pointer(TJclAddr(ArrayPtr) + (Cardinal(Item) * ElementSize));
+ Result := Pointer(TJclAddr(ArrayPtr) + (Item * SizeInt(ElementSize)));
end;
- procedure QuickSort(L, R: Integer);
+ procedure QuickSort(L, R: SizeInt);
var
- I, J, T: Integer;
+ I, J, T: SizeInt;
P, IPtr, JPtr: Pointer;
begin
repeat
@@ -1499,26 +1499,26 @@
if ArrayPtr <> nil then
begin
SetLength(TempBuf, ElementSize);
- QuickSort(0, PInteger(TJclAddr(ArrayPtr) - 4)^ - 1);
+ QuickSort(0, PSizeInt(TJclAddr(ArrayPtr) - SizeOf(SizeInt))^ - 1);
end;
end;
function SearchDynArray(const ArrayPtr: Pointer; ElementSize: Cardinal; SortFunc: TDynArraySortCompare;
- ValuePtr: Pointer; Nearest: Boolean): Integer;
+ ValuePtr: Pointer; Nearest: Boolean): SizeInt;
var
- L, H, I, C: Integer;
+ L, H, I, C: SizeInt;
B: Boolean;
begin
Result := -1;
if ArrayPtr <> nil then
begin
L := 0;
- H := PInteger(TJclAddr(ArrayPtr) - 4)^ - 1;
+ H := PSizeInt(TJclAddr(ArrayPtr) - SizeOf(SizeInt))^ - 1;
B := False;
while L <= H do
begin
I := (L + H) shr 1;
- C := SortFunc(Pointer(TJclAddr(ArrayPtr) + (Cardinal(I) * ElementSize)), ValuePtr);
+ C := SortFunc(Pointer(TJclAddr(ArrayPtr) + (I * SizeInt(ElementSize))), ValuePtr);
if C < 0 then
L := I + 1
else
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ou...@us...> - 2011-12-26 20:40:59
|
Revision: 3645
http://jcl.svn.sourceforge.net/jcl/?rev=3645&view=rev
Author: outchy
Date: 2011-12-26 20:40:53 +0000 (Mon, 26 Dec 2011)
Log Message:
-----------
Fix some warnings about operand size extents.
Modified Paths:
--------------
trunk/jcl/source/common/JclSysUtils.pas
Modified: trunk/jcl/source/common/JclSysUtils.pas
===================================================================
--- trunk/jcl/source/common/JclSysUtils.pas 2011-12-04 14:31:49 UTC (rev 3644)
+++ trunk/jcl/source/common/JclSysUtils.pas 2011-12-26 20:40:53 UTC (rev 3645)
@@ -1435,7 +1435,8 @@
function ArrayItemPointer(Item: SizeInt): Pointer;
begin
- Result := Pointer(TJclAddr(ArrayPtr) + (Item * SizeInt(ElementSize)));
+ Assert(Item >= 0);
+ Result := Pointer(TJclAddr(ArrayPtr) + TJclAddr(Item * SizeInt(ElementSize)));
end;
procedure QuickSort(L, R: SizeInt);
@@ -1518,7 +1519,7 @@
while L <= H do
begin
I := (L + H) shr 1;
- C := SortFunc(Pointer(TJclAddr(ArrayPtr) + (I * SizeInt(ElementSize))), ValuePtr);
+ C := SortFunc(Pointer(TJclAddr(ArrayPtr) + TJclAddr(I * SizeInt(ElementSize))), ValuePtr);
if C < 0 then
L := I + 1
else
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ou...@us...> - 2012-01-22 12:20:04
|
Revision: 3699
http://jcl.svn.sourceforge.net/jcl/?rev=3699&view=rev
Author: outchy
Date: 2012-01-22 12:19:57 +0000 (Sun, 22 Jan 2012)
Log Message:
-----------
Fix a bug when the error and output pipes were incorrectly merged together.
Modified Paths:
--------------
trunk/jcl/source/common/JclSysUtils.pas
Modified: trunk/jcl/source/common/JclSysUtils.pas
===================================================================
--- trunk/jcl/source/common/JclSysUtils.pas 2012-01-22 11:17:51 UTC (rev 3698)
+++ trunk/jcl/source/common/JclSysUtils.pas 2012-01-22 12:19:57 UTC (rev 3699)
@@ -3069,13 +3069,13 @@
function Execute(const CommandLine: string; var Output, Error: string; RawOutput, RawError: Boolean;
AbortPtr: PBoolean): Cardinal;
begin
- Result := InternalExecute(CommandLine, AbortPtr, nil, Output, nil, RawOutput, True, Error, nil, RawError);
+ Result := InternalExecute(CommandLine, AbortPtr, nil, Output, nil, RawOutput, False, Error, nil, RawError);
end;
function Execute(const CommandLine: string; AbortEvent: TJclEvent; var Output, Error: string;
RawOutput, RawError: Boolean): Cardinal;
begin
- Result := InternalExecute(CommandLine, nil, AbortEvent, Output, nil, RawOutput, True, Error, nil, RawError);
+ Result := InternalExecute(CommandLine, nil, AbortEvent, Output, nil, RawOutput, False, Error, nil, RawError);
end;
{ TODO -cHelp :
@@ -3089,7 +3089,7 @@
begin
Output := '';
Error := '';
- Result := InternalExecute(CommandLine, AbortPtr, nil, Output, OutputLineCallback, RawOutput, True, Error, ErrorLineCallback, RawError);
+ Result := InternalExecute(CommandLine, AbortPtr, nil, Output, OutputLineCallback, RawOutput, False, Error, ErrorLineCallback, RawError);
end;
function Execute(const CommandLine: string; AbortEvent: TJclEvent; OutputLineCallback, ErrorLineCallback: TTextHandler;
@@ -3099,7 +3099,7 @@
begin
Output := '';
Error := '';
- Result := InternalExecute(CommandLine, nil, AbortEvent, Output, OutputLineCallback, RawOutput, True, Error, ErrorLineCallback, RawError);
+ Result := InternalExecute(CommandLine, nil, AbortEvent, Output, OutputLineCallback, RawOutput, False, Error, ErrorLineCallback, RawError);
end;
//=== { TJclCommandLineTool } ================================================
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
Thanks for helping keep SourceForge clean.
X