This repository has been archived by the owner on Feb 4, 2021. It is now read-only.
Permalink
Cannot retrieve contributors at this time
Name already in use
A tag already exists with the provided branch name. Many Git commands accept both tag and branch names, so creating this branch may cause unexpected behavior. Are you sure you want to create this branch?
pebongo/_bson.pas
Go to fileThis commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
1421 lines (1174 sloc)
31.4 KB
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
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. | |