Changeset 457


Ignore:
Timestamp:
Nov 28, 2012, 7:49:20 AM (11 years ago)
Author:
chronos
Message:
  • Modified: CoolStreaming TStreamHelper can own stream.
  • Added: TVarBlockSerializer support Double and Buffer type.
Files:
8 edited

Legend:

Unmodified
Added
Removed

  • CoolStreaming/UStreamHelper.pas

    r360 r457  
    66
    77uses
    8   Classes, DateUtils, syncobjs, SysUtils;
     8  Classes, DateUtils, SysUtils;
    99
    1010type
    … …  
    2222    procedure SetEndianness(const AValue: TEndianness);
    2323    procedure SetItem(Index: Integer; const AValue: Byte);
     24    procedure SetStream(AValue: TStream);
    2425  public
    2526    procedure Assign(Source: TStreamHelper);
    … …  
    6263    function Write(const Buffer; Count: Longint): Longint; override;
    6364    property Endianness: TEndianness read FEndianness write SetEndianness;
    64     property Stream: TStream read FStream write FStream;
     65    property Stream: TStream read FStream write SetStream;
    6566    property Items[Index: Integer]: Byte read GetItem write SetItem; default;
     67    property OwnStream: Boolean read FOwnStream write FOwnStream;
    6668  end;
    6769
    … …  
    7476  StringLength: Longint;
    7577begin
     78  StringLength := 0;
    7679  FStream.ReadBuffer(StringLength, SizeOf(StringLength));
    7780  Result := ReadString(StringLength);
    … …  
    103106function TStreamHelper.ReadByte: Byte;
    104107begin
     108  Result := 0;
    105109  FStream.ReadBuffer(Result, SizeOf(Byte));
    106110end;
    … …  
    108112function TStreamHelper.ReadCardinal: Cardinal;
    109113begin
     114  Result := 0;
    110115  FStream.ReadBuffer(Result, SizeOf(Cardinal));
    111116  if SwapData then Result := Swap(Result);
    … …  
    114119function TStreamHelper.ReadInt64: Int64;
    115120begin
     121  Result := 0;
    116122  FStream.ReadBuffer(Result, SizeOf(Int64));
    117123  if SwapData then Result := Swap(Result);
    … …  
    130136  Count: Byte;
    131137begin
     138  Count := 0;
    132139  FStream.ReadBuffer(Count, 1);
    133140  Result := ReadString(Count);
    … …  
    135142
    136143procedure TStreamHelper.ReadStream(AStream: TStream; Count: Integer);
    137 var
    138   Buffer: array of Byte;
    139 begin
    140   if Count > 0 then begin
     144//var
     145//  Buffer: array of Byte;
     146begin
     147  AStream.Position := 0;
     148  AStream.CopyFrom(Self, Count);
     149  (*if Count > 0 then begin
    141150    SetLength(Buffer, Count);
    142151    FStream.ReadBuffer(Buffer[0], Count);
    … …  
    144153    AStream.Position := 0;
    145154    AStream.Write(Buffer[0], Count);
    146   end;
     155  end;*)
    147156end;
    148157
    … …  
    259268function TStreamHelper.ReadDouble: Double;
    260269begin
     270  Result := 0;
    261271  FStream.ReadBuffer(Result, SizeOf(Double));
    262272end;
    … …  
    264274function TStreamHelper.ReadSingle: Single;
    265275begin
     276  Result := 0;
    266277  FStream.ReadBuffer(Result, SizeOf(Single));
    267278end;
    … …  
    285296function TStreamHelper.ReadWord: Word;
    286297begin
     298  Result := 0;
    287299  FStream.ReadBuffer(Result, SizeOf(Word));
    288300  if SwapData then Result := Swap(Result);
    … …  
    311323end;
    312324
     325procedure TStreamHelper.SetStream(AValue: TStream);
     326begin
     327  if FStream = AValue then Exit;
     328  if FOwnStream and Assigned(FStream) then FStream.Free;
     329  FStream := AValue;
     330  FOwnStream := False;
     331end;
     332
    313333procedure TStreamHelper.Assign(Source: TStreamHelper);
    314334var
    … …  
    361381
    362382procedure TStreamHelper.WriteStream(AStream: TStream; Count: Integer);
    363 var
    364   Buffer: array of Byte;
    365 begin
    366   if Count > AStream.Size then Count := AStream.Size; // Limit max. stream size
     383//var
     384//  Buffer: array of Byte;
     385begin
     386  AStream.Position := 0;
     387  CopyFrom(AStream, Count);
     388  (*if Count > AStream.Size then Count := AStream.Size; // Limit max. stream size
    367389  AStream.Position := 0;
    368390  if Count > 0 then begin
    … …  
    370392    AStream.Read(Buffer[0], Count);
    371393    FStream.Write(Buffer[0], Count);
    372   end;
     394  end;*)
    373395end;
    374396

  • CoolStreaming/UVarBlockSerializer.pas

    r405 r457  
    1212uses
    1313  Classes, DateUtils, UStreamHelper, Math, SysUtils, USubStream,
    14   Contnrs, SpecializedList, LCLProc;
     14  SpecializedList, LCLProc;
    1515
    1616const
    … …  
    4040    procedure WriteVarList(List: TListByte);
    4141    procedure ReadVarList(List: TListByte);
     42    procedure WriteVarBuffer(var Buffer; Count: Integer);
     43    procedure ReadVarBuffer(var Buffer; Count: Integer);
    4244    function GetVarSize: Integer;
    4345    function GetVarCount: Integer;
    … …  
    5153    procedure WriteVarString(Value: string);
    5254    function ReadVarString: string;
     55    procedure WriteVarDouble(Value: Double);
     56    function ReadVarDouble: Double;
    5357
    5458    // Misc methods
    … …  
    7074  private
    7175  public
    72     Items: TObjectList; // TObjectList<TVarBlockSerializer>
     76    Items: TListObject; // TListObject<TVarBlockSerializer>
    7377    Enclose: Boolean;
    7478    procedure CheckItem(Index: Integer);
    … …  
    8690    procedure WriteVarIndexedBlock(Index: Integer; Block: TVarBlockIndexed);
    8791    procedure ReadVarIndexedBlock(Index: Integer; Block: TVarBlockIndexed);
     92    procedure WriteVarBuffer(Index: Integer; var Buffer; Count: Integer);
     93    procedure ReadVarBuffer(Index: Integer; var Buffer; Count: Integer);
    8894
    8995    // Advanced data types
    … …  
    9298    procedure WriteVarFloat(Index: Integer; Value: Double; Base: Integer = 2);
    9399    function ReadVarFloat(Index: Integer; Base: Integer = 2): Double;
     100    procedure WriteVarDouble(Index: Integer; Value: Double);
     101    function ReadVarDouble(Index: Integer): Double;
    94102    procedure WriteVarString(Index: Integer; Value: string);
    95103    function ReadVarString(Index: Integer): string;
    … …  
    324332    Block.Free;
    325333  end;
     334end;
     335
     336procedure TVarBlockSerializer.WriteVarDouble(Value: Double);
     337begin
     338  WriteVarBuffer(Value, 8);
     339end;
     340
     341function TVarBlockSerializer.ReadVarDouble: Double;
     342begin
     343  Result := 0;
     344  ReadVarBuffer(Result, 8);
    326345end;
    327346
    … …  
    428447    WriteVarStream(Mem);
    429448  finally
    430     Mem.Free
     449    Mem.Free;
    431450  end;
    432451end;
    … …  
    439458    Mem := TMemoryStream.Create;
    440459    ReadVarStream(Mem);
     460    Mem.Position := 0;
    441461    List.Count := Mem.Size;
    442462    List.ReplaceStream(Mem);
    443463  finally
    444     Mem.Free
     464    Mem.Free;
     465  end;
     466end;
     467
     468procedure TVarBlockSerializer.WriteVarBuffer(var Buffer; Count: Integer);
     469var
     470  Mem: TMemoryStream;
     471begin
     472  try
     473    Mem := TMemoryStream.Create;
     474    Mem.WriteBuffer(Buffer, Count);
     475    WriteVarStream(Mem);
     476  finally
     477    Mem.Free;
     478  end;
     479end;
     480
     481procedure TVarBlockSerializer.ReadVarBuffer(var Buffer; Count: Integer);
     482var
     483  Mem: TMemoryStream;
     484begin
     485  try
     486    Mem := TMemoryStream.Create;
     487    ReadVarStream(Mem);
     488    Mem.Position := 0;
     489    Mem.ReadBuffer(Buffer, Count);
     490  finally
     491    Mem.Free;
    445492  end;
    446493end;
    … …  
    542589  I: Integer;
    543590  StreamHelper: TStreamHelper;
    544   RequestedSize: Integer;
    545591begin
    546592  try
    … …  
    552598      I := 0;
    553599      while (Stream.Position < Stream.Size) and (I < Index) do begin
    554         if TestMask(Mask, I) then Stream.Position := Stream.Position + GetVarSize;
     600        if TestMask(Mask, I) then
     601          Stream.Position := Stream.Position + GetVarSize;
    555602        Inc(I);
    556603      end;
    … …  
    738785procedure TVarBlockIndexed.ReadVarList(Index: Integer; List: TListByte);
    739786begin
     787  TVarBlockSerializer(Items[Index]).Stream.Position := 0;
    740788  TVarBlockSerializer(Items[Index]).ReadVarList(List);
    741789end;
    … …  
    771819end;
    772820
     821procedure TVarBlockIndexed.WriteVarBuffer(Index: Integer; var Buffer;
     822  Count: Integer);
     823begin
     824  CheckItem(Index);
     825  TVarBlockSerializer(Items[Index]).WriteVarBuffer(Buffer, Count);
     826end;
     827
     828procedure TVarBlockIndexed.ReadVarBuffer(Index: Integer; var Buffer;
     829  Count: Integer);
     830begin
     831  CheckItem(Index);
     832  TVarBlockSerializer(Items[Index]).ReadVarBuffer(Buffer, Count);
     833end;
     834
    773835procedure TVarBlockIndexed.WriteVarSInt(Index: Integer; Value:Int64);
    774836begin
    … …  
    793855  TVarBlockSerializer(Items[Index]).Stream.Position := 0;
    794856  Result := TVarBlockSerializer(Items[Index]).ReadVarFloat(Base);
     857end;
     858
     859procedure TVarBlockIndexed.WriteVarDouble(Index: Integer; Value: Double);
     860begin
     861  CheckItem(Index);
     862  TVarBlockSerializer(Items[Index]).WriteVarDouble(Value);
     863end;
     864
     865function TVarBlockIndexed.ReadVarDouble(Index: Integer): Double;
     866begin
     867  TVarBlockSerializer(Items[Index]).Stream.Position := 0;
     868  Result := TVarBlockSerializer(Items[Index]).ReadVarDouble;
    795869end;
    796870
    … …  
    892966  I: Integer;
    893967  StreamHelper: TStreamHelper;
    894 begin
    895   try
    896     StreamHelper := TStreamHelper.Create(VarBlock.Stream);
    897     VarBlock.Stream.Size := 0;
     968  Temp: TVarBlockSerializer;
     969  Output: TVarBlockSerializer;
     970begin
     971  try
     972    if Enclose then begin
     973      Temp := TVarBlockSerializer.Create;
     974      Output := Temp;
     975    end else begin
     976      Temp := nil;
     977      Output := VarBlock;
     978    end;
     979    StreamHelper := TStreamHelper.Create(Output.Stream);
     980
     981    Output.Stream.Size := 0;
    898982    Mask := 0;
    899983    for I := 0 to Items.Count - 1 do
    900984      if Assigned(Items[I]) then Mask := Mask or (1 shl I);
    901     VarBlock.WriteVarUInt(Mask);
     985    Output.WriteVarUInt(Mask);
    902986    for I := 0 to Items.Count - 1 do
    903       if Assigned(Items[I]) then StreamHelper.WriteStream(TVarBlockSerializer(Items[I]).Stream,
     987      if Assigned(Items[I]) then
     988        StreamHelper.WriteStream(TVarBlockSerializer(Items[I]).Stream,
    904989        TVarBlockSerializer(Items[I]).Stream.Size);
    905     if Enclose then VarBlock.BlockEnclose;
    906   finally
     990
     991    if Enclose then VarBlock.WriteVarBlock(Temp);
     992  finally
     993    if Assigned(Temp) then Temp.Free;
    907994    StreamHelper.Free;
    908995  end;
    … …  
    9131000  Mask: Integer;
    9141001  I: Integer;
    915 begin
    916   if Enclose then VarBlock.BlockUnclose;
    917   VarBlock.Stream.Position := 0;
    918   Mask := VarBlock.ReadVarUInt;
     1002  Temp: TVarBlockSerializer;
     1003  Input: TVarBlockSerializer;
     1004  StreamHelper: TStreamHelper;
     1005begin
     1006  try
     1007    StreamHelper := TStreamHelper.Create;
     1008  if Enclose then begin
     1009    Temp := TVarBlockSerializer.Create;
     1010    Temp.ReadVarBlock(VarBlock);
     1011    Input := Temp;
     1012  end else begin
     1013    Temp := nil;
     1014    Input := VarBlock;
     1015  end;
     1016  StreamHelper.Stream := Input.Stream;
     1017
     1018  Input.Stream.Position := 0;
     1019  Mask := Input.ReadVarUInt;
    9191020  Items.Clear;
    9201021  I := 0;
    921   while Mask <> 0 do begin
    922     if VarBlock.TestMask(Mask, I) then begin
    923       if Items.Count <= I then Items.Count := I + 1;
    924       Items[I] := TVarBlockSerializer.Create;
    925       VarBlock.ReadItemByMaskIndex(I, TVarBlockSerializer(Items[I]));
     1022  while (Mask <> 0) and (Input.Stream.Position < Input.Stream.Size) do begin
     1023    if Input.TestMask(Mask, I) then begin
     1024      CheckItem(I);
     1025      TVarBlockSerializer(Items[I]).Stream.Size := 0;
     1026      StreamHelper.ReadStream(TVarBlockSerializer(Items[I]).Stream, Input.GetVarSize);
     1027      //Input.ReadItemByMaskIndex(I, TVarBlockSerializer(Items[I]));
    9261028      Mask := Mask xor (1 shl I); // Clear bit on current index
    9271029    end;
    9281030    Inc(I);
     1031  end;
     1032  finally
     1033    if Assigned(Temp) then Temp.Free;
     1034    StreamHelper.Free;
    9291035  end;
    9301036end;
    … …  
    9881094constructor TVarBlockIndexed.Create;
    9891095begin
    990   Items := TObjectList.Create;
     1096  Items := TListObject.Create;
    9911097  Enclose := True;
    9921098end;
    … …  
    9941100destructor TVarBlockIndexed.Destroy;
    9951101begin
    996   Items.Free;
    997   inherited Destroy;
     1102  FreeAndNil(Items);
     1103  inherited;
    9981104end;
    9991105

  • CoolTranslator/Demo/Languages/TranslatorDemo.cs.po

    r286 r457  
    1010"Content-Transfer-Encoding: 8bit\n"
    1111
    12 #: TFORM1.FORM1.CAPTION
     12#: tform1.form1.caption
    1313msgctxt "TFORM1.FORM1.CAPTION"
    1414msgid "Translator Demo"
    1515msgstr "Ukázka Translatoru"
    1616
    17 #: TMAINFORM.BUTTON1.CAPTION
     17#: tmainform.button1.caption
    1818msgid "Show MainForm.Name"
    1919msgstr "Ukázat MainForm.Name"
    2020
    21 #: TMAINFORM.CAPTION
     21#: tmainform.caption
    2222msgctxt "TMAINFORM.CAPTION"
    2323msgid "Translator Demo"
    2424msgstr "Ukázka Translatoru"
    2525
    26 #: TMAINFORM.LABEL1.CAPTION
     26#: tmainform.label1.caption
    2727msgid "MainForm"
    2828msgstr "HlavníFormulář"
    2929
    30 #: TMAINFORM.LABEL2.CAPTION
     30#: tmainform.label2.caption
    3131msgid "Form name as label caption:"
    3232msgstr "Jméno formuláře jako titulek textu:"
    3333
    34 #: TMAINFORM.LABEL3.CAPTION
     34#: tmainform.label3.caption
    3535msgid "Language list:"
    3636msgstr ""
    3737
    38 #: TMAINFORM.LABEL4.CAPTION
     38#: tmainform.label4.caption
    3939msgid "Excludes:"
    4040msgstr ""

  • CoolTranslator/Demo/Languages/TranslatorDemo.de.po

    r286 r457  
    22msgstr "Content-Type: text/plain; charset=UTF-8"
    33
    4 #: TFORM1.FORM1.CAPTION
     4#: tform1.form1.caption
    55msgctxt "TFORM1.FORM1.CAPTION"
    66msgid "Translator Demo"
    77msgstr ""
    88
    9 #: TMAINFORM.BUTTON1.CAPTION
     9#: tmainform.button1.caption
    1010msgid "Show MainForm.Name"
    1111msgstr ""
    1212
    13 #: TMAINFORM.CAPTION
     13#: tmainform.caption
    1414msgctxt "TMAINFORM.CAPTION"
    1515msgid "Translator Demo"
    1616msgstr ""
    1717
    18 #: TMAINFORM.LABEL1.CAPTION
     18#: tmainform.label1.caption
    1919msgid "MainForm"
    2020msgstr ""
    2121
    22 #: TMAINFORM.LABEL2.CAPTION
     22#: tmainform.label2.caption
    2323msgid "Form name as label caption:"
    2424msgstr ""
    2525
    26 #: TMAINFORM.LABEL3.CAPTION
     26#: tmainform.label3.caption
    2727msgid "Language list:"
    2828msgstr ""
    2929
    30 #: TMAINFORM.LABEL4.CAPTION
     30#: tmainform.label4.caption
    3131msgid "Excludes:"
    3232msgstr ""

  • CoolTranslator/Demo/Languages/TranslatorDemo.po

    r286 r457  
    22msgstr "Content-Type: text/plain; charset=UTF-8"
    33
    4 #: TFORM1.FORM1.CAPTION
     4#: tform1.form1.caption
    55msgctxt "TFORM1.FORM1.CAPTION"
    66msgid "Translator Demo"
    77msgstr ""
    88
    9 #: TMAINFORM.BUTTON1.CAPTION
     9#: tmainform.button1.caption
    1010msgid "Show MainForm.Name"
    1111msgstr ""
    1212
    13 #: TMAINFORM.CAPTION
     13#: tmainform.caption
    1414msgctxt "TMAINFORM.CAPTION"
    1515msgid "Translator Demo"
    1616msgstr ""
    1717
    18 #: TMAINFORM.LABEL1.CAPTION
     18#: tmainform.label1.caption
    1919msgid "MainForm"
    2020msgstr ""
    2121
    22 #: TMAINFORM.LABEL2.CAPTION
     22#: tmainform.label2.caption
    2323msgid "Form name as label caption:"
    2424msgstr ""
    2525
    26 #: TMAINFORM.LABEL3.CAPTION
     26#: tmainform.label3.caption
    2727msgid "Language list:"
    2828msgstr ""
    2929
    30 #: TMAINFORM.LABEL4.CAPTION
     30#: tmainform.label4.caption
    3131msgid "Excludes:"
    3232msgstr ""

  • CoolTranslator/Demo/TranslatorDemo.lpi

    r287 r457  
    5151        <IsPartOfProject Value="True"/>
    5252        <ComponentName Value="MainForm"/>
     53        <HasResources Value="True"/>
    5354        <ResourceBaseClass Value="Form"/>
    5455        <UnitName Value="UMainForm"/>
     56        <IsVisibleTab Value="True"/>
    5557        <EditorIndex Value="0"/>
    5658        <WindowIndex Value="0"/>
    … …  
    7981        <Filename Value="..\UCoolTranslator.pas"/>
    8082        <UnitName Value="UCoolTranslator"/>
    81         <IsVisibleTab Value="True"/>
    8283        <EditorIndex Value="1"/>
    8384        <WindowIndex Value="0"/>
    8485        <TopLine Value="274"/>
    85         <CursorPos X="1" Y="286"/>
     86        <CursorPos X="33" Y="288"/>
    8687        <UsageCount Value="11"/>
    8788        <Loaded Value="True"/>
    … …  
    265266  </ProjectOptions>
    266267  <CompilerOptions>
    267     <Version Value="10"/>
     268    <Version Value="11"/>
    268269    <PathDelim Value="\"/>
    269270    <Target>
    … …  
    275276    </SearchPaths>
    276277    <Linking>
    277       <Debugging>
    278         <GenerateDebugInfo Value="True"/>
    279         <DebugInfoType Value="dsAuto"/>
    280       </Debugging>
    281278      <Options>
    282279        <Win32>
    … …  
    305302    </Exceptions>
    306303  </Debugging>
     304  <EditorMacros Count="0"/>
    307305</CONFIG>

  • CoolTranslator/Demo/UMainForm.lfm

    r286 r457  
    88  ClientWidth = 466
    99  OnCreate = FormCreate
    10   LCLVersion = '0.9.31'
     10  LCLVersion = '1.1'
    1111  object ListBox1: TListBox
    1212    Left = 171
    … …  
    2929  object Label1: TLabel
    3030    Left = 10
    31     Height = 14
     31    Height = 13
    3232    Top = 24
    33     Width = 47
     33    Width = 46
    3434    Caption = 'MainForm'
    3535    ParentColor = False
    … …  
    3737  object Label2: TLabel
    3838    Left = 10
    39     Height = 14
     39    Height = 13
    4040    Top = 6
    41     Width = 135
     41    Width = 134
    4242    Caption = 'Form name as label caption:'
    4343    ParentColor = False
    … …  
    4545  object Label3: TLabel
    4646    Left = 171
    47     Height = 14
     47    Height = 13
    4848    Top = 8
    49     Width = 68
     49    Width = 67
    5050    Caption = 'Language list:'
    5151    ParentColor = False
    … …  
    6161  object Label4: TLabel
    6262    Left = 321
    63     Height = 14
     63    Height = 13
    6464    Top = 10
    65     Width = 47
     65    Width = 46
    6666    Caption = 'Excludes:'
    6767    ParentColor = False
    … …  
    6969  object CoolTranslator1: TCoolTranslator
    7070    POFilesFolder = 'Languages'
    71     left = 64
    72     top = 40
     71    left = 72
     72    top = 72
    7373  end
    7474end

  • CoolTranslator/UCoolTranslator.pas

    r402 r457  
    66
    77uses
    8   Classes, SysUtils, Forms, StdCtrls, ExtCtrls, StrUtils, Controls, Contnrs,
     8  Classes, SysUtils, Forms, ExtCtrls, Controls, Contnrs,
    99  Translations, TypInfo, Dialogs, FileUtil, LCLProc, ULanguages, LCLType;
    1010
    … …  
    223223var
    224224  PropType: PTypeInfo;
    225   Parent: TObject;
    226225  Obj: TObject;
    227226  I: Integer;
    … …  
    415414var
    416415  T: string;
    417   I: Integer;
    418416  Lang: string;
    419417begin
Note: See TracChangeset for help on using the changeset viewer.