Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

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