Skip to content
This repository
Newer
Older
100644 1263 lines (1206 sloc) 36.295 kb
4a723c88 »
2014-04-10 unit headers
1 {
2
3 TMongoWire: bsonDoc.pas
4
5 Copyright 2010-2014 Stijn Sanders
fb8c8725 »
2014-04-11 renamed COPYING into LICENSE
6 Made available under terms described in file "LICENSE"
4a723c88 »
2014-04-10 unit headers
7 https://github.com/stijnsanders/TMongoWire
8
9 }
b263e816 » unknown
2010-12-01 main files
10 unit bsonDoc;
11
12 {$WARN SYMBOL_PLATFORM OFF}
13
14 interface
15
16 uses
17 ComObj, ActiveX, SysUtils, WinTypes;
18
19 const
20 //bsonElement
21 bsonDouble = $00000001;
22 bsonString = $00000002;
23 bsonEmbeddedDocument = $00000003;
24 bsonArray = $00000004;
25 bsonBinary = $00000005;
26 bsonObjectID = $00000007;
27 bsonBoolean = $00000008;
28 bsonUTCDateTime = $00000009;
29 bsonNULL = $0000000A;
30 bsonRegEx = $0000000B;
31 bsonJavaScriptCode = $0000000D;
32 bsonSymbol = $0000000E;
33 bsonJavaScriptCodeWithScope = $0000000F;
34 bsonInt32 = $00000010;
35 bsonTimestamp = $00000011;
36 bsonInt64 = $00000012;
37 bsonMinKey = $FFFFFFFF;
38 bsonMaxKey = $0000007F;
39
40 //bsonBinarySubType
41 bsonBinaryGeneric = $00000000;
42 bsonBinaryFunction = $00000001;
43 bsonBinaryOldBinary = $00000002;
44 bsonBinaryUUID = $00000003;
45 bsonBinaryMD5 = $00000005;
46 bsonBinaryUserDefined = $00000006;
47
48 //special prefix with unassigned(?) unicode symbols from the Special range
49 bsonJavaScriptCodePrefix:WideString=#$FFF1'bsonJavaScriptCode'#$FFF2;
459bace7 » unknown
2010-12-10 regex without IRegExp, support string prefix
50 bsonRegExPrefix:WideString=#$FFF1'bsonRegEx'#$FFF2;
51 bsonObjectIDPrefix:WideString='ObjectID("';
52 bsonObjectIDSuffix:WideString='")';
bf32f8cf »
2012-04-25 bsonObjectID issue
53 bsonObjectID_L=36;//=Length(bsonObjectIDPrefix)+24+Length(bsonObjectIDSuffix);
b263e816 » unknown
2010-12-01 main files
54
038dbecc »
2014-04-04 IBSONDocumentEnumerator
55 //COM GUID's
56 IID_IBSONDocument
57 : TGUID = '{42534F4E-0000-0001-C000-000000000001}';
58 CLASS_BSONDocument
59 : TGUID = '{42534F4E-0000-0002-C000-000000000002}';
60 IID_IBSONDocumentEnumerator
61 : TGUID = '{42534F4E-0000-0003-C000-000000000003}';
62
b263e816 » unknown
2010-12-01 main files
63 type
64 IBSONDocument = interface(IUnknown)
65 ['{42534F4E-0000-0001-C000-000000000001}']
66 function Get_Item(const Key: WideString): OleVariant; safecall;
67 procedure Set_Item(const Key: WideString; Value: OleVariant); safecall;
c1e0556e » unknown
2010-12-02 extra check Get
68 function ToVarArray:OleVariant; safecall;
b263e816 » unknown
2010-12-01 main files
69 procedure Clear; safecall;
70 property Item[const Key: WideString]: OleVariant read Get_Item write Set_Item; default;
71 end;
72
73 //TODO: ActiveX enumerator over elements
74
75 //BSON document as interfaced object allows storage in a variant variable
76 TBSONDocument = class(TInterfacedObject, IBSONDocument, IPersistStream)
77 private
78 FDirty:boolean;
f8bb5a1a »
2012-05-22 bsonDocument: persist in original sequence
79 FElementIndex,FElementSize:integer;
80 FElements:array of record
038dbecc »
2014-04-04 IBSONDocumentEnumerator
81 SortIndex,LoadIndex:integer;
b263e816 » unknown
2010-12-01 main files
82 Key:WideString;
f8bb5a1a »
2012-05-22 bsonDocument: persist in original sequence
83 Value:OleVariant;
b263e816 » unknown
2010-12-01 main files
84 end;
038dbecc »
2014-04-04 IBSONDocumentEnumerator
85 FLoadIndex,FGotIndex,FGotSorted:integer;
f8bb5a1a »
2012-05-22 bsonDocument: persist in original sequence
86 FGotMatch:boolean;
683b2001 »
2012-07-09 some bugfixes and improvements
87 function GetKeyIndex(const Key: WideString): boolean;
b263e816 » unknown
2010-12-01 main files
88 protected
89 function Get_Item(const Key: WideString): OleVariant; safecall;
90 procedure Set_Item(const Key: WideString; Value: OleVariant); safecall;
91 function GetClassID(out classID: TCLSID): HResult; stdcall;
92 function IsDirty: HResult; stdcall;
93 function GetSizeMax(out cbSize: Largeint): HResult; stdcall;
94 public
95 procedure AfterConstruction; override;
96 destructor Destroy; override;
97 function Load(const stm: IStream): HResult; stdcall;
98 function Save(const stm: IStream; fClearDirty: BOOL): HResult; stdcall;
c1e0556e » unknown
2010-12-02 extra check Get
99 function ToVarArray:OleVariant; safecall;
b263e816 » unknown
2010-12-01 main files
100 procedure Clear; safecall;
101 property Item[const Key: WideString]: OleVariant read Get_Item write Set_Item; default;
102 end;
103
104 EBSONException=class(Exception);
105
f67bc102 » unknown
2010-12-02 BSON builder
106 {
107 BSON document builder
108 pass an array of key/value-pairs,
109 use value '[' to start an embedded document,
110 and key ']' to close it.
111 example:
112 MongoWireQuery1.Query('mydb1.orders',BSON([
113 'confirmed',false,
114 '$orderby','[',
115 'created',-1,
116 ']'
117 ]);
118 }
038dbecc »
2014-04-04 IBSONDocumentEnumerator
119 function BSON: IBSONDocument; overload;
120 function BSON(x: array of OleVariant): IBSONDocument; overload;
121
122 type
123 IBSONDocumentEnumerator = interface(IUnknown)
124 ['{42534F4E-0000-0003-C000-000000000003}']
125 procedure SetStream(const stm: IStream); stdcall;
126 procedure Add(pos: int64); stdcall;
127 function GetCount: integer; stdcall;
128 function Next(const doc: IBSONDocument): boolean; stdcall;
129 procedure Skip(n: integer); safecall;
130 procedure Reset; safecall;
131 property Count: integer read GetCount;
132 end;
133
134 TBSONDocumentEnumerator = class(TInterfacedObject,
135 IBSONDocumentEnumerator)//IPersistStream?
136 private
137 FData:IStream;
138 FPos:array of int64;
139 FPosIndex,FPosSize,FPosCurrent:integer;
140 public
141 procedure AfterConstruction; override;
142 destructor Destroy; override;
143 procedure SetStream(const stm: IStream); stdcall;
144 function GetCount: integer; stdcall;
145 procedure Add(pos: int64); stdcall;
146 //Save?Dirty?
147 function Next(const doc: IBSONDocument): boolean; stdcall;
148 procedure Skip(n: integer); safecall;
149 procedure Reset; safecall;
150 end;
151
f7e5bf73 »
2014-04-04 BSONenum overload for conversion of existing value
152 function BSONEnum: IBSONDocumentEnumerator; overload;
153 function BSONEnum(const v:OleVariant): IBSONDocumentEnumerator; overload;
f67bc102 » unknown
2010-12-02 BSON builder
154
b263e816 » unknown
2010-12-01 main files
155 implementation
156
157 uses
158 Classes,
159 {$IFDEF BSON_SUPPORT_REGEX}
160 VBScript_RegExp_55_TLB,
161 {$ENDIF}
162 Variants;
163
164 const
165 BSONArrayBaseIndex=0;//1?
166 BSONDetectVarArrayType=true;
167
168 procedure TBSONDocument.AfterConstruction;
169 begin
170 inherited;
171 FDirty:=false;
172 FElementIndex:=0;
173 FElementSize:=0;
f8bb5a1a »
2012-05-22 bsonDocument: persist in original sequence
174 FGotIndex:=0;
175 FGotSorted:=0;
176 FGotMatch:=false;
038dbecc »
2014-04-04 IBSONDocumentEnumerator
177 FLoadIndex:=0;
b263e816 » unknown
2010-12-01 main files
178 end;
179
180 destructor TBSONDocument.Destroy;
181 var
182 i:integer;
183 begin
f8bb5a1a »
2012-05-22 bsonDocument: persist in original sequence
184 for i:=0 to FElementIndex-1 do VarClear(FElements[i].Value);
b263e816 » unknown
2010-12-01 main files
185 inherited;
186 end;
187
188 function TBSONDocument.GetSizeMax(out cbSize: Largeint): HResult;
189 begin
190 //TODO: calculate total size
191 raise EInvalidOperation.Create('Not implemented');
192 end;
193
683b2001 »
2012-07-09 some bugfixes and improvements
194 function TBSONDocument.GetKeyIndex(const Key: WideString):boolean;
b263e816 » unknown
2010-12-01 main files
195 var
f8bb5a1a »
2012-05-22 bsonDocument: persist in original sequence
196 a,b,c,d,x:integer;
b263e816 » unknown
2010-12-01 main files
197 begin
198 //case sensitivity?
199 //check last getindex, speeds up set right after get
f8bb5a1a »
2012-05-22 bsonDocument: persist in original sequence
200 if FGotMatch and (CompareStr(Key,FElements[FGotIndex].Key)=0) then
b263e816 » unknown
2010-12-01 main files
201 begin
f8bb5a1a »
2012-05-22 bsonDocument: persist in original sequence
202 //assert FGotIndex=FSorted[FGotSorted];
203 Result:=true;
b263e816 » unknown
2010-12-01 main files
204 end
205 else
206 begin
207 a:=0;
208 b:=FElementIndex-1;
f8bb5a1a »
2012-05-22 bsonDocument: persist in original sequence
209 d:=FElementIndex;
210 FGotMatch:=false;//default
b263e816 » unknown
2010-12-01 main files
211 while b>=a do
212 begin
213 c:=(a+b) div 2;
038dbecc »
2014-04-04 IBSONDocumentEnumerator
214 d:=FElements[c].SortIndex;
b263e816 » unknown
2010-12-01 main files
215 //if c=a? c=b?
f8bb5a1a »
2012-05-22 bsonDocument: persist in original sequence
216 x:=CompareStr(Key,FElements[d].Key);
b263e816 » unknown
2010-12-01 main files
217 if x=0 then
218 begin
219 a:=c;
220 b:=c-1;
f8bb5a1a »
2012-05-22 bsonDocument: persist in original sequence
221 FGotMatch:=true;
b263e816 » unknown
2010-12-01 main files
222 end
223 else
224 if x<0 then
225 if b=c then dec(b) else b:=c
226 else
227 if a=c then inc(a) else a:=c;
228 end;
f8bb5a1a »
2012-05-22 bsonDocument: persist in original sequence
229 FGotSorted:=a;
230 FGotIndex:=d;
231 Result:=FGotMatch;
b263e816 » unknown
2010-12-01 main files
232 end;
233 end;
234
235 function TBSONDocument.Get_Item(const Key: WideString): OleVariant;
236 begin
038dbecc »
2014-04-04 IBSONDocumentEnumerator
237 if GetKeyIndex(Key) and (FElements[FGotIndex].LoadIndex=FLoadIndex) then
238 Result:=FElements[FGotIndex].Value
239 else
240 Result:=Null;
b263e816 » unknown
2010-12-01 main files
241 end;
242
243 procedure TBSONDocument.Set_Item(const Key: WideString; Value: OleVariant);
244 var
f8bb5a1a »
2012-05-22 bsonDocument: persist in original sequence
245 i:integer;
b263e816 » unknown
2010-12-01 main files
246 const
247 GrowStep=$20;//not too much, not too little (?)
248 begin
72ad0ac0 »
2012-06-23 bson to/from json
249 //if ((VarType(Value) and varArray)<>0) and (VarArrayDimCount(v)>1) then
250 // raise EBSONException.Create('VarArray: multi-dimensional arrays not supported');
f8bb5a1a »
2012-05-22 bsonDocument: persist in original sequence
251 if not GetKeyIndex(Key) then
b263e816 » unknown
2010-12-01 main files
252 begin
253 if FElementIndex=FElementSize then
254 begin
255 inc(FElementSize,GrowStep);
f8bb5a1a »
2012-05-22 bsonDocument: persist in original sequence
256 SetLength(FElements,FElementSize);
b263e816 » unknown
2010-12-01 main files
257 end;
038dbecc »
2014-04-04 IBSONDocumentEnumerator
258 for i:=FElementIndex-1 downto FGotSorted do
259 FElements[i+1].SortIndex:=FElements[i].SortIndex;
260 FGotIndex:=FElementIndex;
b263e816 » unknown
2010-12-01 main files
261 inc(FElementIndex);
038dbecc »
2014-04-04 IBSONDocumentEnumerator
262 FElements[FGotSorted].SortIndex:=FGotIndex;
263 FElements[FGotIndex].LoadIndex:=FLoadIndex;
72ad0ac0 »
2012-06-23 bson to/from json
264 FElements[FGotIndex].Key:=Key;
b263e816 » unknown
2010-12-01 main files
265 end;
f8bb5a1a »
2012-05-22 bsonDocument: persist in original sequence
266 FElements[FGotIndex].Value:=Value;
b263e816 » unknown
2010-12-01 main files
267 //TODO: if VarType(Value)=varEmpty then drop element
268 FDirty:=true;
269 end;
270
271 function TBSONDocument.IsDirty: HResult;
272 begin
273 if FDirty then Result:=S_OK else Result:=S_FALSE;
274 end;
275
276 function TBSONDocument.Load(const stm: IStream): HResult;
277 var
278 i,lstart,ltotal,ltmax:integer;
279 procedure stmRead(p:pointer;s:integer);
280 var
281 l:integer;
282 begin
283 OleCheck(stm.Read(p,s,@l));
683b2001 »
2012-07-09 some bugfixes and improvements
284 if l<>s then
285 raise EBSONException.Create('Unexpected end of stream');
b263e816 » unknown
2010-12-01 main files
286 inc(ltotal,s);
683b2001 »
2012-07-09 some bugfixes and improvements
287 if ltotal>ltmax then
288 raise EBSONException.Create('More BSON data than declared');
b263e816 » unknown
2010-12-01 main files
289 end;
038dbecc »
2014-04-04 IBSONDocumentEnumerator
290 var //outside of stmReadCString to recycle memory
291 ss:AnsiString;
292 sx,sl:integer;
293 function stmReadCString: WideString;
b263e816 » unknown
2010-12-01 main files
294 var
295 c:AnsiChar;
296 begin
297 sx:=0;
298 stmRead(@c,1);
299 while c<>#0 do
300 begin
301 if sx=sl then
302 begin
038dbecc »
2014-04-04 IBSONDocumentEnumerator
303 inc(sl,$100);//grow in steps
304 SetLength(ss,sl);
b263e816 » unknown
2010-12-01 main files
305 end;
306 inc(sx);
038dbecc »
2014-04-04 IBSONDocumentEnumerator
307 ss[sx]:=c;
b263e816 » unknown
2010-12-01 main files
308 stmRead(@c,1);
309 end;
038dbecc »
2014-04-04 IBSONDocumentEnumerator
310 Result:=UTF8Decode(Copy(ss,1,sx));
b263e816 » unknown
2010-12-01 main files
311 end;
038dbecc »
2014-04-04 IBSONDocumentEnumerator
312 function stmReadString: WideString;
b263e816 » unknown
2010-12-01 main files
313 var
314 l:integer;
315 s:AnsiString;
316 begin
317 stmRead(@l,4);
04ed2a42 »
2010-12-14 issue save/load strings
318 if l=1 then s:='' else
319 begin
320 SetLength(s,l-1);
321 stmRead(@s[1],l-1);
322 end;
b263e816 » unknown
2010-12-01 main files
323 //read closing null
324 l:=0;
325 stmRead(@l,1);
683b2001 »
2012-07-09 some bugfixes and improvements
326 if l<>0 then
327 raise EBSONException.Create('BSON string incorrectly terminated at offset '+IntToHex(lstart,8));
b263e816 » unknown
2010-12-01 main files
328 Result:=UTF8Decode(s);
329 end;
330 {$IFDEF BSON_SUPPORT_REGEX}
038dbecc »
2014-04-04 IBSONDocumentEnumerator
331 function stmReadRegEx: IRegExp2;
b263e816 » unknown
2010-12-01 main files
332 var
333 i:integer;
334 s:string;
335 begin
336 Result:=CoRegExp.Create;
337 REsult.Pattern:=stmReadCString;
338 s:=stmReadCString;
339 for i:=1 to Length(s)-1 do
340 case s[i] of
341 'i','I':Result.IgnoreCase:=true;
342 'm','M':Result.Multiline:=true;
343 'g','G':Result.Global:=true;
344 //'x','X':;//verbose
345 //'l','L':;//locale
346 //'s','S':;//dotall
347 //'u','U':;//unicode
348 else raise EBSONException.Create('Unsupported regex option "'+s+'" at offset '+IntToHex(lstart,8));
349 end;
350 end;
351 {$ENDIF}
038dbecc »
2014-04-04 IBSONDocumentEnumerator
352 function stmReadBSONDocument(ReuseDoc:boolean; var vv:OleVariant): boolean;
2a45a53b » unknown
2010-12-03 red embedded BSON doc bug
353 var
354 p1,p2:int64;
355 d:TBSONDocument;
038dbecc »
2014-04-04 IBSONDocumentEnumerator
356 dd:IBSONDocument;
2a45a53b » unknown
2010-12-03 red embedded BSON doc bug
357 begin
358 OleCheck(stm.Seek(0,soFromCurrent,p1));
038dbecc »
2014-04-04 IBSONDocumentEnumerator
359 if ReuseDoc and (VarType(FElements[FGotIndex].Value)=varUnknown) and
360 (IUnknown(FElements[FGotIndex].Value).QueryInterface(IID_IBSONDocument,dd)=S_OK) then
361 begin
362 (dd as IPersistStream).Load(stm);
363 Result:=true;
364 end
365 else
366 begin
367 d:=TBSONDocument.Create;
368 try
369 d.Load(stm);
370 vv:=(d as IBSONDocument);
371 except //not finally!
372 d.Free;
373 raise;
374 end;
375 Result:=false;
376 end;
2a45a53b » unknown
2010-12-03 red embedded BSON doc bug
377 OleCheck(stm.Seek(0,soFromCurrent,p2));
378 inc(ltotal,p2-p1);
379 end;
038dbecc »
2014-04-04 IBSONDocumentEnumerator
380 function stmReadBSONDocArray(const v:OleVariant): boolean;
381 var
382 e:IBSONDocumentEnumerator;
383 p:int64;
384 l:integer;
385 n:WideString;
386 begin
387 if (VarType(v)=varUnknown) and
388 (IUnknown(v).QueryInterface(IID_IBSONDocumentEnumerator,e)=S_OK) then
389 begin
390 e.SetStream(stm);
391 repeat
392 OleCheck(stm.Seek(0,soFromCurrent,p));
393 e.Add(p);
394 stmRead(@l,4);
395 dec(l,4);
396 OleCheck(stm.Seek(l,soFromCurrent,p));
397 inc(ltotal,l);
398 l:=0;
399 stmRead(@l,1);
400 if l=0 then n:='' else
401 begin
402 if l<>bsonEmbeddedDocument then
403 raise EBSONException.Create('Can''t mix documents and non-documents with IBSONDocumentEnumerator');
404 n:=stmReadCString;
405 //assert n=IntToStr(e.Count);
406 end;
407 until n='';
408 Result:=true;
409 end
410 else
411 Result:=false;
412 end;
b263e816 » unknown
2010-12-01 main files
413 var
414 j:integer;
415 v:OleVariant;
416 k:WideString;
7ff6d2bf »
2013-11-01 accessviolation on TGUID (thank you brandonhamilton)
417 o:array[0..15] of byte;
b263e816 » unknown
2010-12-01 main files
418 ii:int64 absolute o;
419 dd:double absolute o;
420 pp:pointer absolute o;
421 gg:TGUID absolute o;
422 vindex:integer;
423 vstack:array of record
424 vkey:WideString;
425 vv:array of OleVariant;
426 vl,vi,vlength,vstart:integer;
427 vt:TVarType;
428 end;
429 const
430 hex:array[0..15] of char='0123456789abcdef';
d36094b2 »
2012-04-09 Issue with nested arrays (thank you fabriciocolombo)
431 vstackValuesGrowStep=$100;
b263e816 » unknown
2010-12-01 main files
432 begin
038dbecc »
2014-04-04 IBSONDocumentEnumerator
433 stm._AddRef;
434 try
435 inc(FLoadIndex);
436 sl:=0;
437 ltotal:=0;
438 lstart:=0;
439 ltmax:=4;
440 stmRead(@ltMax,4);
441 vindex:=-1;
442 SetLength(vstack,0);
b263e816 » unknown
2010-12-01 main files
443
038dbecc »
2014-04-04 IBSONDocumentEnumerator
444 while ltotal<ltmax do
b263e816 » unknown
2010-12-01 main files
445 begin
038dbecc »
2014-04-04 IBSONDocumentEnumerator
446 i:=0;
447 lstart:=ltotal;
448 stmRead(@i,1);
449 if i=0 then //end of document
b263e816 » unknown
2010-12-01 main files
450 begin
038dbecc »
2014-04-04 IBSONDocumentEnumerator
451 if vindex=-1 then
452 begin
453 if ltotal<>ltmax then
454 raise EBSONException.Create('Less BSON data than declared');
455 end
b263e816 » unknown
2010-12-01 main files
456 else
d36094b2 »
2012-04-09 Issue with nested arrays (thank you fabriciocolombo)
457 begin
038dbecc »
2014-04-04 IBSONDocumentEnumerator
458 if ltotal-vstack[vindex].vstart>vstack[vindex].vlength then
459 raise EBSONException.Create('More BSON array data than declared at offset '+IntToHex(lstart,8));
460 SetLength(vstack[vindex].vv,vstack[vindex].vi);
461 //create variant array of variant (from pascal array of variant)
462 v:=VarArrayCreate([BSONArrayBaseIndex,vstack[vindex].vi-1+BSONArrayBaseIndex],vstack[vindex].vt);
463 for j:=0 to vstack[vindex].vi-1 do v[j]:=vstack[vindex].vv[j];
464 //store item
465 if vindex=0 then
466 Set_Item(vstack[vindex].vkey,v)
467 else
d36094b2 »
2012-04-09 Issue with nested arrays (thank you fabriciocolombo)
468 begin
038dbecc »
2014-04-04 IBSONDocumentEnumerator
469 i:=vindex-1;
470 if vstack[i].vi=vstack[i].vl then
b263e816 » unknown
2010-12-01 main files
471 begin
038dbecc »
2014-04-04 IBSONDocumentEnumerator
472 inc(vstack[i].vl,vstackValuesGrowStep);//grow in steps
473 SetLength(vstack[i].vv,vstack[i].vl);
b263e816 » unknown
2010-12-01 main files
474 end;
038dbecc »
2014-04-04 IBSONDocumentEnumerator
475 vstack[i].vv[vstack[i].vi]:=v;
476 inc(vstack[i].vi);
477 end;
478 //pop from array stack
479 SetLength(vstack[vindex].vv,0);
480 dec(vindex);
481 //SetLength(vstack,vindex);
b263e816 » unknown
2010-12-01 main files
482 end;
038dbecc »
2014-04-04 IBSONDocumentEnumerator
483 end
b263e816 » unknown
2010-12-01 main files
484 else
038dbecc »
2014-04-04 IBSONDocumentEnumerator
485 begin
486 k:=stmReadCString;
487 v:=Null;//VarClear
488 //TODO: store value somewhere?
489 case i of
490 bsonDouble:
491 begin
492 stmRead(@dd,8);
493 v:=dd;
494 end;
495 bsonString:
496 v:=stmReadString;
497 bsonEmbeddedDocument:
498 if (vindex=0) and GetKeyIndex(vstack[vindex].vkey) and
499 stmReadBSONDocArray(FElements[FGotIndex].Value) then
500 vindex:=-2 //see below
501 else
502 if stmReadBSONDocument((vindex=-1) and GetKeyIndex(k),v) then
503 vindex:=-2;//see below
504 bsonArray:
505 begin
506 //push onto array stack
507 inc(vindex);
508 SetLength(vstack,vindex+1);
509 vstack[vindex].vkey:=k;
510 vstack[vindex].vi:=-1;
511 vstack[vindex].vl:=0;
512 vstack[vindex].vstart:=ltotal;
513 vstack[vindex].vt:=varVariant;//default, see BSONDetectVarArrayType below
514 stmRead(@vstack[vindex].vlength,4);//array document length
515 end;
516 bsonBinary:
517 begin
518 stmRead(@i,4);
519 stmRead(@o[11],1);
520 //TODO: store value somewhere?
521 case o[11] of
522 bsonBinaryGeneric,bsonBinaryOldBinary,bsonBinaryUserDefined:
523 begin
524 //
525 v:=VarArrayCreate([BSONArrayBaseIndex,i-1+BSONArrayBaseIndex],varByte);
526 pp:=VarArrayLock(v);
527 try
528 stmRead(pp,i);
529 finally
530 VarArrayUnlock(v);
531 end;
532 end;
533 bsonBinaryFunction:
534 begin
535 //TODO
536 raise EInvalidOperation.Create('Not Implemented');
537 end;
538 bsonBinaryUUID:
539 begin
540 if i<>16 then
541 raise EBSONException.Create('Unexpected UUID length ('+
542 IntToStr(i)+') at offset '+IntToHex(lstart,8));
543 stmRead(@gg,16);
544 //TODO try to rig into varStrArg
545 v:=GUIDToString(gg);
546 end;
547 bsonBinaryMD5:
548 begin
549 //TODO
550 raise EInvalidOperation.Create('Not Implemented');
551 end;
552 else
553 raise EBSONException.Create('Unknown BSON binary type '+
554 IntToHex(o[11],2)+' at offset '+IntToHex(lstart,8));
555 end;
556 end;
557 bsonObjectID:
558 begin
559 stmRead(@o[0],12);
560 v:=bsonObjectIDPrefix+
561 hex[o[00] shr 4]+hex[o[00] and $F]+
562 hex[o[01] shr 4]+hex[o[01] and $F]+
563 hex[o[02] shr 4]+hex[o[02] and $F]+
564 hex[o[03] shr 4]+hex[o[03] and $F]+
565 hex[o[04] shr 4]+hex[o[04] and $F]+
566 hex[o[05] shr 4]+hex[o[05] and $F]+
567 hex[o[06] shr 4]+hex[o[06] and $F]+
568 hex[o[07] shr 4]+hex[o[07] and $F]+
569 hex[o[08] shr 4]+hex[o[08] and $F]+
570 hex[o[09] shr 4]+hex[o[09] and $F]+
571 hex[o[10] shr 4]+hex[o[10] and $F]+
572 hex[o[11] shr 4]+hex[o[11] and $F]+
573 bsonObjectIDSuffix;
574 end;
575 bsonBoolean:
576 begin
577 i:=0;
578 stmRead(@i,1);
579 v:=boolean(i<>0);
580 end;
581 bsonUTCDateTime:
582 begin
583 stmRead(@ii,8);
584 v:=VarFromDateTime(ii/MSecsPerDay+UnixDateDelta);
585 end;
586 bsonNULL:;//v:=Null;
587 bsonRegEx:
588 {$IFDEF BSON_SUPPORT_REGEX}
589 v:=stmReadRegEx;
590 {$ELSE}
591 v:=bsonRegExPrefix+'/'+stmReadCString+'/'+stmReadCString;
592 {$ENDIF}
593 bsonJavaScriptCode:
594 v:=bsonJavaScriptCodePrefix+stmReadString;//TODO: find active script interface?
595 bsonSymbol:
596 v:=stmReadString;//?
597 bsonJavaScriptCodeWithScope:
598 begin
599 //TODO
600 raise EInvalidOperation.Create('Not Implemented');
601 end;
602 bsonInt32:
603 begin
604 stmRead(@i,4);
605 v:=i;
606 end;
607 bsonTimestamp:
608 begin
609 stmRead(@ii,8);
610 v:=ii;//convert?
611 end;
612 bsonInt64:
613 begin
614 stmRead(@ii,8);
615 v:=ii;
616 end;
617 else
618 raise EBSONException.Create('Unknown BSON element type '+
619 IntToHex(i,2)+' at offset '+IntToHex(lstart,8));
620 end;
621 if vindex=-1 then
622 Set_Item(k,v) //add the element
623 else if vindex=-2 then
624 vindex:=-1 //see stmReadBSONDocument,stmReadBSONDocument above
b263e816 » unknown
2010-12-01 main files
625 else
038dbecc »
2014-04-04 IBSONDocumentEnumerator
626 if vstack[vindex].vi=-1 then
627 vstack[vindex].vi:=0 //just starting
628 else
b263e816 » unknown
2010-12-01 main files
629 begin
038dbecc »
2014-04-04 IBSONDocumentEnumerator
630 if vstack[vindex].vi=vstack[vindex].vl then
631 begin
632 inc(vstack[vindex].vl,vstackValuesGrowStep);//grow in steps
633 SetLength(vstack[vindex].vv,vstack[vindex].vl);
634 end;
635 if k<>IntToStr(vstack[vindex].vi) then
636 raise EBSONException.Create('Unexpected BSON array index key: "'+k+'"<>"'+
637 IntToStr(vstack[vindex].vi)+'" at offset '+IntToHex(lstart,8));
638 vstack[vindex].vv[vstack[vindex].vi]:=v;
639 if BSONDetectVarArrayType then
640 if vstack[vindex].vi=0 then vstack[vindex].vt:=VarType(v) else
641 if (vstack[vindex].vt<>varVariant) and (vstack[vindex].vt<>VarType(v)) then
642 vstack[vindex].vt:=varVariant;
643 inc(vstack[vindex].vi);
b263e816 » unknown
2010-12-01 main files
644 end;
038dbecc »
2014-04-04 IBSONDocumentEnumerator
645 end;
b263e816 » unknown
2010-12-01 main files
646 end;
038dbecc »
2014-04-04 IBSONDocumentEnumerator
647 finally
648 stm._Release;
649 end;
b263e816 » unknown
2010-12-01 main files
650 FDirty:=false;
651 Result:=S_OK;
652 //TODO: try except Result:=E_?
653 end;
654
655 function TBSONDocument.Save(const stm: IStream;
656 fClearDirty: BOOL): HResult;
657 var
658 lstart,lx:Int64;
659 ltotal,li,xi:integer;
660 procedure stmWrite(p:pointer;s:integer);
661 var
662 l:integer;
663 begin
664 OleCheck(stm.Write(p,s,@l));
665 if l<>s then raise EBSONException.Create('Failed to write data to stream');
666 inc(ltotal,s);
667 end;
683b2001 »
2012-07-09 some bugfixes and improvements
668 procedure stmWriteCString(const s:WideString);
b263e816 » unknown
2010-12-01 main files
669 var
670 sx:UTF8String;
671 sl:integer;
672 begin
673 sx:=UTF8Encode(s);
674 sl:=Length(sx);
675 //sx:=sx+#0;
58e96e62 »
2010-12-14 empty string issue
676 if sl=0 then
677 stmWrite(@sl,1)
678 else
679 stmWrite(@sx[1],sl+1);
b263e816 » unknown
2010-12-01 main files
680 end;
683b2001 »
2012-07-09 some bugfixes and improvements
681 procedure stmWriteString(const s:WideString);
b263e816 » unknown
2010-12-01 main files
682 var
683 sx:UTF8String;
684 sl:integer;
685 begin
686 sx:=UTF8Encode(s);
687 sl:=Length(sx);
688 inc(sl);
689 stmWrite(@sl,4);
690 //sx:=sx+#0;
58e96e62 »
2010-12-14 empty string issue
691 if sl=1 then
692 begin
693 sl:=0;
04ed2a42 »
2010-12-14 issue save/load strings
694 stmWrite(@sl,1);
58e96e62 »
2010-12-14 empty string issue
695 end
696 else
697 stmWrite(@sx[1],sl);
b263e816 » unknown
2010-12-01 main files
698 end;
699 var
700 uu:IUnknown;
701 key:WideString;
702 function TryWriteBSONDocument:boolean;
703 var
704 i:integer;
705 ii,jj:int64;
706 di:IBSONDocument;
707 begin
708 Result:=uu.QueryInterface(IID_IBSONDocument,di)=S_OK;
709 if Result then
710 begin
711 i:=bsonEmbeddedDocument;
712 stmWrite(@i,1);
713 stmWriteCString(key);
714 OleCheck(stm.Seek(0,soFromCurrent,ii));
715 OleCheck((di as IPersistStream).Save(stm,fClearDirty));
716 OleCheck(stm.Seek(0,soFromCurrent,jj));
717 inc(ltotal,jj-ii);
718 end;
719 end;
1ca14adf »
2014-04-04 raise save IBSONDocumentEnumerator not implemented
720 function TryWriteBSONDocumentEnumerator:boolean;
721 var
722 di:IBSONDocumentEnumerator;
723 begin
724 Result:=uu.QueryInterface(IID_IBSONDocumentEnumerator,di)=S_OK;
725 if Result then
726 begin
727 raise EBSONException.Create('Save IBSONDocumentEnumerator not implemented');
728 //TODO: write documents (were any dirty?)
729 end;
730 end;
b263e816 » unknown
2010-12-01 main files
731 {$IFDEF BSON_SUPPORT_REGEX}
732 function TryWriteRegExp:boolean;
733 var
734 i:integer;
735 w:WideString;
736 r:IRegExp2;
737 begin
738 Result:=uu.QueryInterface(IID_IRegExp2,r)=S_OK;
739 if Result then
740 begin
741 i:=bsonRegEx;
742 stmWrite(@i,1);
743 stmWriteCString(key);
744 stmWriteCString(r.Pattern);
745 w:='';
746 if r.Global then w:=w+'g';
747 if r.IgnoreCase then w:=w+'i';
748 if r.Multiline then w:=w+'m';
749 //TODO: other regex flags
750 stmWriteCString(w);
751 end;
752 end;
753 {$ENDIF}
754 function TryWriteStream:boolean;
755 const
756 dSize=$10000;
757 IID_IStream:TGUID='{0000000C-0000-0000-C000-000000000046}';
758 var
759 i,j:integer;
760 ii,jj:int64;
761 ss:IStream;
762 d:array[0..dSize-1] of byte;
763 begin
764 Result:=uu.QueryInterface(IID_IStream,ss)=S_OK;
765 if Result then
766 begin
767 i:=bsonBinary;
14698dda »
2011-11-02 bsonDoc: big bug with binary data (makes mongo.exe crash!)
768 stmWrite(@i,1);
b263e816 » unknown
2010-12-01 main files
769 stmWriteCString(key);
770 //seek end to know full size
771 OleCheck(ss.Seek(0,soFromEnd,ii));
772 //TODO: check less than 2GB
773 //seek start for copying
774 OleCheck(ss.Seek(0,soFromBeginning,jj));
775 stmWrite(@ii,4);
776 i:=bsonBinaryGeneric;
777 stmWrite(@i,1);
778 inc(ltotal,ii);
779 while ii<>0 do
780 begin
781 OleCheck(ss.Read(@d[0],dSize,@i));
782 if i=0 then raise EBSONException.Create('Failed to read from IStream');
783 OleCheck(stm.Write(@d[0],i,@j));
784 if i<>j then raise EBSONException.Create('Failed to write data to stream');
785 dec(ii,i);
786 end;
787 end;
788 end;
789 function TryWritePersistStream:boolean;
790 const
791 IID_IPersistStream:TGUID='{00000109-0000-0000-C000-000000000046}';
792 var
793 i,j:integer;
794 ii,jj:int64;
795 ps:IPersistStream;
796 begin
797 Result:=uu.QueryInterface(IID_IPersistStream,ps)=S_OK;
798 if Result then
799 begin
800 i:=bsonBinary;
14698dda »
2011-11-02 bsonDoc: big bug with binary data (makes mongo.exe crash!)
801 stmWrite(@i,1);
b263e816 » unknown
2010-12-01 main files
802 stmWriteCString(key);
803 OleCheck(stm.Seek(0,soFromCurrent,ii));
804 i:=0;//fill in later
805 stmWrite(@i,4);
806 i:=bsonBinaryGeneric;
807 stmWrite(@i,1);
808 ps.Save(stm,false);
809 //fill in length
810 OleCheck(stm.Seek(0,soFromCurrent,jj));
811 i:=jj-ii-5;
812 OleCheck(stm.Seek(0,soFromBeginning,ii));
813 OleCheck(stm.Write(@i,4,@j));
814 //assert j=4
815 OleCheck(stm.Seek(0,soFromBeginning,jj));
816 end;
817 end;
683b2001 »
2012-07-09 some bugfixes and improvements
818 function StartsWith(const a,b:WideString):boolean;
bf32f8cf »
2012-04-25 bsonObjectID issue
819 var
820 i,l1,l2:integer;
821 begin
822 i:=1;
823 l1:=Length(a);
824 l2:=Length(b);
825 while (i<=l1) and (i<=l2) and (a[i]=b[i]) do inc(i);
826 Result:=i=l2+1;
827 end;
b263e816 » unknown
2010-12-01 main files
828 var
829 vt:TVarType;
bf32f8cf »
2012-04-25 bsonObjectID issue
830 w:WideString;
831 i,j,wl:integer;
b263e816 » unknown
2010-12-01 main files
832 v:OleVariant;
7ff6d2bf »
2013-11-01 accessviolation on TGUID (thank you brandonhamilton)
833 o:array[0..15] of byte;
834 ii:int64 absolute o;
b263e816 » unknown
2010-12-01 main files
835 gg:TGUID absolute o;
836 dd:double absolute o;
837 pp:pointer absolute o;
838 bb:byte;
839 IsArray:boolean;
840 vindex:integer;
841 vstack:array of record
842 vv:OleVariant;
843 vstart,vi,v1,v2:integer;
844 end;
845 begin
038dbecc »
2014-04-04 IBSONDocumentEnumerator
846 stm._AddRef;
847 try
848 OleCheck(stm.Seek(0,soFromCurrent,lstart));
849 ltotal:=0;
850 i:=0;//write now, fill in later
851 stmWrite(@i,4);
b263e816 » unknown
2010-12-01 main files
852
038dbecc »
2014-04-04 IBSONDocumentEnumerator
853 vindex:=-1;
854 xi:=0;
3962a6c7 »
2014-04-04 TBSONDocument Save,ToVarArray check LoadIndex
855 while (xi<FElementIndex) and (FElements[xi].LoadIndex<>FLoadIndex) do inc(xi);
038dbecc »
2014-04-04 IBSONDocumentEnumerator
856 while (xi<FElementIndex) or (vindex>=0) do
b263e816 » unknown
2010-12-01 main files
857 begin
038dbecc »
2014-04-04 IBSONDocumentEnumerator
858 if vindex=-1 then
859 begin
860 key:=FElements[xi].Key;
861 v:=FElements[xi].Value;
862 inc(xi);
3962a6c7 »
2014-04-04 TBSONDocument Save,ToVarArray check LoadIndex
863 while (xi<FElementIndex) and (FElements[xi].LoadIndex<>FLoadIndex) do inc(xi);
038dbecc »
2014-04-04 IBSONDocumentEnumerator
864 end
865 else
866 begin
867 key:=IntToStr(vstack[vindex].vi-vstack[vindex].v1);
868 v:=vstack[vindex].vv[vstack[vindex].vi];
869 inc(vstack[vindex].vi);
870 end;
b263e816 » unknown
2010-12-01 main files
871
038dbecc »
2014-04-04 IBSONDocumentEnumerator
872 vt:=VarType(v);
873 IsArray:=(vt and varArray)<>0;
874 if IsArray then
875 if VarArrayDimCount(v)>1 then
876 raise EInvalidOperation.Create('VarArray: multi-dimensional arrays not supported');//TODO:
877 if (vt and varByRef)<>0 then
878 raise EInvalidOperation.Create('VarByRef: not implemented');//TODO: arrays!!!
b263e816 » unknown
2010-12-01 main files
879
038dbecc »
2014-04-04 IBSONDocumentEnumerator
880 if IsArray and ((vt and varTypeMask)=varByte) then
881 begin
882 i:=bsonBinary;
883 stmWrite(@i,1);
884 stmWriteCString(key);
885 j:=VarArrayHighBound(v,1)-VarArrayLowBound(v,1);
886 stmWrite(@j,4);
887 i:=bsonBinaryGeneric;
888 stmWrite(@i,1);
889 pp:=VarArrayLock(v);
890 try
891 stmWrite(pp,j);
892 finally
893 VarArrayUnlock(v);
894 end;
895 end
896 else
897 if IsArray then
898 begin
899 //push onto array stack
900 inc(vindex);
901 SetLength(vstack,vindex+1);
902 vstack[vindex].vv:=v;
903 vstack[vindex].v1:=VarArrayLowBound(v,1);
904 vstack[vindex].v2:=VarArrayHighBound(v,1);
905 vstack[vindex].vi:=vstack[vindex].v1;
906 i:=bsonArray;
907 stmWrite(@i,1);
908 stmWriteCString(key);
909 vstack[vindex].vstart:=ltotal;
910 i:=0;
911 stmWrite(@i,4);//don't know total length now, filled in later
912 end
913 else
914 begin
b263e816 » unknown
2010-12-01 main files
915
038dbecc »
2014-04-04 IBSONDocumentEnumerator
916 //TODO: re-use stored bson type? if any?
917 case vt and varTypeMask of
918 //varEmpty?
919 varNull:
b263e816 » unknown
2010-12-01 main files
920 begin
3962a6c7 »
2014-04-04 TBSONDocument Save,ToVarArray check LoadIndex
921 {
038dbecc »
2014-04-04 IBSONDocumentEnumerator
922 i:=bsonNULL;
b263e816 » unknown
2010-12-01 main files
923 stmWrite(@i,1);
924 stmWriteCString(key);
3962a6c7 »
2014-04-04 TBSONDocument Save,ToVarArray check LoadIndex
925 }
038dbecc »
2014-04-04 IBSONDocumentEnumerator
926 end;
927 varSmallint,varInteger,varShortInt,varByte,varWord,varLongWord:
928 begin
929 i:=bsonInt32;
b263e816 » unknown
2010-12-01 main files
930 stmWrite(@i,1);
038dbecc »
2014-04-04 IBSONDocumentEnumerator
931 stmWriteCString(key);
932 i:=v;
933 stmWrite(@i,4);
934 end;
935 varInt64:
b263e816 » unknown
2010-12-01 main files
936 begin
038dbecc »
2014-04-04 IBSONDocumentEnumerator
937 i:=bsonInt64;
b263e816 » unknown
2010-12-01 main files
938 stmWrite(@i,1);
939 stmWriteCString(key);
038dbecc »
2014-04-04 IBSONDocumentEnumerator
940 ii:=v;
941 stmWrite(@ii,8);
942 //TODO: detect bsonTimestamp?
943 end;
944 varSingle,varDouble,varCurrency:
b263e816 » unknown
2010-12-01 main files
945 begin
038dbecc »
2014-04-04 IBSONDocumentEnumerator
946 i:=bsonDouble;
b263e816 » unknown
2010-12-01 main files
947 stmWrite(@i,1);
948 stmWriteCString(key);
038dbecc »
2014-04-04 IBSONDocumentEnumerator
949 dd:=v;
950 stmWrite(@dd,8);
951 end;
952 varDate:
459bace7 » unknown
2010-12-10 regex without IRegExp, support string prefix
953 begin
038dbecc »
2014-04-04 IBSONDocumentEnumerator
954 i:=bsonUTCDateTime;
459bace7 » unknown
2010-12-10 regex without IRegExp, support string prefix
955 stmWrite(@i,1);
956 stmWriteCString(key);
038dbecc »
2014-04-04 IBSONDocumentEnumerator
957 ii:=Round((VarToDateTime(v)-UnixDateDelta)*MSecsPerDay);
958 stmWrite(@ii,8);
959 end;
960 varOleStr:
961 begin
962 //detect GUID //TODO try to rig varStrArg
963 w:=VarToWideStr(v);
964 wl:=Length(w);
965 if (wl=38) and (w[1]='{') and (w[38]='}')
966 and (w[10]='-') and (w[15]='-')
967 and (w[20]='-') and (w[25]='-') then //and the other are hex digits?
968 begin
969 //assume UUID
970 gg:=StringToGUID(w);
971 i:=bsonBinary;
972 stmWrite(@i,1);
973 stmWriteCString(key);
974 i:=16;//SizeOf(TGUID);
975 stmWrite(@i,4);
976 i:=bsonBinaryUUID;
977 stmWrite(@i,1);
978 stmWrite(@gg,16);
979 end
980 else
981 //detect objectID
982 if (wl=bsonObjectID_L) and StartsWith(w,bsonObjectIDPrefix) then //and the other are hex digits?
983 begin
984 i:=bsonObjectID;
985 stmWrite(@i,1);
986 stmWriteCString(key);
987 j:=Length(bsonObjectIDPrefix)+1;
988 for i:=0 to 11 do
989 begin
990 bb:=byte(AnsiChar(w[j+i*2]));
991 if (bb and $F0)=$30 then o[i]:=bb shl 4 else o[i]:=(9+bb) shl 4;
992 bb:=byte(AnsiChar(w[j+i*2+1]));
993 if (bb and $F0)=$30 then inc(o[i],bb and $F) else inc(o[i],(9+bb) and $F);
994 end;
995 stmWrite(@o[0],12);
996 end
997 else
998 //detect javascript
999 if StartsWith(w,bsonJavaScriptCodePrefix) then
1000 begin
1001 i:=bsonJavaScriptCode;
1002 stmWrite(@i,1);
1003 stmWriteCString(key);
1004 stmWriteString(Copy(w,Length(bsonJavaScriptCodePrefix)+1,Length(w)-Length(bsonJavaScriptCodePrefix)));
1005 end
1006 else
1007 //detect regex
1008 if StartsWith(w,bsonRegExPrefix) then
1009 begin
1010 i:=bsonRegEx;
1011 stmWrite(@i,1);
1012 stmWriteCString(key);
1013 i:=Length(bsonRegExPrefix)+1;
1014 if (i<=Length(w)) and (w[i]='/') then inc(i);//TODO: support alternate regex delimiter?
1015 j:=i;
1016 while (j<=Length(w)) and (w[i]<>'/') do inc(j);
1017 stmWriteCString(Copy(w,i,j-i));
1018 stmWriteCString(Copy(w,j+1,Length(w)-j));
1019 end
1020 else
1021 begin
1022 i:=bsonString;
1023 stmWrite(@i,1);
1024 stmWriteCString(key);
1025 stmWriteString(w);
1026 end;
1027 //TODO: bsonJavaScriptCodeWithScope, bsonSymbol ?
1028 end;
1029 //TODO varStrArg as bsonBinaryUUID
1030 varBoolean:
b263e816 » unknown
2010-12-01 main files
1031 begin
038dbecc »
2014-04-04 IBSONDocumentEnumerator
1032 i:=bsonBoolean;
b263e816 » unknown
2010-12-01 main files
1033 stmWrite(@i,1);
1034 stmWriteCString(key);
038dbecc »
2014-04-04 IBSONDocumentEnumerator
1035 if v then i:=1 else i:=0;
1036 stmWrite(@i,1);
b263e816 » unknown
2010-12-01 main files
1037 end;
038dbecc »
2014-04-04 IBSONDocumentEnumerator
1038 //varVariant://TODO
1039 varDispatch,varUnknown:
1040 begin
1041 uu:=IUnknown(v);
1042 if uu<>nil then
1043 if not TryWriteBSONDocument then
1ca14adf »
2014-04-04 raise save IBSONDocumentEnumerator not implemented
1044 if not TryWriteBSONDocumentEnumerator then
038dbecc »
2014-04-04 IBSONDocumentEnumerator
1045 {$IFDEF BSON_SUPPORT_REGEX}
1046 if not TryWriteRegExp then
1047 {$ENDIF}
1048 if not TryWriteStream then
1049 if not TryWritePersistStream then
1050 raise EBSONException.Create('No supported interface found on object "'+key+'"');
1051 end;
1052 else raise EBSONException.Create('Unsupported variant type '+IntToHex(vt,4)+' "'+key+'"');
1053 end;
1054 end;
b263e816 » unknown
2010-12-01 main files
1055
038dbecc »
2014-04-04 IBSONDocumentEnumerator
1056 while (vindex>=0) and (vstack[vindex].vi>vstack[vindex].v2) do
1057 begin
1058 //terminator
1059 i:=0;
1060 stmWrite(@i,1);
1061 //write total length
1062 OleCheck(stm.Seek(lstart+vstack[vindex].vstart,soFromBeginning,lx));
1063 i:=ltotal-vstack[vindex].vstart;
1064 OleCheck(stm.Write(@i,4,@li));
1065 //return to end position
1066 OleCheck(stm.Seek(lstart+ltotal,soFromBeginning,lx));
1067 //pop from array stack
1068 vstack[vindex].vv:=Null;
1069 dec(vindex);
1070 //SetLength(vstack,vindex);
1071 end;
b263e816 » unknown
2010-12-01 main files
1072
038dbecc »
2014-04-04 IBSONDocumentEnumerator
1073 end;
1074 //terminator
1075 i:=0;
1076 stmWrite(@i,1);
b263e816 » unknown
2010-12-01 main files
1077
038dbecc »
2014-04-04 IBSONDocumentEnumerator
1078 //write total length
1079 OleCheck(stm.Seek(lstart,soFromBeginning,lx));
1080 OleCheck(stm.Write(@ltotal,4,@li));
1081 //assert(li=4);
b263e816 » unknown
2010-12-01 main files
1082
038dbecc »
2014-04-04 IBSONDocumentEnumerator
1083 //return to end position
1084 OleCheck(stm.Seek(ltotal-4,soFromCurrent,lx));
1085 //assert(lx=lstart+ltotal);
b263e816 » unknown
2010-12-01 main files
1086
038dbecc »
2014-04-04 IBSONDocumentEnumerator
1087 finally
1088 stm._Release;
1089 end;
b263e816 » unknown
2010-12-01 main files
1090 if fClearDirty then FDirty:=false;
1091 Result:=S_OK;
1092 //TODO: try except Result:=E_?
1093 end;
1094
1095 function TBSONDocument.GetClassID(out classID: TCLSID): HResult;
1096 begin
1097 classID:=CLASS_BSONDocument;
1098 Result:=S_OK;
1099 end;
1100
1101 procedure TBSONDocument.Clear;
1102 var
1103 i:integer;
1104 begin
1105 FDirty:=false;//?
f8bb5a1a »
2012-05-22 bsonDocument: persist in original sequence
1106 for i:=0 to FElementIndex-1 do VarClear(FElements[i].Value);
b263e816 » unknown
2010-12-01 main files
1107 //TODO: if IBSONDocument then Clear?
1108 FElementIndex:=0;//?
f8bb5a1a »
2012-05-22 bsonDocument: persist in original sequence
1109 FGotMatch:=false;
b263e816 » unknown
2010-12-01 main files
1110 end;
1111
c1e0556e » unknown
2010-12-02 extra check Get
1112 function TBSONDocument.ToVarArray: OleVariant;
b263e816 » unknown
2010-12-01 main files
1113 var
3962a6c7 »
2014-04-04 TBSONDocument Save,ToVarArray check LoadIndex
1114 i,l:integer;
b263e816 » unknown
2010-12-01 main files
1115 begin
3962a6c7 »
2014-04-04 TBSONDocument Save,ToVarArray check LoadIndex
1116 l:=0;
b263e816 » unknown
2010-12-01 main files
1117 for i:=0 to FElementIndex-1 do
3962a6c7 »
2014-04-04 TBSONDocument Save,ToVarArray check LoadIndex
1118 if FElements[i].LoadIndex=FLoadIndex then inc(l);
1119 //and not(VarIsNull(FElements[i].Value))?
1120 Result:=VarArrayCreate([0,l-1,0,1],varVariant);
1121 l:=0;
1122 for i:=0 to FElementIndex-1 do
1123 if FElements[i].LoadIndex=FLoadIndex then
1124 begin
1125 Result[l,0]:=FElements[i].Key;
1126 Result[l,1]:=FElements[i].Value;
1127 inc(l);
1128 end;
b263e816 » unknown
2010-12-01 main files
1129 end;
1130
e97e865b »
2010-12-14 function BSON overloads
1131 function BSON:IBSONDocument; //overload;
1132 begin
1133 Result:=TBSONDocument.Create as IBSONDocument;
1134 end;
1135
1136 function BSON(x:array of OleVariant):IBSONDocument; //overload;
f67bc102 » unknown
2010-12-02 BSON builder
1137 var
1138 i,di,l:integer;
1139 d:array of IBSONDocument;
1140 key:WideString;
1141 const
1142 GrowStep=8;
1143 begin
1144 i:=0;
1145 l:=Length(x);
1146 di:=0;
1147 SetLength(d,8);
1148 d[di]:=TBSONDocument.Create as IBSONDocument;
1149 while i<l do
1150 begin
1151 //key
1152 key:=VarToStr(x[i]);
1153 if key=']' then
1154 begin
1155 //pop from stack
1156 d[di]:=nil;
1157 dec(di);
1158 end
1159 else
1160 begin
1161 if key='[' then raise Exception.Create('BSON builder: embedded document needs key at index '+IntToStr(i));
1162 //value
1163 inc(i);
1164 if (VarType(x[i])=varOleStr) and (x[i]='[') then
1165 begin
1166 //push on stack
1167 inc(di);
1168 if di=Length(d) then SetLength(d,di+GrowStep);
1169 d[di]:=TBSONDocument.Create as IBSONDocument;
1170 d[di-1].Item[key]:=d[di];
1171 end
1172 else
1173 if i<l then
1174 d[di].Item[key]:=x[i]
1175 else
1176 raise Exception.Create('BSON builder: last key is missing value');
1177 end;
1178 inc(i);
1179 end;
1180 //if di>0 then raise Exception.Create('BSON builder: '+IntToStr(di)+' closing brackets missing');?
1181 Result:=d[0];
3962a6c7 »
2014-04-04 TBSONDocument Save,ToVarArray check LoadIndex
1182 //TODO: Result.FIsDirty:=false?
f67bc102 » unknown
2010-12-02 BSON builder
1183 end;
1184
038dbecc »
2014-04-04 IBSONDocumentEnumerator
1185 { TBSONDocumentEnumerator }
1186
1187 procedure TBSONDocumentEnumerator.AfterConstruction;
1188 begin
1189 inherited;
1190 FData:=nil;
1191 FPosIndex:=0;
1192 FPosSize:=0;
1193 FPosCurrent:=-1;
1194 end;
1195
1196 destructor TBSONDocumentEnumerator.Destroy;
1197 begin
1198 FData:=nil;
1199 SetLength(FPos,0);
1200 inherited;
1201 end;
1202
1203 procedure TBSONDocumentEnumerator.SetStream(const stm: IStream);
1204 begin
1205 FData:=stm;
1206 FPosIndex:=0;
1207 FPosCurrent:=-1;
1208 end;
1209
1210 procedure TBSONDocumentEnumerator.Add(pos: int64);
1211 begin
1212 if FPosIndex=FPosSize then
1213 begin
1214 inc(FPosSize,128);//grow
1215 SetLength(FPos,FPosSize);
1216 end;
1217 FPos[FPosIndex]:=pos;
1218 end;
1219
1220 function TBSONDocumentEnumerator.GetCount: integer;
1221 begin
1222 Result:=FPosIndex;
1223 end;
1224
1225 function TBSONDocumentEnumerator.Next(const doc: IBSONDocument): boolean;
1226 var
1227 p:int64;
1228 begin
1229 //TODO: detect dirty (deep!), then update into stream??
1230 if FPosCurrent>=FPosIndex then Result:=false else
1231 begin
1232 OleCheck(FData.Seek(FPos[FPosCurrent],soFromBeginning,p));
1233 (doc as IPersistStream).Load(FData);
1234 Result:=true;
1235 inc(FPosCurrent);
1236 end;
1237 end;
1238
1239 procedure TBSONDocumentEnumerator.Reset;
1240 begin
1241 FPosCurrent:=0;
1242 end;
1243
1244 procedure TBSONDocumentEnumerator.Skip(n: integer);
1245 begin
1246 if (FPosCurrent+n>FPosIndex) or (FPosCurrent+n<0) then
1247 raise EBSONException.Create('IBSONDocumentEnumerator.Skip can''t skip past count');
1248 inc(FPosCurrent,n);
1249 end;
1250
1251 function BSONEnum:IBSONDocumentEnumerator;
1252 begin
1253 Result:=TBSONDocumentEnumerator.Create;
1254 end;
1255
f7e5bf73 »
2014-04-04 BSONenum overload for conversion of existing value
1256 function BSONEnum(const v:OleVariant): IBSONDocumentEnumerator; overload;
1257 begin
1258 if not((VarType(v)=varUnknown) and
1259 (IUnknown(v).QueryInterface(IID_IBSONDocumentEnumerator,Result)=S_OK)) then
1260 raise EBSONException.Create('Value is not IBSONDocumentEnumerator');
1261 end;
1262
b263e816 » unknown
2010-12-01 main files
1263 end.
Something went wrong with that request. Please try again.