Menu
▾
▴
jcl-checkins-diff — SVN file check-in notifications with file differences included
You can subscribe to this list here.
| 2006 |
Jan
|
Feb
|
Mar
|
Apr
(20) |
May
(48) |
Jun
(8) |
Jul
(23) |
Aug
(41) |
Sep
(42) |
Oct
(22) |
Nov
(17) |
Dec
(36) |
|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 2007 |
Jan
(43) |
Feb
(42) |
Mar
(17) |
Apr
(39) |
May
(16) |
Jun
(35) |
Jul
(37) |
Aug
(47) |
Sep
(49) |
Oct
(9) |
Nov
(52) |
Dec
(37) |
| 2008 |
Jan
(48) |
Feb
(21) |
Mar
(7) |
Apr
(2) |
May
(5) |
Jun
(17) |
Jul
(17) |
Aug
(40) |
Sep
(58) |
Oct
(38) |
Nov
(19) |
Dec
(32) |
| 2009 |
Jan
(67) |
Feb
(46) |
Mar
(54) |
Apr
(34) |
May
(37) |
Jun
(52) |
Jul
(67) |
Aug
(72) |
Sep
(48) |
Oct
(35) |
Nov
(27) |
Dec
(12) |
| 2010 |
Jan
(56) |
Feb
(46) |
Mar
(19) |
Apr
(14) |
May
(21) |
Jun
(3) |
Jul
(13) |
Aug
(48) |
Sep
(34) |
Oct
(51) |
Nov
(16) |
Dec
(32) |
| 2011 |
Jan
(36) |
Feb
(14) |
Mar
(12) |
Apr
(3) |
May
(5) |
Jun
(24) |
Jul
(15) |
Aug
(30) |
Sep
(21) |
Oct
(4) |
Nov
(25) |
Dec
(23) |
| 2012 |
Jan
(45) |
Feb
(42) |
Mar
(19) |
Apr
(14) |
May
(13) |
Jun
(7) |
Jul
(3) |
Aug
(46) |
Sep
(21) |
Oct
(10) |
Nov
(2) |
Dec
|
| 2013 |
Jan
(5) |
Feb
|
Mar
|
Apr
|
May
|
Jun
|
Jul
|
Aug
|
Sep
|
Oct
|
Nov
|
Dec
|
|
From: <mar...@us...> - 2006-05-03 09:05:24
|
Revision: 1633 Author: marquardt Date: 2006-05-03 02:05:05 -0700 (Wed, 03 May 2006) ViewCVS: http://svn.sourceforge.net/jcl/?rev=1633&view=rev Log Message: ----------- several new stream classes from Heinz Zastrau Modified Paths: -------------- trunk/jcl/source/common/JclStreams.pas Modified: trunk/jcl/source/common/JclStreams.pas =================================================================== --- trunk/jcl/source/common/JclStreams.pas 2006-05-01 19:59:08 UTC (rev 1632) +++ trunk/jcl/source/common/JclStreams.pas 2006-05-03 09:05:05 UTC (rev 1633) @@ -18,6 +18,7 @@ { } { Contributors: } { Florent Ouchet (outchy) } +{ Heinz Zastrau } { } {**************************************************************************************************} @@ -127,6 +128,112 @@ property Count: Integer read GetCount; end; + TJclStreamDecorator = class(TJclStream) + private + FAfterStreamChange: TNotifyEvent; + FBeforeStreamChange: TNotifyEvent; + FOwnsStream: Boolean; + FStream: TStream; + procedure SetStream(Value: TStream); + protected + procedure DoAfterStreamChange; virtual; + procedure DoBeforeStreamChange; virtual; + procedure SetSize(NewSize: Longint); overload; override; + procedure SetSize(const NewSize: Int64); overload; override; + public + constructor Create(AStream: TStream; AOwnsStream: Boolean = False); virtual; + destructor Destroy; override; + function Read(var Buffer; Count: Longint): Longint; override; + function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; overload; override; + function Seek(Offset: Longint; Origin: Word): Longint; overload; override; + function Write(const Buffer; Count: Longint): Longint; override; + property AfterStreamChange: TNotifyEvent read FAfterStreamChange write FAfterStreamChange; + property BeforeStreamChange: TNotifyEvent read FBeforeStreamChange write FBeforeStreamChange; + property OwnsStream: Boolean read FOwnsStream write FOwnsStream; + property Stream: TStream read FStream write SetStream; + end; + + TJclBufferedStream = class(TJclStreamDecorator) + private + FBuffer: array of Byte; + FBufferCurrentSize: Longint; + FBufferMaxModifiedPos: Longint; + FBufferSize: Longint; + FBufferStart: Longint; + FPosition: Longint; + FSize: Longint; + function BufferHit: Boolean; + function GetCalcedSize: Longint; + function LoadBuffer: Boolean; + procedure SetBufferSize(Value: Longint); + function ReadFromBuffer(var Buffer; Count, Start: Longint): Longint; + function WriteToBuffer(const Buffer; Count, Start: Longint): Longint; + protected + procedure DoAfterStreamChange; override; + procedure DoBeforeStreamChange; override; + procedure SetSize(NewSize: Longint); override; + public + constructor Create(AStream: TStream; AOwnsStream: Boolean = False); override; + destructor Destroy; override; + procedure Flush; + function Read(var Buffer; Count: Longint): Longint; override; + function Seek(Offset: Longint; Origin: Word): Longint; override; + function Write(const Buffer; Count: Longint): Longint; override; + property BufferSize: Longint read FBufferSize write SetBufferSize; + end; + + TStreamNotifyEvent = procedure(Sender: TObject; Position: Int64; Size: Int64) of object; + + TJclEventStream = class(TJclStreamDecorator) + private + FNotification: TStreamNotifyEvent; + procedure DoNotification; + protected + procedure DoBeforeStreamChange; override; + procedure DoAfterStreamChange; override; + procedure SetSize(NewSize: Longint); overload; override; + procedure SetSize(const NewSize: Int64); overload; override; + public + constructor Create(AStream: TStream; ANotification: TStreamNotifyEvent = nil; + AOwnsStream: Boolean = False); reintroduce; virtual; + function Read(var Buffer; Count: Longint): Longint; override; + function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; overload; override; + function Seek(Offset: Longint; Origin: Word): Longint; overload; override; + function Write(const Buffer; Count: Longint): Longint; override; + property OnNotification: TStreamNotifyEvent read FNotification write FNotification; + end; + + TJclEasyStream = class(TJclStreamDecorator) + public + function IsEqual(Stream: TStream): Boolean; + function ReadBoolean: Boolean; + function ReadChar: Char; + function ReadComp: Comp; + function ReadCurrency: Currency; + function ReadDateTime: TDateTime; + function ReadDouble: Double; + function ReadExtended: Extended; + function ReadInt64: Int64; + function ReadInteger: Integer; + function ReadCString: string; + function ReadShortString: string; + function ReadSingle: Single; + function ReadSizedString: string; + procedure WriteBoolean(Value: Boolean); + procedure WriteChar(Value: Char); + procedure WriteComp(const Value: Comp); + procedure WriteCurrency(const Value: Currency); + procedure WriteDateTime(const Value: TDateTime); + procedure WriteDouble(const Value: Double); + procedure WriteExtended(const Value: Extended); + procedure WriteInt64(Value: Int64); overload; + procedure WriteInteger(Value: Integer); overload; + procedure WriteStringDlimitedByNull(const Value: string); + procedure WriteShortString(const Value: ShortString); + procedure WriteSingle(const Value: Single); + procedure WriteSizedString(const Value: string); + end; + implementation uses @@ -457,6 +564,503 @@ Result := MinByteWritten; end; +//=== { TJclStreamDecorator } ================================================ + +constructor TJclStreamDecorator.Create(AStream: TStream; AOwnsStream: Boolean = False); +begin + inherited Create; + FStream := AStream; + FOwnsStream := AOwnsStream; +end; + +destructor TJclStreamDecorator.Destroy; +begin + if OwnsStream then + FStream.Free; + inherited Destroy; +end; + +procedure TJclStreamDecorator.DoAfterStreamChange; +begin + if Assigned(FAfterStreamChange) then + FAfterStreamChange(Self); +end; + +procedure TJclStreamDecorator.DoBeforeStreamChange; +begin + if Assigned(FBeforeStreamChange) then + FBeforeStreamChange(Self); +end; + +function TJclStreamDecorator.Read(var Buffer; Count: Longint): Longint; +begin + if Assigned(FStream) then + Result := Stream.Read(Buffer, Count) + else + Result := 0; +end; + +function TJclStreamDecorator.Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; +begin + if Assigned(FStream) then + Result := Stream.Seek(Offset, Origin) + else + Result := -1; +end; + +function TJclStreamDecorator.Seek(Offset: Longint; Origin: Word): Longint; +begin + if Assigned(FStream) then + Result := Stream.Seek(Offset, Origin) + else + Result := -1; +end; + +procedure TJclStreamDecorator.SetSize(NewSize: Longint); +begin + if Assigned(FStream) then + Stream.Size := NewSize; +end; + +procedure TJclStreamDecorator.SetSize(const NewSize: Int64); +begin + if Assigned(FStream) then + Stream.Size := NewSize; +end; + +procedure TJclStreamDecorator.SetStream(Value: TStream); +begin + if Value <> FStream then + try + DoBeforeStreamChange; + finally + if OwnsStream then + FStream.Free; + FStream := Value; + DoAfterStreamChange; + end; +end; + +function TJclStreamDecorator.Write(const Buffer; Count: Longint): Longint; +begin + if Assigned(FStream) then + Result := Stream.Write(Buffer, Count) + else + Result := 0; +end; + +//=== { TJclBufferedStream } ================================================= + +constructor TJclBufferedStream.Create(AStream: TStream; AOwnsStream: Boolean = False); +begin + inherited Create(AStream, AOwnsStream); + FSize := -1; + FPosition := Stream.Position; + BufferSize := 4096; +end; + +destructor TJclBufferedStream.Destroy; +begin + Flush; + inherited Destroy; +end; + +function TJclBufferedStream.BufferHit: Boolean; +begin + Result := (FBufferStart <= FPosition) and (FPosition < FBufferCurrentSize); +end; + +procedure TJclBufferedStream.DoAfterStreamChange; +begin + inherited DoAfterStreamChange; + if Stream <> nil then + FPosition := Stream.Position; +end; + +procedure TJclBufferedStream.DoBeforeStreamChange; +begin + inherited DoBeforeStreamChange; + Flush; +end; + +procedure TJclBufferedStream.Flush; +begin + if Stream = nil then + Exit; + if FBufferMaxModifiedPos > 0 then + begin + Stream.Position := FBufferStart; + Stream.WriteBuffer(FBuffer[0], FBufferMaxModifiedPos); + FSize := Stream.Size; + FBufferMaxModifiedPos := 0; + end; +end; + +function TJclBufferedStream.GetCalcedSize: Longint; +begin + if FSize < 0 then + FSize := Stream.Size; + if FSize < FBufferMaxModifiedPos + FBufferStart then + FSize := FBufferMaxModifiedPos + FBufferStart; + Result := FSize; +end; + +function TJclBufferedStream.LoadBuffer: Boolean; +begin + Flush; + if Length(FBuffer) <> FBufferSize then + SetLength(FBuffer, FBufferSize); + FStream.Position := FPosition; + FBufferCurrentSize := FStream.Read(FBuffer[0], FBufferSize); + FBufferStart := FPosition; + Result := (FBufferCurrentSize > 0); +end; + +function TJclBufferedStream.Read(var Buffer; Count: Longint): Longint; +begin + Result := Count; + while Count > 0 do + begin + if not BufferHit then + if not LoadBuffer then + Break; + Dec(Count, ReadFromBuffer(Buffer, Count, Result - Count)); + end; + Result := Result - Count; +end; + +function TJclBufferedStream.ReadFromBuffer(var Buffer; Count, Start: Longint): Longint; +var + BufPos: Longint; + P: PChar; +begin + Result := Count; + BufPos := FPosition - FBufferStart; + if Result > FBufferCurrentSize - BufPos then + Result := FBufferCurrentSize - BufPos; + P := @Buffer; + Move(FBuffer[BufPos], P[Start], Result); + Inc(FPosition, Result); +end; + +function TJclBufferedStream.Seek(Offset: Longint; Origin: Word): Longint; +var + NewPos: Longint; +begin + NewPos := FPosition; + case Origin of + soFromBeginning: + NewPos := Offset; + soFromCurrent: + Inc(NewPos, Offset); + soFromEnd: + NewPos := GetCalcedSize + Offset; + else + NewPos := -1; + end; + if NewPos < 0 then + NewPos := -1 + else + FPosition := NewPos; + Result := NewPos; +end; + +procedure TJclBufferedStream.SetBufferSize(Value: Longint); +begin + if FBufferSize <> Value then + FBufferSize := Value; +end; + +procedure TJclBufferedStream.SetSize(NewSize: Longint); +begin + inherited SetSize(NewSize); +end; + +function TJclBufferedStream.Write(const Buffer; Count: Longint): Longint; +begin + Result := Count; + while Count > 0 do + begin + if not BufferHit then + LoadBuffer; + Dec(Count, WriteToBuffer(Buffer, Count, Result - Count)); + end; + Result := Result - Count; +end; + +function TJclBufferedStream.WriteToBuffer(const Buffer; Count, Start: Longint): Longint; +var + BufPos: Longint; + P: PChar; +begin + Result := Count; + BufPos := FPosition - FBufferStart; + if Result > Length(FBuffer) - BufPos then + Result := Length(FBuffer) - BufPos; + if FBufferCurrentSize < BufPos + Result then + FBufferCurrentSize := BufPos + Result; + P := @Buffer; + Move(P[Start], FBuffer[BufPos], Result); + FBufferMaxModifiedPos := BufPos + Result; + Inc(FPosition, Result); +end; + +//=== { TJclEventStream } ==================================================== + +constructor TJclEventStream.Create(AStream: TStream; ANotification: + TStreamNotifyEvent = nil; AOwnsStream: Boolean = False); +begin + inherited Create(AStream, AOwnsStream); + FNotification := ANotification; +end; + +procedure TJclEventStream.DoAfterStreamChange; +begin + inherited DoAfterStreamChange; + if Stream <> nil then + DoNotification; +end; + +procedure TJclEventStream.DoBeforeStreamChange; +begin + inherited DoBeforeStreamChange; + if Stream <> nil then + DoNotification; +end; + +procedure TJclEventStream.DoNotification; +begin + if Assigned(FNotification) then + FNotification(Self, Stream.Position, Stream.Size); +end; + +function TJclEventStream.Read(var Buffer; Count: Longint): Longint; +begin + Result := inherited Read(Buffer, Count); + DoNotification; +end; + +function TJclEventStream.Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; +begin + Result := inherited Seek(Offset, Origin); + DoNotification; +end; + +function TJclEventStream.Seek(Offset: Longint; Origin: Word): Longint; +begin + Result := inherited Seek(Offset, Origin); + DoNotification; +end; + +procedure TJclEventStream.SetSize(NewSize: Longint); +begin + inherited SetSize(NewSize); + DoNotification; +end; + +procedure TJclEventStream.SetSize(const NewSize: Int64); +begin + inherited SetSize(NewSize); + DoNotification; +end; + +function TJclEventStream.Write(const Buffer; Count: Longint): Longint; +begin + Result := inherited Write(Buffer, Count); + DoNotification; +end; + +//=== { TJclEasyStream } ===================================================== + +function TJclEasyStream.IsEqual(Stream: TStream): Boolean; +type + TTestBuffer = array [0..4095] of Byte; +var + MyPos: Integer; + MyRead: Integer; + MyBuffer: TTestBuffer; + StreamPos: Integer; + StreamRead: Integer; + StreamBuffer: TTestBuffer; + TestSize: Integer; +begin + Result := False; + MyPos := Position; + StreamPos := Stream.Position; + if Size <> Stream.Size then + Exit; + try + Position := 0; + Stream.Position := 0; + TestSize := Size; + while Position < TestSize do + begin + MyRead := Read(MyBuffer, SizeOf(MyBuffer)); + StreamRead := Stream.Read(StreamBuffer, SizeOf(StreamBuffer)); + if MyRead <> StreamRead then + Exit; + if not CompareMem(Addr(MyBuffer), Addr(StreamBuffer), MyRead) then + Exit; + end; + finally + Position := MyPos; + Stream.Position := StreamPos; + end; + Result := True; +end; + +function TJclEasyStream.ReadBoolean: Boolean; +begin + ReadBuffer(Result, SizeOf(Result)); +end; + +function TJclEasyStream.ReadChar: Char; +begin + ReadBuffer(Result, SizeOf(Result)); +end; + +function TJclEasyStream.ReadComp: Comp; +begin + ReadBuffer(Result, SizeOf(Result)); +end; + +function TJclEasyStream.ReadCurrency: Currency; +begin + ReadBuffer(Result, SizeOf(Result)); +end; + +function TJclEasyStream.ReadDateTime: TDateTime; +begin + ReadBuffer(Result, SizeOf(Result)); +end; + +function TJclEasyStream.ReadDouble: Double; +begin + ReadBuffer(Result, SizeOf(Result)); +end; + +function TJclEasyStream.ReadExtended: Extended; +begin + ReadBuffer(Result, SizeOf(Result)); +end; + +function TJclEasyStream.ReadInt64: Int64; +begin + ReadBuffer(Result, SizeOf(Result)); +end; + +function TJclEasyStream.ReadInteger: Integer; +begin + ReadBuffer(Result, SizeOf(Result)); +end; + +function TJclEasyStream.ReadCString: string; +var + CurrPos: Integer; + StrSize: Integer; +begin + CurrPos := Position; + repeat + until ReadChar = #0; + StrSize := Position - CurrPos - 1; + SetString(Result, PChar(nil), StrSize); + Position := CurrPos; + ReadBuffer(Pointer(Result)^, StrSize); + Position := Position + 1; +end; + +function TJclEasyStream.ReadShortString: string; +var + StrSize: Integer; +begin + StrSize := Ord(ReadChar); + SetString(Result, PChar(nil), StrSize); + ReadBuffer(Pointer(Result)^, StrSize); +end; + +function TJclEasyStream.ReadSingle: Single; +begin + ReadBuffer(Result, SizeOf(Result)); +end; + +function TJclEasyStream.ReadSizedString: string; +var + StrSize: Integer; +begin + StrSize := ReadInteger; + SetString(Result, PChar(nil), StrSize); + ReadBuffer(Pointer(Result)^, StrSize); +end; + +procedure TJclEasyStream.WriteBoolean(Value: Boolean); +begin + WriteBuffer(Value, SizeOf(Value)); +end; + +procedure TJclEasyStream.WriteChar(Value: Char); +begin + WriteBuffer(Value, SizeOf(Value)); +end; + +procedure TJclEasyStream.WriteComp(const Value: Comp); +begin + WriteBuffer(Value, SizeOf(Value)); +end; + +procedure TJclEasyStream.WriteCurrency(const Value: Currency); +begin + WriteBuffer(Value, SizeOf(Value)); +end; + +procedure TJclEasyStream.WriteDateTime(const Value: TDateTime); +begin + WriteBuffer(Value, SizeOf(Value)); +end; + +procedure TJclEasyStream.WriteDouble(const Value: Double); +begin + WriteBuffer(Value, SizeOf(Value)); +end; + +procedure TJclEasyStream.WriteExtended(const Value: Extended); +begin + WriteBuffer(Value, SizeOf(Value)); +end; + +procedure TJclEasyStream.WriteInt64(Value: Int64); +begin + WriteBuffer(Value, SizeOf(Value)); +end; + +procedure TJclEasyStream.WriteInteger(Value: Integer); +begin + WriteBuffer(Value, SizeOf(Value)); +end; + +procedure TJclEasyStream.WriteStringDlimitedByNull(const Value: string); +begin + WriteBuffer(PChar(Value)^, Length(Value) + 1); +end; + +procedure TJclEasyStream.WriteShortString(const Value: ShortString); +begin + WriteBuffer(Value[0], Length(Value) + 1); +end; + +procedure TJclEasyStream.WriteSingle(const Value: Single); +begin + WriteBuffer(Value, SizeOf(Value)); +end; + +procedure TJclEasyStream.WriteSizedString(const Value: string); +var + StrSize: Integer; +begin + StrSize := Length(Value); + WriteInteger(StrSize); + WriteBuffer(Pointer(Value)^, StrSize); +end; + // History: // $Log$ This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
|
From: <ou...@us...> - 2006-05-01 19:59:16
|
Revision: 1632 Author: outchy Date: 2006-05-01 12:59:08 -0700 (Mon, 01 May 2006) ViewCVS: http://svn.sourceforge.net/jcl/?rev=1632&view=rev Log Message: ----------- Mantis 3661 last and first items being enumerated were not correct Modified Paths: -------------- trunk/jcl/source/common/JclBinaryTrees.pas Modified: trunk/jcl/source/common/JclBinaryTrees.pas =================================================================== --- trunk/jcl/source/common/JclBinaryTrees.pas 2006-05-01 18:53:33 UTC (rev 1631) +++ trunk/jcl/source/common/JclBinaryTrees.pas 2006-05-01 19:59:08 UTC (rev 1632) @@ -1530,14 +1530,32 @@ end; function TJclIntfBinaryTree.First: IJclIntfIterator; +var + Start: PJclIntfBinaryNode; begin + Start := FRoot; case GetTraverseOrder of toPreOrder: - Result := TPreOrderIntfItr.Create(Self, FRoot); + Result := TPreOrderIntfItr.Create(Self, Start); toOrder: - Result := TInOrderIntfItr.Create(Self, FRoot); + begin + if Start <> nil then + while Start.Left <> nil do + Start := Start.Left; + Result := TInOrderIntfItr.Create(Self, Start); + end; toPostOrder: - Result := TPostOrderIntfItr.Create(Self, FRoot); + begin + if Start <> nil then + while (Start.Left <> nil) or (Start.Right <> nil) do + begin + if Start.Left <> nil then + Start := Start.Left + else + Start := Start.Right; + end; + Result := TPostOrderIntfItr.Create(Self, Start); + end; end; end; @@ -1560,8 +1578,13 @@ toPreOrder: begin if Start <> nil then - while Start.Right <> nil do - Start := Start.Right; + while (Start.Left <> nil) or (Start.Right <> nil) do + begin + if Start.Right <> nil then + Start := Start.Right + else + Start := Start.Left; + end; Result := TPreOrderIntfItr.Create(Self, Start); end; toOrder: @@ -2263,14 +2286,32 @@ end; function TJclStrBinaryTree.First: IJclStrIterator; +var + Start: PJclStrBinaryNode; begin + Start := FRoot; case GetTraverseOrder of toPreOrder: - Result := TPreOrderStrItr.Create(Self, FRoot); + Result := TPreOrderStrItr.Create(Self, Start); toOrder: - Result := TInOrderStrItr.Create(Self, FRoot); + begin + if Start <> nil then + while Start.Left <> nil do + Start := Start.Left; + Result := TInOrderStrItr.Create(Self, Start); + end; toPostOrder: - Result := TPostOrderStrItr.Create(Self, FRoot); + begin + if Start <> nil then + while (Start.Left <> nil) or (Start.Right <> nil) do + begin + if Start.Left <> nil then + Start := Start.Left + else + Start := Start.Right; + end; + Result := TPostOrderStrItr.Create(Self, Start); + end; end; end; @@ -2293,8 +2334,13 @@ toPreOrder: begin if Start <> nil then - while Start.Right <> nil do - Start := Start.Right; + while (Start.Left <> nil) or (Start.Right <> nil) do + begin + if Start.Right <> nil then + Start := Start.Right + else + Start := Start.Left; + end; Result := TPreOrderStrItr.Create(Self, Start); end; toOrder: @@ -2926,14 +2972,32 @@ end; function TJclBinaryTree.First: IJclIterator; +var + Start: PJclBinaryNode; begin + Start := FRoot; case GetTraverseOrder of toPreOrder: - Result := TPreOrderItr.Create(Self, FRoot); + Result := TPreOrderItr.Create(Self, Start); toOrder: - Result := TInOrderItr.Create(Self, FRoot); + begin + if Start <> nil then + while Start.Left <> nil do + Start := Start.Left; + Result := TInOrderItr.Create(Self, Start); + end; toPostOrder: - Result := TPostOrderItr.Create(Self, FRoot); + begin + if Start <> nil then + while (Start.Left <> nil) or (Start.Right <> nil) do + begin + if Start.Left <> nil then + Start := Start.Left + else + Start := Start.Right; + end; + Result := TPostOrderItr.Create(Self, Start); + end; end; end; @@ -2956,8 +3020,13 @@ toPreOrder: begin if Start <> nil then - while Start.Right <> nil do - Start := Start.Right; + while (Start.Left <> nil) or (Start.Right <> nil) do + begin + if Start.Right <> nil then + Start := Start.Right + else + Start := Start.Left; + end; Result := TPreOrderItr.Create(Self, Start); end; toOrder: This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
|
From: <ou...@us...> - 2006-05-01 18:53:51
|
Revision: 1631 Author: outchy Date: 2006-05-01 11:53:33 -0700 (Mon, 01 May 2006) ViewCVS: http://svn.sourceforge.net/jcl/?rev=1631&view=rev Log Message: ----------- Mantis 3653 access violation when adding nodes into trees (more details are given in Mantis 3658). Modified Paths: -------------- trunk/jcl/source/common/JclBinaryTrees.pas Modified: trunk/jcl/source/common/JclBinaryTrees.pas =================================================================== --- trunk/jcl/source/common/JclBinaryTrees.pas 2006-05-01 17:58:32 UTC (rev 1630) +++ trunk/jcl/source/common/JclBinaryTrees.pas 2006-05-01 18:53:33 UTC (rev 1631) @@ -1247,7 +1247,7 @@ if (NewNode.Parent.Parent <> nil) and (NewNode.Parent = NewNode.Parent.Parent.Left) then begin Current := NewNode.Parent.Parent.Right; - if Current.Color = tcRed then + if (Current <> nil) and (Current.Color = tcRed) then begin NewNode.Parent.Color := tcBlack; Current.Color := tcBlack; @@ -2643,7 +2643,7 @@ if (NewNode.Parent.Parent <> nil) and (NewNode.Parent = NewNode.Parent.Parent.Left) then begin Current := NewNode.Parent.Parent.Right; - if Current.Color = tcRed then + if (Current <> nil) and (Current.Color = tcRed) then begin NewNode.Parent.Color := tcBlack; Current.Color := tcBlack; This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
|
From: <ou...@us...> - 2006-05-01 17:58:44
|
Revision: 1630 Author: outchy Date: 2006-05-01 10:58:32 -0700 (Mon, 01 May 2006) ViewCVS: http://svn.sourceforge.net/jcl/?rev=1630&view=rev Log Message: ----------- Fixes for access violations and exceptions Modified Paths: -------------- trunk/jcl/install/JclInstall.pas trunk/jcl/install/JediRegInfo.pas Modified: trunk/jcl/install/JclInstall.pas =================================================================== --- trunk/jcl/install/JclInstall.pas 2006-05-01 17:47:55 UTC (rev 1629) +++ trunk/jcl/install/JclInstall.pas 2006-05-01 17:58:32 UTC (rev 1630) @@ -2128,8 +2128,14 @@ end; function TJclInstallation.RemoveSettings: Boolean; +var + JclSettingsKey: string; begin - Result := RegDeleteKeyTree(HKCU, Target.ConfigDataLocation + '\Jedi\JCL'); + JclSettingsKey := Target.ConfigDataLocation + '\Jedi\JCL'; + if RegKeyExists(HKCU, JclSettingsKey) then + Result := RegDeleteKeyTree(HKCU, JclSettingsKey) + else + Result := True; end; function TJclInstallation.UninstallPackage(const Name: string): Boolean; Modified: trunk/jcl/install/JediRegInfo.pas =================================================================== --- trunk/jcl/install/JediRegInfo.pas 2006-05-01 17:47:55 UTC (rev 1629) +++ trunk/jcl/install/JediRegInfo.pas 2006-05-01 17:58:32 UTC (rev 1630) @@ -151,7 +151,7 @@ if Reg.OpenKey(JediKeyName, False) then // do not localize begin - + Names := TStringList.Create; try Reg.GetKeyNames(Names); if Names.Count = 0 then This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
|
From: <ou...@us...> - 2006-05-01 17:48:07
|
Revision: 1629 Author: outchy Date: 2006-05-01 10:47:55 -0700 (Mon, 01 May 2006) ViewCVS: http://svn.sourceforge.net/jcl/?rev=1629&view=rev Log Message: ----------- Mantis 3652 expert settings can be kept. Modified Paths: -------------- trunk/jcl/install/JclInstall.pas trunk/jcl/install/JediRegInfo.pas Modified: trunk/jcl/install/JclInstall.pas =================================================================== --- trunk/jcl/install/JclInstall.pas 2006-05-01 17:05:08 UTC (rev 1628) +++ trunk/jcl/install/JclInstall.pas 2006-05-01 17:47:55 UTC (rev 1629) @@ -118,6 +118,7 @@ function ProgressWeight(Option: TJediInstallOption): Integer; function Run: Boolean; function Undo: Boolean; + function RemoveSettings: Boolean; function StoredBplPath: string; function StoredDcpPath: string; property Defines: TStringList read FDefines; @@ -1959,6 +1960,7 @@ Result := 2; ioJclPackages: Result := 10; + ioJclExpertDebug..ioJclExpertVersionControl: Result := 5; ioJclCopyPackagesHppFiles: Result := 2; @@ -2125,6 +2127,11 @@ SaveOptions; end; +function TJclInstallation.RemoveSettings: Boolean; +begin + Result := RegDeleteKeyTree(HKCU, Target.ConfigDataLocation + '\Jedi\JCL'); +end; + function TJclInstallation.UninstallPackage(const Name: string): Boolean; var PackageFileName: string; @@ -2553,7 +2560,8 @@ for I := 0 to FTargetInstalls.Count - 1 do begin if not KeepSettings then - TJclInstallation(FTargetInstalls[I]).Undo; + TJclInstallation(FTargetInstalls[I]).RemoveSettings; + TJclInstallation(FTargetInstalls[I]).Undo; Result := Result and TJclInstallation(FTargetInstalls[I]).Run; end; finally @@ -2572,7 +2580,8 @@ InitProgress; for I := 0 to FTargetInstalls.Count - 1 do begin - Success := TJclInstallation(FTargetInstalls[I]).Undo; + Success := TJclInstallation(FTargetInstalls[I]).RemoveSettings + and TJclInstallation(FTargetInstalls[I]).Undo; Result := Result and Success; end; finally Modified: trunk/jcl/install/JediRegInfo.pas =================================================================== --- trunk/jcl/install/JediRegInfo.pas 2006-05-01 17:05:08 UTC (rev 1628) +++ trunk/jcl/install/JediRegInfo.pas 2006-05-01 17:47:55 UTC (rev 1629) @@ -113,13 +113,24 @@ var Reg: TRegistry; Names: TStringList; + JediKeyName, ProjectKeyName: string; begin Reg := TRegistry.Create; try Reg.RootKey := HKEY_CURRENT_USER; - Reg.DeleteKey(IdeRegKey + '\Jedi\' + ProjectName); // do not localize - if Reg.OpenKey(IdeRegKey + '\Jedi', False) then // do not localize +// (outchy) do not delete target settings +// Reg.DeleteKey(IdeRegKey + '\Jedi\' + ProjectName); // do not localize + + JediKeyName := IdeRegKey + '\Jedi'; // do not localize + ProjectKeyName := JediKeyName + '\' + ProjectName; // do not localize + + if Reg.OpenKey(ProjectKeyName, False) then begin + Reg.DeleteValue('Version'); + Reg.DeleteValue('DcpDir'); + Reg.DeleteValue('BplDir'); + Reg.DeleteValue('RootDir'); + Names := TStringList.Create; try Reg.GetKeyNames(Names); @@ -129,13 +140,33 @@ if Names.Count = 0 then begin Reg.CloseKey; - Reg.DeleteKey(IdeRegKey + '\Jedi'); // do not localize + Reg.DeleteKey(ProjectKeyName); // do not localize end; end; finally Names.Free; end; end; + + + if Reg.OpenKey(JediKeyName, False) then // do not localize + begin + + try + Reg.GetKeyNames(Names); + if Names.Count = 0 then + begin + Reg.GetValueNames(Names); + if Names.Count = 0 then + begin + Reg.CloseKey; + Reg.DeleteKey(JediKeyName); // do not localize + end; + end; + finally + Names.Free; + end; + end; finally Reg.Free; end; This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
|
From: <ou...@us...> - 2006-05-01 17:05:21
|
Revision: 1628 Author: outchy Date: 2006-05-01 10:05:08 -0700 (Mon, 01 May 2006) ViewCVS: http://svn.sourceforge.net/jcl/?rev=1628&view=rev Log Message: ----------- Mantis 3652 expert settings can be kept. Personalities informations in installation log. Modified Paths: -------------- trunk/jcl/install/JclInstall.pas Modified: trunk/jcl/install/JclInstall.pas =================================================================== --- trunk/jcl/install/JclInstall.pas 2006-05-01 16:29:36 UTC (rev 1627) +++ trunk/jcl/install/JclInstall.pas 2006-05-01 17:05:08 UTC (rev 1628) @@ -1390,9 +1390,19 @@ var Option: TJediInstallOption; + Personality: TJclBorPersonality; begin Tool.UpdateStatus(Format(RsStatusMessage, [Target.Name])); WriteLog(StrPadRight(BorRADToolVersionStr, 44, '=')); + WriteLog(''); + WriteLog('Installed personalities :'); + for Personality := Low(TJclBorPersonality) to High(TJclBorPersonality) do + if Personality in Target.Personalities then + begin + WriteLog(JclBorPersonalityDescription[Personality]); + end; + WriteLog(StrRepeat('=', 44)); + Result := CheckDirectories; if Result then begin @@ -1949,13 +1959,6 @@ Result := 2; ioJclPackages: Result := 10; - ioJclExpertDebug, - ioJclExpertAnalyzer, - ioJclExpertFavorite, - ioJclExpertThreadNames, - ioJclExpertUses, - ioJclExpertSimdView, - ioJclExpertVersionControl: Result := 5; ioJclCopyPackagesHppFiles: Result := 2; @@ -2531,14 +2534,26 @@ function TJclDistribution.Install: Boolean; var I: Integer; + KeepSettings: Boolean; begin FInstalling := True; // tell UninstallOption not to call Progress() + KeepSettings := False; Result := True; try InitProgress; + for I := 0 to FTargetInstalls.Count - 1 do + if TJclInstallation(FTargetInstalls[I]).OptionSelected(ioJCL) then begin - TJclInstallation(FTargetInstalls[I]).Undo; + KeepSettings := MessageDlg('Do you want to keep JCL expert settings ?', + mtConfirmation, [mbYes, mbNo], 0) = mrYes; + Break; + end; + + for I := 0 to FTargetInstalls.Count - 1 do + begin + if not KeepSettings then + TJclInstallation(FTargetInstalls[I]).Undo; Result := Result and TJclInstallation(FTargetInstalls[I]).Run; end; finally This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
|
From: <ou...@us...> - 2006-05-01 16:29:42
|
Revision: 1627 Author: outchy Date: 2006-05-01 09:29:36 -0700 (Mon, 01 May 2006) ViewCVS: http://svn.sourceforge.net/jcl/?rev=1627&view=rev Log Message: ----------- Mantis 3664 constructor export name fixed. Modified Paths: -------------- trunk/jcl/source/windows/JclDebug.pas Modified: trunk/jcl/source/windows/JclDebug.pas =================================================================== --- trunk/jcl/source/windows/JclDebug.pas 2006-05-01 16:17:04 UTC (rev 1626) +++ trunk/jcl/source/windows/JclDebug.pas 2006-05-01 16:29:36 UTC (rev 1627) @@ -511,8 +511,10 @@ function GetCount: Integer; procedure CorrectOnAccess(ASkipFirstItem: Boolean); public - constructor Create(ARaw: Boolean; AIgnoreLevels: DWORD; AFirstCaller: Pointer; - ADelayedTrace: Boolean = False); + constructor Create(ARaw: Boolean; AIgnoreLevels: DWORD; + AFirstCaller: Pointer); overload; + constructor Create(ARaw: Boolean; AIgnoreLevels: DWORD; + AFirstCaller: Pointer; ADelayedTrace: Boolean); overload; destructor Destroy; override; procedure ForceStackTracing; procedure AddToStrings(Strings: TStrings; IncludeModuleName: Boolean = False; @@ -3313,6 +3315,12 @@ TraceStackFrames; end; +constructor TJclStackInfoList.Create(ARaw: Boolean; AIgnoreLevels: DWORD; + AFirstCaller: Pointer); +begin + Create(ARaw, AIgnoreLevels, AFirstCaller, False); +end; + destructor TJclStackInfoList.Destroy; begin if Assigned(FStackData) then This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
|
From: <ou...@us...> - 2006-05-01 16:17:11
|
Revision: 1626 Author: outchy Date: 2006-05-01 09:17:04 -0700 (Mon, 01 May 2006) ViewCVS: http://svn.sourceforge.net/jcl/?rev=1626&view=rev Log Message: ----------- Mantis 3648: registry exception when installing on incomplete targets. Modified Paths: -------------- trunk/jcl/source/common/JclBorlandTools.pas Modified: trunk/jcl/source/common/JclBorlandTools.pas =================================================================== --- trunk/jcl/source/common/JclBorlandTools.pas 2006-04-29 16:20:35 UTC (rev 1625) +++ trunk/jcl/source/common/JclBorlandTools.pas 2006-05-01 16:17:04 UTC (rev 1626) @@ -4571,8 +4571,9 @@ function EnumVersions(const KeyName: string; const Personalities: array of string; CreateClass: TJclBorRADToolInstallationClass) : Boolean; var I, J: Integer; - VersionKeyName: string; + VersionKeyName, PersonalitiesKeyName: string; PersonalitiesList: TStrings; + Installation: TJclBorRADToolInstallation; begin Result := False; if RegKeyExists(HKEY_LOCAL_MACHINE, KeyName) and @@ -4586,7 +4587,9 @@ if Length(Personalities) = 0 then begin try - FList.Add(CreateClass.Create(VersionKeyName)); + Installation := CreateClass.Create(VersionKeyName); + if Installation.Valid then + FList.Add(Installation); finally Result := True; end; @@ -4595,12 +4598,17 @@ begin PersonalitiesList := TStringList.Create; try - RegGetValueNames(HKEY_LOCAL_MACHINE, VersionKeyName + '\Personalities', PersonalitiesList); + PersonalitiesKeyName := VersionKeyName + '\Personalities'; + if RegKeyExists(HKEY_LOCAL_MACHINE, PersonalitiesKeyName) then + RegGetValueNames(HKEY_LOCAL_MACHINE, PersonalitiesKeyName, PersonalitiesList); + for J := Low(Personalities) to High(Personalities) do if PersonalitiesList.IndexOf(Personalities[J]) >= 0 then begin try - FList.Add(CreateClass.Create(VersionKeyName)); + Installation := CreateClass.Create(VersionKeyName); + if Installation.Valid then + FList.Add(Installation); finally Result := True; end; This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
|
From: <ah...@us...> - 2006-04-29 16:20:45
|
Revision: 1625 Author: ahuser Date: 2006-04-29 09:20:35 -0700 (Sat, 29 Apr 2006) ViewCVS: http://svn.sourceforge.net/jcl/?rev=1625&view=rev Log Message: ----------- UTF8 to ANSI Modified Paths: -------------- trunk/jcl/source/common/JclUnitVersioningProviders.pas Modified: trunk/jcl/source/common/JclUnitVersioningProviders.pas =================================================================== --- trunk/jcl/source/common/JclUnitVersioningProviders.pas 2006-04-29 06:23:15 UTC (rev 1624) +++ trunk/jcl/source/common/JclUnitVersioningProviders.pas 2006-04-29 16:20:35 UTC (rev 1625) @@ -1,4 +1,4 @@ -{**************************************************************************************************} +{**************************************************************************************************} { } { Project JEDI Code Library (JCL) } { } This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
|
From: <ou...@us...> - 2006-04-29 06:23:27
|
Revision: 1624 Author: outchy Date: 2006-04-28 23:23:15 -0700 (Fri, 28 Apr 2006) ViewCVS: http://svn.sourceforge.net/jcl/?rev=1624&view=rev Log Message: ----------- UnitVersioning: $URL$ keyword enabled. Modified Paths: -------------- trunk/jcl/source/common/JclBorlandTools.pas trunk/jcl/source/common/JclSysInfo.pas trunk/jcl/source/common/JclUnitVersioningProviders.pas Property Changed: ---------------- trunk/jcl/source/common/JclUnitVersioningProviders.pas Modified: trunk/jcl/source/common/JclBorlandTools.pas =================================================================== --- trunk/jcl/source/common/JclBorlandTools.pas 2006-04-29 03:27:24 UTC (rev 1623) +++ trunk/jcl/source/common/JclBorlandTools.pas 2006-04-29 06:23:15 UTC (rev 1624) @@ -124,11 +124,17 @@ ProjectTypePackage = 'package'; ProjectTypeLibrary = 'library'; - ProjectTypeProgram = 'program'; + ProjectTypeProgram = 'program'; + Personality32Bit = '32 bit'; + Personality64Bit = '64 bit'; PersonalityDelphi = 'Delphi'; + PersonalityDelphiDotNet = 'Delphi.net'; PersonalityBCB = 'C++Builder'; PersonalityCSB = 'C#Builder'; + PersonalityVB = 'Visual Basic'; + PersonalityDesign = 'Design'; + PersonalityUnknown = 'Unknown personality'; PersonalityBDS = 'Borland Developer Studio'; DOFDirectoriesSection = 'Directories'; @@ -149,12 +155,29 @@ // Installed versions information classes type - TJclBorPersonality = (bpDelphi32, bpBCBuilder32, bpDelphiNet32, bpDelphiNet64, - bpCSBuilder32, bpCSBuilder64); + TJclBorPersonality = (bpDelphi32, bpDelphi64, bpBCBuilder32, bpBCBuilder64, + bpDelphiNet32, bpDelphiNet64, bpCSBuilder32, bpCSBuilder64, + bpVisualBasic32, bpVisualBasic64, bpDesign, bpUnknown); // bpDelphi64, bpBCBuilder64); TJclBorPersonalities = set of TJclBorPersonality; +const + JclBorPersonalityDescription: array [TJclBorPersonality] of string = + ( Personality32Bit + ' ' + PersonalityDelphi, + Personality64Bit + ' ' + PersonalityDelphi, + Personality32Bit + ' ' + PersonalityBCB, + Personality64Bit + ' ' + PersonalityBCB, + Personality32Bit + ' ' + PersonalityDelphiDotNet, + Personality64Bit + ' ' + PersonalityDelphiDotNet, + Personality32Bit + ' ' + PersonalityCSB, + Personality64Bit + ' ' + PersonalityCSB, + Personality32Bit + ' ' + PersonalityVB, + Personality64Bit + ' ' + PersonalityVB, + PersonalityDesign, + PersonalityUnknown ); + +type TJclBorRADToolInstallation = class; TJclBorRADToolInstallationObject = class(TInterfacedObject) Modified: trunk/jcl/source/common/JclSysInfo.pas =================================================================== --- trunk/jcl/source/common/JclSysInfo.pas 2006-04-29 03:27:24 UTC (rev 1623) +++ trunk/jcl/source/common/JclSysInfo.pas 2006-04-29 06:23:15 UTC (rev 1624) @@ -426,6 +426,7 @@ SSE: Byte; // SSE version 0 = no SSE, 1 = SSE, 2 = SSE2, 3 = SSE3 IsFDIVOK: Boolean; Is64Bits: Boolean; + DEPEnabled: Boolean; // incomplete HasCacheInfo: Boolean; HasExtendedInfo: Boolean; PType: Byte; @@ -1100,6 +1101,7 @@ function GetFreeSystemResources(const ResourceType: TFreeSysResKind): Integer; overload; function GetFreeSystemResources: TFreeSystemResources; overload; +function GetBPP: Cardinal; {$ENDIF MSWINDOWS} // Public global variables @@ -5190,6 +5192,20 @@ end; end; +function GetBPP: Cardinal; +var + DC: HDC; +begin + DC := GetDC(HWND_DESKTOP); + if DC <> 0 then + begin + Result := GetDeviceCaps(DC, BITSPIXEL) * GetDeviceCaps(DC, PLANES); + ReleaseDC(HWND_DESKTOP, DC); + end + else + Result := 0; +end; + //=== Initialization/Finalization ============================================ procedure InitSysInfo; Modified: trunk/jcl/source/common/JclUnitVersioningProviders.pas =================================================================== --- trunk/jcl/source/common/JclUnitVersioningProviders.pas 2006-04-29 03:27:24 UTC (rev 1623) +++ trunk/jcl/source/common/JclUnitVersioningProviders.pas 2006-04-29 06:23:15 UTC (rev 1624) @@ -1,4 +1,4 @@ -{**************************************************************************************************} +{**************************************************************************************************} { } { Project JEDI Code Library (JCL) } { } @@ -388,7 +388,7 @@ const UnitVersioning: TUnitVersionInfo = ( - RCSfile: '$RCSfile$'; + RCSfile: '$URL$'; Revision: '$Revision$'; Date: '$Date$'; LogPath: 'JCL\common'; Property changes on: trunk/jcl/source/common/JclUnitVersioningProviders.pas ___________________________________________________________________ Name: svn:keywords - Author Date Id Revision + Author Date Id Revision Url This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
|
From: <el...@us...> - 2006-04-29 03:27:31
|
Revision: 1623 Author: elahn Date: 2006-04-28 20:27:24 -0700 (Fri, 28 Apr 2006) ViewCVS: http://svn.sourceforge.net/jcl/?rev=1623&view=rev Log Message: ----------- Set svn:keywords property to include "URL". Property Changed: ---------------- trunk/jcl/source/common/JclUnitVersioning.pas Property changes on: trunk/jcl/source/common/JclUnitVersioning.pas ___________________________________________________________________ Name: svn:keywords - Author Date Id Revision + Author Date Id Revision Url This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
|
From: <ou...@us...> - 2006-04-28 23:32:04
|
Revision: 1622 Author: outchy Date: 2006-04-28 16:31:55 -0700 (Fri, 28 Apr 2006) ViewCVS: http://svn.sourceforge.net/jcl/?rev=1622&view=rev Log Message: ----------- JclUnitVersioning: $RCSfile$ replaced with $HeadURL$ Modified Paths: -------------- trunk/jcl/source/common/JclUnitVersioning.pas Modified: trunk/jcl/source/common/JclUnitVersioning.pas =================================================================== --- trunk/jcl/source/common/JclUnitVersioning.pas 2006-04-28 19:17:09 UTC (rev 1621) +++ trunk/jcl/source/common/JclUnitVersioning.pas 2006-04-28 23:31:55 UTC (rev 1622) @@ -776,7 +776,7 @@ const UnitVersioning: TUnitVersionInfo = ( - RCSfile: '$HeadURL:$'; + RCSfile: '$URL$'; Revision: '$Revision$'; Date: '$Date$'; LogPath: 'JCL\common'; This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
|
From: <jfu...@us...> - 2006-04-28 22:27:53
|
Revision: 1621 Author: jfudickar Date: 2006-04-28 12:17:09 -0700 (Fri, 28 Apr 2006) ViewCVS: http://svn.sourceforge.net/jcl/?rev=1621&view=rev Log Message: ----------- JclUnitVersioning: $RCSfile$ replaced with $HeadURL$ Modified Paths: -------------- trunk/jcl/source/common/JclUnitVersioning.pas Modified: trunk/jcl/source/common/JclUnitVersioning.pas =================================================================== --- trunk/jcl/source/common/JclUnitVersioning.pas 2006-04-28 19:16:31 UTC (rev 1620) +++ trunk/jcl/source/common/JclUnitVersioning.pas 2006-04-28 19:17:09 UTC (rev 1621) @@ -776,7 +776,7 @@ const UnitVersioning: TUnitVersionInfo = ( - RCSfile: '$HeadURL$:'; + RCSfile: '$HeadURL:$'; Revision: '$Revision$'; Date: '$Date$'; LogPath: 'JCL\common'; This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
|
From: <jfu...@us...> - 2006-04-28 22:27:47
|
Revision: 1619 Author: jfudickar Date: 2006-04-28 12:12:35 -0700 (Fri, 28 Apr 2006) ViewCVS: http://svn.sourceforge.net/jcl/?rev=1619&view=rev Log Message: ----------- JclUnitVersioning: $RCSfile$ replaced with $HeadURL$ Modified Paths: -------------- trunk/jcl/source/common/JclUnitVersioning.pas Modified: trunk/jcl/source/common/JclUnitVersioning.pas =================================================================== --- trunk/jcl/source/common/JclUnitVersioning.pas 2006-04-25 06:42:52 UTC (rev 1618) +++ trunk/jcl/source/common/JclUnitVersioning.pas 2006-04-28 19:12:35 UTC (rev 1619) @@ -776,7 +776,7 @@ const UnitVersioning: TUnitVersionInfo = ( - RCSfile: '$RCSfile$'; + RCSfile: '$HeadURL$'; Revision: '$Revision$'; Date: '$Date$'; LogPath: 'JCL\common'; This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
|
From: <jfu...@us...> - 2006-04-28 22:26:44
|
Revision: 1620 Author: jfudickar Date: 2006-04-28 12:16:31 -0700 (Fri, 28 Apr 2006) ViewCVS: http://svn.sourceforge.net/jcl/?rev=1620&view=rev Log Message: ----------- JclUnitVersioning: $RCSfile$ replaced with $HeadURL$ Modified Paths: -------------- trunk/jcl/source/common/JclUnitVersioning.pas Modified: trunk/jcl/source/common/JclUnitVersioning.pas =================================================================== --- trunk/jcl/source/common/JclUnitVersioning.pas 2006-04-28 19:12:35 UTC (rev 1619) +++ trunk/jcl/source/common/JclUnitVersioning.pas 2006-04-28 19:16:31 UTC (rev 1620) @@ -776,7 +776,7 @@ const UnitVersioning: TUnitVersionInfo = ( - RCSfile: '$HeadURL$'; + RCSfile: '$HeadURL$:'; Revision: '$Revision$'; Date: '$Date$'; LogPath: 'JCL\common'; This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
|
From: <ob...@us...> - 2006-04-25 06:43:02
|
Revision: 1618 Author: obones Date: 2006-04-24 23:42:52 -0700 (Mon, 24 Apr 2006) ViewCVS: http://svn.sourceforge.net/jcl/?rev=1618&view=rev Log Message: ----------- Now compiles again. Modified Paths: -------------- trunk/jcl/source/common/JclStreams.pas Modified: trunk/jcl/source/common/JclStreams.pas =================================================================== --- trunk/jcl/source/common/JclStreams.pas 2006-04-24 08:20:33 UTC (rev 1617) +++ trunk/jcl/source/common/JclStreams.pas 2006-04-25 06:42:52 UTC (rev 1618) @@ -174,6 +174,11 @@ // a stream which stays empty no matter what you do // so it is a Unix /dev/null equivalent +procedure TJclEmptyStream.SetSize(NewSize: Longint); +begin + // nothing +end; + procedure TJclEmptyStream.SetSize(const NewSize: Int64); begin // nothing @@ -191,15 +196,6 @@ Result := 0; end; -function TJclEmptyStream.Seek(Offset: Longint; Origin: Word): Longint; -begin - if (Offset <> 0) or not (Origin in [soFromBeginning, soFromCurrent, soFromEnd]) then - // seeking to anywhere except the position 0 is an error - Result := -1 - else - Result := 0; -end; - function TJclEmptyStream.Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; begin if Offset <> 0 then This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
|
From: <mar...@us...> - 2006-04-24 08:20:45
|
Revision: 1617 Author: marquardt Date: 2006-04-24 01:20:33 -0700 (Mon, 24 Apr 2006) ViewCVS: http://svn.sourceforge.net/jcl/?rev=1617&view=rev Log Message: ----------- tightened and fixed Seek logic Modified Paths: -------------- trunk/jcl/source/common/JclResources.pas trunk/jcl/source/common/JclStreams.pas Modified: trunk/jcl/source/common/JclResources.pas =================================================================== --- trunk/jcl/source/common/JclResources.pas 2006-04-24 05:56:49 UTC (rev 1616) +++ trunk/jcl/source/common/JclResources.pas 2006-04-24 08:20:33 UTC (rev 1617) @@ -750,6 +750,21 @@ resourcestring RsComplexInvalidString = 'Failed to create a complex number from the string provided'; +//=== JclCompression ========================================================= +resourcestring + RsCompressionOperationNotSupported = 'Operation is not supported.'; + RsCompressionReadNotSupported = 'read is not an supported operation.'; + RsCompressionWriteNotSupported = 'write is not an supported operation.'; + RsCompressionResetNotSupported = 'reset is not an supported operation.'; + RsCompressionSeekNotSupported = 'seek is not an supported operation.'; + RsCompressionZLibZErrNo = 'zlib returned: ERRNO'; + RsCompressionZLibZStreamError = 'zlib returned: Stream error'; + RsCompressionZLibZDataError = 'zlib returned: data error'; + RsCompressionZLibZMemError = 'zlib returned: memory error'; + RsCompressionZLibZBufError = 'zlib returned: buffer error'; + RsCompressionZLibZVersionError = 'zlib returned: Version error'; + RsCompressionZLibError = 'ZLib error'; + //=== JclConsole ============================================================= resourcestring RsCannotRaiseSignal = 'Cannot raise %s signal.'; @@ -1447,7 +1462,6 @@ RsHKCCShort = 'HKCC'; RsHKDDShort = 'HKDD'; - //=== JclRTTI ================================================================ resourcestring RsRTTIValueOutOfRange = 'Value out of range (%s).'; @@ -1705,25 +1719,6 @@ RsMidiInUnknownError = 'Unknown MIDI-In error No. %d'; RsMidiOutUnknownError = 'Unknown MIDI-Out error No. %d'; -//=== JclCompression ========================================================= -resourcestring - RsCompressionOperationNotSupported = 'Operation is not supported.'; - RsCompressionReadNotSupported = 'read is not an supported operation.'; - RsCompressionWriteNotSupported = 'write is not an supported operation.'; - RsCompressionResetNotSupported = 'reset is not an supported operation.'; - RsCompressionSeekNotSupported = 'seek is not an supported operation.'; - RsCompressionZLibZErrNo = 'zlib returned: ERRNO'; - RsCompressionZLibZStreamError = 'zlib returned: Stream error'; - RsCompressionZLibZDataError = 'zlib returned: data error'; - RsCompressionZLibZMemError = 'zlib returned: memory error'; - RsCompressionZLibZBufError = 'zlib returned: buffer error'; - RsCompressionZLibZVersionError = 'zlib returned: Version error'; - RsCompressionZLibError = 'ZLib error'; - -//=== JclStreams ============================================================= -resourcestring - RsStreamsRangeError = '32 bit overflow in stream operations, use the 64 bit version'; - implementation // History: Modified: trunk/jcl/source/common/JclStreams.pas =================================================================== --- trunk/jcl/source/common/JclStreams.pas 2006-04-24 05:56:49 UTC (rev 1616) +++ trunk/jcl/source/common/JclStreams.pas 2006-04-24 08:20:33 UTC (rev 1617) @@ -66,7 +66,8 @@ TJclEmptyStream = class(TJclStream) protected - procedure SetSize(const NewSize: Int64); override; + procedure SetSize(NewSize: Longint); overload; override; + procedure SetSize(const NewSize: Int64); overload; override; public function Read(var Buffer; Count: Longint): Longint; override; function Write(const Buffer; Count: Longint): Longint; override; @@ -145,10 +146,10 @@ soFromEnd: Result64 := Seek(Int64(Offset), soEnd); else - Result64 := 0; + Result64 := -1; end; - if (Result64 < Low(Longint)) or (Result64 > High(Longint)) then - raise EJclStreamException.CreateRes(@RsStreamsRangeError); + if (Result64 < 0) or (Result64 > High(Longint)) then + Result64 := -1; Result := Result64; end; @@ -190,6 +191,15 @@ Result := 0; end; +function TJclEmptyStream.Seek(Offset: Longint; Origin: Word): Longint; +begin + if (Offset <> 0) or not (Origin in [soFromBeginning, soFromCurrent, soFromEnd]) then + // seeking to anywhere except the position 0 is an error + Result := -1 + else + Result := 0; +end; + function TJclEmptyStream.Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; begin if Offset <> 0 then @@ -248,17 +258,29 @@ else FPosition := 0; if FPosition > FSize then + begin FPosition := FSize; - Result := FPosition; + Result := -1; + end + else + Result := FPosition; end; soCurrent: begin FPosition := FPosition + Offset; if FPosition > FSize then + begin FPosition := FSize; + Result := -1; + end + else if FPosition < 0 then + begin FPosition := 0; - Result := FPosition; + Result := -1; + end + else + Result := FPosition; end; soEnd: begin @@ -267,8 +289,12 @@ else FPosition := FSize; if FPosition < 0 then + begin FPosition := 0; - Result := FPosition; + Result := -1; + end + else + Result := FPosition; end; else Result := -1; This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
|
From: <mar...@us...> - 2006-04-24 05:56:59
|
Revision: 1616 Author: marquardt Date: 2006-04-23 22:56:49 -0700 (Sun, 23 Apr 2006) ViewCVS: http://svn.sourceforge.net/jcl/?rev=1616&view=rev Log Message: ----------- Oops, dynamic needs to be virtual Modified Paths: -------------- trunk/jcl/source/common/JclStreams.pas Modified: trunk/jcl/source/common/JclStreams.pas =================================================================== --- trunk/jcl/source/common/JclStreams.pas 2006-04-24 04:12:03 UTC (rev 1615) +++ trunk/jcl/source/common/JclStreams.pas 2006-04-24 05:56:49 UTC (rev 1616) @@ -87,8 +87,8 @@ TJclRandomStream = class(TJclNullStream) protected - function GetRandSeed: Longint; dynamic; - procedure SetRandSeed(Seed: Longint); dynamic; + function GetRandSeed: Longint; virtual; + procedure SetRandSeed(Seed: Longint); virtual; public function RandomData: Byte; virtual; procedure Randomize; dynamic; This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
|
From: <mar...@us...> - 2006-04-24 04:12:13
|
Revision: 1615 Author: marquardt Date: 2006-04-23 21:12:03 -0700 (Sun, 23 Apr 2006) ViewCVS: http://svn.sourceforge.net/jcl/?rev=1615&view=rev Log Message: ----------- added dynamic to methods of JclRandomStream Modified Paths: -------------- trunk/jcl/source/common/JclStreams.pas Modified: trunk/jcl/source/common/JclStreams.pas =================================================================== --- trunk/jcl/source/common/JclStreams.pas 2006-04-23 06:25:38 UTC (rev 1614) +++ trunk/jcl/source/common/JclStreams.pas 2006-04-24 04:12:03 UTC (rev 1615) @@ -87,8 +87,8 @@ TJclRandomStream = class(TJclNullStream) protected - function GetRandSeed: Longint; - procedure SetRandSeed(Seed: Longint); + function GetRandSeed: Longint; dynamic; + procedure SetRandSeed(Seed: Longint); dynamic; public function RandomData: Byte; virtual; procedure Randomize; dynamic; This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
|
From: <mar...@us...> - 2006-04-23 06:26:12
|
Revision: 1614 Author: marquardt Date: 2006-04-22 23:25:38 -0700 (Sat, 22 Apr 2006) ViewCVS: http://svn.sourceforge.net/jcl/?rev=1614&view=rev Log Message: ----------- added JclStreams.pas to Jcl-R.xml sand packages Modified Paths: -------------- trunk/jcl/packages/c5/JclC50.bpk trunk/jcl/packages/c5/JclC50.cpp trunk/jcl/packages/c5/JclC50.dpk trunk/jcl/packages/c6/Jcl.bpk trunk/jcl/packages/c6/Jcl.dpk trunk/jcl/packages/cs1/Jcl.dpk trunk/jcl/packages/d10/Jcl.dpk trunk/jcl/packages/d5/JclD50.dpk trunk/jcl/packages/d5.dev/JclD50.dpk trunk/jcl/packages/d6/Jcl.dpk trunk/jcl/packages/d7/Jcl.dpk trunk/jcl/packages/d8/Jcl.dpk trunk/jcl/packages/d9/Jcl.dpk trunk/jcl/packages/k3/Jcl.bpk trunk/jcl/packages/k3/Jcl.dpk trunk/jcl/packages/xml/Jcl-R.xml Modified: trunk/jcl/packages/c5/JclC50.bpk =================================================================== --- trunk/jcl/packages/c5/JclC50.bpk 2006-04-23 06:17:08 UTC (rev 1613) +++ trunk/jcl/packages/c5/JclC50.bpk 2006-04-23 06:25:38 UTC (rev 1614) @@ -5,7 +5,7 @@ DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR ALWAYS EDIT THE RELATED XML FILE (Jcl-R.xml) - Last generated: 23-03-2006 20:33:54 UTC + Last generated: 23-04-2006 06:25:22 UTC ***************************************************************************** --> <PROJECT> @@ -53,6 +53,7 @@ ..\..\lib\c5\JclSchedule.obj ..\..\lib\c5\JclStacks.obj ..\..\lib\c5\JclStatistics.obj + ..\..\lib\c5\JclStreams.obj ..\..\lib\c5\JclStrHashMap.obj ..\..\lib\c5\JclStrings.obj ..\..\lib\c5\JclSysInfo.obj Modified: trunk/jcl/packages/c5/JclC50.cpp =================================================================== --- trunk/jcl/packages/c5/JclC50.cpp 2006-04-23 06:17:08 UTC (rev 1613) +++ trunk/jcl/packages/c5/JclC50.cpp 2006-04-23 06:25:38 UTC (rev 1614) @@ -4,7 +4,7 @@ DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR ALWAYS EDIT THE RELATED XML FILE (Jcl-R.xml) - Last generated: 23-03-2006 20:33:55 UTC + Last generated: 23-04-2006 06:25:22 UTC ----------------------------------------------------------------------------- */ @@ -50,6 +50,7 @@ USEUNIT("..\..\source\common\JclSchedule.pas"); USEUNIT("..\..\source\common\JclStacks.pas"); USEUNIT("..\..\source\common\JclStatistics.pas"); +USEUNIT("..\..\source\common\JclStreams.pas"); USEUNIT("..\..\source\common\JclStrHashMap.pas"); USEUNIT("..\..\source\common\JclStrings.pas"); USEUNIT("..\..\source\common\JclSysInfo.pas"); Modified: trunk/jcl/packages/c5/JclC50.dpk =================================================================== --- trunk/jcl/packages/c5/JclC50.dpk 2006-04-23 06:17:08 UTC (rev 1613) +++ trunk/jcl/packages/c5/JclC50.dpk 2006-04-23 06:25:38 UTC (rev 1614) @@ -4,7 +4,7 @@ DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR ALWAYS EDIT THE RELATED XML FILE (Jcl-R.xml) - Last generated: 23-03-2006 20:33:55 UTC + Last generated: 23-04-2006 06:25:22 UTC ----------------------------------------------------------------------------- } @@ -79,6 +79,7 @@ JclSchedule in '..\..\source\common\JclSchedule.pas' , JclStacks in '..\..\source\common\JclStacks.pas' , JclStatistics in '..\..\source\common\JclStatistics.pas' , + JclStreams in '..\..\source\common\JclStreams.pas' , JclStrHashMap in '..\..\source\common\JclStrHashMap.pas' , JclStrings in '..\..\source\common\JclStrings.pas' , JclSysInfo in '..\..\source\common\JclSysInfo.pas' , Modified: trunk/jcl/packages/c6/Jcl.bpk =================================================================== --- trunk/jcl/packages/c6/Jcl.bpk 2006-04-23 06:17:08 UTC (rev 1613) +++ trunk/jcl/packages/c6/Jcl.bpk 2006-04-23 06:25:38 UTC (rev 1614) @@ -5,7 +5,7 @@ DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR ALWAYS EDIT THE RELATED XML FILE (Jcl-R.xml) - Last generated: 23-03-2006 20:33:55 UTC + Last generated: 23-04-2006 06:25:23 UTC ***************************************************************************** --> <PROJECT> @@ -53,6 +53,7 @@ ..\..\lib\c6\obj\JclSchedule.obj ..\..\lib\c6\obj\JclStacks.obj ..\..\lib\c6\obj\JclStatistics.obj + ..\..\lib\c6\obj\JclStreams.obj ..\..\lib\c6\obj\JclStrHashMap.obj ..\..\lib\c6\obj\JclStrings.obj ..\..\lib\c6\obj\JclSysInfo.obj @@ -187,6 +188,7 @@ <FILE FILENAME="..\..\source\common\JclSchedule.pas" FORMNAME="" UNITNAME="JclSchedule" CONTAINERID="PascalCompiler" DESIGNCLASS="" LOCALCOMMAND=""/> <FILE FILENAME="..\..\source\common\JclStacks.pas" FORMNAME="" UNITNAME="JclStacks" CONTAINERID="PascalCompiler" DESIGNCLASS="" LOCALCOMMAND=""/> <FILE FILENAME="..\..\source\common\JclStatistics.pas" FORMNAME="" UNITNAME="JclStatistics" CONTAINERID="PascalCompiler" DESIGNCLASS="" LOCALCOMMAND=""/> + <FILE FILENAME="..\..\source\common\JclStreams.pas" FORMNAME="" UNITNAME="JclStreams" CONTAINERID="PascalCompiler" DESIGNCLASS="" LOCALCOMMAND=""/> <FILE FILENAME="..\..\source\common\JclStrHashMap.pas" FORMNAME="" UNITNAME="JclStrHashMap" CONTAINERID="PascalCompiler" DESIGNCLASS="" LOCALCOMMAND=""/> <FILE FILENAME="..\..\source\common\JclStrings.pas" FORMNAME="" UNITNAME="JclStrings" CONTAINERID="PascalCompiler" DESIGNCLASS="" LOCALCOMMAND=""/> <FILE FILENAME="..\..\source\common\JclSysInfo.pas" FORMNAME="" UNITNAME="JclSysInfo" CONTAINERID="PascalCompiler" DESIGNCLASS="" LOCALCOMMAND=""/> Modified: trunk/jcl/packages/c6/Jcl.dpk =================================================================== --- trunk/jcl/packages/c6/Jcl.dpk 2006-04-23 06:17:08 UTC (rev 1613) +++ trunk/jcl/packages/c6/Jcl.dpk 2006-04-23 06:25:38 UTC (rev 1614) @@ -4,7 +4,7 @@ DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR ALWAYS EDIT THE RELATED XML FILE (Jcl-R.xml) - Last generated: 23-03-2006 20:33:55 UTC + Last generated: 23-04-2006 06:25:23 UTC ----------------------------------------------------------------------------- } @@ -78,6 +78,7 @@ JclSchedule in '..\..\source\common\JclSchedule.pas' , JclStacks in '..\..\source\common\JclStacks.pas' , JclStatistics in '..\..\source\common\JclStatistics.pas' , + JclStreams in '..\..\source\common\JclStreams.pas' , JclStrHashMap in '..\..\source\common\JclStrHashMap.pas' , JclStrings in '..\..\source\common\JclStrings.pas' , JclSysInfo in '..\..\source\common\JclSysInfo.pas' , Modified: trunk/jcl/packages/cs1/Jcl.dpk =================================================================== --- trunk/jcl/packages/cs1/Jcl.dpk 2006-04-23 06:17:08 UTC (rev 1613) +++ trunk/jcl/packages/cs1/Jcl.dpk 2006-04-23 06:25:38 UTC (rev 1614) @@ -4,7 +4,7 @@ DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR ALWAYS EDIT THE RELATED XML FILE (Jcl-R.xml) - Last generated: 23-03-2006 20:33:57 UTC + Last generated: 23-04-2006 06:25:23 UTC ----------------------------------------------------------------------------- } @@ -79,6 +79,7 @@ JclSchedule in '..\..\source\common\JclSchedule.pas' , JclStacks in '..\..\source\common\JclStacks.pas' , JclStatistics in '..\..\source\common\JclStatistics.pas' , + JclStreams in '..\..\source\common\JclStreams.pas' , JclStrHashMap in '..\..\source\common\JclStrHashMap.pas' , JclStrings in '..\..\source\common\JclStrings.pas' , JclSysInfo in '..\..\source\common\JclSysInfo.pas' , Modified: trunk/jcl/packages/d10/Jcl.dpk =================================================================== --- trunk/jcl/packages/d10/Jcl.dpk 2006-04-23 06:17:08 UTC (rev 1613) +++ trunk/jcl/packages/d10/Jcl.dpk 2006-04-23 06:25:38 UTC (rev 1614) @@ -4,7 +4,7 @@ DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR ALWAYS EDIT THE RELATED XML FILE (Jcl-R.xml) - Last generated: 23-03-2006 18:46:46 UTC + Last generated: 23-04-2006 06:25:24 UTC ----------------------------------------------------------------------------- } @@ -79,6 +79,7 @@ JclSchedule in '..\..\source\common\JclSchedule.pas' , JclStacks in '..\..\source\common\JclStacks.pas' , JclStatistics in '..\..\source\common\JclStatistics.pas' , + JclStreams in '..\..\source\common\JclStreams.pas' , JclStrHashMap in '..\..\source\common\JclStrHashMap.pas' , JclStrings in '..\..\source\common\JclStrings.pas' , JclSysInfo in '..\..\source\common\JclSysInfo.pas' , Modified: trunk/jcl/packages/d5/JclD50.dpk =================================================================== --- trunk/jcl/packages/d5/JclD50.dpk 2006-04-23 06:17:08 UTC (rev 1613) +++ trunk/jcl/packages/d5/JclD50.dpk 2006-04-23 06:25:38 UTC (rev 1614) @@ -4,7 +4,7 @@ DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR ALWAYS EDIT THE RELATED XML FILE (Jcl-R.xml) - Last generated: 23-03-2006 18:46:43 UTC + Last generated: 23-04-2006 06:25:23 UTC ----------------------------------------------------------------------------- } @@ -79,6 +79,7 @@ JclSchedule in '..\..\source\common\JclSchedule.pas' , JclStacks in '..\..\source\common\JclStacks.pas' , JclStatistics in '..\..\source\common\JclStatistics.pas' , + JclStreams in '..\..\source\common\JclStreams.pas' , JclStrHashMap in '..\..\source\common\JclStrHashMap.pas' , JclStrings in '..\..\source\common\JclStrings.pas' , JclSysInfo in '..\..\source\common\JclSysInfo.pas' , Modified: trunk/jcl/packages/d5.dev/JclD50.dpk =================================================================== --- trunk/jcl/packages/d5.dev/JclD50.dpk 2006-04-23 06:17:08 UTC (rev 1613) +++ trunk/jcl/packages/d5.dev/JclD50.dpk 2006-04-23 06:25:38 UTC (rev 1614) @@ -4,7 +4,7 @@ DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR ALWAYS EDIT THE RELATED XML FILE (Jcl-R.xml) - Last generated: 23-03-2006 18:46:43 UTC + Last generated: 23-04-2006 06:25:23 UTC ----------------------------------------------------------------------------- } @@ -78,6 +78,7 @@ JclSchedule in '..\..\source\common\JclSchedule.pas' , JclStacks in '..\..\source\common\JclStacks.pas' , JclStatistics in '..\..\source\common\JclStatistics.pas' , + JclStreams in '..\..\source\common\JclStreams.pas' , JclStrHashMap in '..\..\source\common\JclStrHashMap.pas' , JclStrings in '..\..\source\common\JclStrings.pas' , JclSysInfo in '..\..\source\common\JclSysInfo.pas' , Modified: trunk/jcl/packages/d6/Jcl.dpk =================================================================== --- trunk/jcl/packages/d6/Jcl.dpk 2006-04-23 06:17:08 UTC (rev 1613) +++ trunk/jcl/packages/d6/Jcl.dpk 2006-04-23 06:25:38 UTC (rev 1614) @@ -4,7 +4,7 @@ DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR ALWAYS EDIT THE RELATED XML FILE (Jcl-R.xml) - Last generated: 23-03-2006 18:46:44 UTC + Last generated: 23-04-2006 06:25:23 UTC ----------------------------------------------------------------------------- } @@ -79,6 +79,7 @@ JclSchedule in '..\..\source\common\JclSchedule.pas' , JclStacks in '..\..\source\common\JclStacks.pas' , JclStatistics in '..\..\source\common\JclStatistics.pas' , + JclStreams in '..\..\source\common\JclStreams.pas' , JclStrHashMap in '..\..\source\common\JclStrHashMap.pas' , JclStrings in '..\..\source\common\JclStrings.pas' , JclSysInfo in '..\..\source\common\JclSysInfo.pas' , Modified: trunk/jcl/packages/d7/Jcl.dpk =================================================================== --- trunk/jcl/packages/d7/Jcl.dpk 2006-04-23 06:17:08 UTC (rev 1613) +++ trunk/jcl/packages/d7/Jcl.dpk 2006-04-23 06:25:38 UTC (rev 1614) @@ -4,7 +4,7 @@ DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR ALWAYS EDIT THE RELATED XML FILE (Jcl-R.xml) - Last generated: 23-03-2006 18:46:45 UTC + Last generated: 23-04-2006 06:25:23 UTC ----------------------------------------------------------------------------- } @@ -79,6 +79,7 @@ JclSchedule in '..\..\source\common\JclSchedule.pas' , JclStacks in '..\..\source\common\JclStacks.pas' , JclStatistics in '..\..\source\common\JclStatistics.pas' , + JclStreams in '..\..\source\common\JclStreams.pas' , JclStrHashMap in '..\..\source\common\JclStrHashMap.pas' , JclStrings in '..\..\source\common\JclStrings.pas' , JclSysInfo in '..\..\source\common\JclSysInfo.pas' , Modified: trunk/jcl/packages/d8/Jcl.dpk =================================================================== --- trunk/jcl/packages/d8/Jcl.dpk 2006-04-23 06:17:08 UTC (rev 1613) +++ trunk/jcl/packages/d8/Jcl.dpk 2006-04-23 06:25:38 UTC (rev 1614) @@ -4,7 +4,7 @@ DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR ALWAYS EDIT THE RELATED XML FILE (Jcl-R.xml) - Last generated: 23-03-2006 18:46:45 UTC + Last generated: 23-04-2006 06:25:23 UTC ----------------------------------------------------------------------------- } @@ -79,6 +79,7 @@ JclSchedule in '..\..\source\common\JclSchedule.pas' , JclStacks in '..\..\source\common\JclStacks.pas' , JclStatistics in '..\..\source\common\JclStatistics.pas' , + JclStreams in '..\..\source\common\JclStreams.pas' , JclStrHashMap in '..\..\source\common\JclStrHashMap.pas' , JclStrings in '..\..\source\common\JclStrings.pas' , JclSysInfo in '..\..\source\common\JclSysInfo.pas' , Modified: trunk/jcl/packages/d9/Jcl.dpk =================================================================== --- trunk/jcl/packages/d9/Jcl.dpk 2006-04-23 06:17:08 UTC (rev 1613) +++ trunk/jcl/packages/d9/Jcl.dpk 2006-04-23 06:25:38 UTC (rev 1614) @@ -4,7 +4,7 @@ DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR ALWAYS EDIT THE RELATED XML FILE (Jcl-R.xml) - Last generated: 23-03-2006 18:46:46 UTC + Last generated: 23-04-2006 06:25:23 UTC ----------------------------------------------------------------------------- } @@ -79,6 +79,7 @@ JclSchedule in '..\..\source\common\JclSchedule.pas' , JclStacks in '..\..\source\common\JclStacks.pas' , JclStatistics in '..\..\source\common\JclStatistics.pas' , + JclStreams in '..\..\source\common\JclStreams.pas' , JclStrHashMap in '..\..\source\common\JclStrHashMap.pas' , JclStrings in '..\..\source\common\JclStrings.pas' , JclSysInfo in '..\..\source\common\JclSysInfo.pas' , Modified: trunk/jcl/packages/k3/Jcl.bpk =================================================================== --- trunk/jcl/packages/k3/Jcl.bpk 2006-04-23 06:17:08 UTC (rev 1613) +++ trunk/jcl/packages/k3/Jcl.bpk 2006-04-23 06:25:38 UTC (rev 1614) @@ -44,6 +44,7 @@ ..\..\lib\k3\obj\JclSchedule.obj ..\..\lib\k3\obj\JclStacks.obj ..\..\lib\k3\obj\JclStatistics.obj + ..\..\lib\k3\obj\JclStreams.obj ..\..\lib\k3\obj\JclStrHashMap.obj ..\..\lib\k3\obj\JclStrings.obj ..\..\lib\k3\obj\JclSysInfo.obj @@ -140,6 +141,7 @@ <FILE FILENAME="../../source/common/JclSchedule.pas" FORMNAME="" UNITNAME="JclSchedule" CONTAINERID="PascalCompiler" DESIGNCLASS="" LOCALCOMMAND=""/> <FILE FILENAME="../../source/common/JclStacks.pas" FORMNAME="" UNITNAME="JclStacks" CONTAINERID="PascalCompiler" DESIGNCLASS="" LOCALCOMMAND=""/> <FILE FILENAME="../../source/common/JclStatistics.pas" FORMNAME="" UNITNAME="JclStatistics" CONTAINERID="PascalCompiler" DESIGNCLASS="" LOCALCOMMAND=""/> + <FILE FILENAME="../../source/common/JclStreams.pas" FORMNAME="" UNITNAME="JclStreams" CONTAINERID="PascalCompiler" DESIGNCLASS="" LOCALCOMMAND=""/> <FILE FILENAME="../../source/common/JclStrHashMap.pas" FORMNAME="" UNITNAME="JclStrHashMap" CONTAINERID="PascalCompiler" DESIGNCLASS="" LOCALCOMMAND=""/> <FILE FILENAME="../../source/common/JclStrings.pas" FORMNAME="" UNITNAME="JclStrings" CONTAINERID="PascalCompiler" DESIGNCLASS="" LOCALCOMMAND=""/> <FILE FILENAME="../../source/common/JclSysInfo.pas" FORMNAME="" UNITNAME="JclSysInfo" CONTAINERID="PascalCompiler" DESIGNCLASS="" LOCALCOMMAND=""/> Modified: trunk/jcl/packages/k3/Jcl.dpk =================================================================== --- trunk/jcl/packages/k3/Jcl.dpk 2006-04-23 06:17:08 UTC (rev 1613) +++ trunk/jcl/packages/k3/Jcl.dpk 2006-04-23 06:25:38 UTC (rev 1614) @@ -4,7 +4,7 @@ DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR ALWAYS EDIT THE RELATED XML FILE (Jcl-R.xml) - Last generated: 23-03-2006 18:46:47 UTC + Last generated: 23-04-2006 06:25:24 UTC ----------------------------------------------------------------------------- } @@ -80,6 +80,7 @@ JclSchedule in '../../source/common/JclSchedule.pas' , JclStacks in '../../source/common/JclStacks.pas' , JclStatistics in '../../source/common/JclStatistics.pas' , + JclStreams in '../../source/common/JclStreams.pas' , JclStrHashMap in '../../source/common/JclStrHashMap.pas' , JclStrings in '../../source/common/JclStrings.pas' , JclSysInfo in '../../source/common/JclSysInfo.pas' , Modified: trunk/jcl/packages/xml/Jcl-R.xml =================================================================== --- trunk/jcl/packages/xml/Jcl-R.xml 2006-04-23 06:17:08 UTC (rev 1613) +++ trunk/jcl/packages/xml/Jcl-R.xml 2006-04-23 06:25:38 UTC (rev 1614) @@ -56,6 +56,7 @@ <File Name="..\..\source\common\JclSchedule.pas" Targets="JclDev" Formname="" Condition=""/> <File Name="..\..\source\common\JclStacks.pas" Targets="JclDev" Formname="" Condition=""/> <File Name="..\..\source\common\JclStatistics.pas" Targets="JclDev" Formname="" Condition=""/> + <File Name="..\..\source\common\JclStreams.pas" Targets="JclDev" Formname="" Condition=""/> <File Name="..\..\source\common\JclStrHashMap.pas" Targets="JclDev" Formname="" Condition=""/> <File Name="..\..\source\common\JclStrings.pas" Targets="JclDev" Formname="" Condition=""/> <File Name="..\..\source\common\JclSysInfo.pas" Targets="JclDev" Formname="" Condition=""/> This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
|
From: <mar...@us...> - 2006-04-23 06:17:17
|
Revision: 1613 Author: marquardt Date: 2006-04-22 23:17:08 -0700 (Sat, 22 Apr 2006) ViewCVS: http://svn.sourceforge.net/jcl/?rev=1613&view=rev Log Message: ----------- rework for style and proper abstraction Modified Paths: -------------- trunk/jcl/source/common/JclStreams.pas Modified: trunk/jcl/source/common/JclStreams.pas =================================================================== --- trunk/jcl/source/common/JclStreams.pas 2006-04-22 17:41:25 UTC (rev 1612) +++ trunk/jcl/source/common/JclStreams.pas 2006-04-23 06:17:08 UTC (rev 1613) @@ -34,9 +34,9 @@ SysUtils, Classes; type -{$IFDEF COMPILER5} + {$IFDEF COMPILER5} TSeekOrigin = (soBeginning, soCurrent, soEnd); -{$ENDIF COMPILER5} + {$ENDIF COMPILER5} EJclStreamException = class(Exception); @@ -45,21 +45,24 @@ TJclStream = class(TStream) protected procedure SetSize(NewSize: Longint); overload; override; - procedure SetSize(const NewSize: Int64); {$IFDEF COMPILER5} reintroduce; overload; virtual; {$ELSE COMPILER5} overload; override; {$ENDIF COMPILER5} + procedure SetSize(const NewSize: Int64); + {$IFDEF COMPILER5} reintroduce; overload; virtual; {$ELSE} overload; override; {$ENDIF} public function Seek(Offset: Longint; Origin: Word): Longint; overload; override; - function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; {$IFDEF COMPILER5} reintroduce; overload; virtual; {$ELSE COMPILER5} overload; override; {$ENDIF COMPILER5} + function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; + {$IFDEF COMPILER5} reintroduce; overload; virtual; {$ELSE} overload; override; {$ENDIF} end; - // classes that inherit from TJclStream should override these methods: - //TMyJclStream = class(TJclStream) - //protected - // procedure SetSize(const NewSize: Int64); override; - //public - // function Read(var Buffer; Count: Longint): Longint; override; - // function Write(const Buffer; Count: Longint): Longint; override; - // function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; override; - //end; + { classes that inherit from TJclStream should override these methods: + TMyJclStream = class(TJclStream) + protected + procedure SetSize(const NewSize: Int64); override; + public + function Read(var Buffer; Count: Longint): Longint; override; + function Write(const Buffer; Count: Longint): Longint; override; + function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; override; + end; + } TJclEmptyStream = class(TJclStream) protected @@ -83,8 +86,14 @@ end; TJclRandomStream = class(TJclNullStream) + protected + function GetRandSeed: Longint; + procedure SetRandSeed(Seed: Longint); public + function RandomData: Byte; virtual; + procedure Randomize; dynamic; function Read(var Buffer; Count: Longint): Longint; override; + property RandSeed: Longint read GetRandSeed write SetRandSeed; end; TJclMultiplexStream = class(TJclStream) @@ -92,7 +101,7 @@ FStreams: TList; FReadStreamIndex: Integer; function GetStream(Index: Integer): TStream; - function GetStreamCount: Integer; + function GetCount: Integer; procedure SetStream(Index: Integer; const Value: TStream); function GetReadStream: TStream; procedure SetReadStream(const Value: TStream); @@ -100,45 +109,45 @@ protected procedure SetSize(const NewSize: Int64); override; public - constructor Create; reintroduce; + constructor Create; virtual; destructor Destroy; override; function Read(var Buffer; Count: Longint): Longint; override; function Write(const Buffer; Count: Longint): Longint; override; function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; override; - function AddStream(NewStream: TStream): Integer; - procedure ClearStream; - function RemoveStream(AStream: TStream): Integer; - procedure DeleteStream(const Index: Integer); + function Add(NewStream: TStream): Integer; + procedure Clear; + function Remove(AStream: TStream): Integer; + procedure Delete(const Index: Integer); property Streams[Index: Integer]: TStream read GetStream write SetStream; property ReadStreamIndex: Integer read FReadStreamIndex write SetReadStreamIndex; property ReadStream: TStream read GetReadStream write SetReadStream; - property StreamCount: Integer read GetStreamCount; + property Count: Integer read GetCount; end; implementation uses - JclResources, JclBase; + JclBase, JclResources; //=== { TJclStream } ========================================================= -function TJclStream.Seek(Offset: Integer; Origin: Word): Longint; +function TJclStream.Seek(Offset: Longint; Origin: Word): Longint; var Result64: Int64; begin case Origin of - soFromBeginning : + soFromBeginning: Result64 := Seek(Int64(Offset), soBeginning); - soFromCurrent : + soFromCurrent: Result64 := Seek(Int64(Offset), soCurrent); - soFromEnd : + soFromEnd: Result64 := Seek(Int64(Offset), soEnd); else Result64 := 0; end; - if (Result64 < Low(LongInt)) or (Result64 > High(LongInt)) then + if (Result64 < Low(Longint)) or (Result64 > High(Longint)) then raise EJclStreamException.CreateRes(@RsStreamsRangeError); Result := Result64; end; @@ -149,7 +158,7 @@ Result := -1; end; -procedure TJclStream.SetSize(NewSize: Integer); +procedure TJclStream.SetSize(NewSize: Longint); begin SetSize(Int64(NewSize)); end; @@ -161,6 +170,9 @@ //=== { TJclEmptyStream } ==================================================== +// a stream which stays empty no matter what you do +// so it is a Unix /dev/null equivalent + procedure TJclEmptyStream.SetSize(const NewSize: Int64); begin // nothing @@ -168,21 +180,30 @@ function TJclEmptyStream.Read(var Buffer; Count: Longint): Longint; begin + // you cannot read anything Result := 0; end; function TJclEmptyStream.Write(const Buffer; Count: Longint): Longint; begin + // you cannot write anything Result := 0; end; function TJclEmptyStream.Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; begin - Result := 0; + if Offset <> 0 then + // seeking to anywhere except the position 0 is an error + Result := -1 + else + Result := 0; end; //=== { TJclNullStream } ===================================================== +// a stream which only keeps position and size, but no data +// so it is a Unix /dev/zero equivalent (?) + procedure TJclNullStream.SetSize(const NewSize: Int64); begin if NewSize > 0 then @@ -256,68 +277,84 @@ //=== { TJclRandomStream } =================================================== -function TJclRandomStream.Read(var Buffer; Count: Integer): Longint; -{$IFDEF COMPILER5} -type - PWord = ^Word; -{$ENDIF COMPILER5} +// A TJclNullStream decendant which returns random data when read +// so it is a Unix /dev/random equivalent + +function TJclRandomStream.GetRandSeed: Longint; +begin + Result := System.RandSeed; +end; + +procedure TJclRandomStream.SetRandSeed(Seed: Longint); +begin + System.RandSeed := Seed; +end; + +function TJclRandomStream.RandomData: Byte; +begin + Result := Byte(System.Random(256)); +end; + +procedure TJclRandomStream.Randomize; +begin + System.Randomize; +end; + +function TJclRandomStream.Read(var Buffer; Count: Longint): Longint; var + I: Longint; BufferPtr: PByte; begin if Count < 0 then Count := 0; - if FSize - FPosition < Count then - Count := FSize - FPosition; - if Count > 0 then + if Size - Position < Count then + Count := Size - Position; + BufferPtr := @Buffer; + for I := 0 to Count - 1 do begin - BufferPtr := @Buffer; - while Count > 1 do - begin - PWord(BufferPtr)^ := Random($10000); - Inc(BufferPtr, 2); - end; - if Count <> 0 then - BufferPtr^ := Random($100); - FPosition := FPosition + Count; + BufferPtr^ := RandomData; + Inc(BufferPtr); end; + Position := Position + Count; Result := Count; end; //=== { TJclMultiplexStream } ================================================ -function TJclMultiplexStream.AddStream(NewStream: TStream): Integer; +constructor TJclMultiplexStream.Create; begin - Result := FStreams.Add(Pointer(NewStream)); + inherited Create; + FStreams := TList.Create; + FReadStreamIndex := -1; end; -procedure TJclMultiplexStream.ClearStream; +destructor TJclMultiplexStream.Destroy; begin - FStreams.Clear; - FReadStreamIndex := -1; + FStreams.Free; + inherited Destroy; end; -constructor TJclMultiplexStream.Create; +function TJclMultiplexStream.Add(NewStream: TStream): Integer; begin - inherited Create; - FStreams := TList.Create; + Result := FStreams.Add(Pointer(NewStream)); +end; + +procedure TJclMultiplexStream.Clear; +begin + FStreams.Clear; FReadStreamIndex := -1; end; -procedure TJclMultiplexStream.DeleteStream(const Index: Integer); +procedure TJclMultiplexStream.Delete(const Index: Integer); begin FStreams.Delete(Index); if ReadStreamIndex = Index then FReadStreamIndex := -1 - else if ReadStreamIndex > Index then + else + if ReadStreamIndex > Index then Dec(FReadStreamIndex); end; -destructor TJclMultiplexStream.Destroy; -begin - FStreams.Free; - inherited Destroy; -end; - function TJclMultiplexStream.GetReadStream: TStream; begin if FReadStreamIndex >= 0 then @@ -331,33 +368,33 @@ Result := TStream(FStreams.Items[Index]); end; -function TJclMultiplexStream.GetStreamCount: Integer; +function TJclMultiplexStream.GetCount: Integer; begin Result := FStreams.Count; end; -function TJclMultiplexStream.Read(var Buffer; Count: Integer): Longint; +function TJclMultiplexStream.Read(var Buffer; Count: Longint): Longint; var - AReadStream: TStream; + Stream: TStream; begin - AReadStream := ReadStream; - if Assigned(AReadStream) then - Result := AReadStream.Read(Buffer, Count) + Stream := ReadStream; + if Assigned(Stream) then + Result := Stream.Read(Buffer, Count) else Result := 0; end; -function TJclMultiplexStream.RemoveStream(AStream: TStream): Integer; +function TJclMultiplexStream.Remove(AStream: TStream): Integer; begin Result := FStreams.Remove(Pointer(AStream)); if FReadStreamIndex = Result then FReadStreamIndex := -1 - else if FReadStreamIndex > Result then + else + if FReadStreamIndex > Result then Dec(FReadStreamIndex); end; -function TJclMultiplexStream.Seek(const Offset: Int64; - Origin: TSeekOrigin): Int64; +function TJclMultiplexStream.Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; begin // what should this function do? Result := -1; @@ -383,13 +420,13 @@ FStreams.Items[Index] := Pointer(Value); end; -function TJclMultiplexStream.Write(const Buffer; Count: Integer): Longint; +function TJclMultiplexStream.Write(const Buffer; Count: Longint): Longint; var Index: Integer; ByteWritten, MinByteWritten: Longint; begin MinByteWritten := Count; - for Index := 0 to StreamCount - 1 do + for Index := 0 to Self.Count - 1 do begin ByteWritten := TStream(FStreams.Items[Index]).Write(Buffer, Count); if ByteWritten < MinByteWritten then This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
|
From: <ou...@us...> - 2006-04-22 17:41:31
|
Revision: 1612 Author: outchy Date: 2006-04-22 10:41:25 -0700 (Sat, 22 Apr 2006) ViewCVS: http://svn.sourceforge.net/jcl/?rev=1612&view=rev Log Message: ----------- Removed C5 and D5 compilation warnings Modified Paths: -------------- trunk/jcl/source/common/JclStreams.pas Modified: trunk/jcl/source/common/JclStreams.pas =================================================================== --- trunk/jcl/source/common/JclStreams.pas 2006-04-21 13:11:16 UTC (rev 1611) +++ trunk/jcl/source/common/JclStreams.pas 2006-04-22 17:41:25 UTC (rev 1612) @@ -45,10 +45,10 @@ TJclStream = class(TStream) protected procedure SetSize(NewSize: Longint); overload; override; - procedure SetSize(const NewSize: Int64); overload; {$IFDEF COMPILER5} virtual; {$ELSE COMPILER5} override; {$ENDIF COMPILER5} + procedure SetSize(const NewSize: Int64); {$IFDEF COMPILER5} reintroduce; overload; virtual; {$ELSE COMPILER5} overload; override; {$ENDIF COMPILER5} public function Seek(Offset: Longint; Origin: Word): Longint; overload; override; - function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; overload; {$IFDEF COMPILER5} virtual; {$ELSE COMPILER5} override; {$ENDIF COMPILER5} + function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; {$IFDEF COMPILER5} reintroduce; overload; virtual; {$ELSE COMPILER5} overload; override; {$ENDIF COMPILER5} end; // classes that inherit from TJclStream should override these methods: This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
|
From: <ou...@us...> - 2006-04-21 13:11:25
|
Revision: 1611 Author: outchy Date: 2006-04-21 06:11:16 -0700 (Fri, 21 Apr 2006) ViewCVS: http://svn.sourceforge.net/jcl/?rev=1611&view=rev Log Message: ----------- JclStream introduced for C5 and D5 compatibility New random and multiplexed streams Bug fix: position was not incremented Modified Paths: -------------- trunk/jcl/source/common/JclResources.pas trunk/jcl/source/common/JclStreams.pas Modified: trunk/jcl/source/common/JclResources.pas =================================================================== --- trunk/jcl/source/common/JclResources.pas 2006-04-21 10:36:32 UTC (rev 1610) +++ trunk/jcl/source/common/JclResources.pas 2006-04-21 13:11:16 UTC (rev 1611) @@ -1720,6 +1720,10 @@ RsCompressionZLibZVersionError = 'zlib returned: Version error'; RsCompressionZLibError = 'ZLib error'; +//=== JclStreams ============================================================= +resourcestring + RsStreamsRangeError = '32 bit overflow in stream operations, use the 64 bit version'; + implementation // History: Modified: trunk/jcl/source/common/JclStreams.pas =================================================================== --- trunk/jcl/source/common/JclStreams.pas 2006-04-21 10:36:32 UTC (rev 1610) +++ trunk/jcl/source/common/JclStreams.pas 2006-04-21 13:11:16 UTC (rev 1611) @@ -17,6 +17,7 @@ { All rights reserved. } { } { Contributors: } +{ Florent Ouchet (outchy) } { } {**************************************************************************************************} @@ -30,44 +31,139 @@ interface uses - Classes; + SysUtils, Classes; type - TJclEmptyStream = class(TStream) +{$IFDEF COMPILER5} + TSeekOrigin = (soBeginning, soCurrent, soEnd); +{$ENDIF COMPILER5} + + EJclStreamException = class(Exception); + + // abstraction layer to support Delphi 5 and C++Builder 5 streams + // 64 bit version of overloaded functions are introduced + TJclStream = class(TStream) protected - procedure SetSize(NewSize: Longint); override; + procedure SetSize(NewSize: Longint); overload; override; + procedure SetSize(const NewSize: Int64); overload; {$IFDEF COMPILER5} virtual; {$ELSE COMPILER5} override; {$ENDIF COMPILER5} + public + function Seek(Offset: Longint; Origin: Word): Longint; overload; override; + function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; overload; {$IFDEF COMPILER5} virtual; {$ELSE COMPILER5} override; {$ENDIF COMPILER5} + end; + + // classes that inherit from TJclStream should override these methods: + //TMyJclStream = class(TJclStream) + //protected + // procedure SetSize(const NewSize: Int64); override; + //public + // function Read(var Buffer; Count: Longint): Longint; override; + // function Write(const Buffer; Count: Longint): Longint; override; + // function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; override; + //end; + + TJclEmptyStream = class(TJclStream) + protected procedure SetSize(const NewSize: Int64); override; public function Read(var Buffer; Count: Longint): Longint; override; function Write(const Buffer; Count: Longint): Longint; override; - function Seek(Offset: Longint; Origin: Word): Longint; override; function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; override; end; - TJclNullStream = class(TStream) + TJclNullStream = class(TJclStream) private FPosition: Int64; FSize: Int64; protected - procedure SetSize(NewSize: Longint); override; procedure SetSize(const NewSize: Int64); override; public function Read(var Buffer; Count: Longint): Longint; override; function Write(const Buffer; Count: Longint): Longint; override; - function Seek(Offset: Longint; Origin: Word): Longint; override; function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; override; end; + TJclRandomStream = class(TJclNullStream) + public + function Read(var Buffer; Count: Longint): Longint; override; + end; + + TJclMultiplexStream = class(TJclStream) + private + FStreams: TList; + FReadStreamIndex: Integer; + function GetStream(Index: Integer): TStream; + function GetStreamCount: Integer; + procedure SetStream(Index: Integer; const Value: TStream); + function GetReadStream: TStream; + procedure SetReadStream(const Value: TStream); + procedure SetReadStreamIndex(const Value: Integer); + protected + procedure SetSize(const NewSize: Int64); override; + public + constructor Create; reintroduce; + destructor Destroy; override; + function Read(var Buffer; Count: Longint): Longint; override; + function Write(const Buffer; Count: Longint): Longint; override; + function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; override; + + function AddStream(NewStream: TStream): Integer; + procedure ClearStream; + function RemoveStream(AStream: TStream): Integer; + procedure DeleteStream(const Index: Integer); + + property Streams[Index: Integer]: TStream read GetStream write SetStream; + property ReadStreamIndex: Integer read FReadStreamIndex write SetReadStreamIndex; + property ReadStream: TStream read GetReadStream write SetReadStream; + property StreamCount: Integer read GetStreamCount; + end; + implementation -//=== { TJclEmptyStream } ==================================================== +uses + JclResources, JclBase; -procedure TJclEmptyStream.SetSize(NewSize: Longint); +//=== { TJclStream } ========================================================= + +function TJclStream.Seek(Offset: Integer; Origin: Word): Longint; +var + Result64: Int64; begin + case Origin of + soFromBeginning : + Result64 := Seek(Int64(Offset), soBeginning); + soFromCurrent : + Result64 := Seek(Int64(Offset), soCurrent); + soFromEnd : + Result64 := Seek(Int64(Offset), soEnd); + else + Result64 := 0; + end; + if (Result64 < Low(LongInt)) or (Result64 > High(LongInt)) then + raise EJclStreamException.CreateRes(@RsStreamsRangeError); + Result := Result64; end; +function TJclStream.Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; +begin + // override to customize + Result := -1; +end; + +procedure TJclStream.SetSize(NewSize: Integer); +begin + SetSize(Int64(NewSize)); +end; + +procedure TJclStream.SetSize(const NewSize: Int64); +begin + // override to customize +end; + +//=== { TJclEmptyStream } ==================================================== + procedure TJclEmptyStream.SetSize(const NewSize: Int64); begin + // nothing end; function TJclEmptyStream.Read(var Buffer; Count: Longint): Longint; @@ -80,11 +176,6 @@ Result := 0; end; -function TJclEmptyStream.Seek(Offset: Longint; Origin: Word): Longint; -begin - Result := 0; -end; - function TJclEmptyStream.Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; begin Result := 0; @@ -92,11 +183,6 @@ //=== { TJclNullStream } ===================================================== -procedure TJclNullStream.SetSize(NewSize: Longint); -begin - SetSize(Int64(NewSize)); -end; - procedure TJclNullStream.SetSize(const NewSize: Int64); begin if NewSize > 0 then @@ -114,7 +200,10 @@ if FSize - FPosition < Count then Count := FSize - FPosition; if Count > 0 then + begin FillChar(Buffer, Count, 0); + FPosition := FPosition + Count; + end; Result := Count; end; @@ -128,27 +217,15 @@ Result := Count; end; -function TJclNullStream.Seek(Offset: Longint; Origin: Word): Longint; -begin - case Origin of - soFromBeginning: - Result := Seek(Int64(Offset), soBeginning); - soFromCurrent: - Result := Seek(Int64(Offset), soCurrent); - soFromEnd: - Result := Seek(Int64(Offset), soEnd); - else - Result := -1; - end; -end; - function TJclNullStream.Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; begin case Origin of soBeginning: begin if Offset >= 0 then - FPosition := Offset; + FPosition := Offset + else + FPosition := 0; if FPosition > FSize then FPosition := FSize; Result := FPosition; @@ -165,7 +242,9 @@ soEnd: begin if Offset <= 0 then - FPosition := FSize - Offset; + FPosition := FSize + Offset // offset is negative + else + FPosition := FSize; if FPosition < 0 then FPosition := 0; Result := FPosition; @@ -175,6 +254,150 @@ end; end; +//=== { TJclRandomStream } =================================================== + +function TJclRandomStream.Read(var Buffer; Count: Integer): Longint; +{$IFDEF COMPILER5} +type + PWord = ^Word; +{$ENDIF COMPILER5} +var + BufferPtr: PByte; +begin + if Count < 0 then + Count := 0; + if FSize - FPosition < Count then + Count := FSize - FPosition; + if Count > 0 then + begin + BufferPtr := @Buffer; + while Count > 1 do + begin + PWord(BufferPtr)^ := Random($10000); + Inc(BufferPtr, 2); + end; + if Count <> 0 then + BufferPtr^ := Random($100); + FPosition := FPosition + Count; + end; + Result := Count; +end; + +//=== { TJclMultiplexStream } ================================================ + +function TJclMultiplexStream.AddStream(NewStream: TStream): Integer; +begin + Result := FStreams.Add(Pointer(NewStream)); +end; + +procedure TJclMultiplexStream.ClearStream; +begin + FStreams.Clear; + FReadStreamIndex := -1; +end; + +constructor TJclMultiplexStream.Create; +begin + inherited Create; + FStreams := TList.Create; + FReadStreamIndex := -1; +end; + +procedure TJclMultiplexStream.DeleteStream(const Index: Integer); +begin + FStreams.Delete(Index); + if ReadStreamIndex = Index then + FReadStreamIndex := -1 + else if ReadStreamIndex > Index then + Dec(FReadStreamIndex); +end; + +destructor TJclMultiplexStream.Destroy; +begin + FStreams.Free; + inherited Destroy; +end; + +function TJclMultiplexStream.GetReadStream: TStream; +begin + if FReadStreamIndex >= 0 then + Result := TStream(FStreams.Items[FReadStreamIndex]) + else + Result := nil; +end; + +function TJclMultiplexStream.GetStream(Index: Integer): TStream; +begin + Result := TStream(FStreams.Items[Index]); +end; + +function TJclMultiplexStream.GetStreamCount: Integer; +begin + Result := FStreams.Count; +end; + +function TJclMultiplexStream.Read(var Buffer; Count: Integer): Longint; +var + AReadStream: TStream; +begin + AReadStream := ReadStream; + if Assigned(AReadStream) then + Result := AReadStream.Read(Buffer, Count) + else + Result := 0; +end; + +function TJclMultiplexStream.RemoveStream(AStream: TStream): Integer; +begin + Result := FStreams.Remove(Pointer(AStream)); + if FReadStreamIndex = Result then + FReadStreamIndex := -1 + else if FReadStreamIndex > Result then + Dec(FReadStreamIndex); +end; + +function TJclMultiplexStream.Seek(const Offset: Int64; + Origin: TSeekOrigin): Int64; +begin + // what should this function do? + Result := -1; +end; + +procedure TJclMultiplexStream.SetReadStream(const Value: TStream); +begin + FReadStreamIndex := FStreams.IndexOf(Pointer(Value)); +end; + +procedure TJclMultiplexStream.SetReadStreamIndex(const Value: Integer); +begin + FReadStreamIndex := Value; +end; + +procedure TJclMultiplexStream.SetSize(const NewSize: Int64); +begin + // what should this function do? +end; + +procedure TJclMultiplexStream.SetStream(Index: Integer; const Value: TStream); +begin + FStreams.Items[Index] := Pointer(Value); +end; + +function TJclMultiplexStream.Write(const Buffer; Count: Integer): Longint; +var + Index: Integer; + ByteWritten, MinByteWritten: Longint; +begin + MinByteWritten := Count; + for Index := 0 to StreamCount - 1 do + begin + ByteWritten := TStream(FStreams.Items[Index]).Write(Buffer, Count); + if ByteWritten < MinByteWritten then + MinByteWritten := ByteWritten; + end; + Result := MinByteWritten; +end; + // History: // $Log$ This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
|
From: <ah...@us...> - 2006-04-21 10:36:40
|
Revision: 1610 Author: ahuser Date: 2006-04-21 03:36:32 -0700 (Fri, 21 Apr 2006) ViewCVS: http://svn.sourceforge.net/jcl/?rev=1610&view=rev Log Message: ----------- Moved AutoPtr code out of the IFNDEF CLR. Modified Paths: -------------- trunk/jcl/source/common/JclSysUtils.pas Modified: trunk/jcl/source/common/JclSysUtils.pas =================================================================== --- trunk/jcl/source/common/JclSysUtils.pas 2006-04-21 08:31:19 UTC (rev 1609) +++ trunk/jcl/source/common/JclSysUtils.pas 2006-04-21 10:36:32 UTC (rev 1610) @@ -103,22 +103,6 @@ function GuardGetMem(Size: Cardinal; out SafeGuard: ISafeGuard): Pointer; function GuardAllocMem(Size: Cardinal; out SafeGuard: ISafeGuard): Pointer; -// AutoPtr -type - IAutoPtr = interface - {$IFNDEF CLR} - { Returns the object as pointer, so it is easier to assign it to a variable } - function AsPointer: Pointer; - {$ENDIF ~CLR} - { Returns the AutoPtr handled object } - function AsObject: TObject; - { Releases the object from the AutoPtr. The AutoPtr looses the control over - the object. } - function ReleaseObject: TObject; - end; - -function CreateAutoPtr(Value: TObject): IAutoPtr; - { Shared memory between processes functions } // Functions for the shared memory owner @@ -217,6 +201,22 @@ end; {$ENDIF ~CLR} +// AutoPtr +type + IAutoPtr = interface + {$IFNDEF CLR} + { Returns the object as pointer, so it is easier to assign it to a variable } + function AsPointer: Pointer; + {$ENDIF ~CLR} + { Returns the AutoPtr handled object } + function AsObject: TObject; + { Releases the object from the AutoPtr. The AutoPtr looses the control over + the object. } + function ReleaseObject: TObject; + end; + +function CreateAutoPtr(Value: TObject): IAutoPtr; + // Replacement for the C ternary conditional operator ? : function Iff(const Condition: Boolean; const TruePart, FalsePart: string): string; overload; function Iff(const Condition: Boolean; const TruePart, FalsePart: Char): Char; overload; @@ -848,58 +848,6 @@ Guard(Result, SafeGuard); end; -//=== { TAutoPtr } =========================================================== -type - TAutoPtr = class(TInterfacedObject, IAutoPtr) - private - FValue: TObject; - public - constructor Create(AValue: TObject); - destructor Destroy; override; - {$IFNDEF CLR} - function AsPointer: Pointer; - {$ENDIF ~CLR} - function AsObject: TObject; - function ReleaseObject: TObject; - end; - -function CreateAutoPtr(Value: TObject): IAutoPtr; -begin - Result := TAutoPtr.Create(Value); -end; - -{ TAutoPtr } - -constructor TAutoPtr.Create(AValue: TObject); -begin - inherited Create; - FValue := AValue; -end; - -destructor TAutoPtr.Destroy; -begin - FValue.Free; - inherited Destroy; -end; - -function TAutoPtr.AsObject: TObject; -begin - Result := FValue; -end; - -{$IFNDEF CLR} -function TAutoPtr.AsPointer: Pointer; -begin - Result := FValue; -end; -{$ENDIF ~CLR} - -function TAutoPtr.ReleaseObject: TObject; -begin - Result := FValue; - FValue := nil; -end; - //=== Shared memory functions ================================================ type @@ -1472,6 +1420,59 @@ end; {$ENDIF ~CLR} +//=== { TAutoPtr } =========================================================== + +type + TAutoPtr = class(TInterfacedObject, IAutoPtr) + private + FValue: TObject; + public + constructor Create(AValue: TObject); + destructor Destroy; override; + {$IFNDEF CLR} + function AsPointer: Pointer; + {$ENDIF ~CLR} + function AsObject: TObject; + function ReleaseObject: TObject; + end; + +function CreateAutoPtr(Value: TObject): IAutoPtr; +begin + Result := TAutoPtr.Create(Value); +end; + +{ TAutoPtr } + +constructor TAutoPtr.Create(AValue: TObject); +begin + inherited Create; + FValue := AValue; +end; + +destructor TAutoPtr.Destroy; +begin + FValue.Free; + inherited Destroy; +end; + +function TAutoPtr.AsObject: TObject; +begin + Result := FValue; +end; + +{$IFNDEF CLR} +function TAutoPtr.AsPointer: Pointer; +begin + Result := FValue; +end; +{$ENDIF ~CLR} + +function TAutoPtr.ReleaseObject: TObject; +begin + Result := FValue; + FValue := nil; +end; + //=== replacement for the C distfix operator ? : ============================= function Iff(const Condition: Boolean; const TruePart, FalsePart: string): string; This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
|
From: <ob...@us...> - 2006-04-21 08:31:28
|
Revision: 1609 Author: obones Date: 2006-04-21 01:31:19 -0700 (Fri, 21 Apr 2006) ViewCVS: http://svn.sourceforge.net/jcl/?rev=1609&view=rev Log Message: ----------- PathAddExtension now works completely fine if the given extension does not have the leading dot. Modified Paths: -------------- trunk/jcl/source/common/JclFileUtils.pas Modified: trunk/jcl/source/common/JclFileUtils.pas =================================================================== --- trunk/jcl/source/common/JclFileUtils.pas 2006-04-21 04:57:36 UTC (rev 1608) +++ trunk/jcl/source/common/JclFileUtils.pas 2006-04-21 08:31:19 UTC (rev 1609) @@ -1721,7 +1721,11 @@ function PathAddExtension(const Path, Extension: string): string; begin Result := Path; - if (Path <> '') and (Extension <> '') and not SameText(ExtractFileExt(Path), Extension) then + // (obones) Extension may not contain the leading dot while ExtractFileExt + // always returns it. Hence the need to use StrEnsurePrefix for the SameText + // test to return an accurate value. + if (Path <> '') and (Extension <> '') and + not SameText(ExtractFileExt(Path), StrEnsurePrefix('.', Extension)) then begin if Path[Length(Path)] = '.' then Delete(Result, Length(Path), 1); This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
49 messages has been excluded from this view by a project administrator.
