├── dpbp.res ├── tools ├── pbv.res ├── pbv.dpr ├── pbv.cfg ├── pbv1.dfm ├── pbv.dof └── pbv1.pas ├── .gitignore ├── Developer Guide - Protocol Buffers — Google Developers.URL ├── README.md ├── TODO.txt ├── dpbp.cfg ├── SelfVersion.pas ├── LICENSE ├── dpbp.dof ├── dpbp.dpr ├── ProtBuf.pas └── ProtBufParse.pas /dpbp.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/stijnsanders/DelphiProtocolBuffer/HEAD/dpbp.res -------------------------------------------------------------------------------- /tools/pbv.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/stijnsanders/DelphiProtocolBuffer/HEAD/tools/pbv.res -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | *.dcu 2 | *.dsk 3 | *.~*~ 4 | *.local 5 | *.identcache 6 | __history 7 | *.drc 8 | *.map 9 | *.exe 10 | *.dll 11 | bin/* 12 | -------------------------------------------------------------------------------- /Developer Guide - Protocol Buffers — Google Developers.URL: -------------------------------------------------------------------------------- 1 | [InternetShortcut] 2 | URL=https://developers.google.com/protocol-buffers/docs/overview?hl=nl 3 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | DelphiProtocolBuffer 2 | ==================== 3 | 4 | Delphi Protocol Buffer parser 5 | 6 | dpbp: parses .proto files(s), generates .pas file(s) -------------------------------------------------------------------------------- /TODO.txt: -------------------------------------------------------------------------------- 1 | TODO 2 | 3 | - [deprecated] 4 | - documentation 5 | - more testing 6 | - something better than SetLength(R,Length(R)+1); 7 | - use interface references 8 | 9 | 10 | IDEA'S 11 | 12 | - generate SQL scripts -------------------------------------------------------------------------------- /tools/pbv.dpr: -------------------------------------------------------------------------------- 1 | program pbv; 2 | 3 | uses 4 | Forms, 5 | pbv1 in 'pbv1.pas' {frmProtBufViewMain}, 6 | ProtBufParse in '..\ProtBufParse.pas', 7 | SelfVersion in '..\SelfVersion.pas'; 8 | 9 | {$R *.res} 10 | 11 | begin 12 | Application.Initialize; 13 | Application.CreateForm(TfrmProtBufViewMain, frmProtBufViewMain); 14 | Application.Run; 15 | end. 16 | -------------------------------------------------------------------------------- /dpbp.cfg: -------------------------------------------------------------------------------- 1 | -$A8 2 | -$B- 3 | -$C+ 4 | -$D+ 5 | -$E- 6 | -$F- 7 | -$G+ 8 | -$H+ 9 | -$I+ 10 | -$J- 11 | -$K- 12 | -$L+ 13 | -$M- 14 | -$N+ 15 | -$O+ 16 | -$P+ 17 | -$Q- 18 | -$R- 19 | -$S- 20 | -$T- 21 | -$U- 22 | -$V+ 23 | -$W- 24 | -$X+ 25 | -$YD 26 | -$Z1 27 | -cg 28 | -AWinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; 29 | -H+ 30 | -W+ 31 | -M 32 | -$M16384,1048576 33 | -K$00400000 34 | -LE"c:\delphi7\Projects\Bpl" 35 | -LN"c:\delphi7\Projects\Bpl" 36 | -w-UNSAFE_TYPE 37 | -w-UNSAFE_CODE 38 | -w-UNSAFE_CAST 39 | -------------------------------------------------------------------------------- /tools/pbv.cfg: -------------------------------------------------------------------------------- 1 | -$A8 2 | -$B- 3 | -$C+ 4 | -$D+ 5 | -$E- 6 | -$F- 7 | -$G+ 8 | -$H+ 9 | -$I+ 10 | -$J- 11 | -$K- 12 | -$L+ 13 | -$M- 14 | -$N+ 15 | -$O+ 16 | -$P+ 17 | -$Q- 18 | -$R- 19 | -$S- 20 | -$T- 21 | -$U- 22 | -$V+ 23 | -$W- 24 | -$X+ 25 | -$YD 26 | -$Z1 27 | -cg 28 | -AWinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; 29 | -H+ 30 | -W+ 31 | -M 32 | -$M16384,1048576 33 | -K$00400000 34 | -LE"c:\delphi7\Projects\Bpl" 35 | -LN"c:\delphi7\Projects\Bpl" 36 | -w-UNSAFE_TYPE 37 | -w-UNSAFE_CODE 38 | -w-UNSAFE_CAST 39 | -------------------------------------------------------------------------------- /SelfVersion.pas: -------------------------------------------------------------------------------- 1 | { 2 | 3 | DelphiProtocolBuffer: SelfVersion.pas 4 | 5 | Copyright 2014 Stijn Sanders 6 | Made available under terms described in file "LICENSE" 7 | https://github.com/stijnsanders/DelphiProtocolBuffer 8 | 9 | } 10 | unit SelfVersion; 11 | 12 | interface 13 | 14 | function GetSelfVersion: string; 15 | 16 | implementation 17 | 18 | uses SysUtils, Windows; 19 | 20 | function GetSelfVersion: string; 21 | var 22 | r:THandle; 23 | p:pointer; 24 | v:PVSFIXEDFILEINFO; 25 | vl:cardinal; 26 | begin 27 | try 28 | r:=LoadResource(HInstance, 29 | FindResource(HInstance,MakeIntResource(1),RT_VERSION)); 30 | p:=LockResource(r); 31 | if VerQueryValue(p,'\',pointer(v),vl) then 32 | Result:=Format('v%d.%d.%d.%d', 33 | [v.dwFileVersionMS shr 16 34 | ,v.dwFileVersionMS and $FFFF 35 | ,v.dwFileVersionLS shr 16 36 | ,v.dwFileVersionLS and $FFFF 37 | ]); 38 | except 39 | Result:='v???'; 40 | end; 41 | end; 42 | 43 | end. 44 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | The MIT License 2 | 3 | Copyright (c) 2014-2016 Stijn Sanders 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in 13 | all copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 21 | THE SOFTWARE. -------------------------------------------------------------------------------- /tools/pbv1.dfm: -------------------------------------------------------------------------------- 1 | object frmProtBufViewMain: TfrmProtBufViewMain 2 | Left = 192 3 | Top = 139 4 | Width = 573 5 | Height = 437 6 | Caption = 'Protocol Buffer Viewer' 7 | Color = clBtnFace 8 | Font.Charset = DEFAULT_CHARSET 9 | Font.Color = clWindowText 10 | Font.Height = -11 11 | Font.Name = 'Tahoma' 12 | Font.Style = [] 13 | Menu = MainMenu1 14 | OldCreateOrder = False 15 | Position = poDefault 16 | OnResize = FormResize 17 | PixelsPerInch = 96 18 | TextHeight = 13 19 | object Splitter1: TSplitter 20 | Left = 233 21 | Top = 22 22 | Width = 4 23 | Height = 357 24 | end 25 | object tvFields: TTreeView 26 | Left = 0 27 | Top = 22 28 | Width = 233 29 | Height = 357 30 | Align = alLeft 31 | HideSelection = False 32 | Indent = 19 33 | TabOrder = 0 34 | OnChange = tvFieldsChange 35 | OnDeletion = tvFieldsDeletion 36 | OnExpanding = tvFieldsExpanding 37 | end 38 | object txtValue: TMemo 39 | Left = 237 40 | Top = 22 41 | Width = 320 42 | Height = 357 43 | Align = alClient 44 | HideSelection = False 45 | ReadOnly = True 46 | ScrollBars = ssVertical 47 | TabOrder = 1 48 | end 49 | object Panel1: TPanel 50 | Left = 0 51 | Top = 0 52 | Width = 557 53 | Height = 22 54 | Align = alTop 55 | BevelOuter = bvNone 56 | TabOrder = 2 57 | object cbMessages: TComboBox 58 | Left = 0 59 | Top = 0 60 | Width = 153 61 | Height = 21 62 | Style = csDropDownList 63 | DropDownCount = 32 64 | ItemHeight = 13 65 | TabOrder = 0 66 | OnChange = cbMessagesChange 67 | end 68 | end 69 | object MainMenu1: TMainMenu 70 | Left = 8 71 | Top = 40 72 | object File1: TMenuItem 73 | Caption = '&File' 74 | object Openproto1: TMenuItem 75 | Caption = 'Open &proto...' 76 | OnClick = Openproto1Click 77 | end 78 | object Open1: TMenuItem 79 | Caption = 'Open &data...' 80 | OnClick = Open1Click 81 | end 82 | object N1: TMenuItem 83 | Caption = '-' 84 | end 85 | object Exit1: TMenuItem 86 | Caption = 'E&xit' 87 | OnClick = Exit1Click 88 | end 89 | end 90 | end 91 | object odBuffer: TOpenDialog 92 | DefaultExt = '.bin' 93 | Filter = 'Binary files (*.bin)|*.bin|All files (*.*)|*.*' 94 | Left = 8 95 | Top = 104 96 | end 97 | object odProto: TOpenDialog 98 | DefaultExt = '.proto' 99 | Filter = 100 | 'Protocol Buffer Declaration (*.proto)|*.proto|All files (*.*)|*.' + 101 | '*' 102 | Left = 8 103 | Top = 72 104 | end 105 | end 106 | -------------------------------------------------------------------------------- /tools/pbv.dof: -------------------------------------------------------------------------------- 1 | [FileVersion] 2 | Version=7.0 3 | [Compiler] 4 | A=8 5 | B=0 6 | C=1 7 | D=1 8 | E=0 9 | F=0 10 | G=1 11 | H=1 12 | I=1 13 | J=0 14 | K=0 15 | L=1 16 | M=0 17 | N=1 18 | O=1 19 | P=1 20 | Q=0 21 | R=0 22 | S=0 23 | T=0 24 | U=0 25 | V=1 26 | W=0 27 | X=1 28 | Y=1 29 | Z=1 30 | ShowHints=1 31 | ShowWarnings=1 32 | UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; 33 | NamespacePrefix= 34 | SymbolDeprecated=1 35 | SymbolLibrary=1 36 | SymbolPlatform=1 37 | UnitLibrary=1 38 | UnitPlatform=1 39 | UnitDeprecated=1 40 | HResultCompat=1 41 | HidingMember=1 42 | HiddenVirtual=1 43 | Garbage=1 44 | BoundsError=1 45 | ZeroNilCompat=1 46 | StringConstTruncated=1 47 | ForLoopVarVarPar=1 48 | TypedConstVarPar=1 49 | AsgToTypedConst=1 50 | CaseLabelRange=1 51 | ForVariable=1 52 | ConstructingAbstract=1 53 | ComparisonFalse=1 54 | ComparisonTrue=1 55 | ComparingSignedUnsigned=1 56 | CombiningSignedUnsigned=1 57 | UnsupportedConstruct=1 58 | FileOpen=1 59 | FileOpenUnitSrc=1 60 | BadGlobalSymbol=1 61 | DuplicateConstructorDestructor=1 62 | InvalidDirective=1 63 | PackageNoLink=1 64 | PackageThreadVar=1 65 | ImplicitImport=1 66 | HPPEMITIgnored=1 67 | NoRetVal=1 68 | UseBeforeDef=1 69 | ForLoopVarUndef=1 70 | UnitNameMismatch=1 71 | NoCFGFileFound=1 72 | MessageDirective=1 73 | ImplicitVariants=1 74 | UnicodeToLocale=1 75 | LocaleToUnicode=1 76 | ImagebaseMultiple=1 77 | SuspiciousTypecast=1 78 | PrivatePropAccessor=1 79 | UnsafeType=0 80 | UnsafeCode=0 81 | UnsafeCast=0 82 | [Linker] 83 | MapFile=0 84 | OutputObjs=0 85 | ConsoleApp=1 86 | DebugInfo=0 87 | RemoteSymbols=0 88 | MinStackSize=16384 89 | MaxStackSize=1048576 90 | ImageBase=4194304 91 | ExeDescription= 92 | [Directories] 93 | OutputDir= 94 | UnitOutputDir= 95 | PackageDLLOutputDir= 96 | PackageDCPOutputDir= 97 | SearchPath= 98 | Packages=vcl;rtl;vclie;xmlrtl;inet;inetdbbde;inetdbxpress;vclx;dbrtl;soaprtl;dsnap;VclSmp;dbexpress;vcldb;dbxcds;adortl;ibxpress;vclactnband;bdertl;vclshlctrls;dclOfficeXP;RoComponents 99 | Conditionals= 100 | DebugSourceDirs= 101 | UsePackages=0 102 | [Parameters] 103 | RunParams= 104 | HostApplication= 105 | Launcher= 106 | UseLauncher=0 107 | DebugCWD= 108 | [Version Info] 109 | IncludeVerInfo=1 110 | AutoIncBuild=0 111 | MajorVer=1 112 | MinorVer=0 113 | Release=0 114 | Build=1 115 | Debug=0 116 | PreRelease=0 117 | Special=0 118 | Private=0 119 | DLL=0 120 | Locale=1033 121 | CodePage=1252 122 | [Version Info Keys] 123 | CompanyName= 124 | FileDescription=Protocol Buffer Viewer 125 | FileVersion=1.0.0.1 126 | InternalName= 127 | LegalCopyright=see LICENSE 128 | LegalTrademarks= 129 | OriginalFilename= 130 | ProductName= 131 | ProductVersion=1.0.0.0 132 | Comments=https://github.com/stijnsanders/DelphiProtocolBuffer 133 | -------------------------------------------------------------------------------- /dpbp.dof: -------------------------------------------------------------------------------- 1 | [FileVersion] 2 | Version=7.0 3 | [Compiler] 4 | A=8 5 | B=0 6 | C=1 7 | D=1 8 | E=0 9 | F=0 10 | G=1 11 | H=1 12 | I=1 13 | J=0 14 | K=0 15 | L=1 16 | M=0 17 | N=1 18 | O=1 19 | P=1 20 | Q=0 21 | R=0 22 | S=0 23 | T=0 24 | U=0 25 | V=1 26 | W=0 27 | X=1 28 | Y=1 29 | Z=1 30 | ShowHints=1 31 | ShowWarnings=1 32 | UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; 33 | NamespacePrefix= 34 | SymbolDeprecated=1 35 | SymbolLibrary=1 36 | SymbolPlatform=1 37 | UnitLibrary=1 38 | UnitPlatform=1 39 | UnitDeprecated=1 40 | HResultCompat=1 41 | HidingMember=1 42 | HiddenVirtual=1 43 | Garbage=1 44 | BoundsError=1 45 | ZeroNilCompat=1 46 | StringConstTruncated=1 47 | ForLoopVarVarPar=1 48 | TypedConstVarPar=1 49 | AsgToTypedConst=1 50 | CaseLabelRange=1 51 | ForVariable=1 52 | ConstructingAbstract=1 53 | ComparisonFalse=1 54 | ComparisonTrue=1 55 | ComparingSignedUnsigned=1 56 | CombiningSignedUnsigned=1 57 | UnsupportedConstruct=1 58 | FileOpen=1 59 | FileOpenUnitSrc=1 60 | BadGlobalSymbol=1 61 | DuplicateConstructorDestructor=1 62 | InvalidDirective=1 63 | PackageNoLink=1 64 | PackageThreadVar=1 65 | ImplicitImport=1 66 | HPPEMITIgnored=1 67 | NoRetVal=1 68 | UseBeforeDef=1 69 | ForLoopVarUndef=1 70 | UnitNameMismatch=1 71 | NoCFGFileFound=1 72 | MessageDirective=1 73 | ImplicitVariants=1 74 | UnicodeToLocale=1 75 | LocaleToUnicode=1 76 | ImagebaseMultiple=1 77 | SuspiciousTypecast=1 78 | PrivatePropAccessor=1 79 | UnsafeType=0 80 | UnsafeCode=0 81 | UnsafeCast=0 82 | [Linker] 83 | MapFile=0 84 | OutputObjs=0 85 | ConsoleApp=1 86 | DebugInfo=0 87 | RemoteSymbols=0 88 | MinStackSize=16384 89 | MaxStackSize=1048576 90 | ImageBase=4194304 91 | ExeDescription= 92 | [Directories] 93 | OutputDir= 94 | UnitOutputDir= 95 | PackageDLLOutputDir= 96 | PackageDCPOutputDir= 97 | SearchPath= 98 | Packages=vcl;rtl;vclie;xmlrtl;inet;inetdbbde;inetdbxpress;vclx;dbrtl;soaprtl;dsnap;VclSmp;dbexpress;vcldb;dbxcds;adortl;ibxpress;vclactnband;bdertl;vclshlctrls;dclOfficeXP;RoComponents 99 | Conditionals= 100 | DebugSourceDirs= 101 | UsePackages=0 102 | [Parameters] 103 | RunParams=-fPnEf D:\Data\2014\TRethinkWire\ql2.proto 104 | HostApplication= 105 | Launcher= 106 | UseLauncher=0 107 | DebugCWD= 108 | [Version Info] 109 | IncludeVerInfo=1 110 | AutoIncBuild=0 111 | MajorVer=1 112 | MinorVer=0 113 | Release=2 114 | Build=4 115 | Debug=0 116 | PreRelease=0 117 | Special=0 118 | Private=0 119 | DLL=0 120 | Locale=2067 121 | CodePage=1252 122 | [Version Info Keys] 123 | CompanyName= 124 | FileDescription=Delphi ProtocolBuffer Parser 125 | FileVersion=1.0.2.4 126 | InternalName=dpbp 127 | LegalCopyright=see LICENSE 128 | LegalTrademarks= 129 | OriginalFilename= 130 | ProductName= 131 | ProductVersion=1.0.0.0 132 | Comments=https://github.com/stijnsanders/DelphiProtocolBuffer 133 | -------------------------------------------------------------------------------- /dpbp.dpr: -------------------------------------------------------------------------------- 1 | { 2 | 3 | DelphiProtocolBuffer: dpbp.dpr 4 | 5 | Copyright 2014-2016 Stijn Sanders 6 | Made available under terms described in file "LICENSE" 7 | https://github.com/stijnsanders/DelphiProtocolBuffer 8 | 9 | } 10 | program dpbp; 11 | 12 | uses 13 | SysUtils, 14 | Classes, 15 | ProtBufParse in 'ProtBufParse.pas', 16 | SelfVersion in 'SelfVersion.pas'; 17 | 18 | {$APPTYPE CONSOLE} 19 | {$R *.res} 20 | 21 | var 22 | p:TProtocolBufferParser; 23 | s,t,InputFN,OutputFN,RelPath:string; 24 | i,j,l,l1:integer; 25 | f:TFileStream; 26 | fv:TProtocolBufferParserValue; 27 | ff:TProtocolBufferParserFlag; 28 | Flags:TProtocolBufferParserFlags; 29 | begin 30 | try 31 | l:=ParamCount; 32 | if l=0 then 33 | begin 34 | writeln('dbpb: Delphi Protocol Buffer Parser'); 35 | writeln('Usage:'); 36 | writeln(' dbpb'); 37 | fv:=TProtocolBufferParserValue(0); 38 | while fv<>pbpv_Unknown do 39 | begin 40 | if ProtocolBufferParserValueDefaults[fv]<>'' then 41 | writeln(' [-'+ProtocolBufferParserValueName[fv]+'] (default:"'+ 42 | ProtocolBufferParserValueDefaults[fv]+'")') 43 | else 44 | writeln(' [-'+ProtocolBufferParserValueName[fv]+']'); 45 | inc(fv); 46 | end; 47 | writeln(' [-f]'); 48 | writeln(' '); 49 | writeln(' []'); 50 | writeln('Flags:'); 51 | ff:=TProtocolBufferParserFlag(0); 52 | while ff<>pbpf_Unknown do 53 | begin 54 | writeln(' '+ProtocolBufferParserFlagName[ff]); 55 | inc(ff); 56 | end; 57 | end 58 | else 59 | begin 60 | p:=TProtocolBufferParser.Create; 61 | try 62 | InputFN:=''; 63 | OutputFN:=''; 64 | Flags:=[]; 65 | i:=1; 66 | while (i<=l) do 67 | begin 68 | s:=ParamStr(i); 69 | inc(i); 70 | if (Length(s)>1) and (s[1]='-') then 71 | begin 72 | if (Length(s)=2) and (i<=l) then 73 | begin 74 | t:=ParamStr(i); 75 | inc(i); 76 | end 77 | else 78 | t:=Copy(s,3,Length(s)-2); 79 | if s[2] in ['f','F'] then 80 | begin 81 | //flags 82 | l1:=Length(t); 83 | j:=1; 84 | while (jpbpf_Unknown) and (t[j]+t[j+1]<> 88 | Copy(ProtocolBufferParserFlagName[ff],1,2)) do inc(ff); 89 | if ff=pbpf_Unknown then 90 | raise Exception.Create('Unknown flag "'+Copy(t,j,2)+'"') 91 | else 92 | Include(Flags,ff); 93 | inc(j,2); 94 | end; 95 | if j=l1 then 96 | raise Exception.Create('Incomplete flag "'+t[j]+'"'); 97 | end 98 | else 99 | begin 100 | //values 101 | fv:=TProtocolBufferParserValue(0); 102 | while (fv<>pbpv_Unknown) and 103 | (s[2]<>ProtocolBufferParserValueName[fv][1]) do inc(fv); 104 | if fv=pbpv_Unknown then 105 | raise Exception.Create('Unknown option "'+s+'"') 106 | else 107 | p.Values[fv]:=t; 108 | end; 109 | end 110 | else 111 | begin 112 | if InputFN='' then 113 | begin 114 | InputFN:=s; 115 | OutputFN:=ChangeFileExt(s,'.pas'); 116 | end 117 | else 118 | begin 119 | OutputFN:=s; 120 | end; 121 | end; 122 | end; 123 | 124 | if RelPath='' then 125 | RelPath:=ExtractFilePath(InputFN) 126 | else 127 | RelPath:=IncludeTrailingPathDelimiter(RelPath); 128 | 129 | //TODO: multiple input files 130 | writeln('Parsing '+InputFN); 131 | p.Parse(InputFN); 132 | 133 | writeln(IntToStr(p.DescriptorCount)+' descriptors'); 134 | 135 | writeln('Writing '+OutputFN); 136 | s:=p.GenerateUnit(Flags); 137 | f:=TFileStream.Create(OutputFN,fmCreate); 138 | try 139 | f.Write(s[1],Length(s)); 140 | finally 141 | f.Free; 142 | end; 143 | 144 | finally 145 | p.Free; 146 | end; 147 | end; 148 | except 149 | on e:Exception do 150 | begin 151 | writeln('### Abnormal termination ('+e.ClassName+')'); 152 | writeln(e.Message); 153 | end; 154 | end; 155 | end. 156 | -------------------------------------------------------------------------------- /ProtBuf.pas: -------------------------------------------------------------------------------- 1 | { 2 | 3 | DelphiProtocolBuffer ProtBuf.pas 4 | declares the TProtocolBufferMessage base class 5 | used by units generated by dpbp 6 | 7 | Copyright 2014-2016 Stijn Sanders 8 | Made available under terms described in file "LICENSE" 9 | https://github.com/stijnsanders/DelphiProtocolBuffer 10 | 11 | } 12 | unit ProtBuf; 13 | 14 | {$D-} 15 | {$L-} 16 | 17 | interface 18 | 19 | uses Classes; 20 | 21 | type 22 | TProtocolBufferKey = 0..$1FFFFFFF;//cardinal, uint23 23 | 24 | TDynArrayOfBytes = array of byte; 25 | 26 | TProtocolBufferMessage=class(TObject)//,IStreamPersist) 27 | private 28 | FDidRead:boolean; 29 | protected 30 | procedure SetDefaultValues; virtual; 31 | procedure ReadVarInt(Stream: TStream; Key: TProtocolBufferKey); virtual; 32 | procedure ReadLengthDelim(Stream: TStream; Key: TProtocolBufferKey); virtual; 33 | procedure ReadFixed64(Stream: TStream; Key: TProtocolBufferKey); virtual; 34 | procedure ReadFixed32(Stream: TStream; Key: TProtocolBufferKey); virtual; 35 | procedure WriteFields(Stream: TStream); virtual; 36 | 37 | //use from LoadFromStream 38 | procedure ReadUint(Stream: TStream; var Value: cardinal); overload; 39 | procedure ReadUint(Stream: TStream; var Value: int64); overload; 40 | procedure ReadSint(Stream: TStream; var Value: integer); overload; 41 | procedure ReadSint(Stream: TStream; var Value: int64); overload; 42 | procedure ReadStr(Stream: TStream; var Value: string); 43 | procedure ReadBytes(Stream: TStream; var Value: TDynArrayOfBytes); 44 | function ReadBool(Stream: TStream): boolean; 45 | function ReadEnum(Stream: TStream): cardinal; 46 | procedure ReadMessage(Stream: TStream; Value: TProtocolBufferMessage); 47 | procedure ReadBlock(Stream: TSTream; var Data; Length: cardinal); 48 | 49 | //use from ReadValue 50 | procedure WriteSInt(Stream: TStream; Key: TProtocolBufferKey; 51 | Value: integer); 52 | procedure WriteUInt(Stream: TStream; Key: TProtocolBufferKey; 53 | Value: cardinal); 54 | procedure WriteSInt64(Stream: TStream; Key: TProtocolBufferKey; 55 | Value: int64); 56 | procedure WriteUInt64(Stream: TStream; Key: TProtocolBufferKey; 57 | Value: int64); 58 | procedure WriteSingle(Stream: TStream; Key: TProtocolBufferKey; 59 | Value: Single); 60 | procedure WriteDouble(Stream: TStream; Key: TProtocolBufferKey; 61 | Value: Double); 62 | procedure WriteStr(Stream: TStream; Key: TProtocolBufferKey; 63 | const Value: UTF8String); overload; 64 | procedure WriteStrA(Stream: TStream; Key: TProtocolBufferKey; 65 | const Value: AnsiString); 66 | procedure WriteStr(Stream: TStream; Key: TProtocolBufferKey; 67 | const Value: WideString); overload; 68 | procedure WriteMessage(Stream: TStream; Key: TProtocolBufferKey; 69 | Value: TProtocolBufferMessage); 70 | procedure WriteBlock(Stream: TStream; Key: TProtocolBufferKey; 71 | var Data; Length: cardinal); 72 | 73 | public 74 | constructor Create; 75 | 76 | procedure LoadFromStream(Stream: TStream; Length: int64); 77 | procedure SaveToStream(Stream: TStream); 78 | end; 79 | 80 | implementation 81 | 82 | uses SysUtils, Variants; 83 | 84 | { TProtocolBufferMessage } 85 | 86 | constructor TProtocolBufferMessage.Create; 87 | begin 88 | inherited; 89 | SetDefaultValues; 90 | // 91 | end; 92 | 93 | procedure _ReadError; //virtual? keep Stream reference? 94 | begin 95 | raise Exception.Create('Error reading from stream'); 96 | end; 97 | 98 | function _ReadVarInt(Stream: TStream; var Value: cardinal): boolean; overload; 99 | var 100 | b:byte; 101 | i,l:integer; 102 | begin 103 | b:=0;//default 104 | i:=0; 105 | l:=Stream.Read(b,1); 106 | Value:=b and $7F; 107 | while (l<>0) and ((b and $80)<>0) do 108 | begin 109 | l:=Stream.Read(b,1); 110 | inc(i,7); 111 | Value:=Value or ((b and $7F) shl i); 112 | end; 113 | Result:=l<>0; 114 | end; 115 | 116 | function _ReadVarInt(Stream: TStream; var Value: int64): boolean; overload; 117 | var 118 | b:byte; 119 | i,l:integer; 120 | begin 121 | b:=0;//default 122 | i:=0; 123 | l:=Stream.Read(b,1); 124 | Value:=b and $7F; 125 | while (l<>0) and ((b and $80)<>0) do 126 | begin 127 | l:=Stream.Read(b,1); 128 | inc(i,7); 129 | Value:=Value or ((b and $7F) shl i); 130 | end; 131 | Result:=l<>0; 132 | end; 133 | 134 | procedure _WriteError; //virtual? keep Stream reference? 135 | begin 136 | raise Exception.Create('Error writing to stream'); 137 | end; 138 | 139 | procedure _WriteVarInt(Stream: TStream; x: cardinal); overload; 140 | var 141 | i:cardinal; 142 | b:byte; 143 | begin 144 | i:=0; 145 | repeat inc(i,7) until (1 shl i)>=x; 146 | while i<>0 do 147 | begin 148 | dec(i,7); 149 | b:=(x shr i) and $7F; 150 | if Stream.Write(b,1)<>1 then _WriteError; 151 | end; 152 | end; 153 | 154 | procedure _WriteVarInt(Stream: TStream; x: int64); overload; 155 | var 156 | i:int64; 157 | b:byte; 158 | begin 159 | i:=0; 160 | repeat inc(i,7) until (1 shl i)>=x; 161 | while i<>0 do 162 | begin 163 | dec(i,7); 164 | b:=(x shr i) and $7F; 165 | if Stream.Write(b,1)<>1 then _WriteError; 166 | end; 167 | end; 168 | 169 | procedure TProtocolBufferMessage.LoadFromStream(Stream: TStream; 170 | Length: int64); 171 | var 172 | i:cardinal; 173 | k:TProtocolBufferKey; 174 | j,p:int64; 175 | begin 176 | //TODO: use some byte buffer 177 | if Length=0 then 178 | p:=Stream.Size //raise? detect? 179 | else 180 | p:=Stream.Position+Length; 181 | //TODO: increase counter on (all!) reads instead of Stream.Position here 182 | while (Stream.Position8 then _ReadError; 196 | end; 197 | 2://length delimited 198 | begin 199 | ReadLengthDelim(Stream,k); 200 | if not FDidRead then 201 | begin 202 | if not _ReadVarInt(Stream,j) then _ReadError; 203 | Stream.Seek(j,soFromCurrent); 204 | end; 205 | end; 206 | 3,4:raise Exception.Create('ProtBuf: groups are deprecated'); 207 | 5://fixed32 208 | begin 209 | ReadFixed32(Stream,k); 210 | if not FDidRead then if Stream.Read(j,4)<>4 then _ReadError; 211 | end; 212 | else 213 | raise Exception.Create('ProfBuf: unexpected wire type '+IntToHex(i,8)); 214 | end; 215 | end; 216 | end; 217 | 218 | procedure TProtocolBufferMessage.SaveToStream(Stream: TStream); 219 | begin 220 | WriteFields(Stream); 221 | end; 222 | 223 | procedure TProtocolBufferMessage.SetDefaultValues; 224 | begin 225 | //implemented by inheriters 226 | end; 227 | 228 | procedure TProtocolBufferMessage.ReadFixed32(Stream: TStream; 229 | Key: TProtocolBufferKey); 230 | begin 231 | //implemented by inheriters 232 | end; 233 | 234 | procedure TProtocolBufferMessage.ReadFixed64(Stream: TStream; 235 | Key: TProtocolBufferKey); 236 | begin 237 | //implemented by inheriters 238 | end; 239 | 240 | procedure TProtocolBufferMessage.ReadLengthDelim(Stream: TStream; 241 | Key: TProtocolBufferKey); 242 | begin 243 | //implemented by inheriters 244 | end; 245 | 246 | procedure TProtocolBufferMessage.ReadVarInt(Stream: TStream; 247 | Key: TProtocolBufferKey); 248 | begin 249 | //implemented by inheriters 250 | end; 251 | 252 | procedure TProtocolBufferMessage.WriteFields(Stream: TStream); 253 | begin 254 | //implemented by inheriters 255 | end; 256 | 257 | procedure TProtocolBufferMessage.WriteSInt(Stream: TStream; 258 | Key: TProtocolBufferKey; Value: integer); 259 | begin 260 | _WriteVarInt(Stream,Key shl 3);//Key, 0 261 | if Value<0 then 262 | _WriteVarInt(Stream,cardinal(Value*-2-1)) 263 | else 264 | _WriteVarInt(Stream,cardinal(Value*2)); 265 | end; 266 | 267 | procedure TProtocolBufferMessage.WriteSInt64(Stream: TStream; 268 | Key: TProtocolBufferKey; Value: int64); 269 | begin 270 | _WriteVarInt(Stream,Key shl 3);//Key, 0 271 | if Value<0 then 272 | _WriteVarInt(Stream,Value*-2-1) 273 | else 274 | _WriteVarInt(Stream,Value*2); 275 | end; 276 | 277 | procedure TProtocolBufferMessage.WriteUInt(Stream: TStream; 278 | Key: TProtocolBufferKey; Value: cardinal); 279 | begin 280 | _WriteVarInt(Stream,Key shl 3);//Key, 0 281 | _WriteVarInt(Stream,Value); 282 | end; 283 | 284 | procedure TProtocolBufferMessage.WriteUInt64(Stream: TStream; 285 | Key: TProtocolBufferKey; Value: int64); 286 | begin 287 | _WriteVarInt(Stream,Key shl 3);//Key, 0 288 | _WriteVarInt(Stream,Value); 289 | end; 290 | 291 | procedure TProtocolBufferMessage.WriteSingle(Stream: TStream; 292 | Key: TProtocolBufferKey; Value: Single); 293 | begin 294 | _WriteVarInt(Stream,(Key shl 3) or 5); 295 | if Stream.Write(Value,4)<>4 then _WriteError; 296 | end; 297 | 298 | procedure TProtocolBufferMessage.WriteDouble(Stream: TStream; 299 | Key: TProtocolBufferKey; Value: Double); 300 | begin 301 | _WriteVarInt(Stream,(Key shl 3) or 1); 302 | if Stream.Write(Value,8)<>8 then _WriteError; 303 | end; 304 | 305 | procedure TProtocolBufferMessage.WriteStr(Stream: TStream; 306 | Key: TProtocolBufferKey; const Value: UTF8String); 307 | var 308 | l:cardinal; 309 | begin 310 | l:=Length(Value); 311 | _WriteVarInt(Stream,(Key shl 3) or 2); 312 | _WriteVarInt(Stream,l); 313 | if l<>0 then 314 | if cardinal(Stream.Write(Value[1],l))<>l then _WriteError; 315 | end; 316 | 317 | procedure TProtocolBufferMessage.WriteStr(Stream: TStream; 318 | Key: TProtocolBufferKey; const Value: WideString); 319 | var 320 | x:UTF8String; 321 | l:cardinal; 322 | begin 323 | x:=UTF8Encode(Value); 324 | l:=Length(x); 325 | _WriteVarInt(Stream,(Key shl 3) or 2); 326 | _WriteVarInt(Stream,l); 327 | if l<>0 then 328 | if cardinal(Stream.Write(x[1],l))<>l then _WriteError; 329 | end; 330 | 331 | procedure TProtocolBufferMessage.WriteStrA(Stream: TStream; 332 | Key: TProtocolBufferKey; const Value: AnsiString); 333 | var 334 | x:UTF8String; 335 | l:cardinal; 336 | begin 337 | x:=AnsiToUtf8(Value); 338 | l:=Length(x); 339 | _WriteVarInt(Stream,(Key shl 3) or 2); 340 | _WriteVarInt(Stream,l); 341 | if l<>0 then 342 | if cardinal(Stream.Write(x[1],l))<>l then _WriteError; 343 | end; 344 | 345 | procedure TProtocolBufferMessage.WriteMessage(Stream: TStream; 346 | Key: TProtocolBufferKey; Value: TProtocolBufferMessage); 347 | var 348 | m:TMemoryStream; 349 | l:cardinal; 350 | begin 351 | _WriteVarInt(Stream,(Key shl 3) or 2); 352 | //TODO: find another way to write data first and a variable length prefix after 353 | m:=TMemoryStream.Create; 354 | try 355 | Value.SaveToStream(m); 356 | l:=m.Position; 357 | _WriteVarInt(Stream,l); 358 | m.Position:=0; 359 | if l<>0 then 360 | if cardinal(Stream.Write(m.Memory^,l))<>l then _WriteError; 361 | finally 362 | m.Free; 363 | end; 364 | end; 365 | 366 | procedure TProtocolBufferMessage.WriteBlock(Stream: TStream; 367 | Key: TProtocolBufferKey; var Data; Length: cardinal); 368 | begin 369 | _WriteVarInt(Stream,(Key shl 3) or 2); 370 | if Length<>0 then 371 | if cardinal(Stream.Write(Data,Length))<>Length then _WriteError; 372 | end; 373 | 374 | procedure TProtocolBufferMessage.ReadBytes(Stream: TStream; 375 | var Value: TDynArrayOfBytes); 376 | var 377 | l:cardinal;//int64? 378 | begin 379 | if not _ReadVarInt(Stream,l) then _ReadError; 380 | SetLength(Value,l); 381 | if l<>0 then 382 | if cardinal(Stream.Read(Value[0],l))<>l then _ReadError; 383 | FDidRead:=true; 384 | end; 385 | 386 | procedure TProtocolBufferMessage.ReadStr(Stream: TStream; var Value: string); 387 | var 388 | l:cardinal;//int64? 389 | begin 390 | if not _ReadVarInt(Stream,l) then _ReadError; 391 | SetLength(Value,l); 392 | if l<>0 then 393 | if cardinal(Stream.Read(Value[1],l))<>l then _ReadError; 394 | FDidRead:=true; 395 | end; 396 | 397 | procedure TProtocolBufferMessage.ReadUint(Stream: TStream; 398 | var Value: cardinal); 399 | begin 400 | if not _ReadVarInt(Stream,Value) then _ReadError; 401 | FDidRead:=true; 402 | end; 403 | 404 | procedure TProtocolBufferMessage.ReadUint(Stream: TStream; 405 | var Value: int64); 406 | begin 407 | if not _ReadVarInt(Stream,Value) then _ReadError; 408 | FDidRead:=true; 409 | end; 410 | 411 | procedure TProtocolBufferMessage.ReadSint(Stream: TStream; 412 | var Value: int64); 413 | begin 414 | if not _ReadVarInt(Stream,Value) then _ReadError; 415 | if (Value and 1)=0 then 416 | Value:=Value shr 1 417 | else 418 | Value:=-((Value+1) shr 1); 419 | FDidRead:=true; 420 | end; 421 | 422 | procedure TProtocolBufferMessage.ReadSint(Stream: TStream; 423 | var Value: integer); 424 | begin 425 | if not _ReadVarInt(Stream,cardinal(Value)) then _ReadError; 426 | if (Value and 1)=0 then 427 | Value:=Value shr 1 428 | else 429 | Value:=-((Value+1) shr 1); 430 | FDidRead:=true; 431 | end; 432 | 433 | function TProtocolBufferMessage.ReadBool(Stream: TStream): boolean; 434 | var 435 | i:cardinal; 436 | begin 437 | if not _ReadVarInt(Stream,i) then _ReadError; 438 | FDidRead:=true; 439 | Result:=i<>0; 440 | end; 441 | 442 | function TProtocolBufferMessage.ReadEnum(Stream: TStream): cardinal; 443 | begin 444 | if not _ReadVarInt(Stream,Result) then _ReadError; 445 | FDidRead:=true; 446 | end; 447 | 448 | procedure TProtocolBufferMessage.ReadMessage(Stream: TStream; 449 | Value: TProtocolBufferMessage); 450 | var 451 | l:int64; 452 | begin 453 | if not _ReadVarInt(Stream,l) then _ReadError; 454 | //p:=Stream.Position; 455 | Value.LoadFromStream(Stream,l); 456 | //if Stream.Position<>p+l then _ReadError; 457 | FDidRead:=true; 458 | end; 459 | 460 | procedure TProtocolBufferMessage.ReadBlock(Stream: TSTream; var Data; 461 | Length: cardinal); 462 | begin 463 | if Length<>0 then 464 | if cardinal(Stream.Read(Data,Length))<>Length then _ReadError; 465 | FDidRead:=true; 466 | end; 467 | 468 | end. 469 | -------------------------------------------------------------------------------- /tools/pbv1.pas: -------------------------------------------------------------------------------- 1 | unit pbv1; 2 | 3 | interface 4 | 5 | uses 6 | Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 7 | Dialogs, Menus, ComCtrls, ExtCtrls, StdCtrls, ProtBufParse; 8 | 9 | type 10 | TfrmProtBufViewMain = class(TForm) 11 | tvFields: TTreeView; 12 | MainMenu1: TMainMenu; 13 | File1: TMenuItem; 14 | Open1: TMenuItem; 15 | N1: TMenuItem; 16 | Exit1: TMenuItem; 17 | odBuffer: TOpenDialog; 18 | txtValue: TMemo; 19 | Splitter1: TSplitter; 20 | Openproto1: TMenuItem; 21 | Panel1: TPanel; 22 | cbMessages: TComboBox; 23 | odProto: TOpenDialog; 24 | procedure Exit1Click(Sender: TObject); 25 | procedure Open1Click(Sender: TObject); 26 | procedure tvFieldsDeletion(Sender: TObject; Node: TTreeNode); 27 | procedure tvFieldsChange(Sender: TObject; Node: TTreeNode); 28 | procedure tvFieldsExpanding(Sender: TObject; Node: TTreeNode; 29 | var AllowExpansion: Boolean); 30 | procedure FormResize(Sender: TObject); 31 | procedure Openproto1Click(Sender: TObject); 32 | procedure cbMessagesChange(Sender: TObject); 33 | private 34 | FDataFile,FProtoFile:string; 35 | FData:TStream; 36 | FProto:TProtocolBufferParser; 37 | procedure LoadFile(const FilePath:string); 38 | procedure LoadProto(const FilePath:string); 39 | procedure LoadFields(pos, max: int64; parent: TTreeNode; 40 | desc: TProtBufMessageDescriptor); 41 | protected 42 | procedure DoCreate; override; 43 | procedure DoDestroy; override; 44 | end; 45 | 46 | TNodeData=class(TObject) 47 | public 48 | procedure Node(n:TTreeNode); virtual; 49 | function Display: string; virtual; abstract; 50 | end; 51 | 52 | TMessageNodeData=class(TNodeData) 53 | private 54 | FTitle,FMessage:string; 55 | public 56 | constructor Create(const Title, Msg: string); 57 | procedure Node(n:TTreeNode); override; 58 | function Display: string; override; 59 | end; 60 | 61 | TErrorNodeData=class(TNodeData) 62 | private 63 | FMessage:string; 64 | public 65 | constructor Create(const Msg: string); 66 | procedure Node(n:TTreeNode); override; 67 | function Display: string; override; 68 | end; 69 | 70 | TNumberNodeData=class(TNodeData) 71 | private 72 | FValue:int64; 73 | public 74 | constructor Create(Value: int64); 75 | procedure Node(n:TTreeNode); override; 76 | function Display: string; override; 77 | end; 78 | 79 | TFixed64=array[0..7] of byte; 80 | TFixed32=array[0..3] of byte; 81 | 82 | TFixed64NodeData=class(TNodeData) 83 | private 84 | FValue:TFixed64; 85 | public 86 | constructor Create(const Value:TFixed64); 87 | procedure Node(n:TTreeNode); override; 88 | function Display: string; override; 89 | end; 90 | 91 | TFixed32NodeData=class(TNodeData) 92 | private 93 | FValue:TFixed32; 94 | public 95 | constructor Create(const Value:TFixed32); 96 | procedure Node(n:TTreeNode); override; 97 | function Display: string; override; 98 | end; 99 | 100 | TByLengthNodeData=class(TNodeData) 101 | private 102 | FData:TStream; 103 | FPos,FLen:int64; 104 | public 105 | constructor Create(Data:TStream;Pos,Len:int64); 106 | procedure Node(n:TTreeNode); override; 107 | function Display: string; override; 108 | property Pos: int64 read FPos; 109 | property Len: int64 read FLen; 110 | end; 111 | 112 | TStringNodeData=class(TNodeData) 113 | private 114 | FData:TStream; 115 | FPos,FLen:int64; 116 | FValue:string; 117 | public 118 | constructor Create(Data:TStream;Pos,Len:int64); 119 | procedure Node(n:TTreeNode); override; 120 | function Display: string; override; 121 | end; 122 | 123 | TEmbeddedMsgNodeData=class(TNodeData) 124 | private 125 | FName:string; 126 | FPos,FLen:int64; 127 | FDesc:TProtBufMessageDescriptor; 128 | public 129 | constructor Create(const Name: string; Pos, Len: int64; 130 | Desc: TProtBufMessageDescriptor); 131 | procedure Node(n:TTreeNode); override; 132 | function Display: string; override; 133 | property Pos: int64 read FPos; 134 | property Len: int64 read FLen; 135 | property Desc:TProtBufMessageDescriptor read FDesc; 136 | end; 137 | 138 | var 139 | frmProtBufViewMain: TfrmProtBufViewMain; 140 | 141 | implementation 142 | 143 | {$R *.dfm} 144 | 145 | { TfrmProtBufViewMain } 146 | 147 | procedure TfrmProtBufViewMain.DoCreate; 148 | var 149 | i:integer; 150 | fn:string; 151 | begin 152 | inherited; 153 | FDataFile:=''; 154 | FData:=nil; 155 | FProtoFile:=''; 156 | FProto:=TProtocolBufferParser.Create; 157 | case ParamCount of 158 | 1: 159 | begin 160 | fn:=ParamStr(1); 161 | i:=Length(fn); 162 | while (i<>0) and (fn[i]<>'.') do dec(i); 163 | if LowerCase(Copy(fn,i,Length(fn)-i+1))='.proto' then 164 | LoadProto(fn) 165 | else 166 | LoadFile(fn); 167 | end; 168 | 2: 169 | begin 170 | LoadProto(ParamStr(1)); 171 | cbMessages.ItemIndex:=0;//? 172 | LoadFile(ParamStr(2)); 173 | end; 174 | 3: 175 | begin 176 | LoadProto(ParamStr(1)); 177 | cbMessages.ItemIndex:=cbMessages.Items.IndexOf(ParamStr(2));//? 178 | LoadFile(ParamStr(3)); 179 | end; 180 | //else? 181 | end; 182 | end; 183 | 184 | procedure TfrmProtBufViewMain.DoDestroy; 185 | begin 186 | inherited; 187 | FProto.Free; 188 | FreeAndNil(FData); 189 | end; 190 | 191 | procedure TfrmProtBufViewMain.Exit1Click(Sender: TObject); 192 | begin 193 | Close; 194 | end; 195 | 196 | procedure TfrmProtBufViewMain.Open1Click(Sender: TObject); 197 | begin 198 | if odBuffer.Execute then LoadFile(odBuffer.FileName); 199 | end; 200 | 201 | procedure TfrmProtBufViewMain.tvFieldsDeletion(Sender: TObject; 202 | Node: TTreeNode); 203 | begin 204 | TTreeNode(Node.Data).Free; 205 | end; 206 | 207 | procedure TfrmProtBufViewMain.LoadFile(const FilePath: string); 208 | var 209 | f:TFileStream; 210 | m:TProtBufMessageDescriptor; 211 | begin 212 | FreeAndNil(FData); 213 | FDataFile:=FilePath; 214 | if FProtoFile='' then 215 | Caption:=FDataFile+' - Protocol Buffer Viewer' 216 | else 217 | Caption:=ExtractFileName(FDataFile)+' - '+ExtractFileName(FProtoFile)+ 218 | ' - Protocol Buffer Viewer'; 219 | Application.Title:=Caption; 220 | f:=TFileStream.Create(FilePath,fmOpenRead or fmShareDenyWrite); 221 | if f.Size>$100000 then FData:=f else 222 | begin 223 | FData:=TMemoryStream.Create; 224 | FData.CopyFrom(f,f.Size); 225 | f.Free; 226 | end; 227 | if cbMessages.ItemIndex=-1 then m:=nil else 228 | m:=cbMessages.Items.Objects[cbMessages.ItemIndex] 229 | as TProtBufMessageDescriptor; 230 | LoadFields(0,FData.Size,nil,m); 231 | end; 232 | 233 | function _ReadVarInt(Stream: TStream; var Value: cardinal): boolean; overload; 234 | var 235 | b:byte; 236 | i,l:integer; 237 | begin 238 | b:=0;//default 239 | i:=0; 240 | l:=Stream.Read(b,1); 241 | Value:=b and $7F; 242 | while (l<>0) and ((b and $80)<>0) do 243 | begin 244 | l:=Stream.Read(b,1); 245 | inc(i,7); 246 | Value:=Value or ((b and $7F) shl i); 247 | end; 248 | Result:=l<>0; 249 | end; 250 | 251 | function _ReadVarInt(Stream: TStream; var Value: int64): boolean; overload; 252 | var 253 | b:byte; 254 | i,l:integer; 255 | begin 256 | b:=0;//default 257 | i:=0; 258 | l:=Stream.Read(b,1); 259 | Value:=b and $7F; 260 | while (l<>0) and ((b and $80)<>0) do 261 | begin 262 | l:=Stream.Read(b,1); 263 | inc(i,7); 264 | Value:=Value or ((b and $7F) shl i); 265 | end; 266 | Result:=l<>0; 267 | end; 268 | 269 | function _UnZigZag(x:int64):int64; overload; 270 | begin 271 | if (x and 1)=0 then Result:=x shr 1 else Result:=-((x+1) shr 1); 272 | end; 273 | 274 | function _UnZigZag(x:integer):integer; overload; 275 | begin 276 | if (x and 1)=0 then Result:=x shr 1 else Result:=-((x+1) shr 1); 277 | end; 278 | 279 | procedure TfrmProtBufViewMain.LoadFields(pos, max: int64; parent: TTreeNode; 280 | desc: TProtBufMessageDescriptor); 281 | var 282 | n:TTreeNode; 283 | i,d:int64; 284 | d64:TFixed64 absolute d; 285 | d32:TFixed32 absolute d; 286 | dF64:double absolute d; 287 | dF32:single absolute d; 288 | FieldName,FieldType:string; 289 | Quant,TypeNr:integer; 290 | m:TProtBufMessageDescriptor; 291 | procedure Msg(const Title,Msg:string); 292 | begin 293 | TMessageNodeData.Create(Title,Msg).Node(n); 294 | end; 295 | begin 296 | FData.Position:=pos; 297 | tvFields.Items.BeginUpdate; 298 | try 299 | if parent=nil then tvFields.Items.Clear; 300 | while (FData.Positionnil) and m.MemberByKey(d, 328 | FieldName,FieldType,Quant,TypeNr) then 329 | Msg(FieldName, 330 | 'enum '+FieldType+#13#10+IntToStr(d)+': '+FieldName) 331 | else 332 | TNumberNodeData.Create(d).Node(n) 333 | end; 334 | TypeNr_bool: 335 | Msg(IntToStr(d),'bool'#13#10+IntToStr(d)); 336 | else 337 | TNumberNodeData.Create(d).Node(n) 338 | end 339 | else 340 | TErrorNodeData.Create('read error').Node(n); 341 | 1://fixed64 342 | if FData.Read(d64[0],8)=8 then 343 | case TypeNr of 344 | TypeNr_fixed64: 345 | Msg(IntToStr(d),'fixed64'#13#10+IntToStr(d)); 346 | TypeNr_sfixed64: 347 | Msg(IntToStr(d),'sfixed64'#13#10+IntToStr(d)); 348 | TypeNr_double: 349 | Msg(FloatToStr(dF64),'double'#13#10+FloatToStr(dF64)); 350 | else 351 | TFixed64NodeData.Create(d64).Node(n); 352 | end 353 | else 354 | TErrorNodeData.Create('read error').Node(n); 355 | 2://length delimited 356 | if _ReadVarInt(FData,d) then 357 | begin 358 | case TypeNr of 359 | TypeNr__typeByName://TypeNr_msg: 360 | begin 361 | m:=FProto.MsgDescByName(desc,FieldType); 362 | TEmbeddedMsgNodeData.Create(FieldType,FData.Position,d,m).Node(n); 363 | end; 364 | //TypeNr_bytes:; 365 | TypeNr_string: 366 | if d<$10000 then 367 | TStringNodeData.Create(FData,FData.Position,d).Node(n) 368 | else 369 | TByLengthNodeData.Create(FData,FData.Position,d).Node(n); 370 | else 371 | TByLengthNodeData.Create(FData,FData.Position,d).Node(n); 372 | end; 373 | FData.Seek(d,soFromCurrent); 374 | end 375 | else 376 | TErrorNodeData.Create('read error').Node(n); 377 | //3,4:raise Exception.Create('ProtBuf: groups are deprecated'); 378 | 5://fixed32 379 | if FData.Read(d32[0],8)=8 then 380 | case TypeNr of 381 | TypeNr_fixed32: 382 | Msg(IntToStr(d),'fixed32'#13#10+IntToStr(d)); 383 | TypeNr_sfixed32: 384 | Msg(IntToStr(d),'sfixed32'#13#10+IntToStr(d)); 385 | TypeNr_float: 386 | Msg(FloatToStr(dF32),'float'#13#10+FloatToStr(dF32)); 387 | else 388 | TFixed32NodeData.Create(d32).Node(n); 389 | end 390 | else 391 | TErrorNodeData.Create('read error').Node(n); 392 | else 393 | TErrorNodeData.Create('Unknown wire type '+IntToHex(i,8)).Node(n); 394 | end; 395 | end; 396 | finally 397 | tvFields.Items.EndUpdate; 398 | end; 399 | end; 400 | 401 | procedure TfrmProtBufViewMain.tvFieldsChange(Sender: TObject; 402 | Node: TTreeNode); 403 | begin 404 | if Node.Data=nil then txtValue.Text:='' else 405 | txtValue.Text:=TNodeData(Node.Data).Display; 406 | end; 407 | 408 | procedure TfrmProtBufViewMain.tvFieldsExpanding(Sender: TObject; 409 | Node: TTreeNode; var AllowExpansion: Boolean); 410 | var 411 | d:TByLengthNodeData; 412 | e:TEmbeddedMsgNodeData; 413 | begin 414 | if Node.HasChildren and (Node.Count=0) then 415 | begin 416 | Node.HasChildren:=false; 417 | if Node.Data<>nil then 418 | begin 419 | if TNodeData(Node.Data) is TByLengthNodeData then 420 | begin 421 | d:=TNodeData(Node.Data) as TByLengthNodeData; 422 | LoadFields(d.Pos,d.Pos+d.Len,Node,nil); 423 | end; 424 | if TNodeData(Node.Data) is TEmbeddedMsgNodeData then 425 | begin 426 | e:=TNodeData(Node.Data) as TEmbeddedMsgNodeData; 427 | LoadFields(e.Pos,e.Pos+e.Len,Node,e.Desc); 428 | end; 429 | end; 430 | end; 431 | end; 432 | 433 | procedure TfrmProtBufViewMain.FormResize(Sender: TObject); 434 | begin 435 | cbMessages.Width:=Panel1.ClientWidth; 436 | end; 437 | 438 | procedure TfrmProtBufViewMain.Openproto1Click(Sender: TObject); 439 | begin 440 | if odProto.Execute then 441 | begin 442 | LoadProto(odProto.FileName); 443 | cbMessages.ItemIndex:=0; 444 | end; 445 | end; 446 | 447 | procedure TfrmProtBufViewMain.LoadProto(const FilePath: string); 448 | begin 449 | FProtoFile:=FilePath; 450 | if FDataFile='' then 451 | Caption:='('+FProtoFile+') - Protocol Buffer Viewer' 452 | else 453 | Caption:=ExtractFileName(FDataFile)+' - '+ExtractFileName(FProtoFile)+ 454 | ' - Protocol Buffer Viewer'; 455 | Application.Title:=Caption; 456 | FProto.Parse(FilePath); 457 | cbMessages.Items.BeginUpdate; 458 | try 459 | cbMessages.Items.Clear; 460 | FProto.ListDescriptors(cbMessages.Items); 461 | finally 462 | cbMessages.Items.EndUpdate; 463 | end; 464 | end; 465 | 466 | procedure TfrmProtBufViewMain.cbMessagesChange(Sender: TObject); 467 | var 468 | m:TProtBufMessageDescriptor; 469 | begin 470 | if FData<>nil then 471 | begin 472 | if cbMessages.ItemIndex=-1 then m:=nil else 473 | m:=cbMessages.Items.Objects[cbMessages.ItemIndex] 474 | as TProtBufMessageDescriptor; 475 | LoadFields(0,FData.Size,nil,m);//refresh 476 | end; 477 | end; 478 | 479 | { TNodeData } 480 | 481 | procedure TNodeData.Node(n: TTreeNode); 482 | begin 483 | n.Data:=Self; 484 | end; 485 | 486 | { TNumberNodeData } 487 | 488 | constructor TNumberNodeData.Create(Value: int64); 489 | begin 490 | inherited Create; 491 | FValue:=Value; 492 | end; 493 | 494 | function TNumberNodeData.Display: string; 495 | begin 496 | Result:=Format('varint'#13#10'unsigned: %d'#13#10'signed: %d'#13#10'%.16x', 497 | [FValue,_UnZigZag(FValue),FValue]); 498 | end; 499 | 500 | procedure TNumberNodeData.Node(n: TTreeNode); 501 | begin 502 | inherited; 503 | n.Text:=Format('%svarint %d %d',[n.Text,FValue,_UnZigZag(FValue)]); 504 | end; 505 | 506 | { TErrorNodeData } 507 | 508 | constructor TErrorNodeData.Create(const Msg: string); 509 | begin 510 | inherited Create; 511 | FMessage:=Msg; 512 | end; 513 | 514 | function TErrorNodeData.Display: string; 515 | begin 516 | Result:='!!!'#13#10+FMessage; 517 | end; 518 | 519 | procedure TErrorNodeData.Node(n: TTreeNode); 520 | begin 521 | inherited; 522 | n.Text:=n.Text+'!!! '+FMessage; 523 | end; 524 | 525 | { TFixed64NodeData } 526 | 527 | constructor TFixed64NodeData.Create(const Value: TFixed64); 528 | begin 529 | inherited Create; 530 | FValue:=Value; 531 | end; 532 | 533 | function TFixed64NodeData.Display: string; 534 | var 535 | d:TFixed64; 536 | d1:int64 absolute d; 537 | d2:double absolute d; 538 | begin 539 | d:=FValue; 540 | Result:=Format('fixed64'#13#10'unsigned: %d'#13#10'signed: %d'#13#10+ 541 | 'float: %f'#13#10'%.2x %.2x %.2x %.2x %.2x %.2x %.2x %.2x', 542 | [d1,d1,d2,d[0],d[1],d[2],d[3],d[4],d[5],d[6],d[7]]); 543 | end; 544 | 545 | procedure TFixed64NodeData.Node(n: TTreeNode); 546 | var 547 | d:TFixed64; 548 | d1:int64 absolute d; 549 | d2:double absolute d; 550 | begin 551 | inherited; 552 | d:=FValue; 553 | n.Text:=Format('%sfixed64 %d %f',[n.Text,d1,d2]); 554 | end; 555 | 556 | { TFixed32NodeData } 557 | 558 | constructor TFixed32NodeData.Create(const Value: TFixed32); 559 | begin 560 | inherited Create; 561 | FValue:=Value; 562 | end; 563 | 564 | function TFixed32NodeData.Display: string; 565 | var 566 | d:TFixed32; 567 | d1:cardinal absolute d; 568 | d2:integer absolute d; 569 | d3:single absolute d; 570 | begin 571 | d:=FValue; 572 | Result:=Format('fixed32'#13#10'unsigned: %d'#13#10'signed: %d'#13#10+ 573 | 'float: %f'#13#10'%.2x %.2x %.2x %.2x', 574 | [d1,d2,d3,d[0],d[1],d[2],d[3]]); 575 | end; 576 | 577 | procedure TFixed32NodeData.Node(n: TTreeNode); 578 | var 579 | d:TFixed32; 580 | d1:integer absolute d; 581 | d2:double absolute d; 582 | begin 583 | inherited; 584 | d:=FValue; 585 | n.Text:=Format('%sfixed32 %d %f',[n.Text,d1,d2]); 586 | end; 587 | 588 | { TByLengthNodeData } 589 | 590 | constructor TByLengthNodeData.Create(Data: TStream; Pos, Len: int64); 591 | begin 592 | inherited Create; 593 | FData:=Data; 594 | FPos:=Pos; 595 | FLen:=Len; 596 | end; 597 | 598 | function TByLengthNodeData.Display: string; 599 | var 600 | x:integer; 601 | begin 602 | Result:=Format('@%d:%d'#13#10,[FPos,FLen]); 603 | if FLen<$10000 then 604 | begin 605 | x:=Length(Result); 606 | SetLength(Result,x+FLen); 607 | FData.Position:=FPos; 608 | FData.Read(Result[x+1],FLen); 609 | end; 610 | //TODO: 'double click to...'; 611 | end; 612 | 613 | procedure TByLengthNodeData.Node(n: TTreeNode); 614 | begin 615 | inherited; 616 | n.Text:=Format('%sbyLength @%d :%d',[n.Text,FPos,FLen]); 617 | n.HasChildren:=FLen<>0; 618 | end; 619 | 620 | { TMessageNodeData } 621 | 622 | constructor TMessageNodeData.Create(const Title, Msg: string); 623 | begin 624 | inherited Create; 625 | FTitle:=Title; 626 | FMessage:=Msg; 627 | end; 628 | 629 | function TMessageNodeData.Display: string; 630 | begin 631 | Result:=FMessage; 632 | end; 633 | 634 | procedure TMessageNodeData.Node(n: TTreeNode); 635 | begin 636 | inherited; 637 | n.Text:=n.Text+FTitle; 638 | end; 639 | 640 | { TStringNodeData } 641 | 642 | constructor TStringNodeData.Create(Data: TStream; Pos, Len: int64); 643 | begin 644 | inherited Create; 645 | FData:=Data; 646 | FPos:=Pos; 647 | FLen:=Len; 648 | FValue:='';//see Node 649 | end; 650 | 651 | function TStringNodeData.Display: string; 652 | begin 653 | Result:=FValue;//more info? 654 | end; 655 | 656 | procedure TStringNodeData.Node(n: TTreeNode); 657 | var 658 | p:int64; 659 | begin 660 | inherited; 661 | SetLength(FValue,FLen); 662 | p:=FData.Position; 663 | if FData.Read(FValue[1],FLen)<>FLen then 664 | FValue:='!!! READ ERROR !!!';//raise? 665 | FData.Position:=p; 666 | n.Text:=Format('%s(%d)"%s"',[n.Text,FLen, 667 | StringReplace(FValue,'"','\"',[rfReplaceAll])]); 668 | end; 669 | 670 | { TEmbeddedMsgNodeData } 671 | 672 | constructor TEmbeddedMsgNodeData.Create(const Name: string; Pos, Len: int64; 673 | Desc: TProtBufMessageDescriptor); 674 | begin 675 | inherited Create; 676 | FName:=Name; 677 | FPos:=Pos; 678 | FLen:=Len; 679 | FDesc:=Desc; 680 | end; 681 | 682 | function TEmbeddedMsgNodeData.Display: string; 683 | begin 684 | Result:=FName; 685 | end; 686 | 687 | procedure TEmbeddedMsgNodeData.Node(n: TTreeNode); 688 | begin 689 | inherited; 690 | n.Text:=n.Text+FName; 691 | n.HasChildren:=FLen<>0; 692 | end; 693 | 694 | end. 695 | -------------------------------------------------------------------------------- /ProtBufParse.pas: -------------------------------------------------------------------------------- 1 | { 2 | 3 | DelphiProtocolBuffer: ProtBufParse.pas 4 | 5 | Copyright 2014-2016 Stijn Sanders 6 | Made available under terms described in file "LICENSE" 7 | https://github.com/stijnsanders/DelphiProtocolBuffer 8 | 9 | } 10 | unit ProtBufParse; 11 | 12 | interface 13 | 14 | uses SysUtils, Classes; 15 | 16 | type 17 | TProtocolBufferParserValue=( 18 | pbpvUnitName, 19 | pbpvTypePrefix, 20 | pbpvImportPath, 21 | pbpvAddPrefix, 22 | //add new here above 23 | pbpv_Unknown); 24 | TProtocolBufferParserFlag=( 25 | pbpfPrependNameParent, 26 | pbpfPrependEnumName, 27 | pbpfPrependEnumFields, 28 | pbpfDebugData, 29 | //add new here above 30 | pbpf_Unknown); 31 | 32 | TProtocolBufferParserValues=array[TProtocolBufferParserValue] of string; 33 | 34 | const 35 | ProtocolBufferParserValueName:TProtocolBufferParserValues=( 36 | 'u', 37 | 'p', 38 | 'i', 39 | 'a', 40 | //add new here above 41 | ''); 42 | ProtocolBufferParserValueDefaults:TProtocolBufferParserValues=( 43 | '', 44 | 'T', 45 | '', 46 | 'Add_', 47 | //add new here above 48 | ''); 49 | ProtocolBufferParserFlagName:array[TProtocolBufferParserFlag] of string=( 50 | 'Pn: prepend with parent name', 51 | 'En: prepend enumeration name with parent', 52 | 'Ef: prepend enumeration field with name', 53 | 'Dd: include debug data', 54 | //add new here above 55 | ''); 56 | 57 | type 58 | EProtocolBufferParseError=class(Exception); 59 | 60 | TProtocolBufferParser=class;//forward 61 | 62 | TProtocolBufferParserFlags=set of TProtocolBufferParserFlag; 63 | 64 | TProtBufMessageDescriptor=class(TObject) 65 | private 66 | FName,FPasName:string; 67 | FMembers:array of record 68 | Key,Quant,TypeNr:integer; 69 | Name,TypeName,DefaultValue,PascalType,OneOfName:string; 70 | end; 71 | FMembersIndex,FMembersCount,FHighKey:integer; 72 | FWireFlags:cardinal; 73 | protected 74 | function GenerateInterface(p:TProtocolBufferParser; 75 | Flags:TProtocolBufferParserFlags):string; virtual; 76 | function GenerateImplementation(p:TProtocolBufferParser; 77 | Flags:TProtocolBufferParserFlags):string; virtual; 78 | public 79 | Parent:TProtBufMessageDescriptor; 80 | NextKey,ExtensionsLo,ExtensionsHi:integer; 81 | Forwarded,Extending:boolean; 82 | OneOfName:string; 83 | constructor Create(const Name:string); 84 | procedure AddMember(Quant,TypeNr:integer; 85 | const Name,TypeName,DefaultValue:string); 86 | function MemberByKey(Key: integer; var FieldName, FieldType: string; 87 | var Quant, TypeNr: integer): boolean; 88 | property Name:string read FName; 89 | property PasName:string read FPasName; 90 | end; 91 | 92 | TProtBufEnumDescriptor=class(TProtBufMessageDescriptor) 93 | protected 94 | function GenerateInterface(p:TProtocolBufferParser; 95 | Flags:TProtocolBufferParserFlags):string; override; 96 | function GenerateImplementation(p:TProtocolBufferParser; 97 | Flags:TProtocolBufferParserFlags):string; override; 98 | end; 99 | 100 | TProtocolBufferParser=class(TObject) 101 | private 102 | FPackageName,FUnitName:string; 103 | FMsgDesc:array of TProtBufMessageDescriptor; 104 | FMsgDescIndex,FMsgDescSize:integer; 105 | procedure AddMsgDesc(x:TProtBufMessageDescriptor); 106 | procedure InsertMsgDesc(x,before:TProtBufMessageDescriptor); 107 | public 108 | Values:TProtocolBufferParserValues; 109 | Options:TStringList; 110 | constructor Create; 111 | destructor Destroy; override; 112 | procedure Parse(const FilePath:string); 113 | function MsgDescByName(OptParent: TProtBufMessageDescriptor; 114 | const Name:string):TProtBufMessageDescriptor; 115 | procedure ListDescriptors(const List:TStrings); 116 | function GenerateUnit(Flags:TProtocolBufferParserFlags):string; 117 | property DescriptorCount: integer read FMsgDescIndex; 118 | end; 119 | 120 | const 121 | Quant_Required=1; 122 | Quant_Optional=2; 123 | Quant_Repeated=3; 124 | Quant_Repeated_Packed=4; 125 | 126 | //varint 127 | TypeNr_int32=$10; 128 | TypeNr_int64=$11; 129 | TypeNr_uint32=$12; 130 | TypeNr_uint64=$13; 131 | TypeNr_sint32=$14; 132 | TypeNr_sint64=$15; 133 | TypeNr_bool=$16; 134 | TypeNr_enum=$17; 135 | //length delimited 136 | TypeNr_string=$20; 137 | TypeNr_bytes=$21; 138 | TypeNr_msg=$22; 139 | //fixed 140 | TypeNr_fixed32=$30; 141 | TypeNr_fixed64=$40; 142 | TypeNr_sfixed32=$31; 143 | TypeNr_sfixed64=$41; 144 | TypeNr_float=$32; 145 | TypeNr_double=$42; 146 | //depends:enum/message/map 147 | TypeNr__typeByName=$01; 148 | TypeNr__map=$02; 149 | 150 | WireFlag_VarInt = $002;// shl 1 151 | WireFlag_Len = $004;// shl 2 152 | WireFlag_32 = $008;// shl 3 153 | WireFlag_64 = $010;// shl 4 154 | WireFlag_Msg = $040;// shl 6 155 | WireFlag_Default = $080;// shl 7 156 | WireFlag_RepeatBase = $100;// shl 8 157 | 158 | kFirstReservedNumber = 19000; 159 | kLastReservedNumber = 19999; 160 | 161 | implementation 162 | 163 | uses SelfVersion; 164 | 165 | { TProtocolBufferParser } 166 | 167 | constructor TProtocolBufferParser.Create; 168 | begin 169 | inherited Create; 170 | FPackageName:=''; 171 | FUnitName:=''; 172 | FMsgDescIndex:=0; 173 | FMsgDescSize:=0; 174 | Values:=ProtocolBufferParserValueDefaults; 175 | Options:=TStringList.Create; 176 | end; 177 | 178 | destructor TProtocolBufferParser.Destroy; 179 | begin 180 | while FMsgDescIndex<>0 do 181 | begin 182 | dec(FMsgDescIndex); 183 | FreeAndNil(FMsgDesc[FMsgDescIndex]); 184 | end; 185 | Options.Free; 186 | inherited; 187 | end; 188 | 189 | procedure TProtocolBufferParser.AddMsgDesc(x: TProtBufMessageDescriptor); 190 | begin 191 | //TODO: check unique name, (auto-enable pbpfPrependNameParent?) 192 | if FMsgDescIndex=FMsgDescSize then 193 | begin 194 | inc(FMsgDescSize,32);//Grow 195 | SetLength(FMsgDesc,FMsgDescSize); 196 | end; 197 | FMsgDesc[FMsgDescIndex]:=x; 198 | inc(FMsgDescIndex); 199 | end; 200 | 201 | procedure TProtocolBufferParser.InsertMsgDesc(x, 202 | before: TProtBufMessageDescriptor); 203 | var 204 | i,j:integer; 205 | begin 206 | if FMsgDescIndex=FMsgDescSize then 207 | begin 208 | inc(FMsgDescSize,32);//Grow 209 | SetLength(FMsgDesc,FMsgDescSize); 210 | end; 211 | i:=FMsgDescIndex; 212 | if i<>0 then 213 | begin 214 | dec(i); 215 | while (i<>0) and (FMsgDesc[i]<>before) do dec(i); 216 | end; 217 | j:=FMsgDescIndex; 218 | while (j<>i) do 219 | begin 220 | FMsgDesc[j]:=FMsgDesc[j-1]; 221 | dec(j); 222 | end; 223 | FMsgDesc[i]:=x; 224 | inc(FMsgDescIndex); 225 | end; 226 | 227 | function pd(const x:string):string; 228 | begin 229 | if x='' then Result:='' else Result:=IncludeTrailingPathDelimiter(x); 230 | end; 231 | 232 | procedure TProtocolBufferParser.Parse(const FilePath: string); 233 | var 234 | Line,CodeL,CodeI,CodeJ,CodeI_EOL:integer; 235 | Code,Keyword:string; 236 | 237 | procedure LoadCode; 238 | var 239 | f:TFileStream; 240 | begin 241 | f:=TFileStream.Create(FilePath,fmOpenRead or fmShareDenyWrite); 242 | try 243 | //TODO: UTF-8? UTF-16? 244 | CodeL:=f.Size; 245 | SetLength(Code,CodeL); 246 | if f.Read(Code[1],CodeL)<>CodeL then RaiseLastOSError; 247 | finally 248 | f.Free; 249 | end; 250 | end; 251 | 252 | procedure SkipWhiteSpace; 253 | var 254 | b:boolean; 255 | begin 256 | b:=true; 257 | while b or ((CodeI<=CodeL) and (Code[CodeI]<=' ')) do 258 | begin 259 | b:=false; 260 | while (CodeI<=CodeL) and (Code[CodeI]<=' ') do 261 | begin 262 | if (Code[CodeI]=#10) then 263 | begin 264 | inc(Line); 265 | CodeI_EOL:=CodeI; 266 | end 267 | else 268 | if (Code[CodeI]=#13) then 269 | begin 270 | inc(Line); 271 | if (CodeI#13) and (Code[CodeI]<>#10) do 282 | inc(CodeI); 283 | end; 284 | end; 285 | end; 286 | 287 | procedure R(const Msg:string); 288 | function ReturnAddr: pointer; 289 | asm 290 | mov eax,[ebp+4] 291 | end; 292 | begin 293 | raise EProtocolBufferParseError.CreateFmt( 294 | '%s, line %d pos %d',[Msg,Line,CodeI-CodeI_EOL]) at ReturnAddr; 295 | end; 296 | 297 | procedure Expect(x:char); 298 | begin 299 | SkipWhiteSpace; 300 | if (CodeI<=CodeL) and (Code[CodeI]=x) then 301 | inc(CodeI) 302 | else 303 | R('Expected "'+x+'"'); 304 | end; 305 | 306 | function IsNext(x:char):boolean; 307 | begin 308 | SkipWhiteSpace; 309 | if (CodeI<=CodeL) and (Code[CodeI]=x) then 310 | begin 311 | inc(CodeI); 312 | Result:=true; 313 | end 314 | else 315 | Result:=false; 316 | end; 317 | 318 | function NextKeyword:boolean; 319 | begin 320 | SkipWhiteSpace; 321 | CodeJ:=CodeI; 322 | //while (CodeJ<=CodeL) and (Code[CodeJ]>' ') do inc(CodeJ); 323 | while (CodeJ<=CodeL) 324 | and (Code[CodeJ] in ['A'..'Z','a'..'z','0'..'9','_','.']) do 325 | inc(CodeJ); 326 | Keyword:=Copy(Code,CodeI,CodeJ-CodeI); 327 | Result:=CodeJ>CodeI; 328 | CodeI:=CodeJ; 329 | end; 330 | 331 | function NextInt:integer; 332 | begin 333 | SkipWhiteSpace; 334 | //TODO: support '-'? 335 | Result:=0; 336 | if (CodeI'"') do 361 | begin 362 | if (Code[CodeI]='\') and (CodeI'' then R('Package name was already set'); 410 | if NextKeyword then FPackageName:=Keyword else R('Package name expected'); 411 | Expect(';'); 412 | end 413 | else 414 | if Keyword='import' then 415 | begin 416 | if NextKeyword then 417 | if Keyword='public' then 418 | //TODO 419 | else 420 | if Keyword='weak' then 421 | //TODO 422 | else 423 | R('Unsupported import moidifier'); 424 | Parse(pd(Values[pbpvImportPath])+StringReplace(NextStr,'/','\',[rfReplaceAll])); 425 | Expect(';'); 426 | end 427 | else 428 | if Keyword='option' then 429 | begin 430 | if IsNext('(') then 431 | begin 432 | if not NextKeyword then R('Option name expected'); 433 | OptionName:=Keyword; 434 | while IsNext('.') do 435 | begin 436 | if not NextKeyword then R('Option name expected'); 437 | OptionName:=OptionName+'.'+Keyword; 438 | end; 439 | Expect(')'); 440 | end 441 | else 442 | begin 443 | if not NextKeyword then R('Option name expected'); 444 | OptionName:=Keyword; 445 | end; 446 | while IsNext('.') do 447 | begin 448 | if not NextKeyword then R('Option name expected'); 449 | OptionName:=OptionName+'.'+Keyword; 450 | end; 451 | Expect('='); 452 | if not NextKeyword then Keyword:=NextStr; 453 | Options.Add(OptionName+'='+Keyword); 454 | Expect(';'); 455 | end 456 | else 457 | //TODO: 'service' 458 | if Keyword='message' then 459 | begin 460 | if not NextKeyword then R('Message identifier expected'); 461 | Expect('{'); 462 | Msg:=TProtBufMessageDescriptor.Create(Keyword); 463 | AddMsgDesc(Msg); 464 | end 465 | else 466 | if Keyword='extend' then 467 | begin 468 | if not NextKeyword then R('Extend identifier expected'); 469 | Expect('{'); 470 | Msg:=MsgDescByName(nil,Keyword); 471 | if Msg=nil then 472 | raise Exception.Create('Extend descriptor "'+Keyword+'" not found'); 473 | Msg.Extending:=true; 474 | Msg.NextKey:=Msg.ExtensionsLo;//assert<>0 475 | end 476 | else 477 | if Keyword='enum' then 478 | begin 479 | if not NextKeyword then R('Enum identifier expected'); 480 | Expect('{'); 481 | MsgEnum:=TProtBufEnumDescriptor.Create(Keyword); 482 | InsertMsgDesc(MsgEnum,nil); 483 | //MsgEnum.Parent:=Msg; 484 | MsgEnum.NextKey:=0; 485 | end 486 | else 487 | R('Unexpected keyword "'+Keyword+'"') 488 | else 489 | if CodeI<=CodeL then 490 | R('Unexpected non-keyword'); 491 | //else EOF 492 | 493 | end 494 | else 495 | 496 | if MsgEnum=nil then //Msg<>nil 497 | begin 498 | 499 | if NextKeyword then 500 | if Keyword='enum' then 501 | begin 502 | if not NextKeyword then R('Enum identifier expected'); 503 | Expect('{'); 504 | MsgEnum:=TProtBufEnumDescriptor.Create(Keyword); 505 | InsertMsgDesc(MsgEnum,Msg); 506 | MsgEnum.Parent:=Msg; 507 | MsgEnum.NextKey:=0; 508 | end 509 | else 510 | if Keyword='message' then 511 | begin 512 | //nested message 513 | if not NextKeyword then R('Message identifier expected'); 514 | Expect('{'); 515 | //push message 516 | Msg1:=Msg; 517 | Msg:=TProtBufMessageDescriptor.Create(Keyword); 518 | AddMsgDesc(Msg); 519 | Msg.Parent:=Msg1; 520 | end 521 | else 522 | if Keyword='extensions' then //TODO: proto2 only 523 | begin 524 | //extensions 525 | if (Msg.ExtensionsLo<>0) then R('Extensions range already set'); 526 | if Msg.Extending then R('Can''t set extensions range when already extending'); 527 | Msg.ExtensionsLo:=NextInt; 528 | if not(NextKeyword) or (Keyword<>'to') then R('Expected "to"'); 529 | if NextKeyword then 530 | if Keyword='max' then 531 | Msg.ExtensionsHi:=$1FFFFFFF//int23 532 | else 533 | if TryStrToInt(Keyword,Msg.ExtensionsHi) then 534 | else 535 | R('Unsupported range syntax') 536 | else 537 | Msg.ExtensionsHi:=NextInt; 538 | if (Msg.ExtensionsLo=0) or (Msg.ExtensionsHi=0) 539 | or (Msg.ExtensionsHi'' then R('Nested oneof not allowed'); 601 | if not NextKeyword then R('Message identifier expected'); 602 | Expect('{'); 603 | Msg.OneOfName:=Keyword;//see below 604 | end 605 | else 606 | begin 607 | //field 608 | if Keyword='required' then Quant:=Quant_Required else //TODO: proto2 only 609 | if Keyword='optional' then Quant:=Quant_Optional else //TODO: proto2 only 610 | if Keyword='repeated' then Quant:=Quant_Repeated else 611 | Quant:=0; 612 | 613 | if Quant<>0 then 614 | if not NextKeyword then R('Type identifier expected'); 615 | DefaultValue:=''; 616 | if Keyword='map' then 617 | begin 618 | if Quant<>0 then R('Quantifiers not allowed on maps'); 619 | Expect('<'); 620 | if not NextKeyword then R('Map key type expected'); 621 | TypeNr:=0; 622 | case Keyword[1] of 623 | 'b': 624 | if Keyword='bool' then TypeNr:=TypeNr_bool 625 | else 626 | ; 627 | 'f': 628 | if Keyword='fixed32' then TypeNr:=TypeNr_fixed32 629 | else 630 | if Keyword='fixed64' then TypeNr:=TypeNr_fixed64 631 | else 632 | ; 633 | 'i': 634 | if Keyword='int32' then TypeNr:=TypeNr_int32 635 | else 636 | if Keyword='int64' then TypeNr:=TypeNr_int64 637 | ; 638 | 's': 639 | if Keyword='string' then TypeNr:=TypeNr_string 640 | else 641 | if Keyword='sint32' then TypeNr:=TypeNr_sint32 642 | else 643 | if Keyword='sint64' then TypeNr:=TypeNr_sint64 644 | else 645 | if Keyword='sfixed32' then TypeNr:=TypeNr_sfixed32 646 | else 647 | if Keyword='sfixed64' then TypeNr:=TypeNr_sfixed64 648 | else 649 | ; 650 | 'u': 651 | if Keyword='uint32' then TypeNr:=TypeNr_uint32 652 | else 653 | if Keyword='uint64' then TypeNr:=TypeNr_uint64 654 | else 655 | ; 656 | 657 | //else ; 658 | end; 659 | if TypeNr=0 then R('Invalud map key value type'); 660 | Expect(','); 661 | if not NextKeyword then R('Map value type expected'); 662 | TypeName:=IntToStr(TypeNr)+':'+Keyword; 663 | Expect('>'); 664 | end 665 | else 666 | begin 667 | TypeName:=''; 668 | TypeNr:=0; 669 | case Keyword[1] of 670 | 'b': 671 | if Keyword='bool' then TypeNr:=TypeNr_bool 672 | else 673 | if Keyword='bytes' then TypeNr:=TypeNr_bytes 674 | else 675 | ; 676 | 'd': 677 | if Keyword='double' then TypeNr:=TypeNr_double 678 | else 679 | ; 680 | 'f': 681 | if Keyword='float' then TypeNr:=TypeNr_float 682 | else 683 | if Keyword='fixed32' then TypeNr:=TypeNr_fixed32 684 | else 685 | if Keyword='fixed64' then TypeNr:=TypeNr_fixed64 686 | else 687 | ; 688 | 'i': 689 | if Keyword='int32' then TypeNr:=TypeNr_int32 690 | else 691 | if Keyword='int64' then TypeNr:=TypeNr_int64 692 | ; 693 | 's': 694 | if Keyword='string' then TypeNr:=TypeNr_string 695 | else 696 | if Keyword='sint32' then TypeNr:=TypeNr_sint32 697 | else 698 | if Keyword='sint64' then TypeNr:=TypeNr_sint64 699 | else 700 | if Keyword='sfixed32' then TypeNr:=TypeNr_sfixed32 701 | else 702 | if Keyword='sfixed64' then TypeNr:=TypeNr_sfixed64 703 | else 704 | if Keyword='single' then TypeNr:=TypeNr_float 705 | else 706 | ; 707 | 'u': 708 | if Keyword='uint32' then TypeNr:=TypeNr_uint32 709 | else 710 | if Keyword='uint64' then TypeNr:=TypeNr_uint64 711 | else 712 | ; 713 | 714 | //else ; 715 | end; 716 | if TypeNr=0 then 717 | begin 718 | TypeName:=Keyword; 719 | TypeNr:=TypeNr__typeByName; 720 | //lookup here? see build output script 721 | end; 722 | 723 | if (TypeNr=TypeNr_bytes) and (Quant>=Quant_Repeated) then 724 | R('"repeated bytes" not supported'); 725 | end; 726 | 727 | if NextKeyword then FieldName:=Keyword else R('Identifier expected'); 728 | while TypeNr<>0 do 729 | begin 730 | SkipWhiteSpace; 731 | if CodeI<=CodeL then 732 | begin 733 | inc(CodeI); 734 | case Code[CodeI-1] of 735 | ';': 736 | begin 737 | 738 | if (Msg.NextKey>=kFirstReservedNumber) 739 | and (Msg.NextKey<=kLastReservedNumber) then 740 | R('Reserved key value '+IntToStr(Msg.NextKey)); 741 | if Msg.Extending and ((Msg.NextKeyMsg.ExtensionsHi)) then 743 | R('Key value outside of extensions range '+IntToStr(Msg.NextKey)); 744 | 745 | Msg.AddMember(Quant,TypeNr,FieldName,TypeName,DefaultValue); 746 | 747 | TypeNr:=0; 748 | end; 749 | '=': 750 | Msg.NextKey:=NextInt; 751 | '[': 752 | begin 753 | NextKeyword; 754 | Expect('='); 755 | if (Keyword='default') and (Quant=Quant_Optional) then 756 | if NextKeyword then 757 | DefaultValue:=Keyword 758 | else 759 | R('Default value expected') 760 | else 761 | if (Keyword='packed') 762 | and (Quant in [Quant_Repeated,Quant_Repeated_Packed]) then 763 | if NextKeyword then 764 | if Keyword='true' then Quant:=Quant_Repeated_Packed else 765 | if Keyword='false' then Quant:=Quant_Repeated else 766 | R('Unknown packed value "'+Keyword+'"') 767 | else R('Packed value expected') 768 | else 769 | R('Unknown modifier "'+Keyword+'"'); 770 | Expect(']'); 771 | end; 772 | else R('Expected ";" or "=" or "["'); 773 | end; 774 | end; 775 | end; 776 | end 777 | else 778 | begin 779 | Expect('}'); 780 | if Msg.OneOfName<>'' then 781 | Msg.OneOfName:='' //continue with message 782 | else 783 | Msg:=Msg.Parent;//pop message 784 | end; 785 | end 786 | 787 | else //MsgEnum<>nil 788 | begin 789 | if NextKeyword then 790 | begin 791 | if Keyword='option' then 792 | begin 793 | if not NextKeyword then R('Enum option identifier expected'); 794 | if Keyword='allow_alias' then 795 | begin 796 | SkipWhiteSpace; 797 | if (CodeI<=CodeL) and (Code[CodeI]='=') then 798 | begin 799 | inc(CodeI); 800 | if not NextKeyword then R('Enum option value expected'); 801 | if Keyword='true' then //TODO: allow_alias=true 802 | else 803 | if Keyword='false' then //TODO: allow_alias=false 804 | else 805 | R('Unknown enum option value "'+Keyword+'"'); 806 | end 807 | else 808 | R('Assignment to "allow_alias" expected'); 809 | end 810 | else 811 | R('Unknown enum option "'+Keyword+'"'); 812 | end 813 | else 814 | begin 815 | SkipWhiteSpace; 816 | if (CodeI<=CodeL) and (Code[CodeI]='=') then 817 | begin 818 | inc(CodeI); 819 | MsgEnum.NextKey:=NextInt; 820 | end; 821 | MsgEnum.AddMember(0,0,Keyword,'',''); 822 | end; 823 | if IsNext('[') then 824 | begin 825 | //option(s) 826 | First:=true; 827 | while First or IsNext(',') do 828 | begin 829 | if First then First:=false; 830 | if IsNext('(') then 831 | begin 832 | if not NextKeyword then R('Option name expected'); 833 | OptionName:=Keyword; 834 | while IsNext('.') do 835 | begin 836 | if not NextKeyword then R('Option name expected'); 837 | OptionName:=OptionName+'.'+Keyword; 838 | end; 839 | Expect(')'); 840 | end 841 | else 842 | begin 843 | if not NextKeyword then R('Option name expected'); 844 | OptionName:=Keyword; 845 | end; 846 | while IsNext('.') do 847 | begin 848 | if not NextKeyword then R('Option name expected'); 849 | OptionName:=OptionName+'.'+Keyword; 850 | end; 851 | Expect('='); 852 | //TODO:OptionName+'='+ 853 | NextStr; 854 | end; 855 | Expect(']'); 856 | end; 857 | Expect(';'); 858 | end 859 | else 860 | if IsNext('}') then 861 | begin 862 | MsgEnum:=nil; //continue 863 | if Msg<>nil then IsNext(';'); 864 | end 865 | else 866 | R('Unexpected syntax'); 867 | end; 868 | end; 869 | 870 | function TProtocolBufferParser.GenerateUnit( 871 | Flags:TProtocolBufferParserFlags): string; 872 | var 873 | MsgI:integer; 874 | v:TProtocolBufferParserValue; 875 | f:TProtocolBufferParserFlag; 876 | begin 877 | //TODO: Flags from options? 878 | if Values[pbpvUnitName]<>'' then FUnitName:=Values[pbpvUnitName]; 879 | Result:='unit '+FUnitName+';'#13#10#13#10+ 880 | '// ATTENTION:'#13#10+ 881 | '// This file was auto generated by dpbp '+GetSelfVersion+#13#10+ 882 | '// https://github.com/stijnsanders/DelphiProtocolBuffer'#13#10+ 883 | '//'#13#10; 884 | v:=TProtocolBufferParserValue(0); 885 | while v<>pbpv_Unknown do 886 | begin 887 | if Values[v]<>ProtocolBufferParserValueDefaults[v] then 888 | Result:=Result+'// VALUE: -'+ 889 | ProtocolBufferParserValueName[v][1]+'"'+Values[v]+'"'#13#10; 890 | inc(v); 891 | end; 892 | f:=TProtocolBufferParserFlag(0); 893 | while f<>pbpf_Unknown do 894 | begin 895 | if f in Flags then Result:=Result+'// FLAG: '+ 896 | ProtocolBufferParserFlagName[f]+#13#10; 897 | inc(f); 898 | end; 899 | 900 | if not(pbpfDebugData in Flags) then 901 | Result:=Result+#13#10'{$D-}'#13#10'{$L-}'#13#10;//'{$Y-}'#13#10;? 902 | 903 | //first pass 904 | for MsgI:=0 to FMsgDescIndex-1 do 905 | begin 906 | //TODO: determine dependancy-safe order? 907 | if FMsgDesc[MsgI] is TProtBufEnumDescriptor then 908 | begin 909 | if (pbpfPrependEnumName in Flags) 910 | and (FMsgDesc[MsgI].Parent<>nil) then 911 | FMsgDesc[MsgI].FPasName:= 912 | FMsgDesc[MsgI].Parent.Name+'_'+FMsgDesc[MsgI].FPasName; 913 | end 914 | else 915 | begin 916 | if (pbpfPrependNameParent in Flags) 917 | and (FMsgDesc[MsgI].Parent<>nil) then 918 | FMsgDesc[MsgI].FPasName:= 919 | FMsgDesc[MsgI].Parent.Name+'_'+FMsgDesc[MsgI].FPasName; 920 | end; 921 | end; 922 | 923 | //interface 924 | Result:=Result+#13#10+ 925 | 'interface'#13#10#13#10+ 926 | 'uses Classes, ProtBuf;'#13#10#13#10+ 927 | 'type'#13#10; 928 | for MsgI:=0 to FMsgDescIndex-1 do 929 | Result:=Result+FMsgDesc[MsgI].GenerateInterface(Self,Flags); 930 | 931 | //implementation 932 | Result:=Result+'implementation'#13#10#13#10'uses SysUtils;'#13#10#13#10; 933 | 934 | for MsgI:=0 to FMsgDescIndex-1 do 935 | Result:=Result+FMsgDesc[MsgI].GenerateImplementation(Self,Flags); 936 | 937 | Result:=Result+'end.'#13#10; 938 | end; 939 | 940 | function TProtocolBufferParser.MsgDescByName( 941 | OptParent: TProtBufMessageDescriptor; 942 | const Name:string):TProtBufMessageDescriptor; 943 | var 944 | i:integer; 945 | begin 946 | if OptParent=nil then i:=FMsgDescIndex else 947 | begin 948 | //search with Parent set 949 | i:=0; 950 | //TODO: ascend over .Parent(s)? 951 | while (iOptParent) 952 | or (FMsgDesc[i].Name<>Name)) do inc(i); 953 | end; 954 | if i=FMsgDescIndex then 955 | begin 956 | //not found, search disregarding parent 957 | i:=0; 958 | while (iName) do inc(i); 959 | end; 960 | if i'' 992 | c:=char(UpCase(x[1])); 993 | //skip anything longer than longest word 994 | if not(c in ['A'..'Z']) or (Length(x)>ResWordMaxLength[c]) then 995 | Result:=false 996 | else 997 | begin 998 | y:=LowerCase(x); 999 | i:=0; 1000 | while (iResWords[i]) do inc(i); 1001 | Result:=iNextKey) do inc(i); 1043 | if (iFHighKey then 1077 | FHighKey:=FMembers[i].Key; 1078 | case FMembers[i].TypeNr of 1079 | TypeNr_string: FMembers[i].PascalType:='string';//? UTF8? 1080 | TypeNr_int32: FMembers[i].PascalType:='integer'; 1081 | TypeNr_int64: FMembers[i].PascalType:='int64'; 1082 | TypeNr_uint32: FMembers[i].PascalType:='cardinal'; 1083 | TypeNr_uint64: FMembers[i].PascalType:='int64';//uint64? 1084 | TypeNr_sint32: FMembers[i].PascalType:='integer';//LongWord? 1085 | TypeNr_sint64: FMembers[i].PascalType:='int64';//LongLongWord? 1086 | TypeNr_fixed32: FMembers[i].PascalType:='cardinal';//? 1087 | TypeNr_fixed64: FMembers[i].PascalType:='int64'; 1088 | TypeNr_sfixed32:FMembers[i].PascalType:='integer';//? 1089 | TypeNr_sfixed64:FMembers[i].PascalType:='int64'; 1090 | TypeNr_float: FMembers[i].PascalType:='single'; 1091 | TypeNr_double: FMembers[i].PascalType:='double'; 1092 | TypeNr_bool: FMembers[i].PascalType:='boolean'; 1093 | TypeNr_bytes: FMembers[i].PascalType:='array of byte';//TBytes? 1094 | //TypeNr_enum: 1095 | //TypeNr_msg: 1096 | TypeNr__typeByName: 1097 | begin 1098 | m:=p.MsgDescByName(Self,FMembers[i].TypeName); 1099 | if m=nil then raise Exception.Create( 1100 | 'Descriptor "'+FMembers[i].TypeName+'" not found'); 1101 | FMembers[i].PascalType:=p.Values[pbpvTypePrefix]+m.PasName; 1102 | if m is TProtBufEnumDescriptor then 1103 | begin 1104 | FMembers[i].TypeNr:=TypeNr_enum; 1105 | if FMembers[i].DefaultValue<>'' then 1106 | begin 1107 | if pbpfPrependEnumName in Flags then 1108 | FMembers[i].DefaultValue:= 1109 | m.PasName+'_'+FMembers[i].DefaultValue; 1110 | end; 1111 | end 1112 | else 1113 | begin 1114 | FMembers[i].TypeNr:=TypeNr_msg; 1115 | FWireFlags:=FWireFlags or WireFlag_Msg; 1116 | if FMembers[i].Quant>=Quant_Repeated then 1117 | FWireFlags:=FWireFlags or (WireFlag_Msg shl 8) 1118 | else 1119 | FWireFlags:=FWireFlags or WireFlag_Default; 1120 | if not m.Forwarded then 1121 | begin 1122 | m.Forwarded:=true; 1123 | Result:=Result+' '+p.Values[pbpvTypePrefix]+m.PasName+ 1124 | ' = class; //forward'#13#10#13#10; 1125 | end; 1126 | end; 1127 | end; 1128 | TypeNr__map:FMembers[i].PascalType:='TMap<'+FMembers[i].TypeName+'>';//TODO: 1129 | else FMembers[i].PascalType:='???'; 1130 | end; 1131 | if (FMembers[i].Quant=Quant_Optional) and (FMembers[i].DefaultValue='') then 1132 | case FMembers[i].TypeNr of 1133 | TypeNr_int32,TypeNr_uint32,TypeNr_sint32, 1134 | TypeNr_int64,TypeNr_uint64,TypeNr_sint64: 1135 | FMembers[i].DefaultValue:='0'; 1136 | TypeNr_bool:FMembers[i].DefaultValue:='false'; 1137 | TypeNr_enum:FMembers[i].DefaultValue:= 1138 | p.Values[pbpvTypePrefix]+FMembers[i].TypeName+'(0)'; 1139 | TypeNr_fixed32,TypeNr_sfixed32, 1140 | TypeNr_fixed64,TypeNr_sfixed64, 1141 | TypeNr_float,TypeNr_double: 1142 | FMembers[i].DefaultValue:='0.0'; 1143 | end; 1144 | w:=FMembers[i].TypeNr shr 4; 1145 | FWireFlags:=FWireFlags or (1 shl w); 1146 | if FMembers[i].Quant>=Quant_Repeated then 1147 | FWireFlags:=FWireFlags or (WireFlag_RepeatBase shl w); 1148 | if FMembers[i].DefaultValue<>'' then 1149 | FWireFlags:=FWireFlags or WireFlag_Default; 1150 | end; 1151 | 1152 | Forwarded:=true; 1153 | Result:=Result+' '+p.Values[pbpvTypePrefix]+ 1154 | FPasName+' = class(TProtocolBufferMessage)'#13#10+ 1155 | ' private'#13#10; 1156 | for i:=0 to FMembersIndex-1 do 1157 | if FMembers[i].Quant=Quant_Repeated then 1166 | begin 1167 | if FMembers[i].TypeNr in [TypeNr_string,TypeNr_bytes] then 1168 | s:='const ' else s:=''; 1169 | Result:=Result+' function Get'+FMembers[i].Name+ 1170 | '(Index: integer): '+FMembers[i].PascalType+';'#13#10+ 1171 | ' procedure Set'+FMembers[i].Name+ 1172 | '(Index: integer; '+s+'Value: '+FMembers[i].PascalType+');'#13#10+ 1173 | ' function Get'+FMembers[i].Name+'Count: integer;'#13#10; 1174 | end; 1175 | 1176 | Result:=Result+' protected'#13#10; 1177 | if (FWireFlags and WireFlag_Default)<>0 then 1178 | Result:=Result+' procedure SetDefaultValues; override;'#13#10; 1179 | if (FWireFlags and WireFlag_VarInt)<>0 then 1180 | Result:=Result+' procedure ReadVarInt(Stream: TStream; '+ 1181 | 'Key: TProtocolBufferKey); override;'#13#10; 1182 | if (FWireFlags and WireFlag_Len)<>0 then 1183 | Result:=Result+' procedure ReadLengthDelim(Stream: TStream; '+ 1184 | 'Key: TProtocolBufferKey); override;'#13#10; 1185 | if (FWireFlags and WireFlag_32)<>0 then 1186 | Result:=Result+' procedure ReadFixed32(Stream: TStream; '+ 1187 | 'Key: TProtocolBufferKey); override;'#13#10; 1188 | if (FWireFlags and WireFlag_64)<>0 then 1189 | Result:=Result+' procedure ReadFixed64(Stream: TStream; '+ 1190 | 'Key: TProtocolBufferKey); override;'#13#10; 1191 | Result:=Result+' procedure WriteFields(Stream: TStream); override;'#13#10; 1192 | 1193 | Result:=Result+' public'#13#10; 1194 | 1195 | if (FWireFlags and WireFlag_Msg)<>0 then 1196 | Result:=Result+' destructor Destroy; override;'#13#10; 1197 | 1198 | for i:=0 to FMembersIndex-1 do 1199 | if FMembers[i].Quant0 then 1233 | begin 1234 | Result:=Result+'procedure '+p.Values[pbpvTypePrefix]+FPasName+'.SetDefaultValues;'#13#10+ 1235 | 'begin'#13#10; 1236 | for i:=0 to FMembersIndex-1 do 1237 | if (FMembers[i].TypeNr=TypeNr_Msg) 1238 | and (FMembers[i].Quant'' then 1246 | case FMembers[i].TypeNr of 1247 | //TypeNr_enum: assert DefaultValue corrected when needed 1248 | TypeNr_string:Result:=Result+' F'+FMembers[i].Name+ 1249 | ' := '''+StringReplace(FMembers[i].DefaultValue, 1250 | '''','''''',[rfReplaceAll])+''';'#13#10; 1251 | else Result:=Result+' F'+FMembers[i].Name+ 1252 | ' := '+FMembers[i].DefaultValue+';'#13#10; 1253 | end; 1254 | Result:=Result+'end;'#13#10#13#10; 1255 | end; 1256 | if (FWireFlags and WireFlag_Msg)<>0 then 1257 | begin 1258 | Result:=Result+'destructor '+p.Values[pbpvTypePrefix]+FPasName+'.Destroy;'#13#10; 1259 | if (FWireFlags and (WireFlag_Msg shl 8))<>0 then 1260 | Result:=Result+'var'#13#10' i: integer;'#13#10; 1261 | Result:=Result+'begin'#13#10; 1262 | for i:=0 to FMembersIndex-1 do 1263 | if FMembers[i].TypeNr=TypeNr_msg then 1264 | if FMembers[i].Quant0 then 1272 | begin 1273 | Result:=Result+'procedure '+p.Values[pbpvTypePrefix]+FPasName+ 1274 | '.ReadVarInt(Stream: TStream; Key: TProtocolBufferKey);'#13#10; 1275 | if ((FWireFlags shr 8) and WireFlag_VarInt)<>0 then 1276 | Result:=Result+'var'#13#10' l: integer;'#13#10; 1277 | Result:=Result+'begin'#13#10' case Key of'#13#10; 1278 | for i:=0 to FMembersIndex-1 do 1279 | case FMembers[i].TypeNr of 1280 | TypeNr_int32: 1281 | if FMembers[i].Quant0 then 1343 | begin 1344 | Result:=Result+'procedure '+p.Values[pbpvTypePrefix]+FPasName+ 1345 | '.ReadLengthDelim(Stream: TStream; Key: TProtocolBufferKey);'#13#10; 1346 | if ((FWireFlags shr 8) and WireFlag_Len)<>0 then 1347 | Result:=Result+'var'#13#10' l: integer;'#13#10; 1348 | Result:=Result+'begin'#13#10' case Key of'#13#10; 1349 | for i:=0 to FMembersIndex-1 do 1350 | case FMembers[i].TypeNr of 1351 | TypeNr_string: 1352 | if FMembers[i].Quant0 then 1388 | begin 1389 | Result:=Result+'procedure '+p.Values[pbpvTypePrefix]+FPasName+ 1390 | '.ReadFixed32(Stream: TStream; Key: TProtocolBufferKey);'#13#10; 1391 | if ((FWireFlags shr 8) and WireFlag_32)<>0 then 1392 | Result:=Result+'var'#13#10' l: integer;'#13#10; 1393 | Result:=Result+'begin'#13#10' case Key of'#13#10; 1394 | for i:=0 to FMembersIndex-1 do 1395 | if FMembers[i].TypeNr in 1396 | [TypeNr_fixed32,TypeNr_sfixed32,TypeNr_float] then 1397 | if FMembers[i].Quant0 then 1410 | begin 1411 | Result:=Result+'procedure '+p.Values[pbpvTypePrefix]+FPasName+ 1412 | '.ReadFixed64(Stream: TStream; Key: TProtocolBufferKey);'#13#10; 1413 | if ((FWireFlags shr 8) and WireFlag_64)<>0 then 1414 | Result:=Result+'var'#13#10' l: integer;'#13#10; 1415 | Result:=Result+'begin'#13#10' case Key of'#13#10; 1416 | for i:=0 to FMembersIndex-1 do 1417 | if FMembers[i].TypeNr in 1418 | [TypeNr_fixed64,TypeNr_sfixed64,TypeNr_double] then 1419 | if FMembers[i].Quant0 then 1435 | Result:=Result+'var'#13#10' i: integer;'#13#10; 1436 | Result:=Result+'begin'#13#10; 1437 | for i:=0 to FMembersIndex-1 do 1438 | case FMembers[i].TypeNr of 1439 | TypeNr_int32,TypeNr_int64,TypeNr_uint32,TypeNr_uint64: 1440 | if FMembers[i].Quant'+ 1446 | FMembers[i].DefaultValue+' then'#13#10+ 1447 | ' WriteUInt(Stream, '+IntToStr(FMembers[i].Key)+ 1448 | ', F'+FMembers[i].Name+');'#13#10 1449 | else 1450 | Result:=Result+' for i := 0 to Length(F'+FMembers[i].Name+')-1 do'#13#10+ 1451 | ' WriteUInt(Stream, '+IntToStr(FMembers[i].Key)+ 1452 | ', F'+FMembers[i].Name+'[i]);'#13#10; 1453 | TypeNr_sint32,TypeNr_sint64: 1454 | if FMembers[i].Quant'+ 1460 | FMembers[i].DefaultValue+' then'#13#10+ 1461 | ' WriteSInt(Stream, '+IntToStr(FMembers[i].Key)+ 1462 | ', F'+FMembers[i].Name+');'#13#10 1463 | else 1464 | Result:=Result+' for i := 0 to Length(F'+FMembers[i].Name+')-1 do'#13#10+ 1465 | ' WriteSInt(Stream, '+IntToStr(FMembers[i].Key)+ 1466 | ', F'+FMembers[i].Name+'[i]);'#13#10; 1467 | TypeNr_bool: 1468 | if FMembers[i].Quant'+ 1492 | FMembers[i].DefaultValue+' then'#13#10+ 1493 | ' WriteStr(Stream, '+IntToStr(FMembers[i].Key)+ 1494 | ', F'+FMembers[i].Name+');'#13#10 1495 | else 1496 | Result:=Result+' for i := 0 to Length(F'+FMembers[i].Name+')-1 do'#13#10+ 1497 | ' WriteStr(Stream, '+IntToStr(FMembers[i].Key)+ 1498 | ', F'+FMembers[i].Name+'[i]);'#13#10; 1499 | TypeNr_bytes: 1500 | //assert FMembers[i].Quant'+ 1511 | FMembers[i].DefaultValue+' then'#13#10+ 1512 | ' WriteBlock(Stream, '+IntToStr(FMembers[i].Key)+ 1513 | ', F'+FMembers[i].Name+', 4);'#13#10 1514 | else 1515 | Result:=Result+' for i := 0 to Length(F'+FMembers[i].Name+')-1 do'#13#10+ 1516 | ' WriteBlock(Stream, '+IntToStr(FMembers[i].Key)+ 1517 | ', F'+FMembers[i].Name+'[i], 4);'#13#10; 1518 | TypeNr_fixed64,TypeNr_sfixed64,TypeNr_double: 1519 | if FMembers[i].Quant'+ 1525 | FMembers[i].DefaultValue+' then'#13#10+ 1526 | ' WriteBlock(Stream, '+IntToStr(FMembers[i].Key)+ 1527 | ', F'+FMembers[i].Name+', 8);'#13#10 1528 | else 1529 | Result:=Result+' for i := 0 to Length(F'+FMembers[i].Name+')-1 do'#13#10+ 1530 | ' WriteBlock(Stream, '+IntToStr(FMembers[i].Key)+ 1531 | ', F'+FMembers[i].Name+'[i], 8);'#13#10; 1532 | TypeNr_enum: 1533 | if FMembers[i].Quant'+ 1539 | FMembers[i].DefaultValue+' then'#13#10+ 1540 | ' WriteUInt(Stream, '+IntToStr(FMembers[i].Key)+ 1541 | ', cardinal(F'+FMembers[i].Name+'));'#13#10 1542 | else 1543 | Result:=Result+' for i := 0 to Length(F'+FMembers[i].Name+')-1 do'#13#10+ 1544 | ' WriteUInt(Stream, '+IntToStr(FMembers[i].Key)+ 1545 | ', cardinal(F'+FMembers[i].Name+'[i]));'#13#10; 1546 | TypeNr_msg: 1547 | //assert FMembers[i].DefaultValue='' 1548 | if FMembers[i].Quantnil then'#13#10+ 1551 | ' WriteMessage(Stream, '+IntToStr(FMembers[i].Key)+ 1552 | ', F'+FMembers[i].Name+');'#13#10 1553 | else 1554 | Result:=Result+' WriteMessage(Stream, '+IntToStr(FMembers[i].Key)+ 1555 | ', F'+FMembers[i].Name+');'#13#10 1556 | else 1557 | Result:=Result+' for i := 0 to Length(F'+FMembers[i].Name+')-1 do'#13#10+ 1558 | //' if F'+FMembers[i].Name+'<>nil then'#13#10+ 1559 | ' WriteMessage(Stream, '+IntToStr(FMembers[i].Key)+ 1560 | ', F'+FMembers[i].Name+'[i]);'#13#10; 1561 | end; 1562 | Result:=Result+'end;'#13#10#13#10; 1563 | 1564 | for i:=0 to FMembersIndex-1 do 1565 | begin 1566 | if FMembers[i].TypeNr in [TypeNr_string,TypeNr_bytes] then 1567 | s:='const ' else s:=''; 1568 | if FMembers[i].Quant>=Quant_Repeated then 1569 | Result:=Result+ 1570 | 'function '+p.Values[pbpvTypePrefix]+FPasName+'.Get'+FMembers[i].Name+ 1571 | '(Index: integer): '+FMembers[i].PascalType+';'#13#10+ 1572 | 'begin'#13#10+ 1573 | ' Result := F'+FMembers[i].Name+'[Index];'#13#10+ 1574 | 'end;'#13#10#13#10+ 1575 | 'procedure '+p.Values[pbpvTypePrefix]+FPasName+'.Set'+FMembers[i].Name+ 1576 | '(Index: integer; '+s+'Value: '+FMembers[i].PascalType+');'#13#10+ 1577 | 'begin'#13#10+ 1578 | ' F'+FMembers[i].Name+'[Index] := Value;'#13#10+ 1579 | 'end;'#13#10#13#10+ 1580 | 'function '+p.Values[pbpvTypePrefix]+FPasName+'.Get'+FMembers[i].Name+ 1581 | 'Count: integer;'#13#10+ 1582 | 'begin'#13#10+ 1583 | ' Result := Length(F'+FMembers[i].Name+');'#13#10+ 1584 | 'end;'#13#10#13#10+ 1585 | 'procedure '+p.Values[pbpvTypePrefix]+FPasName+'.'+ 1586 | p.Values[pbpvAddPrefix]+FMembers[i].Name+ 1587 | '('+s+'Value: '+FMembers[i].PascalType+');'#13#10+ 1588 | 'var'#13#10+ 1589 | ' l: integer;'#13#10+ 1590 | 'begin'#13#10+ 1591 | ' l := Length(F'+FMembers[i].Name+');'#13#10+ 1592 | ' SetLength(F'+FMembers[i].Name+', l+1);'#13#10+ 1593 | ' F'+FMembers[i].Name+'[l] := Value;'#13#10+ 1594 | 'end;'#13#10#13#10; 1595 | end; 1596 | end; 1597 | 1598 | function TProtBufMessageDescriptor.MemberByKey(Key: integer; 1599 | var FieldName, FieldType: string; var Quant, TypeNr: integer): boolean; 1600 | var 1601 | i:integer; 1602 | begin 1603 | i:=0; 1604 | while (iKey) do inc(i); 1605 | if i=FMembersIndex then Result:=false else 1606 | begin 1607 | FieldName:=FMembers[i].Name; 1608 | FieldType:=FMembers[i].TypeName; 1609 | Quant:=FMembers[i].Quant; 1610 | TypeNr:=FMembers[i].TypeNr; 1611 | Result:=true; 1612 | end; 1613 | end; 1614 | 1615 | { TProtBufEnumDescriptor } 1616 | 1617 | function TProtBufEnumDescriptor.GenerateInterface(p:TProtocolBufferParser; 1618 | Flags:TProtocolBufferParserFlags): string; 1619 | var 1620 | i,k:integer; 1621 | b:boolean; 1622 | m:string; 1623 | begin 1624 | //TODO: switch between enum, const 1625 | Result:=' '+p.Values[pbpvTypePrefix]+FPasName+' = ('#13#10' '; 1626 | b:=true; 1627 | k:=0; 1628 | //TODO: switch prefix enum items with enum name? 1629 | for i:=0 to FMembersIndex-1 do 1630 | begin 1631 | if b then b:=false else Result:=Result+','#13#10' '; 1632 | m:=FMembers[i].Name; 1633 | if pbpfPrependEnumFields in Flags then m:=FPasName+'_'+m;//:=FName+'_'+m;? 1634 | if k=FMembers[i].Key then 1635 | begin 1636 | Result:=Result+m; 1637 | end 1638 | else 1639 | begin 1640 | k:=FMembers[i].Key; 1641 | if k>100000 then 1642 | Result:=Result+m+' = $'+IntToHex(k,8) 1643 | else 1644 | Result:=Result+m+' = '+IntToStr(k); 1645 | end; 1646 | inc(k); 1647 | end; 1648 | Result:=Result+#13#10' );'#13#10#13#10; 1649 | end; 1650 | 1651 | function TProtBufEnumDescriptor.GenerateImplementation( 1652 | p:TProtocolBufferParser; Flags:TProtocolBufferParserFlags): string; 1653 | begin 1654 | Result:=''; 1655 | end; 1656 | 1657 | end. 1658 | 1659 | --------------------------------------------------------------------------------