Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

TMongo connection class finished

  • Loading branch information...
commit 553428b44d24d2682c33300d94f3df3fef375e27 1 parent 46e5054
@gerald-lindsly authored
View
81 MongoBson.pas
@@ -84,6 +84,8 @@ TBsonBuffer = class(TObject)
function append(name : PAnsiChar; value : TBsonRegex) : Boolean; overload;
function append(name : PAnsiChar; value : TBsonTimestamp) : Boolean; overload;
function append(name : PAnsiChar; value : TBsonBinary) : Boolean; overload;
+ function append(name : PAnsiChar; value : TBson) : Boolean; overload;
+ function append(name : PAnsiChar; value : OleVariant) : Boolean; overload;
function appendNull(name : PAnsiChar) : Boolean;
function appendCode(name : PAnsiChar; value : PAnsiChar) : Boolean;
function appendSymbol(name : PAnsiChar; value : PAnsiChar) : Boolean;
@@ -98,9 +100,8 @@ TBsonBuffer = class(TObject)
end;
TBson = class(TObject)
- private
- var handle : Pointer;
- public
+ var handle : Pointer;
+
function size() : Integer;
function iterator() : TBsonIterator;
function find(name : PAnsiChar) : TBsonIterator;
@@ -129,7 +130,15 @@ TBsonIterator = class(TObject)
destructor Destroy; override;
end;
- function BSON(x : array of Variant) : TBson;
+ var
+ bsonEmpty : TBson;
+
+ (* The idea for this shorthand way to build a BSON
+ document from an array of variants came from Stijn Sanders
+ and his TMongoWire, located here:
+ https://github.com/stijnsanders/TMongoWire
+ *)
+ function BSON(x : array of OleVariant) : TBson;
function ByteToHex(InByte : Byte) : string;
implementation
@@ -176,6 +185,8 @@ implementation
cdecl; external 'mongoc.dll';
function bson_append_binary(b : Pointer; name : PAnsiChar; kind : Byte; data : Pointer; len : Integer) : Integer;
cdecl; external 'mongoc.dll';
+ function bson_append_bson(b : Pointer; name : PAnsiChar; value : Pointer) : Integer;
+ cdecl; external 'mongoc.dll';
function bson_buffer_size(b : Pointer) : Integer; cdecl; external 'mongoc.dll';
function bson_size(b : Pointer) : Integer; cdecl; external 'mongoc.dll';
function bson_iterator_create() : Pointer; external 'mongoc.dll';
@@ -446,6 +457,26 @@ implementation
Result := (bson_append_binary(handle, name, value.kind, value.data, value.len) = 0);
end;
+ function TBsonBuffer.append(name : PAnsiChar; value : OleVariant) : Boolean;
+ var
+ d : double;
+ begin
+ case VarType(value) of
+ varNull: Result := appendNull(name);
+ varInteger: Result := append(name, Integer(value));
+ varSingle, varDouble, varCurrency: begin
+ d := value;
+ Result := append(name, d);
+ end;
+ varDate: Result := append(name, TDateTime(value));
+ varInt64: Result := append(name, Int64(value));
+ varBoolean: Result := append(name, Boolean(value));
+ varOleStr: Result := append(name, PAnsiChar(AnsiString(value)));
+ else
+ raise Exception.Create('TBson.append(variant): type not supported (' + IntToStr(VarType(value)) + ')');
+ end;
+ end;
+
function TBsonBuffer.appendNull(name: PAnsiChar) : Boolean;
begin
if handle = nil then
@@ -460,6 +491,11 @@ implementation
Result := (bson_append_binary(handle, name, kind, data, length) = 0);
end;
+ function TBsonBuffer.append(name : PAnsiChar; value : TBson) : Boolean;
+ begin
+ Result := (bson_append_bson(handle, name, value.handle) = 0);
+ end;
+
function TBsonBuffer.startObject(name: PAnsiChar) : Boolean;
begin
if handle = nil then
@@ -595,6 +631,9 @@ implementation
procedure TBson.display();
begin
+ if Self = nil then
+ WriteLn('nil BSON')
+ else
_display(iterator, 0);
end;
@@ -671,25 +710,25 @@ implementation
result := digits[InByte shr 4] + digits[InByte and $0F];
end;
- function BSON(x : array of Variant) : TBson;
+ function BSON(x : array of OleVariant) : TBson;
var
- len : Integer;
- i : Integer;
- bb : TBsonBuffer;
+ len : Integer;
+ i : Integer;
+ bb : TBsonBuffer;
depth : Integer;
- key : string;
+ key : string;
value : string;
- name : PAnsiChar;
+ name : PAnsiChar;
begin
bb := TBsonBuffer.Create();
len := Length(x);
i := 0;
depth := 0;
- while i < len do
+ while i < len do begin
key := VarToStr(x[i]);
if key = '}' then begin
if depth = 0 then
- Raise Exception.Create('BSON: unexpected "}"');
+ Raise Exception.Create('BSON(): unexpected "}"');
bb.finishObject();
dec(depth);
end
@@ -697,23 +736,23 @@ implementation
name := PAnsiChar(AnsiString(key));
inc(i);
if i = Len then
- raise Exception.Create('BSON: expected value for ' + key);
+ raise Exception.Create('BSON(): expected value for ' + key);
value := VarToStr(x[i]);
if value = '{' then begin
bb.startObject(name);
inc(depth);
end
else
- case VarType(x[i]) of
- varNull: bb.appendNull(name);
- varInteger: bb.append(name, Integer(x[i]));
- end;
-
+ bb.append(name, x[i]);
end;
inc(i);
-
-
-
+ end;
+ if depth > 0 then
+ Raise Exception.Create('BSON: open subobject');
+ Result := bb.finish();
end;
+ initialization
+ bsonEmpty := BSON([]);
+
end.
View
639 MongoDB.pas
@@ -0,0 +1,639 @@
+unit MongoDB;
+
+interface
+ Uses
+ MongoBson;
+
+ type
+ TMongoCursor = class;
+ TStringArray = array of string;
+
+ TMongo = class(TObject)
+ var handle : Pointer;
+
+ const
+ updateUpsert = 1;
+ updateMulti = 2;
+ updateBasic = 4;
+ indexUnique = 1;
+ indexDropDups = 4;
+ indexBackground = 8;
+ indexSparse = 16;
+
+ constructor Create(); overload;
+ constructor Create(host : string); overload;
+ function isConnected() : Boolean;
+ function checkConnection() : Boolean;
+ function isMaster() : Boolean;
+ procedure disconnect();
+ function reconnect() : Boolean;
+ function getErr() : Integer;
+ function setTimeout(millis : Integer) : Boolean;
+ function getTimeout() : Integer;
+ function getPrimary() : string;
+ function getSocket() : Integer;
+ function getDatabases() : TStringArray;
+ function getDatabaseCollections(db : string) : TStringArray;
+ function rename(from_ns : string; to_ns : string) : Boolean;
+ function drop(ns : string) : Boolean;
+ function dropDatabase(db : string) : Boolean;
+ function insert(ns : string; b : TBson) : Boolean; overload;
+ function insert(ns : string; bs : array of TBson) : Boolean; overload;
+ function update(ns : string; criteria : TBson; objNew : TBson) : Boolean; overload;
+ function update(ns : string; criteria : TBson; objNew : TBson; flags : Integer) : Boolean; overload;
+ function remove(ns : string; criteria : TBson) : Boolean;
+ function findOne(ns : string; query : TBson) : TBson; overload;
+ function findOne(ns : string; query : TBson; fields : TBson) : TBson; overload;
+ function find(ns : string; cursor : TMongoCursor) : Boolean;
+ function count(ns : string) : Double; overload;
+ function count(ns : string; query : TBson) : Double; overload;
+ function indexCreate(ns : string; key : string) : TBson; overload;
+ function indexCreate(ns : string; key : string; options : Integer) : TBson; overload;
+ function indexCreate(ns : string; key : TBson) : TBson; overload;
+ function indexCreate(ns : string; key : TBson; options : Integer) : TBson; overload;
+ function addUser(name : string; password : string) : Boolean; overload;
+ function addUser(name : string; password : string; db : string) : Boolean; overload;
+ function authenticate(name : string; password : string) : Boolean; overload;
+ function authenticate(name : string; password : string; db : string) : Boolean; overload;
+ function command(db : string; command : TBson) : TBson; overload;
+ function command(db : string; cmdstr : string; arg : OleVariant) : TBson; overload;
+ function getLastErr(db : string) : TBson;
+ function getPrevErr(db : string) : TBson;
+ procedure resetErr(db : string);
+ function getServerErr() : Integer;
+ function getServerErrString() : string;
+ destructor Destroy(); override;
+ end;
+
+ TMongoReplset = class(TMongo)
+ constructor Create(name : string);
+ procedure addSeed(host : string);
+ function Connect() : Boolean;
+ function getHostCount() : Integer;
+ function getHost(i : Integer) : string;
+ end;
+
+ TMongoCursor = class(TObject)
+ var
+ handle : Pointer;
+ query : TBson;
+ sort : TBson;
+ fields : TBson;
+ limit : Integer;
+ skip : Integer;
+ options : Integer;
+ conn : TMongo; (* hold ref to prevent release *)
+
+ const
+ tailable = 2; (* Create a tailable cursor. *)
+ slave_ok = 4; (* Allow queries on a non-primary node. *)
+ no_timeout = 16; (* Disable cursor timeouts. *)
+ await_data = 32; (* Momentarily block for more data. *)
+ exhaust = 64; (* Stream in multiple 'more' packages. *)
+ partial = 128; (* Allow reads even if a shard is down. *)
+
+ constructor Create(); overload;
+ constructor Create(query_ : TBson); overload;
+ destructor Destroy(); override;
+ function next() : Boolean;
+ function value() : TBson;
+ end;
+
+implementation
+ Uses
+ SysUtils;
+
+ function mongo_create() : Pointer; cdecl; external 'mongoc.dll';
+ procedure mongo_dispose(c : Pointer); cdecl; external 'mongoc.dll';
+ function mongo_connect(c : Pointer; host : PAnsiChar; port : Integer) : Integer;
+ cdecl; external 'mongoc.dll';
+ procedure mongo_destroy(c : Pointer); cdecl; external 'mongoc.dll';
+ procedure mongo_replset_init(c : Pointer; name : PAnsiChar); external 'mongoc.dll';
+ procedure mongo_replset_add_seed(c : Pointer; host : PAnsiChar; port : Integer);
+ cdecl; external 'mongoc.dll';
+ function mongo_replset_connect(c : Pointer) : Integer; cdecl; external 'mongoc.dll';
+ function mongo_is_connected(c : Pointer) : Boolean; cdecl; external 'mongoc.dll';
+ function mongo_get_err(c : Pointer) : Integer; cdecl; external 'mongoc.dll';
+ function mongo_set_op_timeout(c : Pointer; millis : Integer) : Integer;
+ cdecl; external 'mongoc.dll';
+ function mongo_get_op_timeout(c : Pointer) : Integer; cdecl; external 'mongoc.dll';
+ function mongo_get_primary(c : Pointer) : PAnsiChar; cdecl; external 'mongoc.dll';
+ function mongo_check_connection(c : Pointer) : Integer; cdecl; external 'mongoc.dll';
+ procedure mongo_disconnect(c : Pointer); cdecl; external 'mongoc.dll';
+ function mongo_reconnect(c : Pointer) : Integer; cdecl; external 'mongoc.dll';
+ function mongo_cmd_ismaster(c : Pointer; b : Pointer) : Boolean;
+ cdecl; external 'mongoc.dll';
+ function mongo_get_socket(c : Pointer) : Integer; cdecl; external 'mongoc.dll';
+ function mongo_get_host_count(c : Pointer) : Integer; cdecl; external 'mongoc.dll';
+ function mongo_get_host(c : Pointer; i : Integer) : PAnsiChar; cdecl; external 'mongoc.dll';
+ function mongo_insert(c : Pointer; ns : PAnsiChar; b : Pointer) : Integer;
+ cdecl; external 'mongoc.dll';
+ function mongo_insert_batch(c : Pointer; ns : PAnsiChar; bsons : Pointer; count : Integer) : Integer;
+ cdecl; external 'mongoc.dll';
+ function mongo_update(c : Pointer; ns : PAnsiChar; cond : Pointer; op : Pointer; flags : Integer) : Integer;
+ cdecl; external 'mongoc.dll';
+ function mongo_remove(c : Pointer; ns : PAnsiChar; criteria : Pointer) : Integer;
+ cdecl; external 'mongoc.dll';
+ function mongo_find_one(c : Pointer; ns : PAnsiChar; query : Pointer; fields : Pointer; result : Pointer) : Integer;
+ cdecl; external 'mongoc.dll';
+ function bson_create() : Pointer; external 'mongoc.dll';
+ procedure bson_dispose(b : Pointer); cdecl; external 'mongoc.dll';
+ procedure bson_copy(dest : Pointer; src : Pointer); cdecl; external 'mongoc.dll';
+ function mongo_cursor_create() : Pointer; cdecl; external 'mongoc.dll';
+ procedure mongo_cursor_dispose(cursor : Pointer); cdecl; external 'mongoc.dll';
+ procedure mongo_cursor_destroy(cursor : Pointer); cdecl; external 'mongoc.dll';
+ function mongo_find(c : Pointer; ns : PAnsiChar; query : Pointer; fields : Pointer;
+ limit, skip, options : Integer) : Pointer; cdecl; external 'mongoc.dll';
+ function mongo_cursor_next(cursor : Pointer) : Integer; cdecl; external 'mongoc.dll';
+ function mongo_cursor_bson(cursor : Pointer) : Pointer; cdecl; external 'mongoc.dll';
+ function mongo_cmd_drop_collection(c : Pointer; db : PAnsiChar; collection : PAnsiChar; result : Pointer) : Integer;
+ cdecl; external 'mongoc.dll';
+ function mongo_cmd_drop_db(c : Pointer; db : PAnsiChar) : Integer; cdecl; external 'mongoc.dll';
+ function mongo_count(c : Pointer; db : PAnsiChar; collection : PAnsiChar; query : Pointer) : Double;
+ cdecl; external 'mongoc.dll';
+ function mongo_create_index(c : Pointer; ns : PAnsiChar; key : Pointer; options : Integer; res : Pointer) : Integer;
+ cdecl; external 'mongoc.dll';
+ function mongo_cmd_add_user(c : Pointer; db : PAnsiChar; name : PAnsiChar; password : PAnsiChar) : Integer;
+ cdecl; external 'mongoc.dll';
+ function mongo_cmd_authenticate(c : Pointer; db : PAnsiChar; name : PAnsiChar; password : PAnsiChar) : Integer;
+ cdecl; external 'mongoc.dll';
+ function mongo_run_command(c : Pointer; db : PAnsiChar; command : Pointer; res: Pointer) : Integer;
+ cdecl; external 'mongoc.dll';
+ function mongo_cmd_get_last_error(c : Pointer; db : PAnsiChar; res: Pointer) : Integer;
+ cdecl; external 'mongoc.dll';
+ function mongo_cmd_get_prev_error(c : Pointer; db : PAnsiChar; res: Pointer) : Integer;
+ cdecl; external 'mongoc.dll';
+ function mongo_get_server_err(c : Pointer) : Integer; cdecl; external 'mongoc.dll';
+ function mongo_get_server_err_string(c : Pointer) : PAnsiChar; cdecl; external 'mongoc.dll';
+
+ procedure parseHost(host : string; var hosturl : string; var port : Integer);
+ var i : Integer;
+ begin
+ i := Pos(':', host);
+ hosturl := Copy(host, 1, i - 1);
+ port := StrToInt(Copy(host, i + 1, Length(host) - i));
+ end;
+
+ constructor TMongo.Create();
+ begin
+ handle := mongo_create();
+ mongo_connect(handle, '127.0.0.1', 27017);
+ end;
+
+ constructor TMongo.Create(host : string);
+ var
+ hosturl : string;
+ port : Integer;
+ begin
+ handle := mongo_create();
+ parseHost(host, hosturl, port);
+ mongo_connect(handle, PAnsiChar(AnsiString(hosturl)), port);
+ end;
+
+ destructor TMongo.Destroy();
+ begin
+ mongo_destroy(handle);
+ mongo_dispose(handle);
+ end;
+
+ constructor TMongoReplset.Create(name: string);
+ begin
+ handle := mongo_create();
+ mongo_replset_init(handle, PAnsiChar(AnsiString(name)));
+ end;
+
+ procedure TMongoReplset.addSeed(host : string);
+ var
+ hosturl : string;
+ port : Integer;
+ begin
+ parseHost(host, hosturl, port);
+ mongo_replset_add_seed(handle, PAnsiChar(AnsiString(hosturl)), port);
+ end;
+
+ function TMongoReplset.Connect() : Boolean;
+ begin
+ Result := (mongo_replset_connect(handle) = 0);
+ end;
+
+ function TMongo.isConnected() : Boolean;
+ begin
+ Result := mongo_is_connected(handle);
+ end;
+
+ function TMongo.checkConnection() : Boolean;
+ begin
+ Result := (mongo_check_connection(handle) = 0);
+ end;
+
+ function TMongo.isMaster() : Boolean;
+ begin
+ Result := mongo_cmd_ismaster(handle, nil);
+ end;
+
+ procedure TMongo.disconnect();
+ begin
+ mongo_disconnect(handle);
+ end;
+
+ function TMongo.reconnect() : Boolean;
+ begin
+ Result := (mongo_reconnect(handle) = 0);
+ end;
+
+ function TMongo.getErr() : Integer;
+ begin
+ Result := mongo_get_err(handle);
+ end;
+
+ function TMongo.setTimeout(millis: Integer) : Boolean;
+ begin
+ Result := (mongo_set_op_timeout(handle, millis) = 0);
+ end;
+
+ function TMongo.getTimeout() : Integer;
+ begin
+ Result := mongo_get_op_timeout(handle);
+ end;
+
+ function TMongo.getPrimary() : string;
+ begin
+ Result := string(mongo_get_primary(handle));
+ end;
+
+ function TMongo.getSocket() : Integer;
+ begin
+ Result := mongo_get_socket(handle);
+ end;
+
+ function TMongoReplset.getHostCount() : Integer;
+ begin
+ Result := mongo_get_host_count(handle);
+ end;
+
+ function TMongoReplset.getHost(i : Integer) : string;
+ begin
+ Result := string(mongo_get_host(handle, i));
+ end;
+
+ function TMongo.getDatabases() : TStringArray;
+ var
+ b : TBson;
+ it, databases, database : TBsonIterator;
+ name : string;
+ count, i : Integer;
+ begin
+ b := command('admin', 'listDatabases', True);
+ if b = nil then
+ Result := nil
+ else begin
+ it := b.iterator;
+ it.next();
+ count := 0;
+ databases := it.subiterator();
+ while databases.next() do begin
+ database := databases.subiterator();
+ database.next();
+ name := database.value();
+ if (name <> 'admin') and (name <> 'local') then
+ inc(count);
+ end;
+ SetLength(Result, count);
+ i := 0;
+ databases := it.subiterator();
+ while databases.next() do begin
+ database := databases.subiterator();
+ database.next();
+ name := database.value();
+ if (name <> 'admin') and (name <> 'local') then begin
+ Result[i] := name;
+ inc(i);
+ end;
+ end;
+ end;
+ end;
+
+ function TMongo.getDatabaseCollections(db : string) : TStringArray;
+ var
+ cursor : TMongoCursor;
+ count, i : Integer;
+ ns, name : string;
+ b : TBson;
+ begin
+ count := 0;
+ ns := db + '.system.namespaces';
+ cursor := TMongoCursor.Create();
+ if find(ns, cursor) then
+ while cursor.next() do begin
+ b := cursor.value();
+ name := b.value('name');
+ if (Pos('.system.', name) = 0) and (Pos('$', name) = 0) then
+ inc(count);
+ end;
+ SetLength(Result, count);
+ i := 0;
+ cursor := TMongoCursor.Create();
+ if find(ns, cursor) then
+ while cursor.next() do begin
+ b := cursor.value();
+ name := b.value('name');
+ if (Pos('.system.', name) = 0) and (Pos('$', name) = 0) then begin
+ Result[i] := name;
+ inc(i);
+ end;
+ end;
+ end;
+
+ function TMongo.rename(from_ns : string; to_ns : string) : Boolean;
+ begin
+ Result := (command('admin', BSON(['renameCollection', from_ns, 'to', to_ns])) <> nil);
+ end;
+
+ function TMongo.drop(ns : string) : Boolean;
+ var
+ db : string;
+ collection : string;
+ i : Integer;
+ begin
+ i := Pos('.', ns);
+ if i = 0 then
+ Raise Exception.Create('TMongo.drop: expected a ''.'' in the namespace.');
+ db := Copy(ns, 1, i - 1);
+ collection := Copy(ns, i+1, Length(ns) - i);
+ Result := (mongo_cmd_drop_collection(handle, PAnsiChar(AnsiString(db)),
+ PAnsiChar(AnsiString(collection)), nil) = 0);
+ end;
+
+ function TMongo.dropDatabase(db : string) : Boolean;
+ begin
+ Result := (mongo_cmd_drop_db(handle, PAnsiChar(AnsiString(db))) = 0);
+ end;
+
+ function TMongo.insert(ns: string; b: TBson) : Boolean;
+ begin
+ Result := (mongo_insert(handle, PAnsiChar(AnsiString(ns)), b.handle) = 0);
+ end;
+
+ function TMongo.insert(ns: string; bs: array of TBson) : Boolean;
+ var
+ ps : array of Pointer;
+ i : Integer;
+ len : Integer;
+ begin
+ len := Length(bs);
+ SetLength(ps, Len);
+ for i := 0 to Len-1 do
+ ps[i] := bs[i].handle;
+ Result := (mongo_insert_batch(handle, PAnsiChar(AnsiString(ns)), &ps, len) = 0);
+ end;
+
+ function TMongo.update(ns : string; criteria : TBson; objNew : TBson; flags : Integer) : Boolean;
+ begin
+ Result := (mongo_update(handle, PAnsiChar(AnsiString(ns)), criteria.handle, objNew.handle, flags) = 0);
+ end;
+
+ function TMongo.update(ns : string; criteria : TBson; objNew : TBson) : Boolean;
+ begin
+ Result := update(ns, criteria, objNew, 0);
+ end;
+
+ function TMongo.remove(ns : string; criteria : TBson) : Boolean;
+ begin
+ Result := (mongo_remove(handle, PAnsiChar(AnsiString(ns)), criteria.handle) = 0);
+ end;
+
+ function TMongo.findOne(ns : string; query : TBson; fields : TBson) : TBson;
+ var
+ res : Pointer;
+ begin
+ res := bson_create();
+ if (mongo_find_one(handle, PAnsiChar(AnsiString(ns)), query.handle, fields.handle, res) = 0) then
+ Result := TBson.Create(res)
+ else begin
+ mongo_dispose(res);
+ Result := nil;
+ end;
+ end;
+
+ function TMongo.findOne(ns : string; query : TBson) : TBson;
+ begin
+ Result := findOne(ns, query, TBson.Create(nil));
+ end;
+
+ constructor TMongoCursor.Create();
+ begin
+ handle := nil;
+ query := nil;
+ sort := nil;
+ fields := nil;
+ limit := 0;
+ skip := 0;
+ options := 0;
+ conn := nil;
+ end;
+
+ constructor TMongoCursor.Create(query_ : TBson);
+ begin
+ handle := nil;
+ query := query_;
+ sort := nil;
+ fields := nil;
+ limit := 0;
+ skip := 0;
+ options := 0;
+ conn := nil;
+ end;
+
+ destructor TMongoCursor.Destroy();
+ begin
+ mongo_cursor_destroy(handle);
+ mongo_cursor_dispose(handle);
+ end;
+
+ function TMongo.find(ns : string; cursor : TMongoCursor) : Boolean;
+ var
+ q : TBson;
+ bb : TBsonBuffer;
+ ch : Pointer;
+ begin
+ if cursor.fields = nil then
+ cursor.fields := TBson.Create(nil);
+ q := cursor.query;
+ if q = nil then
+ q := bsonEmpty;
+ if cursor.sort <> nil then begin
+ bb := TBsonBuffer.Create();
+ bb.append('$query', cursor.query);
+ bb.append('$sort', cursor.sort);
+ q := bb.finish;
+ end;
+ cursor.conn := Self;
+ ch := mongo_find(handle, PAnsiChar(AnsiString(ns)), q.handle, cursor.fields.handle,
+ cursor.limit, cursor.skip, cursor.options);
+ if ch <> nil then begin
+ cursor.handle := ch;
+ Result := True;
+ end
+ else
+ Result := False;
+ end;
+
+
+ function TMongoCursor.next() : Boolean;
+ begin
+ Result := (mongo_cursor_next(handle) = 0);
+ end;
+
+ function TMongoCursor.value() : TBson;
+ var
+ b : TBson;
+ h : Pointer;
+ begin
+ h := bson_create();
+ b := TBson.Create(h);
+ bson_copy(h, mongo_cursor_bson(handle));
+ Result := b;
+ end;
+
+ function TMongo.count(ns : string; query : TBson) : Double;
+ var
+ db : string;
+ collection : string;
+ i : Integer;
+ begin
+ i := Pos('.', ns);
+ if i = 0 then
+ Raise Exception.Create('TMongo.drop: expected a ''.'' in the namespace.');
+ db := Copy(ns, 1, i - 1);
+ collection := Copy(ns, i+1, Length(ns) - i);
+ Result := mongo_count(handle, PAnsiChar(AnsiString(db)),
+ PAnsiChar(AnsiString(collection)), query.handle);
+ end;
+
+ function TMongo.count(ns : string) : Double;
+ begin
+ Result := count(ns, TBson.Create(nil));
+ end;
+
+ function TMongo.indexCreate(ns : string; key : TBson; options : Integer) : TBson;
+ var
+ res : TBson;
+ created : Boolean;
+ begin
+ res := TBson.Create(bson_create());
+ created := (mongo_create_index(handle, PAnsiChar(AnsiString(ns)), key.handle, options, res.handle) = 0);
+ if not created then
+ Result := res
+ else
+ Result := nil;
+ end;
+
+ function TMongo.indexCreate(ns : string; key : TBson) : TBson;
+ begin
+ Result := indexCreate(ns, key, 0);
+ end;
+
+ function TMongo.indexCreate(ns : string; key : string; options : Integer) : TBson;
+ begin
+ Result := indexCreate(ns, BSON([key, True]), options);
+ end;
+
+ function TMongo.indexCreate(ns : string; key : string) : TBson;
+ begin
+ Result := indexCreate(ns, key, 0);
+ end;
+
+ function TMongo.addUser(name : string; password : string; db : string) : Boolean;
+ begin
+ Result := (mongo_cmd_add_user(handle, PAnsiChar(AnsiString(db)),
+ PAnsiChar(AnsiString(name)),
+ PAnsiChar(AnsiString(password))) = 0);
+ end;
+
+ function TMongo.addUser(name : string; password : string) : Boolean;
+ begin
+ Result := addUser(name, password, 'admin');
+ end;
+
+ function TMongo.authenticate(name : string; password : string; db : string) : Boolean;
+ begin
+ Result := (mongo_cmd_authenticate(handle, PAnsiChar(AnsiString(db)),
+ PAnsiChar(AnsiString(name)),
+ PAnsiChar(AnsiString(password))) = 0);
+ end;
+
+ function TMongo.authenticate(name : string; password : string) : Boolean;
+ begin
+ Result := authenticate(name, password, 'admin');
+ end;
+
+ function TMongo.command(db : string; command : TBson) : TBson;
+ var
+ b : TBson;
+ res : Pointer;
+ begin
+ res := bson_create();
+ if mongo_run_command(handle, PAnsiChar(AnsiString(db)), command.handle, res) = 0 then begin
+ b := TBson.Create(bson_create());
+ bson_copy(b.handle, res);
+ Result := b;
+ end
+ else
+ Result := nil;
+ bson_dispose(res);
+ end;
+
+ function TMongo.command(db : string; cmdstr : string; arg : OleVariant) : TBson;
+ begin
+ Result := command(db, BSON([cmdstr, arg]));
+ end;
+
+ function TMongo.getLastErr(db : string) : TBson;
+ var
+ b : TBson;
+ res : Pointer;
+ begin
+ res := bson_create();
+ if mongo_cmd_get_last_error(handle, PAnsiChar(AnsiString(db)), res) <> 0 then begin
+ b := TBson.Create(bson_create());
+ bson_copy(b.handle, res);
+ Result := b;
+ end
+ else
+ Result := nil;
+ bson_dispose(res);
+ end;
+
+ function TMongo.getPrevErr(db : string) : TBson;
+ var
+ b : TBson;
+ res : Pointer;
+ begin
+ res := bson_create();
+ if mongo_cmd_get_prev_error(handle, PAnsiChar(AnsiString(db)), res) <> 0 then begin
+ b := TBson.Create(bson_create());
+ bson_copy(b.handle, res);
+ Result := b;
+ end
+ else
+ Result := nil;
+ bson_dispose(res);
+ end;
+
+ procedure TMongo.resetErr(db : string);
+ begin
+ command(db, 'reseterror', True);
+ end;
+
+ function TMongo.getServerErr() : Integer;
+ begin
+ Result := mongo_get_server_err(handle);
+ end;
+
+ function TMongo.getServerErrString() : string;
+ begin
+ Result := string(mongo_get_server_err_string(handle));
+ end;
+
+end.
+
View
3  MongoDelphiDriver.dpk
@@ -31,6 +31,7 @@ requires
rtl;
contains
- Bson in 'Bson.pas';
+ MongoBson in 'MongoBson.pas',
+ MongoDB in 'MongoDB.pas';
end.
View
3  MongoDelphiDriver.dproj
@@ -97,7 +97,8 @@
<MainSource>MainSource</MainSource>
</DelphiCompile>
<DCCReference Include="rtl.dcp"/>
- <DCCReference Include="Bson.pas"/>
+ <DCCReference Include="MongoBson.pas"/>
+ <DCCReference Include="MongoDB.pas"/>
<BuildConfiguration Include="Release">
<Key>Cfg_2</Key>
<CfgParent>Base</CfgParent>
View
6 MongoDelphiDriver.groupproj.local
@@ -1,6 +1,6 @@
<?xml version="1.0" encoding="utf-8"?>
<BorlandProject>
- <Default.Personality>
- <Projects ActiveProject="C:\10gen\mongo-delphi-driver\Test.dproj"/>
- </Default.Personality>
+ <Default.Personality>
+ <Projects ActiveProject="C:\10gen\mongo-delphi-driver\Test.dproj"/>
+ </Default.Personality>
</BorlandProject>
View
208 Test.dpr
@@ -6,16 +6,37 @@ program Test;
uses
System.SysUtils,
- Bson;
+ Variants,
+ MongoBson, MongoDB;
var
bb : TBsonBuffer;
cws : TBsonCodeWScope;
- b : TBson;
+ b, b2, x, y, z, criteria, query, cmd : TBson;
i : TBsonIterator;
oid : TBsonOID;
ts : TBsonTimestamp;
bin : TBsonBinary;
+ sing : Single;
+ mongo : TMongo;
+ count : Integer;
+ j : Integer;
+ cursor : TMongoCursor;
+ databases : TStringArray;
+
+const
+ db = 'test';
+ ns = db + '.people';
+
+procedure displayCollections(db : string);
+var
+ collections : TStringArray;
+ j : Integer;
+begin
+ collections := mongo.getDatabaseCollections(db);
+ for j := 0 to Length(collections)-1 do
+ Writeln(collections[j]);
+end;
begin
try
@@ -58,8 +79,189 @@ begin
bin := i.getBinary();
WriteLn(bin.len);
+ sing := 3.14159;
+
+ b2 := BSON(['test', 'testing', 'age', 32,
+ 'subobj', '{',
+ 'single', sing,
+ '}',
+ 'int64', Int64(1234567890123),
+ 'double', 98.7, 'null', Null, 'logical', False, 'now', now ]);
+ b2.display();
+
+ mongo := TMongo.Create();
+ if mongo.isConnected() then begin
+ mongo.setTimeout(0);
+ WriteLn('Timeout = ', mongo.getTimeout());
+ WriteLn('Primary = ', mongo.getPrimary());
+ WriteLn('IsMaster = ', mongo.isMaster());
+ WriteLn('Socket = ', mongo.getSocket());
+ WriteLn('Check = ', mongo.checkConnection());
+ WriteLn('disconnect');
+ mongo.disconnect();
+ WriteLn(' Check = ', mongo.checkConnection());
+ WriteLn('reconnect');
+ mongo.reconnect();
+ WriteLn(' Check = ', mongo.checkConnection());
+
+ databases := mongo.getDatabases();
+ for j := 0 to Length(databases)-1 do
+ Writeln(databases[j]);
+
+ displayCollections(db);
+ mongo.rename(ns, 'test.renamed');
+ displayCollections(db);
+ mongo.rename('test.renamed', ns);
+ displayCollections(db);
+
+
+ WriteLn('Drop = ', mongo.drop(ns));
+
+ mongo.indexCreate(ns, 'name', mongo.indexUnique);
+
+ (* display hosts for a TMongoReplset
+ Count := mongo.getHostCount();
+ WriteLn('Replset Host Count = ', Count);
+ for j := 0 to count - 1 do
+ WriteLn('Host = ', mongo.getHost(j));
+ *)
+
+ (* insert the collage document *)
+ mongo.insert(ns, b);
+
+ (* Insert a couple more people *)
+ bb := TBsonBuffer.Create();
+ bb.append('name', 'Abe');
+ bb.append('age', 32);
+ bb.append('city', 'Washington');
+ x := bb.finish;
+ x.display();
+ Writeln(mongo.insert(ns, x));
+
+ bb := TBsonBuffer.Create();
+ bb.append('name', 'Joe');
+ bb.append('age', 35);
+ bb.append('city', 'Natick');
+ x := bb.finish;
+ x.display();
+ Writeln(mongo.insert(ns, x));
+
+ (* Batch insert 3 people *)
+ bb := TBsonBuffer.Create();
+ bb.append('name', 'Jeff');
+ bb.append('age', 19);
+ bb.append('city', 'Florence');
+ x := bb.finish;
+ x.display();
+
+ bb := TBsonBuffer.Create();
+ bb.append('name', 'Harry');
+ bb.append('age', 36);
+ bb.append('city', 'Fort Aspenwood');
+ y := bb.finish;
+ y.display();
+
+ bb := TBsonBuffer.Create();
+ bb.append('name', 'John');
+ bb.append('age', 21);
+ bb.append('city', 'Cincinnati');
+ z := bb.finish;
+ z.display();
+ Writeln(mongo.insert(ns, [x, y, z]));
+
+ (* update Joe's document with a new one *)
+ bb := TBsonBuffer.Create();
+ bb.append('name', 'Joe');
+ bb.append('age', 36);
+ bb.append('city', 'Natick');
+ x := bb.finish;
+ criteria := BSON(['name', 'Joe']);
+ x.display();
+ Writeln(mongo.update(ns, criteria, x));
+
+ (* do an upsert *)
+ bb := TBsonBuffer.Create();
+ bb.append('name', 'Paul');
+ bb.append('age', 53);
+ bb.append('city', 'Seattle');
+ x := bb.finish;
+ criteria := BSON(['name', 'Paul']);
+ criteria.display();
+ x.display();
+ Writeln(mongo.update(ns, criteria, x, mongo.updateUpsert));
+
+ (* Remove a record *)
+ WriteLn(mongo.remove(ns, BSON(['name', 'John'])));
+
+ (* successful findOne *)
+ x := mongo.findOne(ns, criteria);
+ x.display();
+
+ (* unsuccessful findOne *)
+ x := mongo.findOne(ns, BSON(['name', 'unknown']));
+ x.display();
+
+ (* display all people *)
+ cursor := TMongoCursor.Create();
+ if mongo.find(ns, cursor) then
+ while cursor.next() do
+ cursor.value.display();
+
+ (* display all people age 36 *)
+ query := BSON(['age', 36]);
+ cursor := TMongoCursor.Create(query);
+ if mongo.find(ns, cursor) then
+ while cursor.next() do
+ cursor.value.display();
+
+ WriteLn(mongo.count(ns));
+ cmd := BSON(['count', 'people']);
+ b := mongo.command(db, cmd);
+ WriteLn(b.value('n'));
+ b := mongo.command(db, 'count', 'people');
+ WriteLn(b.value('n'));
+
+ WriteLn(mongo.count(ns, query));
+
+ (* add a user to database 'admin' *)
+ mongo.addUser('Gerald', 'P97gwep16');
+
+ (* authenticate with correct credentials *)
+ WriteLn(mongo.authenticate('Gerald', 'P97gwep16'));
+
+ (* try authenicate with bad password *)
+ WriteLn(mongo.authenticate('Gerald', 'BadPass21'));
+
+ (* try authenticate with bad user *)
+ WriteLn(mongo.authenticate('Unsub', 'BadUser67'));
+
+ b := BSON(['name', 'dupkey']);
+ mongo.insert(ns, b);
+ mongo.insert(ns, b);
+ b := mongo.getLastErr(db);
+ b.display();
+
+ b := BSON(['name', '{', '$badop', true, '}' ]);
+ b2 := mongo.findOne(ns, b);
+ b2.display();
+ b := mongo.getLastErr(db);
+ b.display();
+ b := mongo.getPrevErr(db);
+ b.display();
+ WriteLn(mongo.getServerErr());
+ WriteLn(mongo.getServerErrString());
+
+ mongo.resetErr(db);
+ b := mongo.getLastErr(db);
+ b.display();
+
+
+ WriteLn('Done');
+ ReadLn;
+ end
+ else
+ WriteLn('No Connection, Err = ', mongo.getErr());
- { TODO -oUser -cConsole Main : Insert code here }
except
on E: Exception do
Writeln(E.ClassName, ': ', E.Message);
Please sign in to comment.
Something went wrong with that request. Please try again.