Permalink
Switch branches/tags
Nothing to show
Find file Copy path
Fetching contributors…
Cannot retrieve contributors at this time
1422 lines (1174 sloc) 31.4 KB
unit _bson;
{$IFDEF FPC}
{$MODE DELPHI}
{$ENDIF}
interface
uses
SysUtils,
Classes,
Contnrs;
{
BSON element format
<type:byte> <c-str> <data>
<data> below
}
const
BSON_EOF = $00;
BSON_FLOAT = $01; //double 8-byte float
BSON_STRING = $02; //UTF-8 string
BSON_DOC = $03; //embedded document
BSON_ARRAY = $04; //bson document but using integer string for key
BSON_BINARY = $05; //
BSON_UNDEFINED = $06; //deprecated
BSON_OBJECTID = $07; //
BSON_BOOLEAN = $08; //false:$00, true:$01
BSON_DATETIME = $09;
BSON_NULL = $0A;
BSON_REGEX = $0B; //
BSON_DBPTR = $0C; //deprecated
BSON_JS = $0D;
BSON_SYMBOL = $0E;
BSON_JSSCOPE = $0F;
BSON_INT32 = $10;
BSON_TIMESTAMP = $11;
BSON_INT64 = $12;
BSON_MINKEY = $FF;
BSON_MAXKEY = $7F;
{subtype}
BSON_SUBTYPE_FUNC = $01;
BSON_SUBTYPE_BINARY = $02;
BSON_SUBTYPE_UUID = $03;
BSON_SUBTYPE_MD5 = $05;
BSON_SUBTYPE_USER = $80;
{boolean constant}
BSON_BOOL_FALSE = $00;
BSON_BOOL_TRUE = $01;
const
nullterm: AnsiChar = #0;
type
EBSONException = class(Exception);
TBSONObjectID = array[0..11] of byte;
TBSONDocument = class;
TBSONItem = class
protected
eltype: byte;
elname: string;
fnull: boolean;
procedure WriteDouble(Value: real); virtual;
procedure WriteInteger(Value: integer); virtual;
procedure WriteInt64(Value: Int64); virtual;
procedure WriteBoolean(Value: Boolean); virtual;
procedure WriteString(Value: string); virtual;
procedure WriteOID(Value: TBSONObjectID); virtual;
procedure WriteDocument(Value: TBSONDocument); virtual;
procedure WriteItem(idx: integer; Value: TBSONItem); virtual;
function ReadDouble: real; virtual;
function ReadInteger: integer; virtual;
function ReadInt64: Int64; virtual;
function ReadBoolean: Boolean; virtual;
function ReadString: string; virtual;
function ReadOID: TBSONObjectID; virtual;
function ReadDocument: TBSONDocument; virtual;
function ReadItem(idx: integer): TBSONItem; virtual;
public
constructor Create(etype: byte = BSON_NULL);
procedure WriteStream(F: TStream); virtual;
procedure ReadStream(F: TStream); virtual;
function GetSize: longint; virtual;
function ToString: string; virtual;
function Clone: TBSONItem; virtual;
function IsNull: boolean;
property AsObjectID: TBSONObjectID read ReadOID write WriteOID;
property AsInteger: integer read ReadInteger write WriteInteger;
property AsDouble: real read ReadDouble write WriteDouble;
property AsInt64: int64 read ReadInt64 write WriteInt64;
property AsString: string read ReadString write WriteString;
property AsBoolean: Boolean read ReadBoolean write WriteBoolean;
property Items[idx: integer]: TBSONItem read ReadItem write WriteItem;
property Name: string read elname;
end;
TBSONDocument = class
FItems: TObjectList;
function GetItem(i: integer): TBSONItem;
function GetValue(name: string): TBSONItem;
procedure SetValue(Name: string; Value: TBSONItem);
function GetCount: integer;
public
constructor Create;
destructor Destroy; override;
procedure Clear;
procedure ReadStream(F: TStream);
procedure WriteStream(F: TStream);
procedure LoadFromFile(filename: string);
procedure SaveToFile(filename: string);
function IndexOf(name: string): integer;
function GetSize: longint;
function Clone: TBSONDocument;
function ToString: string;
function HasItem(itemname: string): Boolean;
property Items[idx: integer]: TBSONItem read GetItem;
property Values[Name: string]: TBSONItem read GetValue write SetValue;
property Count: integer read GetCount;
end;
TBSONDoubleItem = class(TBSONItem)
FData: real;
procedure WriteDouble(AValue: real); override;
function ReadDouble: real; override;
public
constructor Create(AValue: real = 0.0);
function GetSize: longint; override;
function ToString: string; override;
function Clone: TBSONItem; override;
procedure ReadStream(F: TStream); override;
procedure WriteStream(F: TStream); override;
end;
TBSONIntItem = class(TBSONItem)
FData: integer;
procedure WriteInteger(AValue: integer); override;
function ReadInteger: integer; override;
public
constructor Create(AValue: integer = 0);
function GetSize: longint; override;
function ToString: string; override;
function Clone: TBSONItem; override;
procedure ReadStream(F: TStream); override;
procedure WriteStream(F: TStream); override;
end;
TBSONStringItem = class(TBSONItem)
protected
FData: string;
procedure WriteString(AValue: string); override;
function ReadString: string; override;
public
constructor Create(AValue: string = '');
function GetSize: longint; override;
function ToString: string; override;
function Clone: TBSONItem; override;
procedure ReadStream(F: TStream); override;
procedure WriteStream(F: TStream); override;
end;
TBSONJSItem = class(TBSONStringItem)
public
constructor Create(AValue: string = '');
function Clone: TBSONItem; override;
end;
TBSONSymbolItem = class(TBSONStringItem)
public
constructor Create(AValue: string = '');
function Clone: TBSONItem; override;
end;
TBSONInt64Item = class(TBSONItem)
FData: Int64;
procedure WriteInt64(AValue: int64); override;
function ReadInt64: Int64; override;
public
constructor Create(AValue: Int64 = 0);
function GetSize: longint; override;
function ToString: string; override;
function Clone: TBSONItem; override;
procedure ReadStream(F: TStream); override;
procedure WriteStream(F: TStream); override;
end;
TBSONBooleanItem = class(TBSONItem)
FData: Boolean;
procedure WriteBoolean(AValue: Boolean); override;
function ReadBoolean: Boolean; override;
public
constructor Create(AValue: Boolean = false);
function GetSize: longint; override;
function ToString: string; override;
function Clone: TBSONItem; override;
procedure ReadStream(F: TStream); override;
procedure WriteStream(F: TStream); override;
end;
TBSONDocumentItem = class(TBSONItem)
FData: TBSONDocument;
public
constructor Create;
destructor Destroy; override;
function GetSize: longint; override;
function ToString: string; override;
function Clone: TBSONItem; override;
procedure ReadStream(F: TStream); override;
procedure WriteStream(F: TStream); override;
end;
TBSONArrayItem = class(TBSONItem)
FData: TBSONDocument;
procedure WriteItem(idx: integer; item: TBSONItem); override;
function ReadItem(idx: integer): TBSONItem; override;
public
constructor Create;
destructor Destroy; override;
function GetSize: longint; override;
function ToString: string; override;
function Clone: TBSONItem; override;
procedure ReadStream(F: TStream); override;
procedure WriteStream(F: TStream); override;
end;
TBSONDatetimeItem = class(TBSONItem)
FData: TDatetime;
public
constructor Create(AValue: TDateTime);
function GetSize: longint; override;
function ToString: string; override;
function Clone: TBSONItem; override;
procedure ReadStream(F: TStream); override;
procedure WriteStream(F: TStream); override;
end;
TBSONBinaryItem = class(TBSONItem)
FLen: integer;
FSubtype: byte;
FData: Pointer;
public
constructor Create;
destructor Destroy; override;
function GetSize: longint; override;
function ToString: string; override;
function Clone: TBSONItem; override;
procedure ReadStream(F: TStream); override;
procedure WriteStream(F: TStream); override;
end;
TBSONObjectIDItem = class(TBSONItem)
FData: TBSONObjectID;
procedure WriteOID(AValue: TBSONObjectID); override;
function ReadOID: TBSONObjectID; override;
public
constructor Create(AValue: string = '000000000000');
function GetSize: longint; override;
function ToString: string; override;
function Clone: TBSONItem; override;
procedure ReadStream(F: TStream); override;
procedure WriteStream(F: TStream); override;
end;
TBSONDBRefItem = class(TBSONStringItem)
FValue: TBSONObjectID;
procedure WriteOID(AValue: TBSONObjectID); override;
function ReadOID: TBSONObjectID; override;
public
constructor Create(AValue: string = ''; AData: string = '');
function GetSize: longint; override;
function ToString: string; override;
function Clone: TBSONItem; override;
procedure ReadStream(F: TStream); override;
procedure WriteStream(F: TStream); override;
end;
TBSONRegExItem = class(TBSONItem)
FPattern, FOptions: string;
public
constructor Create(APattern: string = ''; AOptions: string = '');
function GetSize: longint; override;
function ToString: string; override;
function Clone: TBSONItem; override;
procedure ReadStream(F: TStream); override;
procedure WriteStream(F: TStream); override;
end;
TBSONScopedJSItem = class(TBSONItem)
FLen: integer;
FCode: string;
FScope: TBSONDocument;
public
constructor Create;
destructor Destroy; override;
function GetSize: longint; override;
function ToString: string; override;
function Clone: TBSONItem; override;
procedure ReadStream(F: TStream); override;
procedure WriteStream(F: TStream); override;
end;
function _ReadString(F: TStream): string;
implementation
uses
DateUtils;
var
buf: array[0..65535] of char;
nullitem: TBSONItem;
function _ReadString(F: TStream): string;
var
i: integer;
c: Ansichar;
begin
i := 0;
repeat
f.read(c, sizeof(char));
buf[i] := c;
inc(i);
until c = nullterm;
result := strpas(buf);
end;
{ TBSONDocument }
procedure TBSONDocument.Clear;
begin
FItems.Clear;
end;
function TBSONDocument.Clone: TBSONDocument;
var
i: integer;
begin
Result := TBSONDocument.Create;
for i := 0 to FItems.Count - 1 do begin
Result.FItems.Add((FItems[i] as TBSONItem).Clone);
end;
end;
constructor TBSONDocument.Create;
begin
FItems := TObjectlist.Create(true);
end;
destructor TBSONDocument.Destroy;
begin
FItems.Free;
inherited Destroy;
end;
function TBSONDocument.GetCount: integer;
begin
Result := FItems.Count;
end;
function TBSONDocument.GetItem(i: integer): TBSONItem;
begin
if i in [0..(FItems.Count - 1)] then
Result := (FItems[i] as TBSONItem)
else
Result := nullitem;
end;
function TBSONDocument.GetSize: longint;
var
i: integer;
begin
Result := 5;
for i := 0 to FItems.Count - 1 do begin
Result := Result + (FItems[i] as TBSONItem).GetSize;
end;
end;
function TBSONDocument.GetValue(name: string): TBSONItem;
var
i: integer;
begin
result := nullitem;
i := IndexOf(name);
if i <> -1 then Result := (FItems[i] as TBSONItem);
end;
function TBSONDocument.HasItem(itemname: string): Boolean;
var
i: integer;
begin
Result := False;
for i := 0 to FItems.Count - 1 do begin
if (FItems[i] as TBSONItem).elname = itemname then begin
Result := True;
break;
end;
end;
end;
function TBSONDocument.IndexOf(name: string): integer;
var
i: integer;
begin
Result := -1;
for i := 0 to FItems.Count - 1 do begin
if (FItems[i] as TBSONItem).elname = name then begin
Result := i;
break;
end;
end;
end;
procedure TBSONDocument.LoadFromFile(filename: string);
var
f: TFileStream;
begin
f := TFileStream.Create(filename, fmOpenRead);
try
ReadStream(f);
finally
f.Free;
end;
end;
procedure TBSONDocument.ReadStream(F: TStream);
var
len: integer;
elmtype: byte;
elmname: string;
lastItem: TBSONItem;
begin
Clear;
f.Read(len, sizeof(len));
f.Read(elmtype, sizeof(byte));
while elmtype <> BSON_EOF do begin
elmname := _ReadString(f);
case elmtype of
BSON_ARRAY: lastItem := TBSONArrayItem.Create;
BSON_BINARY: lastItem := TBSONBinaryItem.Create;
BSON_DBPTR: lastItem := TBSONDBRefItem.Create;
BSON_FLOAT: lastItem := TBSONDoubleItem.Create;
BSON_INT32: lastItem := TBSONIntItem.Create;
BSON_INT64: lastItem := TBSONInt64Item.Create;
BSON_BOOLEAN: lastItem := TBSONBooleanItem.Create;
BSON_STRING: lastItem := TBSONStringItem.Create;
BSON_DOC: lastItem := TBSONDocumentItem.Create;
BSON_JS: lastItem := TBSONJSItem.Create;
BSON_JSSCOPE: lastItem := TBSONScopedJSItem.Create;
BSON_OBJECTID: lastItem := TBSONObjectIDItem.Create;
BSON_MINKEY: lastItem := TBSONItem.Create(BSON_MINKEY);
BSON_MAXKEY: lastItem := TBSONItem.Create(BSON_MAXKEY);
BSON_REGEX: lastItem := TBSONRegExItem.Create;
BSON_SYMBOL: lastItem := TBSONSymbolItem.Create;
BSON_DATETIME: lastItem := TBSONDateTimeItem.Create(0);
else
raise EBSONException.Create('unimplemented element handler ' + inttostr(elmtype));
end;
with lastItem do begin
elname := elmname;
ReadStream(f);
end;
FItems.Add(lastItem);
f.Read(elmtype, sizeof(byte));
end;
end;
procedure TBSONDocument.SaveToFile(filename: string);
var
f: TFileStream;
begin
{$IFDEF FPC}
f := TFileStream.Create(filename, fmOpenWrite);
{$ELSE}
f := TFileStream.Create(FileCreate(filename));
{$ENDIF}
try
WriteStream(f);
finally
f.Free;
end;
end;
procedure TBSONDocument.SetValue(Name: string; Value: TBSONItem);
var
item: TBSONItem;
idx: integer;
begin
idx := IndexOf(name);
if idx = -1 then begin
Value.elname := Name;
FItems.Add(Value)
end
else begin
item := FItems[idx] as TBSONItem;
if (item.eltype <> value.eltype) then begin
FItems[idx] := Value;
item.Free;
end;
end;
end;
function TBSONDocument.ToString: string;
var
i, n: integer;
begin
Result := '{';
n := FItems.Count - 1;
for i := 0 to n do begin
Result := Result + (FItems[i] as TBSONItem).ToString;
if i < n then Result := Result + ', ';
end;
Result := Result + '}';
end;
procedure TBSONDocument.WriteStream(F: TStream);
var
dummy: integer;
i: integer;
begin
dummy := GetSize;
f.write(dummy, sizeof(dummy));
for i := 0 to FItems.Count - 1 do begin
(FItems[i] as TBSONItem).WriteStream(f);
end;
f.Write(nullterm, sizeof(nullterm));
end;
{ TBSONDoubleItem }
function TBSONDoubleItem.Clone: TBSONItem;
begin
Result := TBSONDoubleItem.Create(FData);
end;
constructor TBSONDoubleItem.Create(AValue: real);
begin
eltype := BSON_FLOAT;
FData := AValue;
end;
function TBSONDoubleItem.GetSize: longint;
begin
Result := 2 + length(elname) + sizeof(FData);
end;
function TBSONDoubleItem.ReadDouble: real;
begin
Result := FData;
end;
procedure TBSONDoubleItem.ReadStream(F: TStream);
begin
f.Read(FData, sizeof(FData));
end;
function TBSONDoubleItem.ToString: string;
begin
Result := format('"%s" : %f', [elname, FData]);
end;
procedure TBSONDoubleItem.WriteDouble(AValue: real);
begin
FData := AValue;
end;
procedure TBSONDoubleItem.WriteStream(F: TStream);
begin
f.Write(eltype, sizeof(byte));
f.Write(elname[1], length(elname));
f.Write(nullterm, sizeof(nullterm));
f.Write(FData, sizeof(FData));
end;
{ TBSONIntItem }
function TBSONIntItem.Clone: TBSONItem;
begin
Result := TBSONIntItem.Create(FData);
end;
constructor TBSONIntItem.Create(AValue: integer);
begin
eltype := BSON_INT32;
FData := AValue;
end;
function TBSONIntItem.GetSize: longint;
begin
Result := 2 + length(elname) + sizeof(FData);
end;
function TBSONIntItem.ReadInteger: integer;
begin
result := FData;
end;
procedure TBSONIntItem.ReadStream(F: TStream);
begin
f.Read(fdata, sizeof(integer));
end;
function TBSONIntItem.ToString: string;
begin
Result := format('"%s" : %d', [elname, FData]);
end;
procedure TBSONIntItem.WriteInteger(AValue: integer);
begin
FData := AValue;
end;
procedure TBSONIntItem.WriteStream(F: TStream);
begin
f.Write(eltype, sizeof(byte));
f.Write(elname[1], length(elname));
f.Write(nullterm, sizeof(nullterm));
f.Write(FData, sizeof(FData));
end;
{ TBSONStringItem }
function TBSONStringItem.Clone: TBSONItem;
begin
Result := TBSONStringItem.Create(FData);
end;
constructor TBSONStringItem.Create(AValue: string);
begin
eltype := BSON_STRING;
FData := AValue;
end;
function TBSONStringItem.GetSize: longint;
begin
Result := 7 + length(elname) + length(fdata);
end;
procedure TBSONStringItem.ReadStream(F: TStream);
var
len: integer;
begin
f.Read(len, sizeof(integer));
FData := _ReadString(F);
end;
function TBSONStringItem.ReadString: string;
begin
Result := FData;
end;
function TBSONStringItem.ToString: string;
begin
Result := format('"%s" : "%s"', [elname, FData]);
end;
procedure TBSONStringItem.WriteStream(F: TStream);
var
len: integer;
begin
len := length(FData) + 1;
f.Write(eltype, sizeof(byte));
f.Write(elname[1], length(elname));
f.Write(nullterm, sizeof(nullterm));
f.Write(len, sizeof(integer));
f.Write(FData[1], length(FData));
f.Write(nullterm, sizeof(nullterm));
end;
procedure TBSONStringItem.WriteString(AValue: string);
begin
FData := AValue;
end;
{ TBSONInt64Item }
function TBSONInt64Item.Clone: TBSONItem;
begin
Result := TBSONInt64Item.Create(FData);
end;
constructor TBSONInt64Item.Create(AValue: Int64);
begin
eltype := BSON_INT64;
FData := AValue;
end;
function TBSONInt64Item.GetSize: longint;
begin
Result := 2 + length(elname) + sizeof(fdata);
end;
function TBSONInt64Item.ReadInt64: Int64;
begin
Result := FData;
end;
procedure TBSONInt64Item.ReadStream(F: TStream);
begin
f.Read(FData, sizeof(FData));
end;
function TBSONInt64Item.ToString: string;
begin
Result := format('"%s" : %d', [elname, FData]);
end;
procedure TBSONInt64Item.WriteInt64(AValue: int64);
begin
FData := AValue;
end;
procedure TBSONInt64Item.WriteStream(F: TStream);
begin
f.Write(eltype, sizeof(byte));
f.Write(elname[1], length(elname));
f.Write(nullterm, sizeof(nullterm));
f.Write(FData, sizeof(FData));
end;
{ TBSONBooleanItem }
function TBSONBooleanItem.Clone: TBSONItem;
begin
Result := TBSONBooleanItem.Create(FData);
end;
constructor TBSONBooleanItem.Create(AValue: Boolean);
begin
eltype := BSON_BOOLEAN;
FData := AValue;
end;
function TBSONBooleanItem.GetSize: longint;
begin
Result := 3 + length(elname);
end;
function TBSONBooleanItem.ReadBoolean: Boolean;
begin
Result := FData;
end;
procedure TBSONBooleanItem.ReadStream(F: TStream);
var
b: Byte;
begin
f.Read(b, sizeof(byte));
FData := b = BSON_BOOL_TRUE
end;
function TBSONBooleanItem.ToString: string;
begin
Result := format('"%s" : %s', [elname, BoolToStr(FData, true)]);
end;
procedure TBSONBooleanItem.WriteBoolean(AValue: Boolean);
begin
FData := AValue;
end;
procedure TBSONBooleanItem.WriteStream(F: TStream);
var
boolb: byte;
begin
f.Write(eltype, sizeof(byte));
f.Write(elname[1], length(elname));
f.Write(nullterm, sizeof(nullterm));
if FData then
boolb := BSON_BOOL_TRUE
else
boolb := BSON_BOOL_FALSE;
f.Write(boolb, sizeof(byte));
end;
{ TBSONItem }
function TBSONItem.Clone: TBSONItem;
begin
Result := TBSONItem.Create(eltype);
end;
constructor TBSONItem.Create(etype: byte);
begin
fnull := true;
eltype := etype;
end;
function TBSONItem.GetSize: longint;
begin
Result := 0;
if FNull then
Result := 2 + Length(elName);
end;
function TBSONItem.IsNull: boolean;
begin
Result := FNull;
end;
function TBSONItem.ReadBoolean: Boolean;
begin
Result := False;
end;
function TBSONItem.ReadDocument: TBSONDocument;
begin
Result := nil;
end;
function TBSONItem.ReadDouble: real;
begin
Result := 0;
end;
function TBSONItem.ReadInt64: Int64;
begin
Result := 0;
end;
function TBSONItem.ReadInteger: integer;
begin
Result := 0;
end;
function TBSONItem.ReadItem(idx: integer): TBSONItem;
begin
Result := nullitem;
end;
function TBSONItem.ReadOID: TBSONObjectID;
begin
Result := Result;
end;
procedure TBSONItem.ReadStream(F: TStream);
begin
end;
function TBSONItem.ReadString: string;
begin
Result := '';
end;
function TBSONItem.ToString: string;
begin
Result := elname + ' : null';
end;
procedure TBSONItem.WriteBoolean(Value: Boolean);
begin
end;
procedure TBSONItem.WriteDocument(Value: TBSONDocument);
begin
end;
procedure TBSONItem.WriteDouble(Value: real);
begin
end;
procedure TBSONItem.WriteInt64(Value: Int64);
begin
end;
procedure TBSONItem.WriteInteger(Value: integer);
begin
end;
procedure TBSONItem.WriteItem(idx: integer; Value: TBSONItem);
begin
end;
procedure TBSONItem.WriteOID(Value: TBSONObjectID);
begin
end;
procedure TBSONItem.WriteStream(F: TStream);
begin
if FNull then begin
f.Write(eltype, sizeof(byte));
f.Write(elname[1], length(elname));
f.Write(nullterm, sizeof(nullterm));
end;
end;
procedure TBSONItem.WriteString(Value: string);
begin
end;
{ TBSONDocumentItem }
function TBSONDocumentItem.Clone: TBSONItem;
var
item: TBSONDocumentItem;
begin
item := TBSONDocumentItem.Create;
item.FData.Free;
item.FData := FData.Clone;
Result := item;
end;
constructor TBSONDocumentItem.Create;
begin
FData := TBSONDocument.Create;
end;
destructor TBSONDocumentItem.Destroy;
begin
FData.Free;
inherited Destroy;
end;
function TBSONDocumentItem.GetSize: longint;
begin
Result := 2 + length(elname) + FData.GetSize;
end;
procedure TBSONDocumentItem.ReadStream(F: TStream);
begin
inherited;
FData.ReadStream(f);
end;
function TBSONDocumentItem.ToString: string;
begin
Result := format('"%s" : %s', [elname, FData.ToString]);
end;
procedure TBSONDocumentItem.WriteStream(F: TStream);
begin
f.Write(eltype, sizeof(byte));
f.Write(elname[1], length(elname));
f.Write(nullterm, sizeof(nullterm));
FData.WriteStream(f);
end;
{ TBSONArrayItem }
function TBSONArrayItem.Clone: TBSONItem;
var
item: TBSONArrayItem;
begin
item := TBSONArrayItem.Create;
item.FData.Free;
item.FData := FData.Clone;
Result := Item;
end;
constructor TBSONArrayItem.Create;
begin
eltype := BSON_ARRAY;
FData := TBSONDocument.Create;
end;
destructor TBSONArrayItem.Destroy;
begin
FData.Free;
inherited Destroy;
end;
function TBSONArrayItem.GetSize: longint;
begin
Result := 2 + length(elname) + FData.GetSize;
end;
function TBSONArrayItem.ReadItem(idx: integer): TBSONItem;
begin
Result := FData.Items[idx];
end;
procedure TBSONArrayItem.ReadStream(F: TStream);
begin
FData.ReadStream(F);
end;
function TBSONArrayItem.ToString: string;
var
i, n: integer;
tmp, t2: string;
begin
tmp := '';
n := FData.Count - 1;
for i := 0 to n do begin
t2 := FData.Items[i].ToString;
tmp := tmp + Copy(t2, Pos(':', t2) + 1, length(t2));
if i < n then tmp := tmp + ', ';
end;
Result := format('"%s" : [%s]', [elname, tmp]);
end;
procedure TBSONArrayItem.WriteItem(idx: integer; item: TBSONItem);
begin
inherited;
FData.SetValue(IntToStr(idx), item);
end;
procedure TBSONArrayItem.WriteStream(F: TStream);
begin
f.Write(eltype, sizeof(byte));
f.Write(elname[1], length(elname));
f.Write(nullterm, sizeof(nullterm));
FData.WriteStream(f);
end;
{ TBSONDatetimeItem }
function TBSONDatetimeItem.Clone: TBSONItem;
begin
Result := TBSONDateTimeItem.Create(FData);
end;
constructor TBSONDatetimeItem.Create(AValue: TDateTime);
begin
eltype := BSON_DATETIME;
FData := AValue;
end;
function TBSONDatetimeItem.GetSize: longint;
begin
result := 2 + length(elname) + sizeof(int64);
end;
procedure TBSONDatetimeItem.ReadStream(F: TStream);
var
data: int64;
begin
f.Read(data, sizeof(int64));
FData := UnixToDateTime(data);
end;
function TBSONDatetimeItem.ToString: string;
begin
Result := format('"%s" : %s', [elname, DateTimeToStr(FData)]);
end;
procedure TBSONDatetimeItem.WriteStream(F: TStream);
var
data: Int64;
begin
data := DateTimeToUnix(FData);
f.Write(eltype, sizeof(byte));
f.Write(elname[1], length(elname));
f.Write(nullterm, sizeof(nullterm));
f.Write(Data, sizeof(int64));
end;
{ TBSONJSItem }
function TBSONJSItem.Clone: TBSONItem;
begin
Result := TBSONJSItem.Create(FData);
end;
constructor TBSONJSItem.Create(AValue: string);
begin
inherited Create(AValue);
eltype := BSON_JS;
end;
{ TBSONObjectIDItem }
function TBSONObjectIDItem.Clone: TBSONItem;
begin
Result := TBSONObjectIDItem.Create;
Result.AsObjectID := FData;
end;
constructor TBSONObjectIDItem.Create(AValue: string);
var
i: integer;
begin
eltype := BSON_OBJECTID;
if length(AValue) = 12 then
for i := 0 to 11 do
FData[i] := StrToInt(AValue[i + 1]);
end;
function TBSONObjectIDItem.GetSize: longint;
begin
result := 2 + length(elname) + 12;
end;
function TBSONObjectIDItem.ReadOID: TBSONObjectID;
begin
Result := FData;
end;
procedure TBSONObjectIDItem.ReadStream(F: TStream);
begin
f.Read(FData[0], 12);
end;
function TBSONObjectIDItem.ToString: string;
begin
Result := format('"%s" : ObjectID("%s%s%s%s%s%s%s%s%s%s%s%s")', [elname,
IntToHex(FData[0], 2),
IntToHex(FData[1], 2),
IntToHex(FData[2], 2),
IntToHex(FData[3], 2),
IntToHex(FData[4], 2),
IntToHex(FData[5], 2),
IntToHex(FData[6], 2),
IntToHex(FData[7], 2),
IntToHex(FData[8], 2),
IntToHex(FData[9], 2),
IntToHex(FData[10], 2),
IntToHex(FData[11], 2)
]);
end;
procedure TBSONObjectIDItem.WriteOID(AValue: TBSONObjectID);
begin
FData := AValue;
end;
procedure TBSONObjectIDItem.WriteStream(F: TStream);
begin
f.Write(eltype, sizeof(byte));
f.Write(elname[1], length(elname));
f.Write(nullterm, sizeof(nullterm));
f.Write(FData[0], 12);
end;
{ TBSONRegExItem }
function TBSONRegExItem.Clone: TBSONItem;
begin
Result := TBSONRegExItem.Create(FPattern, FOptions);
end;
constructor TBSONRegExItem.Create(APattern, AOptions: string);
begin
FPattern := APattern;
FOptions := AOptions;
eltype := BSON_REGEX;
end;
function TBSONRegExItem.GetSize: longint;
begin
result := 2 + length(elname) + 1 + length(FPattern) + 1 + length(FOptions);
end;
procedure TBSONRegExItem.ReadStream(F: TStream);
begin
FPattern := _ReadString(f);
FOptions := _ReadString(f);
end;
function TBSONRegExItem.ToString: string;
begin
Result := format('"%s" : "%s" "%s"', [elname, FPattern, FOptions]);
end;
procedure TBSONRegExItem.WriteStream(F: TStream);
begin
f.Write(eltype, sizeof(byte));
f.Write(elname[1], length(elname));
f.Write(nullterm, sizeof(nullterm));
f.Write(FPattern[1], length(FPattern));
f.Write(nullterm, sizeof(nullterm));
f.Write(FOptions[1], length(FOptions));
f.Write(nullterm, sizeof(nullterm));
end;
{ TBSONBinaryItem }
function TBSONBinaryItem.Clone: TBSONItem;
var
ms: TMemoryStream;
begin
Result := TBSONBinaryItem.Create;
ms := TMemoryStream.Create;
try
WriteStream(ms);
ms.Seek(0, soFromBeginning);
Result.ReadStream(ms);
finally
ms.Free;
end;
end;
constructor TBSONBinaryItem.Create;
begin
FLen := 0;
FData := nil;
FSubtype := BSON_SUBTYPE_USER;
eltype := BSON_BINARY;
end;
destructor TBSONBinaryItem.Destroy;
begin
if FLen <> 0 then
FreeMem(FData);
inherited Destroy;
end;
function TBSONBinaryItem.GetSize: longint;
begin
result := 2 + length(elname) + 4 + 1 + FLen;
end;
procedure TBSONBinaryItem.ReadStream(F: TStream);
begin
f.Read(FLen, sizeof(integer));
f.Read(FSubtype, sizeof(byte));
GetMem(FData, FLen);
f.Read(FData^, Flen);
end;
function TBSONBinaryItem.ToString: string;
begin
Result := format('"%s" : %s', [elname, 'Binary']);
end;
procedure TBSONBinaryItem.WriteStream(F: TStream);
begin
f.Write(eltype, sizeof(byte));
f.Write(elname[1], length(elname));
f.Write(nullterm, sizeof(nullterm));
f.Write(FLen, sizeof(integer));
f.Write(FSubtype, sizeof(byte));
f.Write(FData^, FLen);
end;
{ TBSONScopedJSItem }
function TBSONScopedJSItem.Clone: TBSONItem;
var
item: TBSONScopedJSItem;
begin
item := TBSONScopedJSItem.Create;
item.FCode := FCode;
item.FLen := FLen;
item.FScope.Free;
item.FScope := FScope.Clone;
Result := item;
end;
constructor TBSONScopedJSItem.Create;
begin
eltype := BSON_JSSCOPE;
FScope := TBSONDocument.Create;
end;
destructor TBSONScopedJSItem.Destroy;
begin
FScope.Free;
inherited Destroy;
end;
function TBSONScopedJSItem.GetSize: longint;
begin
result := 2 + length(elname) + 4 + length(fcode) + 1 + FScope.GetSize;
end;
procedure TBSONScopedJSItem.ReadStream(F: TStream);
begin
f.Read(Flen, sizeof(integer));
FCode := _ReadString(f);
FScope.ReadStream(f);
end;
function TBSONScopedJSItem.ToString: string;
begin
Result := format('"%s" : "%s" %s', [elname, FCode, FScope.ToString]);
end;
procedure TBSONScopedJSItem.WriteStream(F: TStream);
begin
f.Write(eltype, sizeof(byte));
f.Write(elname[1], length(elname));
f.Write(nullterm, sizeof(nullterm));
FLen := FScope.GetSize + 5 + length(FCode);
f.Write(FLen, sizeof(integer));
f.Write(FCode[1], length(FCode));
f.Write(nullterm, sizeof(nullterm));
FScope.WriteStream(f);
end;
{ TBSONSymbolItem }
function TBSONSymbolItem.Clone: TBSONItem;
begin
Result := TBSONSymbolItem.Create(FData);
end;
constructor TBSONSymbolItem.Create(AValue: string);
begin
eltype := BSON_SYMBOL;
end;
{ TBSONDBRefItem }
function TBSONDBRefItem.Clone: TBSONItem;
begin
Result := TBSONDBRefItem.Create(FData);
Result.AsObjectID := FValue;
end;
constructor TBSONDBRefItem.Create(AValue, AData: string);
var
i: integer;
begin
inherited Create(AValue);
eltype := BSON_DBPTR;
if length(AData) = 12 then
for i := 0 to 11 do
FValue[i] := StrToInt(AData[1 + i]);
end;
function TBSONDBRefItem.GetSize: longint;
begin
result := 3 + length(elname) + length(FData) + 12;
end;
function TBSONDBRefItem.ReadOID: TBSONObjectID;
begin
Result := FValue;
end;
procedure TBSONDBRefItem.ReadStream(F: TStream);
begin
inherited;
f.Read(FValue[0], 12);
end;
function TBSONDBRefItem.ToString: string;
begin
Result := format('"%s" : DBRef("%s", "%s%s%s%s%s%s%s%s%s%s%s%s")', [elname,
FData,
IntToHex(FValue[0], 2),
IntToHex(FValue[1], 2),
IntToHex(FValue[2], 2),
IntToHex(FValue[3], 2),
IntToHex(FValue[4], 2),
IntToHex(FValue[5], 2),
IntToHex(FValue[6], 2),
IntToHex(FValue[7], 2),
IntToHex(FValue[8], 2),
IntToHex(FValue[9], 2),
IntToHex(FValue[10], 2),
IntToHex(FValue[11], 2)
]);
end;
procedure TBSONDBRefItem.WriteOID(AValue: TBSONObjectID);
begin
FValue := AValue;
end;
procedure TBSONDBRefItem.WriteStream(F: TStream);
begin
inherited;
f.Write(FValue[0], 12);
end;
initialization
nullitem := TBSONItem.Create;
finalization
nullitem.Free;
end.