| 12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189219021912192219321942195219621972198219922002201220222032204220522062207220822092210221122122213221422152216221722182219222022212222222322242225222622272228222922302231223222332234223522362237223822392240224122422243224422452246224722482249225022512252225322542255225622572258225922602261226222632264226522662267226822692270227122722273227422752276227722782279228022812282228322842285228622872288228922902291229222932294229522962297229822992300230123022303230423052306230723082309231023112312231323142315231623172318231923202321232223232324232523262327232823292330233123322333233423352336233723382339234023412342234323442345234623472348234923502351235223532354235523562357235823592360236123622363236423652366236723682369237023712372237323742375237623772378237923802381238223832384238523862387238823892390239123922393239423952396239723982399240024012402240324042405240624072408240924102411241224132414241524162417241824192420242124222423242424252426242724282429243024312432243324342435243624372438243924402441244224432444244524462447244824492450245124522453245424552456245724582459246024612462246324642465246624672468246924702471247224732474247524762477247824792480248124822483248424852486248724882489249024912492249324942495249624972498249925002501250225032504250525062507250825092510251125122513251425152516251725182519252025212522252325242525252625272528252925302531253225332534253525362537253825392540254125422543254425452546254725482549255025512552255325542555255625572558255925602561256225632564256525662567256825692570257125722573257425752576257725782579258025812582258325842585258625872588258925902591259225932594259525962597259825992600260126022603260426052606260726082609261026112612261326142615261626172618261926202621262226232624262526262627262826292630263126322633263426352636263726382639264026412642264326442645264626472648264926502651265226532654265526562657265826592660266126622663266426652666266726682669267026712672267326742675267626772678267926802681268226832684268526862687268826892690269126922693269426952696269726982699270027012702270327042705270627072708270927102711271227132714271527162717271827192720272127222723272427252726272727282729273027312732273327342735273627372738273927402741274227432744274527462747274827492750275127522753275427552756275727582759276027612762276327642765276627672768276927702771277227732774277527762777277827792780278127822783278427852786278727882789279027912792279327942795279627972798279928002801280228032804280528062807280828092810281128122813281428152816281728182819282028212822282328242825282628272828282928302831283228332834283528362837283828392840284128422843284428452846284728482849285028512852285328542855285628572858285928602861286228632864286528662867286828692870287128722873287428752876287728782879288028812882288328842885288628872888288928902891289228932894289528962897289828992900290129022903290429052906290729082909291029112912291329142915291629172918291929202921292229232924292529262927292829292930293129322933293429352936293729382939294029412942294329442945294629472948294929502951295229532954295529562957295829592960296129622963296429652966296729682969297029712972297329742975297629772978297929802981298229832984298529862987298829892990299129922993299429952996299729982999300030013002300330043005300630073008300930103011301230133014301530163017301830193020302130223023302430253026302730283029303030313032303330343035303630373038303930403041304230433044304530463047304830493050305130523053305430553056305730583059306030613062306330643065306630673068306930703071307230733074307530763077307830793080308130823083308430853086308730883089309030913092309330943095309630973098309931003101310231033104310531063107310831093110311131123113311431153116311731183119312031213122312331243125312631273128312931303131313231333134313531363137313831393140314131423143314431453146314731483149 |
- {**************************************************************************************************}
- { }
- { Project JEDI Code Library (JCL) }
- { }
- { The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); }
- { you may not use this file except in compliance with the License. You may obtain a copy of the }
- { License at http://www.mozilla.org/MPL/ }
- { }
- { Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF }
- { ANY KIND, either express or implied. See the License for the specific language governing rights }
- { and limitations under the License. }
- { }
- { The Original Code is JclStreams.pas. }
- { }
- { The Initial Developer of the Original Code is Robert Marquardt. Portions created by }
- { Robert Marquardt are Copyright (C) Robert Marquardt (robert_marquardt att gmx dott de) }
- { All rights reserved. }
- { }
- { Contributors: }
- { Florent Ouchet (outchy) }
- { Heinz Zastrau }
- { Andreas Schmidt }
- { }
- {**************************************************************************************************}
- { }
- { Stream-related functions and classes }
- { }
- {**************************************************************************************************}
- { }
- { Last modified: $Date:: $ }
- { Revision: $Rev:: $ }
- { Author: $Author:: $ }
- { }
- {**************************************************************************************************}
- unit JclStreams;
- {$I jcl.inc}
- interface
- uses
- {$IFDEF UNITVERSIONING}
- JclUnitVersioning,
- {$ENDIF UNITVERSIONING}
- {$IFDEF HAS_UNITSCOPE}
- {$IFDEF MSWINDOWS}
- Winapi.Windows,
- {$ENDIF MSWINDOWS}
- System.SysUtils, System.Classes,
- System.Contnrs,
- {$ELSE ~HAS_UNITSCOPE}
- {$IFDEF MSWINDOWS}
- Windows,
- {$ENDIF MSWINDOWS}
- SysUtils, Classes,
- Contnrs,
- {$ENDIF ~HAS_UNITSCOPE}
- {$IFDEF HAS_UNIT_LIBC}
- Libc,
- {$ENDIF HAS_UNIT_LIBC}
- JclBase{$IFNDEF WINSCP}, JclStringConversions{$ENDIF ~WINSCP};
- const
- StreamDefaultBufferSize = 4096;
- type
- EJclStreamError = class(EJclError);
- // 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); overload; override;
- procedure SetSize(const NewSize: Int64); overload; override;
- public
- function Seek(Offset: Longint; Origin: Word): Longint; overload; override;
- function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; overload; override;
- procedure LoadFromStream(Source: TStream; BufferSize: Longint = StreamDefaultBufferSize); virtual;
- procedure LoadFromFile(const FileName: TFileName; BufferSize: Longint = StreamDefaultBufferSize); virtual;
- procedure SaveToStream(Dest: TStream; BufferSize: Longint = StreamDefaultBufferSize); virtual;
- procedure SaveToFile(const FileName: TFileName; BufferSize: Longint = StreamDefaultBufferSize); virtual;
- end;
- //=== VCL stream replacements ===
- TJclHandleStream = class(TJclStream)
- private
- FHandle: THandle;
- protected
- procedure SetSize(const NewSize: Int64); override;
- public
- constructor Create(AHandle: THandle);
- 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;
- property Handle: THandle read FHandle;
- end;
- TJclFileStream = class(TJclHandleStream)
- public
- constructor Create(const FileName: TFileName; Mode: Word; Rights: Cardinal = $666);
- destructor Destroy; override;
- end;
- {
- TJclCustomMemoryStream = class(TJclStream)
- end;
- TJclMemoryStream = class(TJclCustomMemoryStream)
- end;
- TJclStringStream = class(TJclStream)
- end;
- TJclResourceStream = class(TJclCustomMemoryStream)
- end;
- }
- //=== new stream ideas ===
- 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(const Offset: Int64; Origin: TSeekOrigin): Int64; override;
- end;
- {$IFNDEF WINSCP}
- TJclNullStream = class(TJclStream)
- private
- FPosition: Int64;
- FSize: Int64;
- 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;
- TJclRandomStream = class(TJclNullStream)
- protected
- function GetRandSeed: Longint; virtual;
- procedure SetRandSeed(Seed: Longint); virtual;
- public
- function RandomData: Byte; virtual;
- procedure Randomize; dynamic;
- function Read(var Buffer; Count: Longint): Longint; override;
- property RandSeed: Longint read GetRandSeed write SetRandSeed;
- end;
- {$ENDIF ~WINSCP}
- TJclMultiplexStream = class(TJclStream)
- private
- FStreams: TList;
- FReadStreamIndex: Integer;
- function GetStream(Index: Integer): TStream;
- function GetCount: 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;
- 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 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 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(const NewSize: Int64); override;
- public
- constructor Create(AStream: TStream; AOwnsStream: Boolean = False);
- 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;
- 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)
- protected
- FBuffer: array of Byte;
- FBufferCurrentSize: Longint;
- FBufferMaxModifiedPos: Longint;
- FBufferSize: Longint;
- FBufferStart: Int64; // position of the first byte of the buffer in stream
- FPosition: Int64; // current position in stream
- function BufferHit: Boolean;
- function GetCalcedSize: Int64; virtual;
- function LoadBuffer: Boolean; virtual;
- 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(const NewSize: Int64); override;
- public
- constructor Create(AStream: TStream; AOwnsStream: Boolean = False);
- destructor Destroy; override;
- procedure Flush; virtual;
- 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;
- property BufferSize: Longint read FBufferSize write FBufferSize;
- 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(const NewSize: Int64); override;
- public
- constructor Create(AStream: TStream; ANotification: TStreamNotifyEvent = nil;
- AOwnsStream: Boolean = False);
- 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;
- property OnNotification: TStreamNotifyEvent read FNotification write FNotification;
- end;
- TJclEasyStream = class(TJclStreamDecorator)
- public
- function IsEqual(Stream: TStream): Boolean;
- function ReadBoolean: Boolean;
- function ReadChar: Char;
- function ReadAnsiChar: AnsiChar;
- function ReadWideChar: WideChar;
- function ReadByte: Byte;
- function ReadCurrency: Currency;
- function ReadDateTime: TDateTime;
- function ReadExtended: Extended;
- function ReadDouble: Double;
- function ReadInt64: Int64;
- function ReadInteger: Integer;
- function ReadCString: string; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
- function ReadCAnsiString: AnsiString;
- function ReadCWideString: WideString;
- function ReadShortString: string;
- function ReadSingle: Single;
- function ReadSizedString: string; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
- function ReadSizedAnsiString: AnsiString;
- function ReadSizedWideString: WideString;
- procedure WriteBoolean(Value: Boolean);
- procedure WriteChar(Value: Char);
- procedure WriteAnsiChar(Value: AnsiChar);
- procedure WriteWideChar(Value: WideChar);
- procedure WriteByte(Value: Byte);
- procedure WriteCurrency(const Value: Currency);
- procedure WriteDateTime(const Value: TDateTime);
- procedure WriteExtended(const Value: Extended);
- procedure WriteDouble(const Value: Double);
- procedure WriteInt64(Value: Int64); overload;
- procedure WriteInteger(Value: Integer); overload;
- procedure WriteCString(const Value: string); {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
- procedure WriteCAnsiString(const Value: AnsiString);
- procedure WriteCWideString(const Value: WideString);
- // use WriteCString
- procedure WriteShortString(const Value: ShortString);
- procedure WriteSingle(const Value: Single);
- procedure WriteSizedString(const Value: string); {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
- procedure WriteSizedAnsiString(const Value: AnsiString);
- procedure WriteSizedWideString(const Value: WideString);
- end;
- TJclScopedStream = class(TJclStream)
- private
- FParentStream: TStream;
- FStartPos: Int64;
- FCurrentPos: Int64;
- FMaxSize: Int64;
- protected
- procedure SetSize(const NewSize: Int64); override;
- public
- // scopedstream starting at the current position of the ParentStream
- // if MaxSize is positive or null, read and write operations cannot overrun this size or the ParentStream limitation
- // if MaxSize is negative, read and write operations are unlimited (up to the ParentStream limitation)
- constructor Create(AParentStream: TStream; const AMaxSize: Int64 = -1); overload;
- constructor Create(AParentStream: TStream; const AStartPos, AMaxSize: Int64); overload;
- 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;
- property ParentStream: TStream read FParentStream;
- property StartPos: Int64 read FStartPos;
- property MaxSize: Int64 read FMaxSize write FMaxSize;
- end;
- TJclStreamSeekEvent = function(Sender: TObject; const Offset: Int64;
- Origin: TSeekOrigin): Int64 of object;
- TJclStreamReadEvent = function(Sender: TObject; var Buffer; Count: Longint): Longint of object;
- TJclStreamWriteEvent = function(Sender: TObject; const Buffer;Count: Longint): Longint of object;
- TJclStreamSizeEvent = procedure(Sender: TObject; const NewSize: Int64) of object;
- TJclDelegatedStream = class(TJclStream)
- private
- FOnSeek: TJclStreamSeekEvent;
- FOnRead: TJclStreamReadEvent;
- FOnWrite: TJclStreamWriteEvent;
- FOnSize: TJclStreamSizeEvent;
- protected
- procedure SetSize(const NewSize: Int64); override;
- public
- function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; override;
- function Read(var Buffer; Count: Longint): Longint; override;
- function Write(const Buffer; Count: Longint): Longint; override;
- property OnSeek: TJclStreamSeekEvent read FOnSeek write FOnSeek;
- property OnRead: TJclStreamReadEvent read FOnRead write FOnRead;
- property OnWrite: TJclStreamWriteEvent read FOnWrite write FOnWrite;
- property OnSize: TJclStreamSizeEvent read FOnSize write FOnSize;
- end;
- // ancestor classes for streams with checksums and encrypted streams
- // data are stored in sectors: each BufferSize-d buffer is followed by FSectorOverHead bytes
- // containing the checksum. In case of an encrypted stream, there is no byte
- // but sector is encrypted
- // reusing some code from TJclBufferedStream
- TJclSectoredStream = class(TJclBufferedStream)
- protected
- FSectorOverHead: Longint;
- function FlatToSectored(const Position: Int64): Int64;
- function SectoredToFlat(const Position: Int64): Int64;
- function GetCalcedSize: Int64; override;
- function LoadBuffer: Boolean; override;
- procedure DoAfterStreamChange; override;
- procedure AfterBlockRead; virtual; // override to check protection
- procedure BeforeBlockWrite; virtual; // override to compute protection
- procedure SetSize(const NewSize: Int64); override;
- public
- constructor Create(AStorageStream: TStream; AOwnsStream: Boolean = False;
- ASectorOverHead: Longint = 0);
- procedure Flush; override;
- end;
- {$IFNDEF WINSCP}
- TJclCRC16Stream = class(TJclSectoredStream)
- protected
- procedure AfterBlockRead; override;
- procedure BeforeBlockWrite; override;
- public
- constructor Create(AStorageStream: TStream; AOwnsStream: Boolean = False);
- end;
- TJclCRC32Stream = class(TJclSectoredStream)
- protected
- procedure AfterBlockRead; override;
- procedure BeforeBlockWrite; override;
- public
- constructor Create(AStorageStream: TStream; AOwnsStream: Boolean = False);
- end;
- {$ENDIF ~WINSCP}
- {$IFDEF COMPILER7_UP}
- {$DEFINE SIZE64}
- {$ENDIF ~COMPILER7_UP}
- {$IFDEF FPC}
- {$DEFINE SIZE64}
- {$ENDIF FPC}
- TJclSplitStream = class(TJclStream)
- private
- FVolume: TStream;
- FVolumeIndex: Integer;
- FVolumeMaxSize: Int64;
- FPosition: Int64;
- FVolumePosition: Int64;
- FForcePosition: Boolean;
- protected
- function GetVolume(Index: Integer): TStream; virtual; abstract;
- function GetVolumeMaxSize(Index: Integer): Int64; virtual; abstract;
- function GetSize: Int64; {$IFDEF SIZE64}override;{$ENDIF SIZE64}
- procedure SetSize(const NewSize: Int64); override;
- function InternalLoadVolume(Index: Integer): Boolean;
- public
- constructor Create(AForcePosition: Boolean = False);
- function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; override;
- function Read(var Buffer; Count: Longint): Longint; override;
- function Write(const Buffer; Count: Longint): Longint; override;
- property ForcePosition: Boolean read FForcePosition write FForcePosition;
- end;
- TJclVolumeEvent = function(Index: Integer): TStream of object;
- TJclVolumeMaxSizeEvent = function(Index: Integer): Int64 of object;
- TJclDynamicSplitStream = class(TJclSplitStream)
- private
- FOnVolume: TJclVolumeEvent;
- FOnVolumeMaxSize: TJclVolumeMaxSizeEvent;
- protected
- function GetVolume(Index: Integer): TStream; override;
- function GetVolumeMaxSize(Index: Integer): Int64; override;
- public
- property OnVolume: TJclVolumeEvent read FOnVolume write FOnVolume;
- property OnVolumeMaxSize: TJclVolumeMaxSizeEvent read FOnVolumeMaxSize
- write FOnVolumeMaxSize;
- end;
- TJclSplitVolume = class
- public
- MaxSize: Int64;
- Stream: TStream;
- OwnStream: Boolean;
- end;
- TJclStaticSplitStream = class(TJclSplitStream)
- private
- FVolumes: TObjectList;
- function GetVolumeCount: Integer;
- protected
- function GetVolume(Index: Integer): TStream; override;
- function GetVolumeMaxSize(Index: Integer): Int64; override;
- public
- constructor Create(AForcePosition: Boolean = False);
- destructor Destroy; override;
- function AddVolume(AStream: TStream; AMaxSize: Int64 = 0;
- AOwnStream: Boolean = False): Integer;
- property VolumeCount: Integer read GetVolumeCount;
- property Volumes[Index: Integer]: TStream read GetVolume;
- property VolumeMaxSizes[Index: Integer]: Int64 read GetVolumeMaxSize;
- end;
- {$IFNDEF WINSCP}
- TJclStringStream = class
- protected
- FStream: TStream;
- FOwnStream: Boolean;
- FBOM: array of Byte;
- FBufferSize: SizeInt;
- FStrPosition: Int64; // current position in characters
- FStrBuffer: TUCS4Array; // buffer for read/write operations
- FStrBufferPosition: Int64; // position of the first character of the read/write buffer
- FStrBufferCurrentSize: Int64; // numbers of characters available in str buffer
- FStrBufferModifiedSize: Int64; // numbers of characters modified in str buffer
- FStrBufferStart: Int64; // position of the first byte of the read/write buffer in stream
- FStrBufferNext: Int64; // position of the next character following the read/write buffer in stream
- FStrPeekPosition: Int64; // current peek position in characters
- FStrPeekBuffer: TUCS4Array; // buffer for peek operations
- FStrPeekBufferPosition: Int64; // index of the first character of the peek buffer
- FStrPeekBufferCurrentSize: SizeInt; // numbers of characters available in peek buffer
- FStrPeekBufferStart: Int64; // position of the first byte of the peek buffer in stream
- FStrPeekBufferNext: Int64; // position of the next character following the peek buffer in stream
- function LoadBuffer: Boolean;
- function LoadPeekBuffer: Boolean;
- function InternalGetNextChar(S: TStream; out Ch: UCS4): Boolean; virtual; abstract;
- function InternalGetNextBuffer(S: TStream; var Buffer: TUCS4Array; Start, Count: SizeInt): Longint; virtual;
- function InternalSetNextChar(S: TStream; Ch: UCS4): Boolean; virtual; abstract;
- function InternalSetNextBuffer(S: TStream; const Buffer: TUCS4Array; Start, Count: SizeInt): Longint; virtual;
- procedure InvalidateBuffers;
- public
- constructor Create(AStream: TStream; AOwnsStream: Boolean = False); virtual;
- destructor Destroy; override;
- procedure Flush; virtual;
- function ReadString(var Buffer: string; Start, Count: Longint): Longint; overload;
- function ReadString(BufferSize: Longint = StreamDefaultBufferSize): string; overload;
- function ReadAnsiString(var Buffer: AnsiString; Start, Count: Longint): Longint; overload;
- function ReadAnsiString(BufferSize: Longint = StreamDefaultBufferSize): AnsiString; overload;
- function ReadWideString(var Buffer: WideString; Start, Count: Longint): Longint; overload;
- function ReadWideString(BufferSize: Longint = StreamDefaultBufferSize): WideString; overload;
- function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; virtual;
- function WriteString(const Buffer: string; Start, Count: Longint): Longint;
- function WriteAnsiString(const Buffer: AnsiString; Start, Count: Longint): Longint;
- function WriteWideString(const Buffer: WideString; Start, Count: Longint): Longint;
- function PeekChar(out Buffer: Char): Boolean;
- function PeekAnsiChar(out Buffer: AnsiChar): Boolean;
- function PeekUCS4(out Buffer: UCS4): Boolean;
- function PeekWideChar(out Buffer: WideChar): Boolean;
- function ReadChar(out Buffer: Char): Boolean;
- function ReadAnsiChar(out Buffer: AnsiChar): Boolean;
- function ReadUCS4(out Buffer: UCS4): Boolean;
- function ReadWideChar(out Buffer: WideChar): Boolean;
- function WriteChar(Value: Char): Boolean;
- function WriteAnsiChar(Value: AnsiChar): Boolean;
- function WriteUCS4(Value: UCS4): Boolean;
- function WriteWideChar(Value: WideChar): Boolean;
- function SkipBOM: LongInt; virtual;
- function WriteBOM: Longint; virtual;
- property BufferSize: SizeInt read FBufferSize write FBufferSize;
- property PeekPosition: Int64 read FStrPeekPosition;
- property Position: Int64 read FStrPosition;
- property Stream: TStream read FStream;
- property OwnStream: Boolean read FOwnStream;
- end;
- TJclStringStreamClass = class of TJclStringStream;
- TJclAnsiStream = class(TJclStringStream)
- private
- FCodePage: Word;
- protected
- function InternalGetNextChar(S: TStream; out Ch: UCS4): Boolean; override;
- function InternalGetNextBuffer(S: TStream; var Buffer: TUCS4Array; Start, Count: SizeInt): Longint; override;
- function InternalSetNextChar(S: TStream; Ch: UCS4): Boolean; override;
- function InternalSetNextBuffer(S: TStream; const Buffer: TUCS4Array; Start, Count: SizeInt): Longint; override;
- public
- constructor Create(AStream: TStream; AOwnsStream: Boolean = False); override;
- property CodePage: Word read FCodePage write FCodePage;
- end;
- TJclUTF8Stream = class(TJclStringStream)
- protected
- function InternalGetNextChar(S: TStream; out Ch: UCS4): Boolean; override;
- function InternalGetNextBuffer(S: TStream; var Buffer: TUCS4Array; Start, Count: SizeInt): Longint; override;
- function InternalSetNextChar(S: TStream; Ch: UCS4): Boolean; override;
- function InternalSetNextBuffer(S: TStream; const Buffer: TUCS4Array; Start, Count: SizeInt): Longint; override;
- public
- constructor Create(AStream: TStream; AOwnsStream: Boolean = False); override;
- end;
- TJclUTF16Stream = class(TJclStringStream)
- protected
- function InternalGetNextChar(S: TStream; out Ch: UCS4): Boolean; override;
- function InternalGetNextBuffer(S: TStream; var Buffer: TUCS4Array; Start, Count: SizeInt): Longint; override;
- function InternalSetNextChar(S: TStream; Ch: UCS4): Boolean; override;
- function InternalSetNextBuffer(S: TStream; const Buffer: TUCS4Array; Start, Count: SizeInt): Longint; override;
- public
- constructor Create(AStream: TStream; AOwnsStream: Boolean = False); override;
- end;
- TJclStringEncoding = (seAnsi, seUTF8, seUTF16, seAuto);
- TJclAutoStream = class(TJclStringStream)
- private
- FCodePage: Word;
- FEncoding: TJclStringEncoding;
- procedure SetCodePage(Value: Word);
- protected
- function InternalGetNextChar(S: TStream; out Ch: UCS4): Boolean; override;
- function InternalGetNextBuffer(S: TStream; var Buffer: TUCS4Array; Start, Count: SizeInt): Longint; override;
- function InternalSetNextChar(S: TStream; Ch: UCS4): Boolean; override;
- function InternalSetNextBuffer(S: TStream; const Buffer: TUCS4Array; Start, Count: SizeInt): Longint; override;
- public
- constructor Create(AStream: TStream; AOwnsStream: Boolean = False); override;
- function SkipBOM: LongInt; override;
- property CodePage: Word read FCodePage write SetCodePage;
- property Encoding: TJclStringEncoding read FEncoding;
- end;
- {$ENDIF ~WINSCP}
- // buffered copy of all available bytes from Source to Dest
- // returns the number of bytes that were copied
- function StreamCopy(Source: TStream; Dest: TStream; BufferSize: Longint = StreamDefaultBufferSize): Int64;
- {$IFNDEF WINSCP}
- // buffered copy of all available characters from Source to Dest
- // retuns the number of characters (in specified encoding) that were copied
- function StringStreamCopy(Source, Dest: TJclStringStream; BufferLength: Longint = StreamDefaultBufferSize): Int64;
- function AnsiStringStreamCopy(Source, Dest: TJclStringStream; BufferLength: Longint = StreamDefaultBufferSize): Int64;
- function WideStringStreamCopy(Source, Dest: TJclStringStream; BufferLength: Longint = StreamDefaultBufferSize): Int64;
- {$ENDIF ~WINSCP}
- // compares 2 streams for differencies
- function CompareStreams(A, B : TStream; BufferSize: Longint = StreamDefaultBufferSize): Boolean;
- // compares 2 files for differencies (calling CompareStreams)
- function CompareFiles(const FileA, FileB: TFileName; BufferSize: Longint = StreamDefaultBufferSize): Boolean;
- {$IFDEF UNITVERSIONING}
- const
- UnitVersioning: TUnitVersionInfo = (
- RCSfile: '$URL$';
- Revision: '$Revision$';
- Date: '$Date$';
- LogPath: 'JCL\source\common';
- Extra: '';
- Data: nil
- );
- {$ENDIF UNITVERSIONING}
- implementation
- uses
- {$IFDEF HAS_UNITSCOPE}
- System.Types,
- {$ENDIF HAS_UNITSCOPE}
- JclResources{$IFNDEF WINSCP},
- JclCharsets{$ENDIF ~WINSCP}{,
- JclMath,
- JclSysUtils};
- function StreamCopy(Source: TStream; Dest: TStream; BufferSize: Longint): Int64;
- var
- Buffer: array of Byte;
- ByteCount: Longint;
- begin
- Result := 0;
- SetLength(Buffer, BufferSize);
- repeat
- ByteCount := Source.Read(Buffer[0], BufferSize);
- Result := Result + ByteCount;
- Dest.WriteBuffer(Buffer[0], ByteCount);
- until ByteCount < BufferSize;
- end;
- {$IFNDEF WINSCP}
- function StringStreamCopy(Source, Dest: TJclStringStream; BufferLength: Longint): Int64;
- var
- Buffer: string;
- CharCount: Longint;
- begin
- Result := 0;
- SetLength(Buffer, BufferLength);
- repeat
- CharCount := Source.ReadString(Buffer, 1, BufferLength);
- Result := Result + CharCount;
- CharCount := Dest.WriteString(Buffer, 1, CharCount);
- until CharCount = 0;
- end;
- function AnsiStringStreamCopy(Source, Dest: TJclStringStream; BufferLength: Longint): Int64;
- var
- Buffer: AnsiString;
- CharCount: Longint;
- begin
- Result := 0;
- SetLength(Buffer, BufferLength);
- repeat
- CharCount := Source.ReadAnsiString(Buffer, 1, BufferLength);
- Result := Result + CharCount;
- CharCount := Dest.WriteAnsiString(Buffer, 1, CharCount);
- until CharCount = 0;
- end;
- function WideStringStreamCopy(Source, Dest: TJclStringStream; BufferLength: Longint): Int64;
- var
- Buffer: WideString;
- CharCount: Longint;
- begin
- Result := 0;
- SetLength(Buffer, BufferLength);
- repeat
- CharCount := Source.ReadWideString(Buffer, 1, BufferLength);
- Result := Result + CharCount;
- CharCount := Dest.WriteWideString(Buffer, 1, CharCount);
- until CharCount = 0;
- end;
- {$ENDIF ~WINSCP}
- function CompareStreams(A, B : TStream; BufferSize: Longint): Boolean;
- var
- BufferA, BufferB: array of Byte;
- ByteCountA, ByteCountB: Longint;
- begin
- SetLength(BufferA, BufferSize);
- try
- SetLength(BufferB, BufferSize);
- try
- repeat
- ByteCountA := A.Read(BufferA[0], BufferSize);
- ByteCountB := B.Read(BufferB[0], BufferSize);
- Result := (ByteCountA = ByteCountB);
- Result := Result and CompareMem(BufferA, BufferB, ByteCountA);
- until (ByteCountA <> BufferSize) or (ByteCountB <> BufferSize) or not Result;
- finally
- SetLength(BufferB, 0);
- end;
- finally
- SetLength(BufferA, 0);
- end;
- end;
- function CompareFiles(const FileA, FileB: TFileName; BufferSize: Longint): Boolean;
- var
- A, B: TStream;
- begin
- A := TFileStream.Create(FileA, fmOpenRead or fmShareDenyWrite);
- try
- B := TFileStream.Create(FileB, fmOpenRead or fmShareDenyWrite);
- try
- Result := CompareStreams(A, B, BufferSize);
- finally
- B.Free;
- end;
- finally
- A.Free;
- end;
- end;
- //=== { TJclStream } =========================================================
- function TJclStream.Seek(Offset: Longint; 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 := -1;
- end;
- if (Result64 < 0) or (Result64 > High(Longint)) then
- Result64 := -1;
- Result := Result64;
- end;
- procedure TJclStream.LoadFromFile(const FileName: TFileName;
- BufferSize: Integer);
- var
- FS: TStream;
- begin
- FS := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
- try
- LoadFromStream(FS, BufferSize);
- finally
- FS.Free;
- end;
- end;
- procedure TJclStream.LoadFromStream(Source: TStream; BufferSize: Integer);
- begin
- StreamCopy(Source, Self, BufferSize);
- end;
- procedure TJclStream.SaveToFile(const FileName: TFileName; BufferSize: Integer);
- var
- FS: TStream;
- begin
- FS := TFileStream.Create(FileName, fmCreate);
- try
- SaveToStream(FS, BufferSize);
- finally
- FS.Free;
- end;
- end;
- procedure TJclStream.SaveToStream(Dest: TStream; BufferSize: Integer);
- begin
- StreamCopy(Self, Dest, BufferSize);
- end;
- function TJclStream.Seek(const Offset: Int64; Origin: TSeekOrigin): Int64;
- begin
- // override to customize
- Result := -1;
- end;
- procedure TJclStream.SetSize(NewSize: Longint);
- begin
- SetSize(Int64(NewSize));
- end;
- procedure TJclStream.SetSize(const NewSize: Int64);
- begin
- // override to customize
- end;
- //=== { TJclHandleStream } ===================================================
- constructor TJclHandleStream.Create(AHandle: THandle);
- begin
- inherited Create;
- FHandle := AHandle;
- end;
- function TJclHandleStream.Read(var Buffer; Count: Longint): Longint;
- begin
- Result := 0;
- {$IFDEF MSWINDOWS}
- if (Count <= 0) or not ReadFile(Handle, Buffer, DWORD(Count), DWORD(Result), nil) then
- Result := 0;
- {$ENDIF MSWINDOWS}
- {$IFDEF LINUX}
- Result := __read(Handle, Buffer, Count);
- {$ENDIF LINUX}
- end;
- function TJclHandleStream.Write(const Buffer; Count: Longint): Longint;
- begin
- Result := 0;
- {$IFDEF MSWINDOWS}
- if (Count <= 0) or not WriteFile(Handle, Buffer, DWORD(Count), DWORD(Result), nil) then
- Result := 0;
- {$ENDIF MSWINDOWS}
- {$IFDEF LINUX}
- Result := __write(Handle, Buffer, Count);
- {$ENDIF LINUX}
- end;
- {$IFDEF MSWINDOWS}
- function TJclHandleStream.Seek(const Offset: Int64; Origin: TSeekOrigin): Int64;
- const
- INVALID_SET_FILE_POINTER = -1;
- type
- TLarge = record
- case Boolean of
- False:
- (OffsetLo: Longint;
- OffsetHi: Longint);
- True:
- (Offset64: Int64);
- end;
- var
- Offs: TLarge;
- begin
- Offs.Offset64 := Offset;
- Offs.OffsetLo := SetFilePointer(Handle, Offs.OffsetLo, @Offs.OffsetHi, Ord(Origin));
- if (Offs.OffsetLo = INVALID_SET_FILE_POINTER) and (GetLastError <> NO_ERROR) then
- Result := -1
- else
- Result := Offs.Offset64;
- end;
- {$ENDIF MSWINDOWS}
- {$IFDEF LINUX}
- function TJclHandleStream.Seek(const Offset: Int64; Origin: TSeekOrigin): Int64;
- const
- SeekOrigins: array [TSeekOrigin] of Cardinal = ( SEEK_SET {soBeginning}, SEEK_CUR {soCurrent}, SEEK_END {soEnd} );
- begin
- Result := lseek(Handle, Offset, SeekOrigins[Origin]);
- end;
- {$ENDIF LINUX}
- procedure TJclHandleStream.SetSize(const NewSize: Int64);
- begin
- Seek(NewSize, soBeginning);
- {$IFDEF MSWINDOWS}
- if not SetEndOfFile(Handle) then
- RaiseLastOSError;
- {$ENDIF MSWINDOWS}
- {$IFDEF LINUX}
- if ftruncate(Handle, Position) = -1 then
- raise EJclStreamError.CreateRes(@RsStreamsSetSizeError);
- {$ENDIF LINUX}
- end;
- //=== { TJclFileStream } =====================================================
- constructor TJclFileStream.Create(const FileName: TFileName; Mode: Word; Rights: Cardinal);
- var
- H: THandle;
- {$IFDEF LINUX}
- const
- INVALID_HANDLE_VALUE = -1;
- {$ENDIF LINUX}
- begin
- if Mode = fmCreate then
- begin
- {$IFDEF LINUX}
- H := open(PChar(FileName), O_CREAT or O_RDWR, Rights);
- {$ENDIF LINUX}
- {$IFDEF MSWINDOWS}
- H := CreateFile(PChar(FileName), GENERIC_READ or GENERIC_WRITE,
- 0, nil, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0);
- {$ENDIF MSWINDOWS}
- inherited Create(H);
- if Handle = INVALID_HANDLE_VALUE then
- raise EJclStreamError.CreateResFmt(@RsStreamsCreateError, [FileName]);
- end
- else
- begin
- H := THandle(FileOpen(FileName, Mode));
- inherited Create(H);
- if Handle = INVALID_HANDLE_VALUE then
- raise EJclStreamError.CreateResFmt(@RsStreamsOpenError, [FileName]);
- end;
- end;
- destructor TJclFileStream.Destroy;
- begin
- {$IFDEF MSWINDOWS}
- if Handle <> INVALID_HANDLE_VALUE then
- CloseHandle(Handle);
- {$ENDIF MSWINDOWS}
- {$IFDEF LINUX}
- __close(Handle);
- {$ENDIF LINUX}
- inherited Destroy;
- end;
- //=== { 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
- end;
- 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
- if Offset <> 0 then
- // seeking to anywhere except the position 0 is an error
- Result := -1
- else
- Result := 0;
- end;
- {$IFNDEF WINSCP}
- //=== { 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
- FSize := NewSize
- else
- FSize := 0;
- if FPosition > FSize then
- FPosition := FSize;
- end;
- function TJclNullStream.Read(var Buffer; Count: Longint): Longint;
- begin
- if Count < 0 then
- Count := 0;
- // FPosition > FSize is possible!
- if FSize - FPosition < Count then
- Count := FSize - FPosition;
- // does not read if beyond EOF
- if Count > 0 then
- begin
- ResetMemory(Buffer, Count);
- FPosition := FPosition + Count;
- end;
- Result := Count;
- end;
- function TJclNullStream.Write(const Buffer; Count: Longint): Longint;
- begin
- if Count < 0 then
- Count := 0;
- FPosition := FPosition + Count;
- // writing when FPosition > FSize is possible!
- if FPosition > FSize then
- FSize := FPosition;
- Result := Count;
- end;
- function TJclNullStream.Seek(const Offset: Int64; Origin: TSeekOrigin): Int64;
- var
- Rel: Int64;
- begin
- case Origin of
- soBeginning:
- Rel := 0;
- soCurrent:
- Rel := FPosition;
- soEnd:
- Rel := FSize;
- else
- // force Rel + Offset = -1 (code is never reached)
- Rel := Offset - 1;
- end;
- if Rel + Offset >= 0 then
- begin
- // all non-negative destination positions including beyond EOF are valid
- FPosition := Rel + Offset;
- Result := FPosition;
- end
- else
- Result := -1;
- end;
- //=== { TJclRandomStream } ===================================================
- // 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 := 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
- // this handles all necessary checks
- Count := inherited Read(Buffer, Count);
- BufferPtr := @Buffer;
- for I := 0 to Count - 1 do
- begin
- BufferPtr^ := RandomData;
- Inc(BufferPtr);
- end;
- Result := Count;
- end;
- {$ENDIF ~WINSCP}
- //=== { TJclMultiplexStream } ================================================
- constructor TJclMultiplexStream.Create;
- begin
- inherited Create;
- FStreams := TList.Create;
- FReadStreamIndex := -1;
- end;
- destructor TJclMultiplexStream.Destroy;
- begin
- FStreams.Free;
- inherited Destroy;
- end;
- function TJclMultiplexStream.Add(NewStream: TStream): Integer;
- begin
- Result := FStreams.Add(Pointer(NewStream));
- end;
- procedure TJclMultiplexStream.Clear;
- begin
- FStreams.Clear;
- FReadStreamIndex := -1;
- end;
- procedure TJclMultiplexStream.Delete(const Index: Integer);
- begin
- FStreams.Delete(Index);
- if ReadStreamIndex = Index then
- FReadStreamIndex := -1
- else
- if ReadStreamIndex > Index then
- Dec(FReadStreamIndex);
- 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.GetCount: Integer;
- begin
- Result := FStreams.Count;
- end;
- function TJclMultiplexStream.Read(var Buffer; Count: Longint): Longint;
- var
- Stream: TStream;
- begin
- Stream := ReadStream;
- if Assigned(Stream) then
- Result := Stream.Read(Buffer, Count)
- else
- Result := 0;
- end;
- function TJclMultiplexStream.Remove(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: Longint): Longint;
- var
- Index: Integer;
- ByteWritten, MinByteWritten: Longint;
- begin
- MinByteWritten := Count;
- for Index := 0 to Self.Count - 1 do
- begin
- ByteWritten := TStream(FStreams.Items[Index]).Write(Buffer, Count);
- if ByteWritten < MinByteWritten then
- MinByteWritten := ByteWritten;
- end;
- 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
- Result := Stream.Seek(Offset, Origin);
- 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);
- if Stream <> nil then
- FPosition := Stream.Position;
- BufferSize := StreamDefaultBufferSize;
- LoadBuffer;
- end;
- destructor TJclBufferedStream.Destroy;
- begin
- Flush;
- inherited Destroy;
- end;
- function TJclBufferedStream.BufferHit: Boolean;
- begin
- Result := (FBufferStart <= FPosition) and (FPosition < (FBufferStart + FBufferCurrentSize));
- end;
- procedure TJclBufferedStream.DoAfterStreamChange;
- begin
- inherited DoAfterStreamChange;
- FBufferCurrentSize := 0; // invalidate buffer after stream is changed
- FBufferStart := 0;
- if Stream <> nil then
- FPosition := Stream.Position;
- end;
- procedure TJclBufferedStream.DoBeforeStreamChange;
- begin
- inherited DoBeforeStreamChange;
- Flush;
- end;
- procedure TJclBufferedStream.Flush;
- begin
- if (Stream <> nil) and (FBufferMaxModifiedPos > 0) then
- begin
- Stream.Position := FBufferStart;
- Stream.WriteBuffer(FBuffer[0], FBufferMaxModifiedPos);
- FBufferMaxModifiedPos := 0;
- end;
- end;
- function TJclBufferedStream.GetCalcedSize: Int64;
- begin
- if Assigned(Stream) then
- Result := Stream.Size
- else
- Result := 0;
- if Result < FBufferMaxModifiedPos + FBufferStart then
- Result := FBufferMaxModifiedPos + FBufferStart;
- end;
- function TJclBufferedStream.LoadBuffer: Boolean;
- begin
- Flush;
- if Length(FBuffer) <> FBufferSize then
- SetLength(FBuffer, FBufferSize);
- if Stream <> nil then
- begin
- Stream.Position := FPosition;
- FBufferCurrentSize := Stream.Read(FBuffer[0], FBufferSize);
- end
- else
- FBufferCurrentSize := 0;
- FBufferStart := FPosition;
- Result := (FBufferCurrentSize > 0);
- end;
- function TJclBufferedStream.Read(var Buffer; Count: Longint): Longint;
- const
- Offset = 0;
- begin
- Result := Count + Offset;
- 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 - Offset;
- end;
- function TJclBufferedStream.ReadFromBuffer(var Buffer; Count, Start: Longint): Longint;
- var
- BufPos: Longint;
- P: PAnsiChar;
- 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(const Offset: Int64;
- Origin: TSeekOrigin): Int64;
- var
- NewPos: Int64;
- begin
- NewPos := FPosition;
- case Origin of
- soBeginning:
- NewPos := Offset;
- soCurrent:
- Inc(NewPos, Offset);
- soEnd:
- NewPos := GetCalcedSize + Offset;
- else
- NewPos := -1;
- end;
- if NewPos < 0 then
- NewPos := -1
- else
- FPosition := NewPos;
- Result := NewPos;
- end;
- procedure TJclBufferedStream.SetSize(const NewSize: Int64);
- begin
- inherited SetSize(NewSize);
- if NewSize < (FBufferStart + FBufferMaxModifiedPos) then
- begin
- FBufferMaxModifiedPos := NewSize - FBufferStart;
- if FBufferMaxModifiedPos < 0 then
- FBufferMaxModifiedPos := 0;
- end;
- if NewSize < (FBufferStart + FBufferCurrentSize) then
- begin
- FBufferCurrentSize := NewSize - FBufferStart;
- if FBufferCurrentSize < 0 then
- FBufferCurrentSize := 0;
- end;
- // fix from Marcelo Rocha
- if Stream <> nil then
- FPosition := Stream.Position;
- end;
- function TJclBufferedStream.Write(const Buffer; Count: Longint): Longint;
- const
- Offset = 0;
- begin
- Result := Count + Offset;
- while Count > 0 do
- begin
- if (FBufferStart > FPosition) or (FPosition >= (FBufferStart + FBufferSize)) then
- LoadBuffer;
- Dec(Count, WriteToBuffer(Buffer, Count, Result - Count));
- end;
- Result := Result - Count - Offset;
- end;
- function TJclBufferedStream.WriteToBuffer(const Buffer; Count, Start: Longint): Longint;
- var
- BufPos: Longint;
- P: PAnsiChar;
- 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);
- if FBufferMaxModifiedPos < BufPos + Result then
- 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;
- 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;
- var
- SavePos, StreamSavePos: Int64;
- begin
- SavePos := Position;
- StreamSavePos := Stream.Position;
- try
- Position := 0;
- Stream.Position := 0;
- Result := CompareStreams(Self, Stream);
- finally
- Position := SavePos;
- Stream.Position := StreamSavePos;
- end;
- end;
- function TJclEasyStream.ReadBoolean: Boolean;
- begin
- Result := False;
- ReadBuffer(Result, SizeOf(Result));
- end;
- function TJclEasyStream.ReadChar: Char;
- begin
- Result := #0;
- ReadBuffer(Result, SizeOf(Result));
- end;
- function TJclEasyStream.ReadAnsiChar: AnsiChar;
- begin
- Result := #0;
- ReadBuffer(Result, SizeOf(Result));
- end;
- function TJclEasyStream.ReadWideChar: WideChar;
- begin
- Result := #0;
- ReadBuffer(Result, SizeOf(Result));
- end;
- function TJclEasyStream.ReadByte: Byte;
- begin
- Result := 0;
- ReadBuffer(Result, SizeOf(Result));
- end;
- function TJclEasyStream.ReadCurrency: Currency;
- begin
- Result := 0;
- ReadBuffer(Result, SizeOf(Result));
- end;
- function TJclEasyStream.ReadDateTime: TDateTime;
- begin
- Result := 0;
- ReadBuffer(Result, SizeOf(Result));
- end;
- function TJclEasyStream.ReadDouble: Double;
- begin
- Result := 0;
- ReadBuffer(Result, SizeOf(Result));
- end;
- function TJclEasyStream.ReadExtended: Extended;
- begin
- Result := 0;
- ReadBuffer(Result, SizeOf(Result));
- end;
- function TJclEasyStream.ReadInt64: Int64;
- begin
- Result := 0;
- ReadBuffer(Result, SizeOf(Result));
- end;
- function TJclEasyStream.ReadInteger: Integer;
- begin
- Result := 0;
- ReadBuffer(Result, SizeOf(Result));
- end;
- function TJclEasyStream.ReadCString: string;
- begin
- {$IFDEF SUPPORTS_UNICODE}
- Result := ReadCWideString;
- {$ELSE ~SUPPORTS_UNICODE}
- Result := ReadCAnsiString;
- {$ENDIF ~SUPPORTS_UNICODE}
- end;
- function TJclEasyStream.ReadCAnsiString: AnsiString;
- var
- CurrPos: Longint;
- StrSize: Integer;
- begin
- CurrPos := Position;
- repeat
- until ReadAnsiChar = #0;
- StrSize := Position - CurrPos; // Get number of bytes
- SetLength(Result, StrSize div SizeOf(AnsiChar) - 1); // Set number of chars without #0
- Position := CurrPos; // Seek to start read
- ReadBuffer(Result[1], StrSize); // Read ansi data and #0
- end;
- function TJclEasyStream.ReadCWideString: WideString;
- var
- CurrPos: Integer;
- StrSize: Integer;
- begin
- CurrPos := Position;
- repeat
- until ReadWideChar = #0;
- StrSize := Position - CurrPos; // Get number of bytes
- SetLength(Result, StrSize div SizeOf(WideChar) - 1); // Set number of chars without #0
- Position := CurrPos; // Seek to start read
- ReadBuffer(Result[1], StrSize); // Read wide data and #0
- 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
- Result := 0;
- ReadBuffer(Result, SizeOf(Result));
- end;
- function TJclEasyStream.ReadSizedString: string;
- begin
- {$IFDEF SUPPORTS_UNICODE}
- Result := ReadSizedWideString;
- {$ELSE ~SUPPORTS_UNICODE}
- Result := ReadSizedAnsiString;
- {$ENDIF ~SUPPORTS_UNICODE}
- end;
- function TJclEasyStream.ReadSizedAnsiString: AnsiString;
- var
- StrSize: Integer;
- begin
- StrSize := ReadInteger;
- SetLength(Result, StrSize);
- ReadBuffer(Result[1], StrSize * SizeOf(Result[1]));
- end;
- function TJclEasyStream.ReadSizedWideString: WideString;
- var
- StrSize: Integer;
- begin
- StrSize := ReadInteger;
- SetLength(Result, StrSize);
- ReadBuffer(Result[1], StrSize * SizeOf(Result[1]));
- 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.WriteAnsiChar(Value: AnsiChar);
- begin
- WriteBuffer(Value, SizeOf(Value));
- end;
- procedure TJclEasyStream.WriteWideChar(Value: WideChar);
- begin
- WriteBuffer(Value, SizeOf(Value));
- end;
- procedure TJclEasyStream.WriteByte(Value: Byte);
- 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.WriteCString(const Value: string);
- begin
- {$IFDEF SUPPORTS_UNICODE}
- WriteCWideString(Value);
- {$ELSE ~SUPPORTS_UNICODE}
- WriteCAnsiString(Value);
- {$ENDIF ~SUPPORTS_UNICODE}
- end;
- procedure TJclEasyStream.WriteCAnsiString(const Value: AnsiString);
- var
- StrSize: Integer;
- begin
- StrSize := Length(Value);
- WriteBuffer(Value[1], (StrSize + 1) * SizeOf(Value[1]));
- end;
- procedure TJclEasyStream.WriteCWideString(const Value: WideString);
- var
- StrSize: Integer;
- begin
- StrSize := Length(Value);
- WriteBuffer(Value[1], (StrSize + 1) * SizeOf(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);
- begin
- {$IFDEF SUPPORTS_UNICODE}
- WriteSizedWideString(Value);
- {$ELSE ~SUPPORTS_UNICODE}
- WriteSizedAnsiString(Value);
- {$ENDIF ~SUPPORTS_UNICODE}
- end;
- procedure TJclEasyStream.WriteSizedAnsiString(const Value: AnsiString);
- var
- StrSize: Integer;
- begin
- StrSize := Length(Value);
- WriteInteger(StrSize);
- WriteBuffer(Value[1], StrSize * SizeOf(Value[1]));
- end;
- procedure TJclEasyStream.WriteSizedWideString(const Value: WideString);
- var
- StrSize: Integer;
- begin
- StrSize := Length(Value);
- WriteInteger(StrSize);
- WriteBuffer(Value[1], StrSize * SizeOf(Value[1]));
- end;
- //=== { TJclScopedStream } ===================================================
- constructor TJclScopedStream.Create(AParentStream: TStream; const AMaxSize: Int64);
- begin
- inherited Create;
- FParentStream := AParentStream;
- FStartPos := ParentStream.Position;
- FCurrentPos := 0;
- FMaxSize := AMaxSize;
- end;
- constructor TJclScopedStream.Create(AParentStream: TStream; const AStartPos, AMaxSize: Int64);
- begin
- inherited Create;
- FParentStream := AParentStream;
- FStartPos := AStartPos;
- FCurrentPos := 0;
- FMaxSize := AMaxSize;
- end;
- function TJclScopedStream.Read(var Buffer; Count: Longint): Longint;
- begin
- if (MaxSize >= 0) and ((FCurrentPos + Count) > MaxSize) then
- Count := MaxSize - FCurrentPos;
- if (Count > 0) and Assigned(ParentStream) then
- begin
- Result := ParentStream.Read(Buffer, Count);
- Inc(FCurrentPos, Result);
- end
- else
- Result := 0;
- end;
- function TJclScopedStream.Seek(const Offset: Int64; Origin: TSeekOrigin): Int64;
- begin
- case Origin of
- soBeginning:
- begin
- if (Offset < 0) or ((MaxSize >= 0) and (Offset > MaxSize)) then
- Result := -1 // low and high bound check
- else
- Result := ParentStream.Seek(StartPos + Offset, soBeginning) - StartPos;
- end;
- soCurrent:
- begin
- if Offset = 0 then
- Result := FCurrentPos // speeding the Position property up
- else if ((FCurrentPos + Offset) < 0) or ((MaxSize >= 0)
- and ((FCurrentPos + Offset) > MaxSize)) then
- Result := -1 // low and high bound check
- else
- Result := ParentStream.Seek(Offset, soCurrent) - StartPos;
- end;
- soEnd:
- begin
- if (MaxSize >= 0) then
- begin
- if (Offset > 0) or (MaxSize < -Offset) then // low and high bound check
- Result := -1
- else
- Result := ParentStream.Seek(StartPos + MaxSize + Offset, soBeginning) - StartPos;
- end
- else
- begin
- Result := ParentStream.Seek(Offset, soEnd);
- if (Result <> -1) and (Result < StartPos) then // low bound check
- begin
- Result := -1;
- ParentStream.Seek(StartPos + FCurrentPos, soBeginning);
- end;
- end;
- end;
- else
- Result := -1;
- end;
- if Result <> -1 then
- FCurrentPos := Result;
- end;
- procedure TJclScopedStream.SetSize(const NewSize: Int64);
- var
- ScopedNewSize: Int64;
- begin
- if (FMaxSize >= 0) and (NewSize >= (FStartPos + FMaxSize)) then
- ScopedNewSize := FMaxSize + FStartPos
- else
- ScopedNewSize := NewSize;
- inherited SetSize(ScopedNewSize);
- end;
- function TJclScopedStream.Write(const Buffer; Count: Longint): Longint;
- begin
- if (MaxSize >= 0) and ((FCurrentPos + Count) > MaxSize) then
- Count := MaxSize - FCurrentPos;
- if (Count > 0) and Assigned(ParentStream) then
- begin
- Result := ParentStream.Write(Buffer, Count);
- Inc(FCurrentPos, Result);
- end
- else
- Result := 0;
- end;
- //=== { TJclDelegateStream } =================================================
- procedure TJclDelegatedStream.SetSize(const NewSize: Int64);
- begin
- if Assigned(FOnSize) then
- FOnSize(Self, NewSize);
- end;
- function TJclDelegatedStream.Seek(const Offset: Int64; Origin: TSeekOrigin): Int64;
- begin
- if Assigned(FOnSeek) then
- Result := FOnSeek(Self, Offset, Origin)
- else
- Result := -1;
- end;
- function TJclDelegatedStream.Read(var Buffer; Count: Longint): Longint;
- begin
- if Assigned(FOnRead) then
- Result := FOnRead(Self, Buffer, Count)
- else
- Result := -1;
- end;
- function TJclDelegatedStream.Write(const Buffer; Count: Longint): Longint;
- begin
- if Assigned(FOnWrite) then
- Result := FOnWrite(Self, Buffer, Count)
- else
- Result := -1;
- end;
- //=== { TJclSectoredStream } =================================================
- procedure TJclSectoredStream.AfterBlockRead;
- begin
- // override to customize (checks of protection)
- end;
- procedure TJclSectoredStream.BeforeBlockWrite;
- begin
- // override to customize (computation of protection)
- end;
- constructor TJclSectoredStream.Create(AStorageStream: TStream;
- AOwnsStream: Boolean; ASectorOverHead: Integer);
- begin
- inherited Create(AStorageStream, AOwnsStream);
- FSectorOverHead := ASectorOverHead;
- if Stream <> nil then
- FPosition := SectoredToFlat(Stream.Position);
- end;
- procedure TJclSectoredStream.DoAfterStreamChange;
- begin
- inherited DoAfterStreamChange;
- if Stream <> nil then
- FPosition := SectoredToFlat(Stream.Position);
- end;
- function TJclSectoredStream.FlatToSectored(const Position: Int64): Int64;
- begin
- Result := (Position div BufferSize) * (Int64(BufferSize) + FSectorOverHead) // add overheads of previous buffers
- + (Position mod BufferSize); // offset in sector
- end;
- procedure TJclSectoredStream.Flush;
- begin
- if (Stream <> nil) and (FBufferMaxModifiedPos > 0) then
- begin
- BeforeBlockWrite;
- Stream.Position := FlatToSectored(FBufferStart);
- Stream.WriteBuffer(FBuffer[0], FBufferCurrentSize + FSectorOverHead);
- FBufferMaxModifiedPos := 0;
- end;
- end;
- function TJclSectoredStream.GetCalcedSize: Int64;
- var
- VirtualSize: Int64;
- begin
- if Assigned(Stream) then
- Result := SectoredToFlat(Stream.Size)
- else
- Result := 0;
- VirtualSize := FBufferMaxModifiedPos + FBufferStart;
- if Result < VirtualSize then
- Result := VirtualSize;
- end;
- function TJclSectoredStream.LoadBuffer: Boolean;
- var
- TotalSectorSize: Longint;
- begin
- Flush;
- TotalSectorSize := FBufferSize + FSectorOverHead;
- if Length(FBuffer) <> TotalSectorSize then
- SetLength(FBuffer, TotalSectorSize);
- FBufferStart := (FPosition div BufferSize) * BufferSize;
- if Stream <> nil then
- begin
- Stream.Position := FlatToSectored(FBufferStart);
- FBufferCurrentSize := Stream.Read(FBuffer[0], TotalSectorSize);
- if FBufferCurrentSize > 0 then
- begin
- Dec(FBufferCurrentSize, FSectorOverHead);
- AfterBlockRead;
- end;
- end
- else
- FBufferCurrentSize := 0;
- Result := (FBufferCurrentSize > 0);
- end;
- function TJclSectoredStream.SectoredToFlat(const Position: Int64): Int64;
- var
- TotalSectorSize: Int64;
- begin
- TotalSectorSize := Int64(BufferSize) + FSectorOverHead;
- Result := (Position div TotalSectorSize) * BufferSize // remove previous overheads
- + Position mod TotalSectorSize; // offset in sector
- end;
- procedure TJclSectoredStream.SetSize(const NewSize: Int64);
- begin
- inherited SetSize(FlatToSectored(NewSize));
- end;
- {$IFNDEF WINSCP}
- //=== { TJclCRC16Stream } ====================================================
- procedure TJclCRC16Stream.AfterBlockRead;
- var
- CRC: Word;
- begin
- CRC := Word(FBuffer[FBufferCurrentSize]) or (Word(FBuffer[FBufferCurrentSize + 1]) shl 8);
- if CheckCrc16(FBuffer, FBufferCurrentSize, CRC) < 0 then
- raise EJclStreamError.CreateRes(@RsStreamsCRCError);
- end;
- procedure TJclCRC16Stream.BeforeBlockWrite;
- var
- CRC: Word;
- begin
- CRC := Crc16(FBuffer, FBufferCurrentSize);
- FBuffer[FBufferCurrentSize] := CRC and $FF;
- FBuffer[FBufferCurrentSize + 1] := CRC shr 8;
- end;
- constructor TJclCRC16Stream.Create(AStorageStream: TStream; AOwnsStream: Boolean);
- begin
- inherited Create(AStorageStream, AOwnsStream, 2);
- end;
- //=== { TJclCRC32Stream } ====================================================
- procedure TJclCRC32Stream.AfterBlockRead;
- var
- CRC: Cardinal;
- begin
- CRC := Cardinal(FBuffer[FBufferCurrentSize]) or (Cardinal(FBuffer[FBufferCurrentSize + 1]) shl 8)
- or (Cardinal(FBuffer[FBufferCurrentSize + 2]) shl 16) or (Cardinal(FBuffer[FBufferCurrentSize + 3]) shl 24);
- if CheckCrc32(FBuffer, FBufferCurrentSize, CRC) < 0 then
- raise EJclStreamError.CreateRes(@RsStreamsCRCError);
- end;
- procedure TJclCRC32Stream.BeforeBlockWrite;
- var
- CRC: Cardinal;
- begin
- CRC := Crc32(FBuffer, FBufferCurrentSize);
- FBuffer[FBufferCurrentSize] := CRC and $FF;
- FBuffer[FBufferCurrentSize + 1] := (CRC shr 8) and $FF;
- FBuffer[FBufferCurrentSize + 2] := (CRC shr 16) and $FF;
- FBuffer[FBufferCurrentSize + 3] := (CRC shr 24) and $FF;
- end;
- constructor TJclCRC32Stream.Create(AStorageStream: TStream;
- AOwnsStream: Boolean);
- begin
- inherited Create(AStorageStream, AOwnsStream, 4);
- end;
- {$ENDIF ~WINSCP}
- //=== { TJclSplitStream } ====================================================
- constructor TJclSplitStream.Create(AForcePosition: Boolean);
- begin
- inherited Create;
- FVolume := nil;
- FVolumeIndex := -1;
- FVolumeMaxSize := 0;
- FPosition := 0;
- FVolumePosition := 0;
- FForcePosition := AForcePosition;
- end;
- function TJclSplitStream.GetSize: Int64;
- var
- OldVolumeIndex: Integer;
- OldVolumePosition, OldPosition: Int64;
- begin
- OldVolumeIndex := FVolumeIndex;
- OldVolumePosition := FVolumePosition;
- OldPosition := FPosition;
- Result := 0;
- try
- FVolumeIndex := -1;
- repeat
- if not InternalLoadVolume(FVolumeIndex + 1) then
- Break;
- Result := Result + FVolume.Size;
- until FVolume.Size = 0;
- finally
- InternalLoadVolume(OldVolumeIndex);
- FPosition := OldPosition;
- if Assigned(FVolume) then
- FVolumePosition := FVolume.Seek(OldVolumePosition, soBeginning);
- end;
- end;
- function TJclSplitStream.InternalLoadVolume(Index: Integer): Boolean;
- var
- OldVolumeIndex: Integer;
- OldVolumePosition: Int64;
- OldVolume: TStream;
- begin
- if Index = -1 then
- Index := 0;
- if Index <> FVolumeIndex then
- begin
- // save current pointers
- OldVolumeIndex := FVolumeIndex;
- OldVolumePosition := FVolumePosition;
- OldVolume := FVolume;
- FVolumeIndex := Index;
- FVolumePosition := 0;
- FVolume := GetVolume(Index);
- Result := Assigned(FVolume);
- if Result then begin
- FVolumeMaxSize := GetVolumeMaxSize(Index);
- FVolume.Seek(0, soBeginning)
- end
- else
- begin
- // restore old pointers if volume load failed
- FVolumeIndex := OldVolumeIndex;
- FVolumePosition := OldVolumePosition;
- FVolume := OldVolume;
- end;
- end
- else
- Result := Assigned(FVolume);
- end;
- function TJclSplitStream.Read(var Buffer; Count: Longint): Longint;
- var
- Data: PByte;
- Total, LoopRead: Longint;
- begin
- Result := 0;
- if not InternalLoadVolume(FVolumeIndex) then
- Exit;
- Data := PByte(@Buffer);
- Total := Count;
- repeat
- // force position
- if ForcePosition then
- FVolume.Seek(FVolumePosition, soBeginning);
- // try to read (Count) bytes from current stream
- LoopRead := FVolume.Read(Data^, Count);
- FVolumePosition := FVolumePosition + LoopRead;
- FPosition := FPosition + LoopRead;
- Inc(Result, LoopRead);
- if Result = Total then
- Break;
- // with next volume
- Dec(Count, LoopRead);
- Inc(Data, LoopRead);
- if not InternalLoadVolume(FVolumeIndex + 1) then
- Break;
- until False;
- end;
- function TJclSplitStream.Seek(const Offset: Int64;
- Origin: TSeekOrigin): Int64;
- var
- ExpectedPosition, RemainingOffset: Int64;
- begin
- case TSeekOrigin(Origin) of
- soBeginning:
- ExpectedPosition := Offset;
- soCurrent:
- ExpectedPosition := FPosition + Offset;
- soEnd:
- ExpectedPosition := Size + Offset;
- else
- raise EJclStreamError.CreateRes(@RsStreamsSeekError);
- end;
- RemainingOffset := ExpectedPosition - FPosition;
- Result := FPosition;
- repeat
- if not InternalLoadVolume(FVolumeIndex) then
- Break;
- if RemainingOffset < 0 then
- begin
- // FPosition > ExpectedPosition, seek backward
- if FVolumePosition >= -RemainingOffset then
- begin
- // seek in current volume
- FVolumePosition := FVolume.Seek(FVolumePosition + RemainingOffset, soBeginning);
- Result := Result + RemainingOffset;
- FPosition := Result;
- RemainingOffset := 0;
- end
- else
- begin
- // seek to previous volume
- if FVolumeIndex = 0 then
- Exit;
- // seek to the beginning of current volume
- RemainingOffset := RemainingOffset + FVolumePosition;
- Result := Result - FVolumePosition;
- FPosition := Result;
- FVolumePosition := FVolume.Seek(0, soBeginning);
- // load previous volume
- if not InternalLoadVolume(FVolumeIndex - 1) then
- Break;
- Result := Result - FVolume.Size;
- FPosition := Result;
- RemainingOffset := RemainingOffset + FVolume.Size;
- end;
- end
- else if RemainingOffset > 0 then
- begin
- // FPosition < ExpectedPosition, seek forward
- if (FVolumeMaxSize = 0) or ((FVolumePosition + RemainingOffset) < FVolumeMaxSize) then
- begin
- // can seek in current volume
- FVolumePosition := FVolume.Seek(FVolumePosition + RemainingOffset, soBeginning);
- Result := Result + RemainingOffset;
- FPosition := Result;
- RemainingOffset := 0;
- end
- else
- begin
- // seek to next volume
- RemainingOffset := RemainingOffset - FVolumeMaxSize + FVolumePosition;
- Result := Result + FVolumeMaxSize - FVolumePosition;
- FPosition := Result;
- if not InternalLoadVolume(FVolumeIndex + 1) then begin
- FVolumePosition := FVolumeMaxSize;
- Break;
- end;
- end;
- end;
- until RemainingOffset = 0;
- end;
- procedure TJclSplitStream.SetSize(const NewSize: Int64);
- var
- OldVolumeIndex: Integer;
- OldVolumePosition, OldPosition, RemainingSize, VolumeSize: Int64;
- begin
- OldVolumeIndex := FVolumeIndex;
- OldVolumePosition := FVolumePosition;
- OldPosition := FPosition;
- RemainingSize := NewSize;
- try
- FVolumeIndex := 0;
- repeat
- if not InternalLoadVolume(FVolumeIndex) then
- Break;
- if (FVolumeMaxSize > 0) and (RemainingSize > FVolumeMaxSize) then
- VolumeSize := FVolumeMaxSize
- else
- VolumeSize := RemainingSize;
- FVolume.Size := VolumeSize;
- RemainingSize := RemainingSize - VolumeSize;
- Inc(FVolumeIndex);
- until RemainingSize = 0;
- finally
- InternalLoadVolume(OldVolumeIndex);
- FPosition := OldPosition;
- if Assigned(FVolume) then
- FVolumePosition := FVolume.Seek(OldVolumePosition, soBeginning);
- end;
- end;
- function TJclSplitStream.Write(const Buffer; Count: Longint): Longint;
- var
- Data: PByte;
- Total, LoopWritten: Longint;
- begin
- Result := 0;
- if not InternalLoadVolume(FVolumeIndex) then
- Exit;
- Data := PByte(@Buffer);
- Total := Count;
- repeat
- // force position
- if ForcePosition then
- FVolume.Seek(FVolumePosition, soBeginning);
- // do not write more than (VolumeMaxSize) bytes in current stream
- if (FVolumeMaxSize > 0) and ((Count + FVolumePosition) > FVolumeMaxSize) then
- LoopWritten := FVolumeMaxSize - FVolumePosition
- else
- LoopWritten := Count;
- // try to write (Count) bytes from current stream
- LoopWritten := FVolume.Write(Data^, LoopWritten);
- FVolumePosition := FVolumePosition + LoopWritten;
- FPosition := FPosition + LoopWritten;
- Inc(Result, LoopWritten);
- if Result = Total then
- Break;
- // with next volume
- Dec(Count, LoopWritten);
- Inc(Data, LoopWritten);
- if not InternalLoadVolume(FVolumeIndex + 1) then
- Break;
- until False;
- end;
- //=== { TJclDynamicSplitStream } =============================================
- function TJclDynamicSplitStream.GetVolume(Index: Integer): TStream;
- begin
- if Assigned(FOnVolume) then
- Result := FOnVolume(Index)
- else
- Result := nil;
- end;
- function TJclDynamicSplitStream.GetVolumeMaxSize(Index: Integer): Int64;
- begin
- if Assigned(FOnVolumeMaxSize) then
- Result := FOnVolumeMaxSize(Index)
- else
- Result := 0;
- end;
- //=== { TJclStaticSplitStream } ===========================================
- constructor TJclStaticSplitStream.Create(AForcePosition: Boolean);
- begin
- inherited Create(AForcePosition);
- FVolumes := TObjectList.Create(True);
- end;
- destructor TJclStaticSplitStream.Destroy;
- var
- Index: Integer;
- AVolumeRec: TJclSplitVolume;
- begin
- if Assigned(FVolumes) then
- begin
- for Index := 0 to FVolumes.Count - 1 do
- begin
- AVolumeRec := TJclSplitVolume(FVolumes.Items[Index]);
- if AVolumeRec.OwnStream then
- AVolumeRec.Stream.Free;
- end;
- FVolumes.Free;
- end;
- inherited Destroy;
- end;
- function TJclStaticSplitStream.AddVolume(AStream: TStream; AMaxSize: Int64;
- AOwnStream: Boolean): Integer;
- var
- AVolumeRec: TJclSplitVolume;
- begin
- AVolumeRec := TJclSplitVolume.Create;
- AVolumeRec.MaxSize := AMaxSize;
- AVolumeRec.Stream := AStream;
- AVolumeRec.OwnStream := AOwnStream;
- Result := FVolumes.Add(AVolumeRec);
- end;
- function TJclStaticSplitStream.GetVolume(Index: Integer): TStream;
- begin
- Result := TJclSplitVolume(FVolumes.Items[Index]).Stream;
- end;
- function TJclStaticSplitStream.GetVolumeCount: Integer;
- begin
- Result := FVolumes.Count;
- end;
- function TJclStaticSplitStream.GetVolumeMaxSize(Index: Integer): Int64;
- begin
- Result := TJclSplitVolume(FVolumes.Items[Index]).MaxSize;
- end;
- {$IFNDEF WINSCP}
- //=== { TJclStringStream } ====================================================
- constructor TJclStringStream.Create(AStream: TStream; AOwnsStream: Boolean);
- begin
- inherited Create;
- FStream := AStream;
- FOwnStream := AOwnsStream;
- FBufferSize := StreamDefaultBufferSize;
- end;
- destructor TJclStringStream.Destroy;
- begin
- Flush;
- if FOwnStream then
- FStream.Free;
- inherited;
- end;
- procedure TJclStringStream.Flush;
- begin
- if FStrBufferModifiedSize > 0 then
- begin
- FStream.Position := FStrBufferStart;
- InternalSetNextBuffer(FStream, FStrBuffer, 0, FStrBufferModifiedSize);
- FStrBufferNext := FStream.Seek(0, soCurrent);
- FStrBufferModifiedSize := 0;
- end;
- end;
- function TJclStringStream.InternalGetNextBuffer(S: TStream;
- var Buffer: TUCS4Array; Start, Count: SizeInt): Longint;
- var
- Ch: UCS4;
- begin
- // override to optimize
- Result := 0;
- while Count > 0 do
- begin
- if InternalGetNextChar(S, Ch) then
- begin
- Buffer[Start] := Ch;
- Inc(Start);
- Inc(Result);
- end
- else
- Break;
- Dec(Count);
- end;
- end;
- function TJclStringStream.InternalSetNextBuffer(S: TStream;
- const Buffer: TUCS4Array; Start, Count: SizeInt): Longint;
- begin
- // override to optimize
- Result := 0;
- while Count > 0 do
- begin
- if InternalSetNextChar(S, Buffer[Start]) then
- begin
- Inc(Start);
- Inc(Result);
- end
- else
- Break;
- Dec(Count);
- end;
- end;
- procedure TJclStringStream.InvalidateBuffers;
- begin
- FStrBufferStart := FStream.Seek(0, soCurrent);
- FStrBufferNext := FStrBufferStart;
- FStrBufferPosition := 0;
- FStrBufferCurrentSize := 0;
- FStrBufferModifiedSize := 0;
- FStrPeekBufferStart := FStrBufferStart;
- FStrPeekBufferNext := FStrBufferNext;
- FStrPeekPosition := 0;
- FStrPeekBufferCurrentSize := 0;
- end;
- function TJclStringStream.LoadBuffer: Boolean;
- begin
- Flush;
- // first test if the peek buffer contains the value
- if (FStrBufferNext >= FStrPeekBufferStart) and (FStrBufferNext < FStrPeekBufferNext) then
- begin
- // the requested buffer is already loaded in the peek buffer
- FStrBufferStart := FStrPeekBufferStart;
- FStrBufferNext := FStrPeekBufferNext;
- if Length(FStrBuffer) <> Length(FStrPeekBuffer) then
- SetLength(FStrBuffer, Length(FStrPeekBuffer));
- FStrBufferPosition := FStrPeekBufferPosition;
- FStrBufferCurrentSize := FStrPeekBufferCurrentSize;
- Move(FStrPeekBuffer[0], FStrBuffer[0], FStrBufferCurrentSize * SizeOf(FStrBuffer[0]));
- end
- else
- begin
- // load a new buffer
- if Length(FStrBuffer) <> FBufferSize then
- SetLength(FStrBuffer, FBufferSize);
- Inc(FStrBufferPosition, FStrBufferCurrentSize);
- FStrBufferStart := FStrBufferNext;
- FStream.Seek(FStrBufferStart, soBeginning);
- FStrBufferCurrentSize := InternalGetNextBuffer(FStream, FStrBuffer, 0, FBufferSize);
- FStrBufferNext := FStream.Seek(0, soCurrent);
- // reset the peek buffer
- FStrPeekBufferPosition := FStrBufferPosition + FStrBufferCurrentSize;
- FStrPeekBufferCurrentSize := 0;
- FStrPeekBufferNext := FStrBufferNext;
- FStrPeekBufferStart := FStrBufferNext;
- end;
- Result := (FStrPosition >= FStrBufferPosition) and (FStrPosition < (FStrBufferPosition + FStrBufferCurrentSize));
- end;
- function TJclStringStream.LoadPeekBuffer: Boolean;
- begin
- if Length(FStrPeekBuffer) <> FBufferSize then
- SetLength(FStrPeekBuffer, FBufferSize);
- if FStrPeekBufferPosition > FStrPeekPosition then
- begin
- // the peek position is rolling back, load the buffer after the read buffer
- FStrPeekBufferPosition := FStrBufferPosition;
- FStrPeekBufferCurrentSize := FStrBufferCurrentSize;
- FStrPeekBufferStart := FStrBufferStart;
- FStrPeekBufferNext := FStrBufferNext;
- end;
- FStrPeekBufferStart := FStrPeekBufferNext;
- Inc(FStrPeekBufferPosition, FStrPeekBufferCurrentSize);
- FStream.Seek(FStrPeekBufferStart, soBeginning);
- FStrPeekBufferCurrentSize := InternalGetNextBuffer(FStream, FStrPeekBuffer, 0, FBufferSize);
- FStrPeekBufferNext := FStream.Seek(0, soCurrent);
- Result := (FStrPeekPosition >= FStrPeekBufferPosition) and (FStrPeekPosition < (FStrPeekBufferPosition + FStrPeekBufferCurrentSize));
- end;
- function TJclStringStream.PeekAnsiChar(out Buffer: AnsiChar): Boolean;
- var
- Ch: UCS4;
- begin
- Result := PeekUCS4(Ch);
- if Result then
- Buffer := UCS4ToAnsiChar(Ch);
- end;
- function TJclStringStream.PeekChar(out Buffer: Char): Boolean;
- var
- Ch: UCS4;
- begin
- Result := PeekUCS4(Ch);
- if Result then
- Buffer := UCS4ToChar(Ch);
- end;
- function TJclStringStream.PeekUCS4(out Buffer: UCS4): Boolean;
- begin
- if (FStrPeekPosition >= FStrPeekBufferPosition) and (FStrPeekPosition < (FStrPeekBufferPosition + FStrPeekBufferCurrentSize)) then
- begin
- // read from the peek buffer
- Result := True;
- Buffer := FStrPeekBuffer[FStrPeekPosition - FStrPeekBufferPosition];
- Inc(FStrPeekPosition);
- end
- else
- if (FStrPeekPosition >= FStrBufferPosition) and (FStrPeekPosition < (FStrBufferPosition + FStrBufferCurrentSize)) then
- begin
- // read from the read/write buffer
- Result := True;
- Buffer := FStrBuffer[FStrPeekPosition - FStrBufferPosition];
- Inc(FStrPeekPosition);
- end
- else
- begin
- // load a new peek buffer
- Result := LoadPeekBuffer;
- if Result then
- begin
- Buffer := FStrPeekBuffer[FStrPeekPosition - FStrPeekBufferPosition];
- Inc(FStrPeekPosition);
- end;
- end;
- end;
- function TJclStringStream.PeekWideChar(out Buffer: WideChar): Boolean;
- var
- Ch: UCS4;
- begin
- Result := PeekUCS4(Ch);
- if Result then
- Buffer := UCS4ToWideChar(Ch);
- end;
- function TJclStringStream.ReadString(var Buffer: string; Start, Count: Longint): Longint;
- var
- Index: Integer;
- StrPos: SizeInt;
- Ch: UCS4;
- begin
- Index := Start;
- while Index < Start + Count - 1 do // avoid overflow on surrogate pairs for WideString
- begin
- if ReadUCS4(Ch) then
- begin
- StrPos := Index;
- if StringSetNextChar(Buffer, StrPos, Ch) and (StrPos > 0) then
- Index := StrPos
- else
- Break; // end of string (write)
- end
- else
- Break; // end of stream (read)
- end;
- Result := Index - Start;
- end;
- function TJclStringStream.ReadString(BufferSize: Longint): string;
- var
- Buffer: string;
- ProcessedLength: Longint;
- begin
- Result := '';
- SetLength(Buffer, BufferSize);
- repeat
- ProcessedLength := ReadString(Buffer, 1, BufferSize);
- if ProcessedLength > 0 then
- Result := Result + Copy(Buffer, 1, ProcessedLength);
- until ProcessedLength = 0;
- end;
- function TJclStringStream.ReadAnsiChar(out Buffer: AnsiChar): Boolean;
- var
- Ch: UCS4;
- begin
- Result := ReadUCS4(Ch);
- if Result then
- Buffer := UCS4ToAnsiChar(Ch);
- end;
- function TJclStringStream.ReadAnsiString(var Buffer: AnsiString; Start, Count: Longint): Longint;
- var
- Index: Integer;
- StrPos: SizeInt;
- Ch: UCS4;
- begin
- Index := Start;
- while Index < Start + Count do
- begin
- if ReadUCS4(Ch) then
- begin
- StrPos := Index;
- if AnsiSetNextChar(Buffer, StrPos, Ch) and (StrPos > 0) then
- Index := StrPos
- else
- Break; // end of string (write)
- end
- else
- Break; // end of stream (read)
- end;
- Result := Index - Start;
- end;
- function TJclStringStream.ReadAnsiString(BufferSize: Longint): AnsiString;
- var
- Buffer: AnsiString;
- ProcessedLength: Longint;
- begin
- Result := '';
- SetLength(Buffer, BufferSize);
- repeat
- ProcessedLength := ReadAnsiString(Buffer, 1, BufferSize);
- if ProcessedLength > 0 then
- Result := Result + Copy(Buffer, 1, ProcessedLength);
- until ProcessedLength = 0;
- end;
- function TJclStringStream.ReadChar(out Buffer: Char): Boolean;
- var
- Ch: UCS4;
- begin
- Result := ReadUCS4(Ch);
- if Result then
- Buffer := UCS4ToChar(Ch);
- end;
- function TJclStringStream.ReadUCS4(out Buffer: UCS4): Boolean;
- begin
- if (FStrPosition >= FStrBufferPosition) and (FStrPosition < (FStrBufferPosition + FStrBufferCurrentSize)) then
- begin
- // load from buffer
- Result := True;
- Buffer := FStrBuffer[FStrPosition - FStrBufferPosition];
- Inc(FStrPosition);
- end
- else
- begin
- // load a new buffer
- Result := LoadBuffer;
- if Result then
- begin
- Buffer := FStrBuffer[FStrPosition - FStrBufferPosition];
- Inc(FStrPosition);
- end;
- end;
- FStrPeekPosition := FStrPosition;
- end;
- function TJclStringStream.ReadWideChar(out Buffer: WideChar): Boolean;
- var
- Ch: UCS4;
- begin
- Result := ReadUCS4(Ch);
- if Result then
- Buffer := UCS4ToWideChar(Ch);
- end;
- function TJclStringStream.ReadWideString(var Buffer: WideString; Start, Count: Longint): Longint;
- var
- Index: Integer;
- StrPos: SizeInt;
- Ch: UCS4;
- begin
- Index := Start;
- while Index < Start + Count - 1 do // avoid overflow on surrogate pairs
- begin
- if ReadUCS4(Ch) then
- begin
- StrPos := Index;
- if UTF16SetNextChar(Buffer, StrPos, Ch) and (StrPos > 0) then
- Index := StrPos
- else
- Break; // end of string (write)
- end
- else
- Break; // end of stream (read)
- end;
- Result := Index - Start;
- end;
- function TJclStringStream.ReadWideString(BufferSize: Longint): WideString;
- var
- Buffer: WideString;
- ProcessedLength: Longint;
- begin
- Result := '';
- SetLength(Buffer, BufferSize);
- repeat
- ProcessedLength := ReadWideString(Buffer, 1, BufferSize);
- if ProcessedLength > 0 then
- Result := Result + Copy(Buffer, 1, ProcessedLength);
- until ProcessedLength = 0;
- end;
- function TJclStringStream.Seek(const Offset: Int64; Origin: TSeekOrigin): Int64;
- begin
- case Origin of
- soBeginning:
- if Offset = 0 then
- begin
- Flush;
- FStrPosition := 0;
- FStrBufferPosition := 0;
- FStrBufferCurrentSize := 0;
- FStrBufferStart := 0;
- FStrBufferNext := 0;
- FStrPeekBufferPosition := 0;
- FStrPeekBufferCurrentSize := 0;
- FStrPeekBufferStart := 0;
- FStrPeekBufferNext := 0;
- end
- else
- raise EJclStreamError.CreateRes(@RsStreamsSeekError);
- soCurrent:
- if Offset <> 0 then
- raise EJclStreamError.CreateRes(@RsStreamsSeekError);
- soEnd:
- raise EJclStreamError.CreateRes(@RsStreamsSeekError);
- end;
- Result := FStrPosition;
- FStrPeekPosition := FStrPosition;
- end;
- function TJclStringStream.SkipBOM: Longint;
- var
- Pos: Int64;
- I: Integer;
- BOM: array of Byte;
- begin
- if Length(FBOM) > 0 then
- begin
- Pos := FStream.Seek(0, soCurrent);
- SetLength(BOM, Length(FBOM));
- Result := FStream.Read(BOM[0], Length(BOM) * SizeOf(BOM[0]));
- if Result = Length(FBOM) * SizeOf(FBOM[0]) then
- for I := Low(FBOM) to High(FBOM) do
- if BOM[I - Low(FBOM)] <> FBOM[I] then
- Result := 0;
- if Result <> Length(FBOM) * SizeOf(FBOM[0]) then
- FStream.Seek(Pos, soBeginning);
- end
- else
- Result := 0;
- InvalidateBuffers;
- end;
- function TJclStringStream.WriteBOM: Longint;
- begin
- if Length(FBOM) > 0 then
- Result := FStream.Write(FBOM[0], Length(FBOM) * SizeOf(FBOM[0]))
- else
- Result := 0;
- InvalidateBuffers;
- end;
- function TJclStringStream.WriteChar(Value: Char): Boolean;
- begin
- Result := WriteUCS4(CharToUCS4(Value));
- end;
- function TJclStringStream.WriteString(const Buffer: string; Start, Count: Longint): Longint;
- var
- Index: Integer;
- StrPos: SizeInt;
- Ch: UCS4;
- begin
- Index := Start;
- while Index < Start + Count do
- begin
- StrPos := Index;
- Ch := StringGetNextChar(Buffer, StrPos);
- if (StrPos > 0) and WriteUCS4(Ch) then
- Index := StrPos
- else
- Break; // end of string (read) or end of stream (write)
- end;
- Result := Index - Start;
- end;
- function TJclStringStream.WriteAnsiChar(Value: AnsiChar): Boolean;
- begin
- Result := WriteUCS4(AnsiCharToUCS4(Value));
- end;
- function TJclStringStream.WriteAnsiString(const Buffer: AnsiString; Start, Count: Longint): Longint;
- var
- Index: Integer;
- StrPos: SizeInt;
- Ch: UCS4;
- begin
- Index := Start;
- while Index < Start + Count do
- begin
- StrPos := Index;
- Ch := AnsiGetNextChar(Buffer, StrPos);
- if (StrPos > 0) and WriteUCS4(Ch) then
- Index := StrPos
- else
- Break; // end of string (read) or end of stream (write)
- end;
- Result := Index - Start;
- end;
- function TJclStringStream.WriteUCS4(Value: UCS4): Boolean;
- var
- BufferPos: Int64;
- begin
- if FStrPosition >= (FStrBufferPosition + FBufferSize) then
- // load the next buffer first
- LoadBuffer;
- // write to current buffer
- BufferPos := FStrPosition - FStrBufferPosition;
- Result := True;
- if Length(FStrBuffer) <> FBufferSize then
- SetLength(FStrBuffer, FBufferSize);
- FStrBuffer[BufferPos] := Value;
- Inc(FStrPosition);
- Inc(BufferPos);
- if FStrBufferModifiedSize < BufferPos then
- FStrBufferModifiedSize := BufferPos;
- if FStrBufferCurrentSize < BufferPos then
- FStrBufferCurrentSize := BufferPos;
- FStrPeekPosition := FStrPosition;
- end;
- function TJclStringStream.WriteWideChar(Value: WideChar): Boolean;
- begin
- Result := WriteUCS4(WideCharToUCS4(Value));
- end;
- function TJclStringStream.WriteWideString(const Buffer: WideString; Start, Count: Longint): Longint;
- var
- Index: Integer;
- StrPos: SizeInt;
- Ch: UCS4;
- begin
- Index := Start;
- while Index < Start + Count do
- begin
- StrPos := Index;
- Ch := UTF16GetNextChar(Buffer, StrPos);
- if (StrPos > 0) and WriteUCS4(Ch) then
- Index := StrPos
- else
- Break; // end of string (read) or end of stream (write)
- end;
- Result := Index - Start;
- end;
- //=== { TJclAnsiStream } ======================================================
- constructor TJclAnsiStream.Create(AStream: TStream; AOwnsStream: Boolean);
- begin
- inherited Create(AStream, AOwnsStream);
- SetLength(FBOM, 0);
- FCodePage := CP_ACP;
- end;
- function TJclAnsiStream.InternalGetNextBuffer(S: TStream;
- var Buffer: TUCS4Array; Start, Count: SizeInt): Longint;
- begin
- if FCodePage = CP_ACP then
- Result := AnsiGetNextBufferFromStream(S, Buffer, Start, Count)
- else
- Result := AnsiGetNextBufferFromStream(S, FCodePage, Buffer, Start, Count);
- end;
- function TJclAnsiStream.InternalGetNextChar(S: TStream; out Ch: UCS4): Boolean;
- begin
- if FCodePage = CP_ACP then
- Result := AnsiGetNextCharFromStream(S, Ch)
- else
- Result := AnsiGetNextCharFromStream(S, FCodePage, Ch);
- end;
- function TJclAnsiStream.InternalSetNextBuffer(S: TStream;
- const Buffer: TUCS4Array; Start, Count: SizeInt): Longint;
- begin
- if FCodePage = CP_ACP then
- Result := AnsiSetNextBufferToStream(S, Buffer, Start, Count)
- else
- Result := AnsiSetNextBufferToStream(S, FCodePage, Buffer, Start, Count);
- end;
- function TJclAnsiStream.InternalSetNextChar(S: TStream; Ch: UCS4): Boolean;
- begin
- if FCodePage = CP_ACP then
- Result := AnsiSetNextCharToStream(S, Ch)
- else
- Result := AnsiSetNextCharToStream(S, FCodePage, Ch);
- end;
- //=== { TJclUTF8Stream } ======================================================
- constructor TJclUTF8Stream.Create(AStream: TStream; AOwnsStream: Boolean);
- var
- I: Integer;
- begin
- inherited Create(AStream, AOwnsStream);
- SetLength(FBOM, Length(BOM_UTF8));
- for I := Low(BOM_UTF8) to High(BOM_UTF8) do
- FBOM[I - Low(BOM_UTF8)] := BOM_UTF8[I];
- end;
- function TJclUTF8Stream.InternalGetNextBuffer(S: TStream;
- var Buffer: TUCS4Array; Start, Count: SizeInt): Longint;
- begin
- Result := UTF8GetNextBufferFromStream(S, Buffer, Start, Count);
- end;
- function TJclUTF8Stream.InternalGetNextChar(S: TStream; out Ch: UCS4): Boolean;
- begin
- Result := UTF8GetNextCharFromStream(S, Ch);
- end;
- function TJclUTF8Stream.InternalSetNextBuffer(S: TStream;
- const Buffer: TUCS4Array; Start, Count: SizeInt): Longint;
- begin
- Result := UTF8SetNextBufferToStream(S, Buffer, Start, Count);
- end;
- function TJclUTF8Stream.InternalSetNextChar(S: TStream; Ch: UCS4): Boolean;
- begin
- Result := UTF8SetNextCharToStream(S, Ch);
- end;
- //=== { TJclUTF16Stream } =====================================================
- constructor TJclUTF16Stream.Create(AStream: TStream; AOwnsStream: Boolean);
- var
- I: Integer;
- begin
- inherited Create(AStream, AOwnsStream);
- SetLength(FBOM, Length(BOM_UTF16_LSB));
- for I := Low(BOM_UTF16_LSB) to High(BOM_UTF16_LSB) do
- FBOM[I - Low(BOM_UTF16_LSB)] := BOM_UTF16_LSB[I];
- end;
- function TJclUTF16Stream.InternalGetNextBuffer(S: TStream;
- var Buffer: TUCS4Array; Start, Count: SizeInt): Longint;
- begin
- Result := UTF16GetNextBufferFromStream(S, Buffer, Start, Count);
- end;
- function TJclUTF16Stream.InternalGetNextChar(S: TStream; out Ch: UCS4): Boolean;
- begin
- Result := UTF16GetNextCharFromStream(S, Ch);
- end;
- function TJclUTF16Stream.InternalSetNextBuffer(S: TStream;
- const Buffer: TUCS4Array; Start, Count: SizeInt): Longint;
- begin
- Result := UTF16SetNextBufferToStream(S, Buffer, Start, Count);
- end;
- function TJclUTF16Stream.InternalSetNextChar(S: TStream; Ch: UCS4): Boolean;
- begin
- Result := UTF16SetNextCharToStream(S, Ch);
- end;
- //=== { TJclAutoStream } ======================================================
- constructor TJclAutoStream.Create(AStream: TStream; AOwnsStream: Boolean);
- var
- I, MaxLength, ReadLength: Integer;
- BOM: array of Byte;
- begin
- inherited Create(AStream, AOwnsStream);
- MaxLength := Length(BOM_UTF8);
- if MaxLength < Length(BOM_UTF16_LSB) then
- MaxLength := Length(BOM_UTF16_LSB);
- SetLength(BOM, MaxLength);
- ReadLength := FStream.Read(BOM[0], Length(BOM) * SizeOf(BOM[0])) div SizeOf(BOM[0]);
- FEncoding := seAuto;
- // try UTF8 BOM
- if (FEncoding = seAuto) and (ReadLength >= Length(BOM_UTF8) * SizeOf(BOM_UTF8[0])) then
- begin
- FCodePage := CP_UTF8;
- FEncoding := seUTF8;
- for I := Low(BOM_UTF8) to High(BOM_UTF8) do
- if BOM[I - Low(BOM_UTF8)] <> BOM_UTF8[I] then
- begin
- FEncoding := seAuto;
- Break;
- end;
- end;
- // try UTF16 BOM
- if (FEncoding = seAuto) and (ReadLength >= Length(BOM_UTF16_LSB) * SizeOf(BOM_UTF16_LSB[0])) then
- begin
- FCodePage := CP_UTF16LE;
- FEncoding := seUTF16;
- for I := Low(BOM_UTF16_LSB) to High(BOM_UTF16_LSB) do
- if BOM[I - Low(BOM_UTF8)] <> BOM_UTF16_LSB[I] then
- begin
- FEncoding := seAuto;
- Break;
- end;
- end;
- case FEncoding of
- seUTF8:
- begin
- FCodePage := CP_UTF8;
- SetLength(FBOM, Length(BOM_UTF8));
- for I := Low(BOM_UTF8) to High(BOM_UTF8) do
- FBOM[I - Low(BOM_UTF8)] := BOM_UTF8[I];
- end;
- seUTF16:
- begin
- FCodePage := CP_UTF16LE;
- SetLength(FBOM, Length(BOM_UTF16_LSB));
- for I := Low(BOM_UTF16_LSB) to High(BOM_UTF16_LSB) do
- FBOM[I - Low(BOM_UTF16_LSB)] := BOM_UTF16_LSB[I];
- end;
- seAuto,
- seAnsi:
- begin
- // defaults to Ansi
- FCodePage := CP_ACP;
- FEncoding := seAnsi;
- SetLength(FBOM, 0);
- end;
- end;
- FStream.Seek(Length(FBOM) - ReadLength, soCurrent);
- InvalidateBuffers;
- end;
- function TJclAutoStream.InternalGetNextBuffer(S: TStream;
- var Buffer: TUCS4Array; Start, Count: SizeInt): Longint;
- begin
- case FCodePage of
- CP_UTF8:
- Result := UTF8GetNextBufferFromStream(S, Buffer, Start, Count);
- CP_UTF16LE:
- Result := UTF16GetNextBufferFromStream(S, Buffer, Start, Count);
- CP_ACP:
- Result := AnsiGetNextBufferFromStream(S, Buffer, Start, Count);
- else
- Result := AnsiGetNextBufferFromStream(S, CodePage, Buffer, Start, Count);
- end;
- end;
- function TJclAutoStream.InternalGetNextChar(S: TStream; out Ch: UCS4): Boolean;
- begin
- case FCodePage of
- CP_UTF8:
- Result := UTF8GetNextCharFromStream(S, Ch);
- CP_UTF16LE:
- Result := UTF16GetNextCharFromStream(S, Ch);
- CP_ACP:
- Result := AnsiGetNextCharFromStream(S, Ch);
- else
- Result := AnsiGetNextCharFromStream(S, CodePage, Ch);
- end;
- end;
- function TJclAutoStream.InternalSetNextBuffer(S: TStream;
- const Buffer: TUCS4Array; Start, Count: SizeInt): Longint;
- begin
- case FCodePage of
- CP_UTF8:
- Result := UTF8SetNextBufferToStream(S, Buffer, Start, Count);
- CP_UTF16LE:
- Result := UTF16SetNextBufferToStream(S, Buffer, Start, Count);
- CP_ACP:
- Result := AnsiSetNextBufferToStream(S, Buffer, Start, Count);
- else
- Result := AnsiSetNextBufferToStream(S, CodePage, Buffer, Start, Count);
- end;
- end;
- function TJclAutoStream.InternalSetNextChar(S: TStream; Ch: UCS4): Boolean;
- begin
- case FCodePage of
- CP_UTF8:
- Result := UTF8SetNextCharToStream(S, Ch);
- CP_UTF16LE:
- Result := UTF16SetNextCharToStream(S, Ch);
- CP_ACP:
- Result := AnsiSetNextCharToStream(S, Ch);
- else
- Result := AnsiSetNextCharToStream(S, CodePage, Ch);
- end;
- end;
- procedure TJclAutoStream.SetCodePage(Value: Word);
- begin
- if Value = CP_UTF8 then
- FEncoding := seUTF8
- else
- if Value = CP_UTF16LE then
- FEncoding := seUTF16
- else
- if Value = CP_ACP then
- FEncoding := seAnsi
- else
- FEncoding := seAuto;
- FCodePage := Value;
- end;
- function TJclAutoStream.SkipBOM: LongInt;
- begin
- // already skipped to determine encoding
- Result := 0;
- InvalidateBuffers;
- end;
- {$ENDIF ~WINSCP}
- {$IFDEF UNITVERSIONING}
- initialization
- RegisterUnitVersion(HInstance, UnitVersioning);
- finalization
- UnregisterUnitVersion(HInstance);
- {$ENDIF UNITVERSIONING}
- end.
|