├── .gitignore ├── AddressBook.dpr ├── AddressBook.dproj ├── AddressBook.res ├── AddressBookForm.dfm ├── AddressBookForm.pas ├── COPYRIGHT.txt ├── GridFS.pas ├── LICENSE.txt ├── MongoBson.pas ├── MongoDB.pas ├── MongoDelphiDriver.dpk ├── MongoDelphiDriver.dproj ├── MongoDelphiDriver.groupproj ├── MongoDelphiDriver.groupproj.local ├── MongoDelphiDriver.res ├── README.md ├── Test.dpr ├── Test.dproj ├── Test.res └── mongo-c-driver.zip /.gitignore: -------------------------------------------------------------------------------- 1 | Win32/ 2 | Win64/ 3 | __history 4 | MongoDelphiDriver.dproj.local 5 | MongoDelphiDriver.identcache 6 | Test.dproj.local 7 | Test.identcache 8 | MongoDelphiDriver_prjgroup.tvsconfig 9 | AddressBook.dproj.local 10 | AddressBook.identcache 11 | -------------------------------------------------------------------------------- /AddressBook.dpr: -------------------------------------------------------------------------------- 1 | { 2 | Copyright 2009-2011 10gen Inc. 3 | 4 | Licensed under the Apache License, Version 2.0 (the "License"); 5 | you may not use this file except in compliance with the License. 6 | You may obtain a copy of the License at 7 | 8 | http://www.apache.org/licenses/LICENSE-2.0 9 | 10 | Unless required by applicable law or agreed to in writing, software 11 | distributed under the License is distributed on an "AS IS" BASIS, 12 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 13 | See the License for the specific language governing permissions and 14 | limitations under the License. 15 | } 16 | program AddressBook; 17 | 18 | uses 19 | Vcl.Forms, 20 | AddressBookForm in 'AddressBookForm.pas' {Form1}; 21 | 22 | {$R *.res} 23 | 24 | begin 25 | Application.Initialize; 26 | Application.MainFormOnTaskbar := True; 27 | Application.CreateForm(TForm1, Form1); 28 | Application.Run; 29 | end. 30 | -------------------------------------------------------------------------------- /AddressBook.dproj: -------------------------------------------------------------------------------- 1 | 2 | 3 | {EE370486-5233-498B-B225-FE8AEB2310C3} 4 | 13.4 5 | VCL 6 | AddressBook.dpr 7 | True 8 | Debug 9 | Win32 10 | 1 11 | Application 12 | 13 | 14 | true 15 | 16 | 17 | true 18 | Base 19 | true 20 | 21 | 22 | true 23 | Base 24 | true 25 | 26 | 27 | true 28 | Base 29 | true 30 | 31 | 32 | true 33 | Cfg_1 34 | true 35 | true 36 | 37 | 38 | true 39 | Base 40 | true 41 | 42 | 43 | bindcompfmx;fmx;rtl;dbrtl;IndySystem;DbxClientDriver;bindcomp;inetdb;DBXInterBaseDriver;DataSnapCommon;DataSnapClient;DataSnapServer;DataSnapProviderClient;xmlrtl;ibxpress;DbxCommonDriver;IndyProtocols;DBXMySQLDriver;dbxcds;bindengine;FMXTee;soaprtl;DBXOracleDriver;dsnap;DBXInformixDriver;IndyCore;fmxase;CloudService;FmxTeeUI;DBXFirebirdDriver;inet;fmxobj;inetdbxpress;DBXSybaseASADriver;fmxdae;dbexpress;DataSnapIndy10ServerTransport;IPIndyImpl;$(DCC_UsePackage) 44 | $(BDS)\bin\delphi_PROJECTICON.ico 45 | System;Xml;Data;Datasnap;Web;Soap;Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;$(DCC_Namespace) 46 | .\$(Platform)\$(Config) 47 | .\$(Platform)\$(Config) 48 | false 49 | false 50 | false 51 | false 52 | false 53 | 54 | 55 | TeeDB;vclib;Tee;DBXOdbcDriver;DBXSybaseASEDriver;vclimg;TeeUI;vclactnband;vcldb;vcldsnap;bindcompvcl;vclie;vcltouch;DBXDb2Driver;websnap;vclribbon;VclSmp;vcl;DataSnapConnectors;DBXMSSQLDriver;dsnapcon;vclx;webdsnap;adortl;$(DCC_UsePackage) 56 | 57 | 58 | vcldbx;frx16;TeeDB;Rave100VCL;vclib;Tee;inetdbbde;DBXOdbcDriver;svnui;DBXSybaseASEDriver;vclimg;frxDB16;intrawebdb_120_160;fmi;fs16;TeeUI;vclactnband;vcldb;vcldsnap;bindcompvcl;vclie;vcltouch;Intraweb_120_160;DBXDb2Driver;websnap;vclribbon;frxe16;VclSmp;fsDB16;vcl;DataSnapConnectors;DBXMSSQLDriver;CodeSiteExpressPkg;dsnapcon;vclx;webdsnap;svn;bdertl;adortl;$(DCC_UsePackage) 59 | true 60 | Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) 61 | 1033 62 | $(BDS)\bin\default_app.manifest 63 | CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments= 64 | 65 | 66 | DEBUG;$(DCC_Define) 67 | false 68 | true 69 | true 70 | true 71 | 72 | 73 | false 74 | 75 | 76 | false 77 | RELEASE;$(DCC_Define) 78 | 0 79 | false 80 | 81 | 82 | 83 | MainSource 84 | 85 | 86 | 87 | dfm 88 | 89 | 90 | Cfg_2 91 | Base 92 | 93 | 94 | Base 95 | 96 | 97 | Cfg_1 98 | Base 99 | 100 | 101 | 102 | Delphi.Personality.12 103 | 104 | 105 | 106 | 107 | False 108 | False 109 | 1 110 | 0 111 | 0 112 | 0 113 | False 114 | False 115 | False 116 | False 117 | False 118 | 1033 119 | 1252 120 | 121 | 122 | 123 | 124 | 1.0.0.0 125 | 126 | 127 | 128 | 129 | 130 | 1.0.0.0 131 | 132 | 133 | 134 | AddressBook.dpr 135 | 136 | 137 | 138 | 139 | False 140 | True 141 | 142 | 143 | 12 144 | 145 | 146 | 147 | 148 | -------------------------------------------------------------------------------- /AddressBook.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/gerald-lindsly/mongo-delphi-driver/6f4e145bab99ad3d737c484a8d0c3f284828a6f6/AddressBook.res -------------------------------------------------------------------------------- /AddressBookForm.dfm: -------------------------------------------------------------------------------- 1 | object Form1: TForm1 2 | Left = 0 3 | Top = 0 4 | Caption = 'MonogDelphiDriver Address Book' 5 | ClientHeight = 158 6 | ClientWidth = 363 7 | Color = clBtnFace 8 | Font.Charset = DEFAULT_CHARSET 9 | Font.Color = clWindowText 10 | Font.Height = -11 11 | Font.Name = 'Tahoma' 12 | Font.Style = [] 13 | OldCreateOrder = False 14 | PixelsPerInch = 96 15 | TextHeight = 13 16 | object lblName: TLabel 17 | Left = 8 18 | Top = 8 19 | Width = 27 20 | Height = 13 21 | Caption = 'Name' 22 | end 23 | object lblAddress: TLabel 24 | Left = 8 25 | Top = 35 26 | Width = 39 27 | Height = 13 28 | Caption = 'Address' 29 | end 30 | object lblCity: TLabel 31 | Left = 8 32 | Top = 62 33 | Width = 19 34 | Height = 13 35 | Caption = 'City' 36 | end 37 | object lblState: TLabel 38 | Left = 175 39 | Top = 62 40 | Width = 26 41 | Height = 13 42 | Caption = 'State' 43 | end 44 | object lblZip: TLabel 45 | Left = 263 46 | Top = 62 47 | Width = 14 48 | Height = 13 49 | Caption = 'Zip' 50 | end 51 | object lblPhone: TLabel 52 | Left = 8 53 | Top = 88 54 | Width = 30 55 | Height = 13 56 | Caption = 'Phone' 57 | end 58 | object txtName: TEdit 59 | Left = 57 60 | Top = 5 61 | Width = 296 62 | Height = 21 63 | TabOrder = 0 64 | end 65 | object txtAddress: TEdit 66 | Left = 57 67 | Top = 32 68 | Width = 296 69 | Height = 21 70 | TabOrder = 1 71 | end 72 | object txtCity: TEdit 73 | Left = 57 74 | Top = 59 75 | Width = 112 76 | Height = 21 77 | TabOrder = 2 78 | end 79 | object txtState: TEdit 80 | Left = 207 81 | Top = 59 82 | Width = 50 83 | Height = 21 84 | TabOrder = 3 85 | end 86 | object txtZip: TEdit 87 | Left = 283 88 | Top = 59 89 | Width = 70 90 | Height = 21 91 | TabOrder = 4 92 | end 93 | object txtPhone: TEdit 94 | Left = 57 95 | Top = 86 96 | Width = 112 97 | Height = 21 98 | TabOrder = 5 99 | end 100 | object btnClear: TButton 101 | Left = 8 102 | Top = 125 103 | Width = 75 104 | Height = 25 105 | Caption = 'Clear' 106 | TabOrder = 6 107 | OnClick = btnClearClick 108 | end 109 | object btnSave: TButton 110 | Left = 94 111 | Top = 125 112 | Width = 75 113 | Height = 25 114 | Caption = 'Save' 115 | TabOrder = 7 116 | OnClick = btnSaveClick 117 | end 118 | object btnSearch: TButton 119 | Left = 280 120 | Top = 125 121 | Width = 75 122 | Height = 25 123 | Caption = 'Search' 124 | TabOrder = 8 125 | OnClick = btnSearchClick 126 | end 127 | object btnDelete: TButton 128 | Left = 182 129 | Top = 125 130 | Width = 75 131 | Height = 25 132 | Caption = 'Delete' 133 | TabOrder = 9 134 | OnClick = btnDeleteClick 135 | end 136 | object btnPrev: TButton 137 | Left = 175 138 | Top = 86 139 | Width = 18 140 | Height = 21 141 | Caption = '<' 142 | TabOrder = 10 143 | OnClick = btnPrevClick 144 | end 145 | object btnNext: TButton 146 | Left = 199 147 | Top = 86 148 | Width = 18 149 | Height = 21 150 | Caption = '>' 151 | TabOrder = 11 152 | OnClick = btnNextClick 153 | end 154 | end 155 | -------------------------------------------------------------------------------- /AddressBookForm.pas: -------------------------------------------------------------------------------- 1 | { 2 | Copyright 2009-2011 10gen Inc. 3 | 4 | Licensed under the Apache License, Version 2.0 (the "License"); 5 | you may not use this file except in compliance with the License. 6 | You may obtain a copy of the License at 7 | 8 | http://www.apache.org/licenses/LICENSE-2.0 9 | 10 | Unless required by applicable law or agreed to in writing, software 11 | distributed under the License is distributed on an "AS IS" BASIS, 12 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 13 | See the License for the specific language governing permissions and 14 | limitations under the License. 15 | } 16 | unit AddressBookForm; 17 | 18 | interface 19 | 20 | uses 21 | Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, 22 | Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, 23 | MongoDB, MongoBson; 24 | 25 | type 26 | TForm1 = class(TForm) 27 | lblName: TLabel; 28 | txtName: TEdit; 29 | lblAddress: TLabel; 30 | txtAddress: TEdit; 31 | lblCity: TLabel; 32 | txtCity: TEdit; 33 | lblState: TLabel; 34 | txtState: TEdit; 35 | lblZip: TLabel; 36 | txtZip: TEdit; 37 | lblPhone: TLabel; 38 | txtPhone: TEdit; 39 | btnClear: TButton; 40 | btnSave: TButton; 41 | btnSearch: TButton; 42 | btnDelete: TButton; 43 | btnPrev: TButton; 44 | btnNext: TButton; 45 | procedure btnClearClick(Sender: TObject); 46 | procedure btnSaveClick(Sender: TObject); 47 | procedure btnDeleteClick(Sender: TObject); 48 | procedure btnSearchClick(Sender: TObject); 49 | procedure btnPrevClick(Sender: TObject); 50 | procedure ShowRecord(b : TBson); 51 | procedure btnNextClick(Sender: TObject); 52 | end; 53 | 54 | var 55 | Form1: TForm1; 56 | mongo: TMongo; 57 | 58 | implementation 59 | 60 | {$R *.dfm} 61 | 62 | const 63 | db = 'test'; 64 | ns = db + '.addresses'; 65 | 66 | procedure TForm1.btnClearClick(Sender: TObject); 67 | begin 68 | txtName.Text := ''; 69 | txtAddress.Text := ''; 70 | txtCity.Text := ''; 71 | txtState.Text := ''; 72 | txtZip.Text := ''; 73 | txtPhone.Text := ''; 74 | end; 75 | 76 | procedure TForm1.btnDeleteClick(Sender: TObject); 77 | var 78 | query : TBson; 79 | begin 80 | query := BSON(['phone', txtPhone.Text]); 81 | if mongo.findOne(ns, query) = nil Then 82 | ShowMessage('A record with that phone number does not exist.') 83 | else if MessageDlg('Delete record for phone number ' + txtPhone.Text + '?', 84 | mtWarning, [mbYes, MbNo], 0) = mrYes then begin 85 | mongo.remove(ns, query); 86 | btnClearClick(Sender); 87 | ShowMessage('Record deleted.'); 88 | end; 89 | end; 90 | 91 | procedure TForm1.ShowRecord(b : TBson); 92 | begin 93 | txtName.Text := b.value('name'); 94 | txtAddress.Text := b.value('address'); 95 | txtCity.Text := b.value('city'); 96 | txtState.Text := b.value('state'); 97 | txtZip.Text := b.value('zip'); 98 | txtPhone.Text := b.value('phone'); 99 | end; 100 | 101 | procedure TForm1.btnNextClick(Sender: TObject); 102 | var 103 | query, b : TBson; 104 | begin 105 | query := BSON(['phone', '{', '$gt', txtPhone.Text, '}']); 106 | b := mongo.findOne(ns, query); 107 | if b = nil then 108 | ShowMessage('No next record.') 109 | else 110 | ShowRecord(b); 111 | end; 112 | 113 | procedure TForm1.btnPrevClick(Sender: TObject); 114 | var 115 | query, b : TBson; 116 | begin 117 | query := BSON(['phone', '{', '$lt', txtPhone.Text, '}']); 118 | b := mongo.findOne(ns, query); 119 | if b = nil then 120 | ShowMessage('No previous record.') 121 | else 122 | ShowRecord(b); 123 | end; 124 | 125 | 126 | procedure TForm1.btnSaveClick(Sender: TObject); 127 | var 128 | bb : TBsonBuffer; 129 | b : TBson; 130 | query : TBson; 131 | begin 132 | query := BSON(['phone', txtPhone.Text]); 133 | if (mongo.findOne(ns, query) = nil) Or 134 | (MessageDlg('A record already exists with that phone number. Replace?', mtWarning, [mbYes, MbNo], 0) = mrYes) then begin 135 | bb := TbsonBuffer.Create(); 136 | bb.append('name', txtName.Text); 137 | bb.append('address', txtAddress.Text); 138 | bb.append('city', txtCity.Text); 139 | bb.append('state', txtState.Text); 140 | bb.append('zip', txtZip.Text); 141 | bb.append('phone', txtPhone.Text); 142 | b := bb.finish(); 143 | mongo.update(ns, query, b, updateUpsert); 144 | ShowMessage('Record saved.'); 145 | end; 146 | end; 147 | 148 | procedure TForm1.btnSearchClick(Sender: TObject); 149 | var 150 | bb : TBsonBuffer; 151 | query, b : TBson; 152 | begin 153 | bb := TbsonBuffer.Create(); 154 | if txtName.Text <> '' then begin 155 | bb.startObject('name'); 156 | bb.append('$regex', txtName.Text); 157 | bb.append('$options', 'i'); 158 | bb.finishObject(); 159 | end; 160 | if txtAddress.Text <> '' then begin 161 | bb.startObject('address'); 162 | bb.append('$regex', txtAddress.Text); 163 | bb.append('$options', 'i'); 164 | bb.finishObject(); 165 | end; 166 | if txtCity.Text <> '' then begin 167 | bb.startObject('city'); 168 | bb.append('$regex', txtCity.Text); 169 | bb.append('$options', 'i'); 170 | bb.finishObject(); 171 | end; 172 | if txtState.Text <> '' then begin 173 | bb.startObject('state'); 174 | bb.append('$regex', txtState.Text); 175 | bb.append('$options', 'i'); 176 | bb.finishObject(); 177 | end; 178 | if txtZip.Text <> '' then begin 179 | bb.startObject('zip'); 180 | bb.append('$regex', txtZip.Text); 181 | bb.append('$options', 'i'); 182 | bb.finishObject(); 183 | end; 184 | if txtPhone.Text <> '' then begin 185 | bb.startObject('phone'); 186 | bb.append('$regex', txtPhone.Text); 187 | bb.append('$options', 'i'); 188 | bb.finishObject(); 189 | end; 190 | query := bb.finish(); 191 | b := mongo.findOne(ns, query); 192 | if b = nil then 193 | ShowMessage('No match') 194 | else 195 | ShowRecord(b); 196 | end; 197 | 198 | 199 | const 200 | NoConnectMsg = 'Unable to connect to a MongoDB server running on localhost'; 201 | 202 | initialization 203 | mongo := TMongo.Create(); 204 | if not mongo.isConnected() then begin 205 | ShowMessage(NoConnectMsg); 206 | Halt(1); 207 | end; 208 | mongo.indexCreate(ns, 'phone'); 209 | 210 | 211 | end. 212 | -------------------------------------------------------------------------------- /COPYRIGHT.txt: -------------------------------------------------------------------------------- 1 | Copyright 2011 10gen Inc. 2 | 3 | Licensed under the Apache License, Version 2.0 (the "License"); 4 | you may not use this file except in compliance with the License. 5 | You may obtain a copy of the License at 6 | 7 | http://www.apache.org/licenses/LICENSE-2.0 8 | 9 | Unless required by applicable law or agreed to in writing, software 10 | distributed under the License is distributed on an "AS IS" BASIS, 11 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 12 | See the License for the specific language governing permissions and 13 | limitations under the License. -------------------------------------------------------------------------------- /GridFS.pas: -------------------------------------------------------------------------------- 1 | { 2 | Copyright 2009-2011 10gen Inc. 3 | 4 | Licensed under the Apache License, Version 2.0 (the "License"); 5 | you may not use this file except in compliance with the License. 6 | You may obtain a copy of the License at 7 | 8 | http://www.apache.org/licenses/LICENSE-2.0 9 | 10 | Unless required by applicable law or agreed to in writing, software 11 | distributed under the License is distributed on an "AS IS" BASIS, 12 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 13 | See the License for the specific language governing permissions and 14 | limitations under the License. 15 | } 16 | { GridFS Unit - The classes in this unit are used to store and/or 17 | access a "Grid File System" (GridFS) on a MongoDB server. 18 | While primarily intended to store large documents that 19 | won't fit on the server as a single BSON object, 20 | GridFS may also be used to store large numbers of smaller files. 21 | 22 | See http://www.mongodb.org/display/DOCS/GridFS and 23 | http://www.mongodb.org/display/DOCS/When+to+use+GridFS. 24 | 25 | Objects of class TGridFS represent the interface to the GridFS. 26 | Objects of class TGridfile are used to access gridfiles and read from them. 27 | Objects of class TGridfileWriter are used to write buffered data to the GridFS. 28 | } 29 | unit GridFS; 30 | 31 | interface 32 | Uses 33 | MongoDB, MongoBson; 34 | 35 | type 36 | TGridfile = class; 37 | TGridfileWriter = class; 38 | 39 | TGridFS = class(TObject) 40 | private 41 | var 42 | { Pointer to externally managed data representing the GridFS } 43 | handle : Pointer; 44 | { Holds a reference to the TMongo object used in construction. 45 | Prevents release until the TGridFS is destroyed. } 46 | conn : TMongo; 47 | public 48 | { Create a TGridFS object for accessing the GridFS on the MongoDB server. 49 | Parameter mongo is an already established connection object to the 50 | server; db is the name of the database in which to construct the GridFS. 51 | The prefix defaults to 'fs'.} 52 | constructor Create(mongo : TMongo; db : string); overload; 53 | { Create a TGridFS object for accessing the GridFS on the MongoDB server. 54 | Parameter mongo is an already established connection object to the 55 | server; db is the name of the database in which to construct the GridFS. 56 | prefix is appended to the database name for the collections that represent 57 | the GridFS: 'db.prefix.files' & 'db.prefix.chunks'. } 58 | constructor Create(mongo : TMongo; db : string; prefix : string); overload; 59 | { Store a file on the GridFS. filename is the path to the file. 60 | Returns True if successful; otherwise, False. } 61 | function storeFile(filename : string) : Boolean; overload; 62 | { Store a file on the GridFS. filename is the path to the file. 63 | remoteName is the name that the file will be known as within the GridFS. 64 | Returns True if successful; otherwise, False. } 65 | function storeFile(filename : string; remoteName : string) : Boolean; overload; 66 | { Store a file on the GridFS. filename is the path to the file. 67 | remoteName is the name that the file will be known as within the GridFS. 68 | contentType is the MIME-type content type of the file. 69 | Returns True if successful; otherwise, False. } 70 | function storeFile(filename : string; remoteName : string; contentType : string) : Boolean; overload; 71 | { Remove a file from the GridFS. } 72 | procedure removeFile(remoteName : string); 73 | { Store data as a GridFS file. Pointer is the address of the data and length 74 | is its size. remoteName is the name that the file will be known as within the GridFS. 75 | Returns True if successful; otherwise, False. } 76 | function store(p : Pointer; length : Int64; remoteName : string) : Boolean; overload; 77 | { Store data as a GridFS file. Pointer is the address of the data and length 78 | is its size. remoteName is the name that the file will be known as within the GridFS. 79 | contentType is the MIME-type content type of the file. 80 | Returns True if successful; otherwise, False. } 81 | function store(p : Pointer; length : Int64; remoteName : string; contentType : string) : Boolean; overload; 82 | { Create a TGridfileWriter object for writing buffered data to a GridFS file. 83 | remoteName is the name that the file will be known as within the GridFS. } 84 | function writerCreate(remoteName : string) : TGridfileWriter; overload; 85 | { Create a TGridfileWriter object for writing buffered data to a GridFS file. 86 | remoteName is the name that the file will be known as within the GridFS. 87 | contentType is the MIME-type content type of the file. } 88 | function writerCreate(remoteName : string; contentType : string) : TGridfileWriter; overload; 89 | { Locate a GridFS file by its remoteName and return a TGridfile object for 90 | accessing it. } 91 | function find(remoteName : string) : TGridfile; overload; 92 | { Locate a GridFS file by an TBson query document on the GridFS file descriptors. 93 | Returns a TGridfile object for accessing it. } 94 | function find(query : TBson) : TGridfile; overload; 95 | { Destroy this GridFS object. Releases external resources. } 96 | destructor Destroy(); override; 97 | end; 98 | 99 | { Objects of class TGridfile are used to access gridfiles and read from them. } 100 | TGridfile = class(TObject) 101 | private 102 | var 103 | { Pointer to externally managed data representing the gridfile } 104 | handle : Pointer; 105 | { Hold a reference to the TGridFS object used in construction of this 106 | TGridfile. Prevents release until this TGridfile is destroyed. } 107 | gfs : TGridFS; 108 | { Create a TGridfile object. Internal use only by TGridFS.find(). } 109 | constructor Create(gridfs : TGridFS); 110 | public 111 | { Get the filename (remoteName) of this gridfile. } 112 | function getFilename() : string; 113 | { Get the size of the chunks into which the file is divided. } 114 | function getChunkSize() : Integer; 115 | { Get the length of this gridfile. } 116 | function getLength() : Int64; 117 | { Get the content type of this gridfile. } 118 | function getContentType() : string; 119 | { Get the upload date of this gridfile. } 120 | function getUploadDate() : TDateTime; 121 | { Get the MD5 hash of this gridfile. This is a 16-digit hex string. } 122 | function getMD5() : string; 123 | { Get any metadata associated with this gridfile as a TBson document. 124 | Returns nil if there is none. } 125 | function getMetadata() : TBson; 126 | { Get the number of chunks into which the file is divided. } 127 | function getChunkCount() : Integer; 128 | { Get the descriptor of this gridfile as a TBson document. } 129 | function getDescriptor() : TBson; 130 | { Get the Ith chunk of this gridfile. The content of the chunk is 131 | in the 'data' field of the returned TBson document. Returns nil 132 | if i is not in the range 0 to getChunkCount() - 1. } 133 | function getChunk(i : Integer) : TBson; 134 | { Get a cursor for stepping through a range of chunks of this gridfile. 135 | i is the index of the first chunk to be returned. count is the number 136 | of chunks to return. Returns nil if there are no chunks in the 137 | specified range. } 138 | function getChunks(i : Integer; count : Integer) : TMongoCursor; 139 | { Read data from this gridfile. The gridfile maintains a current position 140 | so that successive reads will return consecutive data. The data is 141 | read to the address indicated by p and length bytes are read. The size 142 | of the data read is returned and can be less than length if there was 143 | not enough data remaining to be read. } 144 | function read(p : Pointer; length : Int64) : Int64; 145 | { Seek to a specified offset within the gridfile. read() will then 146 | return data starting at that location. Returns the position that 147 | was set. This can be at the end of the gridfile if offset is greater 148 | the length of this gridfile. } 149 | function seek(offset : Int64) : Int64; 150 | { Destroy this TGridfile object. Releases external resources. } 151 | destructor Destroy(); override; 152 | end; 153 | 154 | { Objects of class TGridfileWriter are used to write buffered data to the GridFS. } 155 | TGridfileWriter = class(TObject) 156 | private 157 | var 158 | { Holds a pointer to externally managed data representing the TGridfileWriter. } 159 | handle : Pointer; 160 | { Holds a reference to the TGridFS object used in construction. 161 | Prevents release of the TGridFS until this TGridfileWriter is destroyed. } 162 | gfs : TGridFS; 163 | public 164 | { Create a TGridfile writer on the given TGridFS that will write data to 165 | the given remoteName. } 166 | constructor Create(gridfs : TGridFS; remoteName : string); overload; 167 | { Create a TGridfile writer on the given TGridFS that will write data to 168 | the given remoteName. contentType is the MIME-type content type of the gridfile 169 | to be written. } 170 | constructor Create(gridfs : TGridFS; remoteName : string; contentType : string); overload; 171 | { Write data to this TGridfileWriter. p is the address of the data and length 172 | is its size. Multiple calls to write() may be made to append successive 173 | data. } 174 | procedure write(p : Pointer; length : Int64); 175 | { Finish with this TGridfileWriter. Flushes any data remaining to be written 176 | to a chunk and posts the 'directory' information of the gridfile to the 177 | GridFS. Returns True if successful; otherwise, False. } 178 | function finish() : Boolean; 179 | { Destroy this TGridfileWriter. Calls finish() if necessary and releases 180 | external resources. } 181 | destructor Destroy(); override; 182 | end; 183 | 184 | implementation 185 | uses 186 | SysUtils; 187 | 188 | function gridfs_create() : Pointer; cdecl; external 'mongoc.dll'; 189 | procedure gridfs_dispose(g : Pointer); cdecl; external 'mongoc.dll'; 190 | function gridfs_init(c : Pointer; db : PAnsiChar; prefix : PAnsiChar; g : Pointer) : Integer; 191 | cdecl; external 'mongoc.dll'; 192 | procedure gridfs_destroy(g : Pointer); cdecl; external 'mongoc.dll'; 193 | function gridfs_store_file(g : Pointer; filename : PAnsiChar; remoteName : PAnsiChar; contentType : PAnsiChar) : Integer; 194 | cdecl; external 'mongoc.dll'; 195 | procedure gridfs_remove_filename(g : Pointer; remoteName : PAnsiChar); cdecl; external 'mongoc.dll'; 196 | function gridfs_store_buffer(g : Pointer; p : Pointer; size : Int64; remoteName : PAnsiChar; contentType : PAnsiChar) : Integer; 197 | cdecl; external 'mongoc.dll'; 198 | function gridfile_create() : Pointer; cdecl; external 'mongoc.dll'; 199 | procedure gridfile_dispose(gf : Pointer); cdecl; external 'mongoc.dll'; 200 | procedure gridfile_writer_init(gf : Pointer; gfs : Pointer; remoteName : PAnsiChar; contentType : PAnsiChar); 201 | cdecl; external 'mongoc.dll'; 202 | procedure gridfile_write_buffer(gf : Pointer; data : Pointer; length : Int64); 203 | cdecl; external 'mongoc.dll'; 204 | function gridfile_writer_done(gf : Pointer) : Integer; cdecl; external 'mongoc.dll'; 205 | function gridfs_find_query(g : Pointer; query : Pointer; gf : Pointer) : Integer; 206 | cdecl; external 'mongoc.dll'; 207 | procedure gridfile_destroy(gf : Pointer); cdecl; external 'mongoc.dll'; 208 | function gridfile_get_filename(gf : Pointer) : PAnsiChar; cdecl; external 'mongoc.dll'; 209 | function gridfile_get_chunksize(gf : Pointer) : Integer; cdecl; external 'mongoc.dll'; 210 | function gridfile_get_contentlength(gf : Pointer) : Int64; cdecl; external 'mongoc.dll'; 211 | function gridfile_get_contenttype(gf : Pointer) : PAnsiChar; cdecl; external 'mongoc.dll'; 212 | function gridfile_get_uploaddate(gf : Pointer) : Int64; cdecl; external 'mongoc.dll'; 213 | function gridfile_get_md5(gf : Pointer) : PAnsiChar; cdecl; external 'mongoc.dll'; 214 | procedure gridfile_get_metadata(gf : Pointer; b : Pointer); cdecl; external 'mongoc.dll'; 215 | function bson_create() : Pointer; cdecl; external 'mongoc.dll'; 216 | procedure bson_dispose(b : Pointer); cdecl; external 'mongoc.dll'; 217 | function bson_size(b : Pointer) : Integer; cdecl; external 'mongoc.dll'; 218 | procedure bson_copy(dest : Pointer; src : Pointer); cdecl; external 'mongoc.dll'; 219 | function gridfile_get_numchunks(gf : Pointer) : Integer; cdecl; external 'mongoc.dll'; 220 | procedure gridfile_get_descriptor(gf : Pointer; b : Pointer); cdecl; external 'mongoc.dll'; 221 | procedure gridfile_get_chunk(gf : Pointer; i : Integer; b : Pointer); cdecl; external 'mongoc.dll'; 222 | function gridfile_get_chunks(gf : Pointer; i : Integer; count : Integer) : Pointer; 223 | cdecl; external 'mongoc.dll'; 224 | function gridfile_read(gf : Pointer; size : Int64; buf : Pointer) : Int64; 225 | cdecl; external 'mongoc.dll'; 226 | function gridfile_seek(gf : Pointer; offset : Int64) : Int64; 227 | cdecl; external 'mongoc.dll'; 228 | 229 | 230 | constructor TGridFS.Create(mongo: TMongo; db: string; prefix : string); 231 | begin 232 | conn := mongo; 233 | handle := gridfs_create(); 234 | if gridfs_init(mongo.handle, PAnsiChar(System.UTF8Encode(db)), 235 | PAnsiChar(System.UTF8Encode(prefix)), handle) <> 0 then begin 236 | gridfs_dispose(handle); 237 | Raise Exception.Create('Unable to create GridFS'); 238 | end; 239 | end; 240 | 241 | constructor TGridFS.Create(mongo: TMongo; db: string); 242 | begin 243 | Create(mongo, db, 'fs'); 244 | end; 245 | 246 | destructor TGridFS.Destroy(); 247 | begin 248 | gridfs_destroy(handle); 249 | gridfs_dispose(handle); 250 | end; 251 | 252 | function TGridFS.storeFile(filename : string; remoteName : string; contentType : string) : Boolean; 253 | begin 254 | Result := (gridfs_store_file(handle, PAnsiChar(System.UTF8Encode(filename)), 255 | PAnsiChar(System.UTF8Encode(remoteName)), 256 | PAnsiChar(System.UTF8Encode(contentType))) = 0); 257 | end; 258 | 259 | function TGridFS.storeFile(filename : string; remoteName : string) : Boolean; 260 | begin 261 | Result := storeFile(filename, remoteName, ''); 262 | end; 263 | 264 | function TGridFS.storeFile(filename : string) : Boolean; 265 | begin 266 | Result := storeFile(filename, filename, ''); 267 | end; 268 | 269 | procedure TGridFS.removeFile(remoteName : string); 270 | begin 271 | gridfs_remove_filename(handle, PAnsiChar(System.UTF8Encode(remoteName))); 272 | end; 273 | 274 | function TGridFS.store(p : Pointer; length : Int64; remoteName : string; contentType : string) : Boolean; 275 | begin 276 | Result := (gridfs_store_buffer(handle, p, length, PAnsiChar(System.UTF8Encode(remoteName)), 277 | PAnsiChar(System.UTF8Encode(contentType))) = 0); 278 | end; 279 | 280 | function TGridFS.store(p : Pointer; length : Int64; remoteName : string) : Boolean; 281 | begin 282 | Result := store(p, length, remoteName, ''); 283 | end; 284 | 285 | function TGridFS.writerCreate(remoteName : string; contentType : string) : TGridfileWriter; 286 | begin 287 | Result := TGridfileWriter.Create(Self, remoteName, contentType); 288 | end; 289 | 290 | function TGridFS.writerCreate(remoteName : string) : TGridfileWriter; 291 | begin 292 | Result := writerCreate(remoteName, ''); 293 | end; 294 | 295 | constructor TGridfileWriter.Create(gridfs : TGridFS; remoteName : string; contentType : string); 296 | begin 297 | gfs := gridfs; 298 | handle := gridfile_create(); 299 | gridfile_writer_init(handle, gridfs.handle, PAnsiChar(System.UTF8Encode(remoteName)), PAnsiChar(System.UTF8Encode(contentType))); 300 | end; 301 | 302 | constructor TGridfileWriter.Create(gridfs : TGridFS; remoteName : string); 303 | begin 304 | Create(gridfs, remoteName, ''); 305 | end; 306 | 307 | procedure TGridfileWriter.write(p: Pointer; length: Int64); 308 | begin 309 | gridfile_write_buffer(handle, p, length); 310 | end; 311 | 312 | function TGridfileWriter.finish() : Boolean; 313 | begin 314 | if handle = nil then 315 | Result := True 316 | else begin 317 | Result := (gridfile_writer_done(handle) = 0); 318 | gridfile_dispose(handle); 319 | handle := nil; 320 | end; 321 | end; 322 | 323 | destructor TGridfileWriter.Destroy(); 324 | begin 325 | finish(); 326 | end; 327 | 328 | function TGridFS.find(query : TBson) : TGridfile; 329 | var 330 | gf : TGridfile; 331 | begin 332 | gf := TGridfile.Create(Self); 333 | if gridfs_find_query(handle, query.handle, gf.handle) = 0 then 334 | Result := gf 335 | else begin 336 | gf.Free; 337 | Result := nil; 338 | end; 339 | end; 340 | 341 | function TGridFS.find(remoteName : string) : TGridfile; 342 | begin 343 | Result := find(BSON(['filename', System.UTF8Encode(remoteName)])); 344 | end; 345 | 346 | constructor TGridfile.Create(gridfs : TGridFS); 347 | begin 348 | gfs := gridfs; 349 | handle := gridfile_create(); 350 | end; 351 | 352 | destructor TGridfile.Destroy(); 353 | begin 354 | if handle <> nil then begin 355 | gridfile_destroy(handle); 356 | gridfile_dispose(handle); 357 | handle := nil; 358 | end; 359 | end; 360 | 361 | function TGridfile.getFilename() : string; 362 | begin 363 | Result := string(System.UTF8ToWideString(gridfile_get_filename(handle))); 364 | end; 365 | 366 | function TGridfile.getChunkSize() : Integer; 367 | begin 368 | Result := gridfile_get_chunksize(handle); 369 | end; 370 | 371 | function TGridfile.getLength() : Int64; 372 | begin 373 | Result := gridfile_get_contentlength(handle); 374 | end; 375 | 376 | function TGridfile.getContentType() : string; 377 | begin 378 | Result := string(System.UTF8ToWideString(gridfile_get_contenttype(handle))); 379 | end; 380 | 381 | function TGridfile.getUploadDate() : TDateTime; 382 | begin 383 | Result := Int64toDouble(gridfile_get_uploaddate(handle)) / (1000 * 24 * 60 * 60) + 25569; 384 | end; 385 | 386 | function TGridfile.getMD5() : string; 387 | begin 388 | Result := string(gridfile_get_md5(handle)); 389 | end; 390 | 391 | function TGridfile.getMetadata() : TBson; 392 | var 393 | b : Pointer; 394 | res : TBson; 395 | begin 396 | b := bson_create(); 397 | gridfile_get_metadata(handle, b); 398 | if bson_size(b) <= 5 then 399 | Result := nil 400 | else begin 401 | res := TBson.Create(bson_create()); 402 | bson_copy(res.handle, b); 403 | Result := res; 404 | end; 405 | bson_dispose(b); 406 | end; 407 | 408 | function TGridfile.getChunkCount() : Integer; 409 | begin 410 | Result := gridfile_get_numchunks(handle); 411 | end; 412 | 413 | function TGridfile.getDescriptor() : TBson; 414 | var 415 | b : Pointer; 416 | res : TBson; 417 | begin 418 | b := bson_create(); 419 | gridfile_get_descriptor(handle, b); 420 | res := TBson.Create(bson_create()); 421 | bson_copy(res.handle, b); 422 | bson_dispose(b); 423 | Result := res; 424 | end; 425 | 426 | function TGridfile.getChunk(i : Integer) : TBson; 427 | var 428 | b : TBson; 429 | begin 430 | b := TBson.Create(bson_create()); 431 | gridfile_get_chunk(handle, i, b.handle); 432 | if b.size() <= 5 then 433 | begin 434 | b.Free; 435 | Result := nil; 436 | end 437 | else 438 | Result := b; 439 | end; 440 | 441 | function TGridfile.getChunks(i : Integer; count : Integer) : TMongoCursor; 442 | var 443 | cursor : TMongoCursor; 444 | begin 445 | cursor := TMongoCursor.Create(); 446 | cursor.handle := gridfile_get_chunks(handle, i, count); 447 | if cursor.handle = nil then 448 | begin 449 | cursor.free; 450 | Result := nil; 451 | end 452 | else 453 | Result := cursor; 454 | end; 455 | 456 | function TGridfile.read(p : Pointer; length : Int64) : Int64; 457 | begin 458 | Result := gridfile_read(handle, length, p); 459 | end; 460 | 461 | function TGridfile.seek(offset : Int64) : Int64; 462 | begin 463 | Result := gridfile_seek(handle, offset); 464 | end; 465 | 466 | 467 | end. 468 | -------------------------------------------------------------------------------- /LICENSE.txt: -------------------------------------------------------------------------------- 1 | Apache License 2 | Version 2.0, January 2004 3 | http://www.apache.org/licenses/ 4 | 5 | TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION 6 | 7 | 1. Definitions. 8 | 9 | "License" shall mean the terms and conditions for use, reproduction, 10 | and distribution as defined by Sections 1 through 9 of this document. 11 | 12 | "Licensor" shall mean the copyright owner or entity authorized by 13 | the copyright owner that is granting the License. 14 | 15 | "Legal Entity" shall mean the union of the acting entity and all 16 | other entities that control, are controlled by, or are under common 17 | control with that entity. For the purposes of this definition, 18 | "control" means (i) the power, direct or indirect, to cause the 19 | direction or management of such entity, whether by contract or 20 | otherwise, or (ii) ownership of fifty percent (50%) or more of the 21 | outstanding shares, or (iii) beneficial ownership of such entity. 22 | 23 | "You" (or "Your") shall mean an individual or Legal Entity 24 | exercising permissions granted by this License. 25 | 26 | "Source" form shall mean the preferred form for making modifications, 27 | including but not limited to software source code, documentation 28 | source, and configuration files. 29 | 30 | "Object" form shall mean any form resulting from mechanical 31 | transformation or translation of a Source form, including but 32 | not limited to compiled object code, generated documentation, 33 | and conversions to other media types. 34 | 35 | "Work" shall mean the work of authorship, whether in Source or 36 | Object form, made available under the License, as indicated by a 37 | copyright notice that is included in or attached to the work 38 | (an example is provided in the Appendix below). 39 | 40 | "Derivative Works" shall mean any work, whether in Source or Object 41 | form, that is based on (or derived from) the Work and for which the 42 | editorial revisions, annotations, elaborations, or other modifications 43 | represent, as a whole, an original work of authorship. For the purposes 44 | of this License, Derivative Works shall not include works that remain 45 | separable from, or merely link (or bind by name) to the interfaces of, 46 | the Work and Derivative Works thereof. 47 | 48 | "Contribution" shall mean any work of authorship, including 49 | the original version of the Work and any modifications or additions 50 | to that Work or Derivative Works thereof, that is intentionally 51 | submitted to Licensor for inclusion in the Work by the copyright owner 52 | or by an individual or Legal Entity authorized to submit on behalf of 53 | the copyright owner. For the purposes of this definition, "submitted" 54 | means any form of electronic, verbal, or written communication sent 55 | to the Licensor or its representatives, including but not limited to 56 | communication on electronic mailing lists, source code control systems, 57 | and issue tracking systems that are managed by, or on behalf of, the 58 | Licensor for the purpose of discussing and improving the Work, but 59 | excluding communication that is conspicuously marked or otherwise 60 | designated in writing by the copyright owner as "Not a Contribution." 61 | 62 | "Contributor" shall mean Licensor and any individual or Legal Entity 63 | on behalf of whom a Contribution has been received by Licensor and 64 | subsequently incorporated within the Work. 65 | 66 | 2. Grant of Copyright License. Subject to the terms and conditions of 67 | this License, each Contributor hereby grants to You a perpetual, 68 | worldwide, non-exclusive, no-charge, royalty-free, irrevocable 69 | copyright license to reproduce, prepare Derivative Works of, 70 | publicly display, publicly perform, sublicense, and distribute the 71 | Work and such Derivative Works in Source or Object form. 72 | 73 | 3. Grant of Patent License. Subject to the terms and conditions of 74 | this License, each Contributor hereby grants to You a perpetual, 75 | worldwide, non-exclusive, no-charge, royalty-free, irrevocable 76 | (except as stated in this section) patent license to make, have made, 77 | use, offer to sell, sell, import, and otherwise transfer the Work, 78 | where such license applies only to those patent claims licensable 79 | by such Contributor that are necessarily infringed by their 80 | Contribution(s) alone or by combination of their Contribution(s) 81 | with the Work to which such Contribution(s) was submitted. If You 82 | institute patent litigation against any entity (including a 83 | cross-claim or counterclaim in a lawsuit) alleging that the Work 84 | or a Contribution incorporated within the Work constitutes direct 85 | or contributory patent infringement, then any patent licenses 86 | granted to You under this License for that Work shall terminate 87 | as of the date such litigation is filed. 88 | 89 | 4. Redistribution. You may reproduce and distribute copies of the 90 | Work or Derivative Works thereof in any medium, with or without 91 | modifications, and in Source or Object form, provided that You 92 | meet the following conditions: 93 | 94 | (a) You must give any other recipients of the Work or 95 | Derivative Works a copy of this License; and 96 | 97 | (b) You must cause any modified files to carry prominent notices 98 | stating that You changed the files; and 99 | 100 | (c) You must retain, in the Source form of any Derivative Works 101 | that You distribute, all copyright, patent, trademark, and 102 | attribution notices from the Source form of the Work, 103 | excluding those notices that do not pertain to any part of 104 | the Derivative Works; and 105 | 106 | (d) If the Work includes a "NOTICE" text file as part of its 107 | distribution, then any Derivative Works that You distribute must 108 | include a readable copy of the attribution notices contained 109 | within such NOTICE file, excluding those notices that do not 110 | pertain to any part of the Derivative Works, in at least one 111 | of the following places: within a NOTICE text file distributed 112 | as part of the Derivative Works; within the Source form or 113 | documentation, if provided along with the Derivative Works; or, 114 | within a display generated by the Derivative Works, if and 115 | wherever such third-party notices normally appear. The contents 116 | of the NOTICE file are for informational purposes only and 117 | do not modify the License. You may add Your own attribution 118 | notices within Derivative Works that You distribute, alongside 119 | or as an addendum to the NOTICE text from the Work, provided 120 | that such additional attribution notices cannot be construed 121 | as modifying the License. 122 | 123 | You may add Your own copyright statement to Your modifications and 124 | may provide additional or different license terms and conditions 125 | for use, reproduction, or distribution of Your modifications, or 126 | for any such Derivative Works as a whole, provided Your use, 127 | reproduction, and distribution of the Work otherwise complies with 128 | the conditions stated in this License. 129 | 130 | 5. Submission of Contributions. Unless You explicitly state otherwise, 131 | any Contribution intentionally submitted for inclusion in the Work 132 | by You to the Licensor shall be under the terms and conditions of 133 | this License, without any additional terms or conditions. 134 | Notwithstanding the above, nothing herein shall supersede or modify 135 | the terms of any separate license agreement you may have executed 136 | with Licensor regarding such Contributions. 137 | 138 | 6. Trademarks. This License does not grant permission to use the trade 139 | names, trademarks, service marks, or product names of the Licensor, 140 | except as required for reasonable and customary use in describing the 141 | origin of the Work and reproducing the content of the NOTICE file. 142 | 143 | 7. Disclaimer of Warranty. Unless required by applicable law or 144 | agreed to in writing, Licensor provides the Work (and each 145 | Contributor provides its Contributions) on an "AS IS" BASIS, 146 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or 147 | implied, including, without limitation, any warranties or conditions 148 | of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A 149 | PARTICULAR PURPOSE. You are solely responsible for determining the 150 | appropriateness of using or redistributing the Work and assume any 151 | risks associated with Your exercise of permissions under this License. 152 | 153 | 8. Limitation of Liability. In no event and under no legal theory, 154 | whether in tort (including negligence), contract, or otherwise, 155 | unless required by applicable law (such as deliberate and grossly 156 | negligent acts) or agreed to in writing, shall any Contributor be 157 | liable to You for damages, including any direct, indirect, special, 158 | incidental, or consequential damages of any character arising as a 159 | result of this License or out of the use or inability to use the 160 | Work (including but not limited to damages for loss of goodwill, 161 | work stoppage, computer failure or malfunction, or any and all 162 | other commercial damages or losses), even if such Contributor 163 | has been advised of the possibility of such damages. 164 | 165 | 9. Accepting Warranty or Additional Liability. While redistributing 166 | the Work or Derivative Works thereof, You may choose to offer, 167 | and charge a fee for, acceptance of support, warranty, indemnity, 168 | or other liability obligations and/or rights consistent with this 169 | License. However, in accepting such obligations, You may act only 170 | on Your own behalf and on Your sole responsibility, not on behalf 171 | of any other Contributor, and only if You agree to indemnify, 172 | defend, and hold each Contributor harmless for any liability 173 | incurred by, or claims asserted against, such Contributor by reason 174 | of your accepting any such warranty or additional liability. 175 | 176 | END OF TERMS AND CONDITIONS 177 | 178 | APPENDIX: How to apply the Apache License to your work. 179 | 180 | To apply the Apache License to your work, attach the following 181 | boilerplate notice, with the fields enclosed by brackets "[]" 182 | replaced with your own identifying information. (Don't include 183 | the brackets!) The text should be enclosed in the appropriate 184 | comment syntax for the file format. We also recommend that a 185 | file or class name and description of purpose be included on the 186 | same "printed page" as the copyright notice for easier 187 | identification within third-party archives. 188 | 189 | Copyright [yyyy] [name of copyright owner] 190 | 191 | Licensed under the Apache License, Version 2.0 (the "License"); 192 | you may not use this file except in compliance with the License. 193 | You may obtain a copy of the License at 194 | 195 | http://www.apache.org/licenses/LICENSE-2.0 196 | 197 | Unless required by applicable law or agreed to in writing, software 198 | distributed under the License is distributed on an "AS IS" BASIS, 199 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 200 | See the License for the specific language governing permissions and 201 | limitations under the License. 202 | -------------------------------------------------------------------------------- /MongoBson.pas: -------------------------------------------------------------------------------- 1 | { 2 | Copyright 2009-2011 10gen Inc. 3 | 4 | Licensed under the Apache License, Version 2.0 (the "License"); 5 | you may not use this file except in compliance with the License. 6 | You may obtain a copy of the License at 7 | 8 | http://www.apache.org/licenses/LICENSE-2.0 9 | 10 | Unless required by applicable law or agreed to in writing, software 11 | distributed under the License is distributed on an "AS IS" BASIS, 12 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 13 | See the License for the specific language governing permissions and 14 | limitations under the License. 15 | } 16 | { This unit implements BSON, a binary JSON-like document format. 17 | It is used to represent documents in MongoDB and also for network traffic. 18 | See http://www.mongodb.org/display/DOCS/BSON } 19 | 20 | unit MongoBson; 21 | 22 | interface 23 | type TBson = class; 24 | TIntegerArray = array of Integer; 25 | TDoubleArray = array of Double; 26 | TBooleanArray = array of Boolean; 27 | TStringArray = array of string; 28 | 29 | { A value of TBsonType indicates the type of the data associated 30 | with a field within a BSON document. } 31 | TBsonType = ( 32 | bsonEOO = 0, 33 | bsonDOUBLE = 1, 34 | bsonSTRING = 2, 35 | bsonOBJECT = 3, 36 | bsonARRAY = 4, 37 | bsonBINDATA = 5, 38 | bsonUNDEFINED = 6, 39 | bsonOID = 7, 40 | bsonBOOL = 8, 41 | bsonDATE = 9, 42 | bsonNULL = 10, 43 | bsonREGEX = 11, 44 | bsonDBREF = 12, (* Deprecated. *) 45 | bsonCODE = 13, 46 | bsonSYMBOL = 14, 47 | bsonCODEWSCOPE = 15, 48 | bsonINT = 16, 49 | bsonTIMESTAMP = 17, 50 | bsonLONG = 18); 51 | 52 | TBsonIterator = class; 53 | 54 | { A TBsonOID is used to store BSON Object IDs. 55 | See http://www.mongodb.org/display/DOCS/Object+IDs } 56 | TBsonOID = class(TObject) 57 | var 58 | { the oid data } 59 | value : array[0..11] of Byte; 60 | { Generate an Object ID } 61 | constructor Create(); overload; 62 | { Create an ObjectID from a 24-digit hex string } 63 | constructor Create(s : string); overload; 64 | { Create an Object ID from a TBsonIterator pointing to an oid field } 65 | constructor Create(i : TBsonIterator); overload; 66 | { Convert this Object ID to a 24-digit hex string } 67 | function AsString() : string; 68 | end; 69 | 70 | { A TBsonCodeWScope is used to hold javascript code and its associated scope. 71 | See TBsonIterator.getCodeWScope() } 72 | TBsonCodeWScope = class(TObject) 73 | var 74 | code : string; 75 | scope : TBson; 76 | { Create a TBsonCodeWScope from a javascript string and a TBson scope } 77 | constructor Create(code_ : string; scope_ : TBson); overload; 78 | { Create a TBsonCodeWScope from a TBSonIterator pointing to a 79 | CODEWSCOPE field. } 80 | constructor Create(i : TBsonIterator); overload; 81 | end; 82 | 83 | { A TBsonRegex is used to hold a regular expression string and its options. 84 | See TBsonIterator.getRegex(). } 85 | TBsonRegex = class(TObject) 86 | var 87 | pattern : string; 88 | options : string; 89 | { Create a TBsonRegex from reqular expression and options strings } 90 | constructor Create(pattern_ : string; options_ : string); overload; 91 | { Create a TBsonRegex from a TBsonIterator pointing to a REGEX field } 92 | constructor Create(i : TBsonIterator); overload; 93 | end; 94 | 95 | { A TBsonTimestamp is used to hold a TDateTime and an increment value. 96 | See http://www.mongodb.org/display/DOCS/Timestamp+data+type and 97 | TBsonIterator.getTimestamp() } 98 | TBsonTimestamp = class(TObject) 99 | var 100 | time : TDateTime; 101 | increment : Integer; 102 | { Create a TBsonTimestamp from a TDateTime and an increment } 103 | constructor Create(time_ : TDateTime; increment_ : Integer); overload; 104 | { Create a TBSonTimestamp from a TBsonIterator pointing to a TIMESTAMP 105 | field. } 106 | constructor Create(i : TBsonIterator); overload; 107 | end; 108 | 109 | { A TBsonBinary is used to hold the contents of BINDATA fields. 110 | See TBsonIterator.getBinary() } 111 | TBsonBinary = class(TObject) 112 | var 113 | { Pointer to data allocated on the heap with GetMem } 114 | data : Pointer; 115 | { The length of the data in bytes } 116 | len : Integer; 117 | { The subtype of the BINDATA (usually 0) } 118 | kind : Integer; 119 | { Create a TBsonBinary from a pointer and a length. The data 120 | is copied to the heap. kind is initialized to 0 } 121 | constructor Create(p : Pointer; length : Integer); overload; 122 | { Create a TBsonBinary from a TBsonIterator pointing to a BINDATA 123 | field. } 124 | constructor Create(i : TBsonIterator); overload; 125 | { Destroys the TBsonBinary and releases its memory with FreeMem() } 126 | destructor Destroy(); override; 127 | end; 128 | 129 | { A TBsonBuffer is used to build a BSON document by appending the 130 | names and values of fields. Call finish() when done to convert 131 | the buffer to a TBson which can be used in database operations. 132 | Example: @longcode(# 133 | var 134 | bb : TBsonBuffer; 135 | b : TBson; 136 | begin 137 | bb := TBsonBuffer.Create(); 138 | bb.append('name', 'Joe'); 139 | bb.append('age', 33); 140 | bb.append('city', 'Boston'); 141 | b := bb.finish(); 142 | end; 143 | #) } 144 | TBsonBuffer = class(TObject) 145 | private 146 | var handle : Pointer; 147 | public 148 | { Create an empty TBsonBuffer ready to have fields appended. } 149 | constructor Create(); 150 | { Append a string (PAnsiChar) to the buffer } 151 | function append(name : string; value : PAnsiChar) : Boolean; overload; 152 | { Append an Integer to the buffer } 153 | function append(name : string; value : Integer) : Boolean; overload; 154 | { Append an Int64 to the buffer } 155 | function append(name : string; value : Int64) : Boolean; overload; 156 | { Append a Double to the buffer } 157 | function append(name : string; value : Double) : Boolean; overload; 158 | { Append a TDateTime to the buffer; converted to 64-bit POSIX time } 159 | function append(name : string; value : TDateTime) : Boolean; overload; 160 | { Append a Boolean to the buffer } 161 | function append(name : string; value : Boolean) : Boolean; overload; 162 | { Append an Object ID to the buffer } 163 | function append(name : string; value : TBsonOID) : Boolean; overload; 164 | { Append a CODEWSCOPE to the buffer } 165 | function append(name : string; value : TBsonCodeWScope) : Boolean; overload; 166 | { Append a REGEX to the buffer } 167 | function append(name : string; value : TBsonRegex) : Boolean; overload; 168 | { Append a TIMESTAMP to the buffer } 169 | function append(name : string; value : TBsonTimestamp) : Boolean; overload; 170 | { Append BINDATA to the buffer } 171 | function append(name : string; value : TBsonBinary) : Boolean; overload; 172 | { Append a TBson document as a subobject } 173 | function append(name : string; value : TBson) : Boolean; overload; 174 | { Generic version of append. Calls one of the other append functions 175 | if the type contained in the variant is supported. } 176 | function append(name : string; value : OleVariant) : Boolean; overload; 177 | { Append an array of Integers } 178 | function appendArray(name : string; value : array of Integer) : Boolean; overload; 179 | { Append an array of Doubles } 180 | function appendArray(name : string; value : array of Double) : Boolean; overload; 181 | { Append an array of Booleans } 182 | function appendArray(name : string; value : array of Boolean) : Boolean; overload; 183 | { Append an array of strings } 184 | function appendArray(name : string; value : array of string) : Boolean; overload; 185 | { Append a NULL field to the buffer } 186 | function appendNull(name : string) : Boolean; 187 | { Append an UNDEFINED field to the buffer } 188 | function appendUndefined(name : string) : Boolean; 189 | { Append javascript code to the buffer } 190 | function appendCode(name : string; value : PAnsiChar) : Boolean; 191 | { Append a SYMBOL to the buffer } 192 | function appendSymbol(name : string; value : PAnsiChar) : Boolean; 193 | { Alternate way to append BINDATA directly without first creating a 194 | TBsonBinary value } 195 | function appendBinary(name : string; kind : Integer; data : Pointer; length : Integer) : Boolean; 196 | { Indicate that you will be appending more fields as a subobject } 197 | function startObject(name : string) : Boolean; 198 | { Indicate that you will be appending more fields as an array } 199 | function startArray(name : string) : Boolean; 200 | { Indicate that a subobject or array is done. } 201 | function finishObject() : Boolean; 202 | { Return the current size of the BSON document you are building } 203 | function size() : Integer; 204 | { Call this when finished appending fields to the buffer to turn it into 205 | a TBson for network transport. } 206 | function finish() : TBson; 207 | { Destroy this TBsonBuffer. Releases external resources. } 208 | destructor Destroy(); override; 209 | end; 210 | 211 | { A TBson holds a BSON document. BSON is a binary, JSON-like document format. 212 | It is used to represent documents in MongoDB and also for network traffic. 213 | See http://www.mongodb.org/display/DOCS/BSON } 214 | TBson = class(TObject) 215 | { Pointer to externally managed data. User code should not modify this. 216 | It is public only because the MongoDB and GridFS units must access it. } 217 | var handle : Pointer; 218 | { Return the size of this BSON document in bytes } 219 | function size() : Integer; 220 | { Get a TBsonIterator that points to the first field of this BSON } 221 | function iterator() : TBsonIterator; 222 | { Get a TBsonIterator that points to the field with the given name. 223 | If name is not found, nil is returned. } 224 | function find(name : string) : TBsonIterator; 225 | { Get the value of a field given its name. This function does not support 226 | all BSON field types. Use find() and one of the 'get' functions of 227 | TBsonIterator to retrieve special values. } 228 | function value(name : string) : Variant; 229 | { Display this BSON document on the console. subobjects and arrays are 230 | appropriately indented. } 231 | procedure display(); 232 | { Create a TBson given a pointer to externally managed data describing 233 | the document. User code should not instantiate TBson directly. Use 234 | TBsonBuffer and finish() to create BSON documents. } 235 | constructor Create(h : Pointer); 236 | { Destroy this TBson. Releases the externally managed data. } 237 | destructor Destroy; override; 238 | end; 239 | 240 | { TBsonIterators are used to step through the fields of a TBson document. } 241 | TBsonIterator = class(TObject) 242 | private 243 | { Pointer to externally managed data. } 244 | var handle : Pointer; 245 | public 246 | { Return the TBsonType of the field pointed to by this iterator. } 247 | function kind() : TBsonType; 248 | { Return the key (or name) of the field pointed to by this iterator. } 249 | function key() : string; 250 | { Step to the first or next field of a TBson document. Returns True 251 | if there is a next field; otherwise, returns false at the end of the 252 | document (or subobject). 253 | Example: @longcode(# 254 | iter := b.iterator; 255 | while i.next() do 256 | if i.kind = bsonNULL then 257 | WriteLn(i.key, ' is a NULL field.'); 258 | #) } 259 | function next() : Boolean; 260 | { Get the value of the field pointed to by this iterator. This function 261 | does not support all BSON field types and will throw an exception for 262 | those it does not. Use one of the 'get' functions to extract one of these 263 | special types. } 264 | function value() : Variant; 265 | { Get an TBsonIterator pointing to the first field of a subobject or array. 266 | kind() must be bsonOBJECT or bsonARRAY. } 267 | function subiterator() : TBsonIterator; 268 | { Get an Object ID from the field pointed to by this iterator. } 269 | function getOID() : TBsonOID; 270 | { Get a TBsonCodeWScope object for a CODEWSCOPE field pointed to by this 271 | iterator. } 272 | function getCodeWScope() : TBsonCodeWScope; 273 | { Get a TBsonRegex for a REGEX field } 274 | function getRegex() : TBsonRegex; 275 | { Get a TBsonTimestamp object for a TIMESTAMP field pointed to by this 276 | iterator. } 277 | function getTimestamp() : TBsonTimestamp; 278 | { Get a TBsonBinary object for the BINDATA field pointed to by this 279 | iterator. } 280 | function getBinary() : TBsonBinary; 281 | { Get an array of Integers. This iterator must point to ARRAY field 282 | which has each component type as Integer } 283 | function getIntegerArray() : TIntegerArray; 284 | { Get an array of Doubles. This iterator must point to ARRAY field 285 | which has each component type as Double } 286 | function getDoubleArray() : TDoubleArray; 287 | { Get an array of strings. This iterator must point to ARRAY field 288 | which has each component type as string } 289 | function getStringArray() : TStringArray; 290 | { Get an array of Booleans. This iterator must point to ARRAY field 291 | which has each component type as Boolean } 292 | function getBooleanArray() : TBooleanArray; 293 | { Internal usage only. Create an uninitialized TBsonIterator } 294 | constructor Create(); overload; 295 | { Create a TBsonIterator that points to the first field of the given 296 | TBson } 297 | constructor Create(b : TBson); overload; 298 | { Destroy this TBsonIterator. Releases external resources. } 299 | destructor Destroy; override; 300 | end; 301 | 302 | var 303 | { An empty BSON document } 304 | bsonEmpty : TBson; 305 | 306 | (* The idea for this shorthand way to build a BSON 307 | document from an array of variants came from Stijn Sanders 308 | and his TMongoWire, located here: 309 | https://github.com/stijnsanders/TMongoWire 310 | 311 | Subobjects are started with '{' and ended with '}' 312 | 313 | Example: @longcode(# 314 | var b : TBson; 315 | begin 316 | b := BSON(['name', 'Albert', 'age', 64, 317 | 'address', '{', 318 | 'street', '109 Vine Street', 319 | 'city', 'New Haven', 320 | '}' ]); 321 | #) *) 322 | function BSON(x : array of OleVariant) : TBson; 323 | 324 | { Convert a byte to a 2-digit hex string } 325 | function ByteToHex(InByte : Byte) : string; 326 | 327 | { Convert an Int64 to a Double. Some loss of precision may occur. } 328 | function Int64toDouble(i64 : int64) : double; 329 | cdecl; external 'mongoc.dll' name 'bson_int64_to_double'; 330 | 331 | implementation 332 | uses SysUtils, Variants; 333 | 334 | procedure set_bson_err_handler(err_handler : Pointer); cdecl; external 'mongoc.dll'; 335 | 336 | function bson_create() : Pointer; cdecl; external 'mongoc.dll'; 337 | procedure bson_init(b : Pointer); cdecl; external 'mongoc.dll'; 338 | procedure bson_destroy(b : Pointer); cdecl; external 'mongoc.dll'; 339 | procedure bson_dispose(b : Pointer); cdecl; external 'mongoc.dll'; 340 | procedure bson_copy(dest : Pointer; src : Pointer); cdecl; external 'mongoc.dll'; 341 | function bson_finish(b : Pointer) : Integer; cdecl; external 'mongoc.dll'; 342 | procedure bson_oid_gen(oid : Pointer); cdecl; external 'mongoc.dll'; 343 | procedure bson_oid_to_string(oid : Pointer; s : PAnsiChar); cdecl; external 'mongoc.dll'; 344 | procedure bson_oid_from_string(oid : Pointer; s : PAnsiChar); cdecl; external 'mongoc.dll'; 345 | function bson_append_string(b : Pointer; name : PAnsiChar; value : PAnsiChar) : Integer; 346 | cdecl; external 'mongoc.dll'; 347 | function bson_append_code(b : Pointer; name : PAnsiChar; value : PAnsiChar) : Integer; 348 | cdecl; external 'mongoc.dll'; 349 | function bson_append_symbol(b : Pointer; name : PAnsiChar; value : PAnsiChar) : Integer; 350 | cdecl; external 'mongoc.dll'; 351 | function bson_append_int(b : Pointer; name : PAnsiChar; value : Integer) : Integer; 352 | cdecl; external 'mongoc.dll'; 353 | function bson_append_long(b : Pointer; name : PAnsiChar; value : Int64) : Integer; 354 | cdecl; external 'mongoc.dll'; 355 | function bson_append_double(b : Pointer; name : PAnsiChar; value : Double) : Integer; 356 | cdecl; external 'mongoc.dll'; 357 | function bson_append_date(b : Pointer; name : PAnsiChar; value : Int64) : Integer; 358 | cdecl; external 'mongoc.dll'; 359 | function bson_append_bool(b : Pointer; name : PAnsiChar; value : Boolean) : Integer; 360 | cdecl; external 'mongoc.dll'; 361 | function bson_append_null(b : Pointer; name : PAnsiChar) : Integer; 362 | cdecl; external 'mongoc.dll'; 363 | function bson_append_undefined(b : Pointer; name : PAnsiChar) : Integer; 364 | cdecl; external 'mongoc.dll'; 365 | function bson_append_start_object(b : Pointer; name : PAnsiChar) : Integer; 366 | cdecl; external 'mongoc.dll'; 367 | function bson_append_start_array(b : Pointer; name : PAnsiChar) : Integer; 368 | cdecl; external 'mongoc.dll'; 369 | function bson_append_finish_object(b : Pointer) : Integer; cdecl; external 'mongoc.dll'; 370 | function bson_append_oid(b : Pointer; name : PAnsiChar; oid : Pointer) : Integer; cdecl; external 'mongoc.dll'; 371 | function bson_append_code_w_scope(b : Pointer; name : PAnsiChar; code : PAnsiChar; scope : Pointer) : Integer; 372 | cdecl; external 'mongoc.dll'; 373 | function bson_append_regex(b : Pointer; name : PAnsiChar; pattern : PAnsiChar; options : PAnsiChar) : Integer; 374 | cdecl; external 'mongoc.dll'; 375 | function bson_append_timestamp2(b : Pointer; name : PAnsiChar; time : Integer; increment : Integer) : Integer; 376 | cdecl; external 'mongoc.dll'; 377 | function bson_append_binary(b : Pointer; name : PAnsiChar; kind : Byte; data : Pointer; len : Integer) : Integer; 378 | cdecl; external 'mongoc.dll'; 379 | function bson_append_bson(b : Pointer; name : PAnsiChar; value : Pointer) : Integer; 380 | cdecl; external 'mongoc.dll'; 381 | function bson_buffer_size(b : Pointer) : Integer; cdecl; external 'mongoc.dll'; 382 | function bson_size(b : Pointer) : Integer; cdecl; external 'mongoc.dll'; 383 | function bson_iterator_create() : Pointer; cdecl; external 'mongoc.dll'; 384 | procedure bson_iterator_dispose(i : Pointer); cdecl; external 'mongoc.dll'; 385 | procedure bson_iterator_init(i : Pointer; b : Pointer); cdecl; external 'mongoc.dll'; 386 | function bson_find(i : Pointer; b : Pointer; name : PAnsiChar) : TBsonType; 387 | cdecl; external 'mongoc.dll'; 388 | function bson_iterator_type(i : Pointer) : TBsonType; cdecl; external 'mongoc.dll'; 389 | function bson_iterator_next(i : Pointer) : TBsonType; cdecl; external 'mongoc.dll'; 390 | function bson_iterator_key(i : Pointer) : PAnsiChar; cdecl; external 'mongoc.dll'; 391 | function bson_iterator_double(i : Pointer) : Double; cdecl; external 'mongoc.dll'; 392 | function bson_iterator_long(i : Pointer) : Int64; cdecl; external 'mongoc.dll'; 393 | function bson_iterator_int(i : Pointer) : Integer; cdecl; external 'mongoc.dll'; 394 | function bson_iterator_bool(i : Pointer) : Boolean; cdecl; external 'mongoc.dll'; 395 | function bson_iterator_string(i : Pointer) : PAnsiChar; cdecl; external 'mongoc.dll'; 396 | function bson_iterator_date(i : Pointer) : Int64; cdecl; external 'mongoc.dll'; 397 | procedure bson_iterator_subiterator(i : Pointer; sub : Pointer); 398 | cdecl; external 'mongoc.dll'; 399 | function bson_iterator_oid(i : Pointer) : Pointer; cdecl; external 'mongoc.dll'; 400 | function bson_iterator_code(i : Pointer) : PAnsiChar; cdecl; external 'mongoc.dll'; 401 | procedure bson_iterator_code_scope(i : Pointer; b : Pointer); cdecl; external 'mongoc.dll'; 402 | function bson_iterator_regex(i : Pointer) : PAnsiChar; cdecl; external 'mongoc.dll'; 403 | function bson_iterator_regex_opts(i : Pointer) : PAnsiChar; cdecl; external 'mongoc.dll'; 404 | function bson_iterator_timestamp_time(i : Pointer) : Integer; cdecl; external 'mongoc.dll'; 405 | function bson_iterator_timestamp_increment(i : Pointer) : Integer; cdecl; external 'mongoc.dll'; 406 | function bson_iterator_bin_len(i : Pointer) : Integer; cdecl; external 'mongoc.dll'; 407 | function bson_iterator_bin_type(i : Pointer) : Byte; cdecl; external 'mongoc.dll'; 408 | function bson_iterator_bin_data(i : Pointer) : Pointer; cdecl; external 'mongoc.dll'; 409 | 410 | 411 | constructor TBsonOID.Create(); 412 | begin 413 | bson_oid_gen(@value); 414 | end; 415 | 416 | constructor TBsonOID.Create(s : string); 417 | begin 418 | if length(s) <> 24 then 419 | Raise Exception.Create('Expected a 24 digit hex string'); 420 | bson_oid_from_string(@value, PAnsiChar(AnsiString(s))); 421 | end; 422 | 423 | constructor TBsonOID.Create(i : TBsonIterator); 424 | var 425 | p : PByte; 426 | begin 427 | p := bson_iterator_oid(i.handle); 428 | Move(p^, value, 12); 429 | end; 430 | 431 | function TBsonOID.AsString() : string; 432 | var 433 | buf : array[0..24] of AnsiChar; 434 | begin 435 | bson_oid_to_string(@value, @buf); 436 | Result := string(buf); 437 | end; 438 | 439 | constructor TBsonIterator.Create(); 440 | begin 441 | inherited Create(); 442 | handle := bson_iterator_create(); 443 | end; 444 | 445 | constructor TBsonIterator.Create(b : TBson); 446 | begin 447 | inherited Create(); 448 | handle := bson_iterator_create(); 449 | bson_iterator_init(handle, b.handle); 450 | end; 451 | 452 | destructor TBsonIterator.Destroy; 453 | begin 454 | bson_iterator_dispose(handle); 455 | end; 456 | 457 | function TBsonIterator.kind() : TBsonType; 458 | begin 459 | Result := bson_iterator_type(handle); 460 | end; 461 | 462 | function TBsonIterator.next() : Boolean; 463 | begin 464 | Result := bson_iterator_next(handle) <> bsonEOO; 465 | end; 466 | 467 | function TBsonIterator.key() : string; 468 | begin 469 | Result := string(System.UTF8ToWideString(bson_iterator_key(handle))); 470 | end; 471 | 472 | function TBsonIterator.value() : Variant; 473 | var 474 | k : TBsonType; 475 | d : TDateTime; 476 | begin 477 | k := kind(); 478 | case k of 479 | bsonEOO, bsonNULL : Result := Null; 480 | bsonDOUBLE: Result := bson_iterator_double(handle); 481 | bsonSTRING, bsonCODE, bsonSYMBOL: 482 | Result := string(System.UTF8ToWideString(bson_iterator_string(handle))); 483 | bsonINT: Result := bson_iterator_int(handle); 484 | bsonBOOL: Result := bson_iterator_bool(handle); 485 | bsonDATE: begin 486 | d := Int64toDouble(bson_iterator_date(handle)) / (1000 * 24 * 60 * 60) + 25569; 487 | Result := d; 488 | end; 489 | bsonLONG: Result := bson_iterator_long(handle); 490 | else 491 | Raise Exception.Create('BsonType (' + IntToStr(Ord(k)) + ') not supported by TBsonIterator.value'); 492 | end; 493 | end; 494 | 495 | function TBsonIterator.getOID() : TBsonOID; 496 | begin 497 | Result := TBsonOID.Create(Self); 498 | end; 499 | 500 | function TBsonIterator.getCodeWScope() : TBsonCodeWScope; 501 | begin 502 | Result := TBsonCodeWScope.Create(Self); 503 | end; 504 | 505 | function TBsonIterator.getRegex() : TBsonRegex; 506 | begin 507 | Result := TBsonRegex.Create(Self); 508 | end; 509 | 510 | function TBsonIterator.getTimestamp() : TBsonTimestamp; 511 | begin 512 | Result := TBsonTimestamp.Create(Self); 513 | end; 514 | 515 | function TBsonIterator.getBinary() : TBsonBinary; 516 | begin 517 | Result := TBsonBinary.Create(Self); 518 | end; 519 | 520 | function TBsonIterator.subiterator() : TBsonIterator; 521 | var 522 | i : TBsonIterator; 523 | begin 524 | i := TBsonIterator.Create(); 525 | bson_iterator_subiterator(handle, i.handle); 526 | Result := i; 527 | end; 528 | 529 | function TBsonIterator.getIntegerArray() : TIntegerArray; 530 | var 531 | i : TBsonIterator; 532 | j, count : Integer; 533 | begin 534 | if kind() <> bsonArray then 535 | raise Exception.Create('Iterator does not point to an array'); 536 | i := subiterator(); 537 | count := 0; 538 | while i.next() do begin 539 | if i.kind() <> bsonINT then 540 | raise Exception.Create('Array component is not an Integer'); 541 | inc(count); 542 | end; 543 | i := subiterator; 544 | j := 0; 545 | SetLength(Result, count); 546 | while i.next() do begin 547 | Result[j] := i.value(); 548 | inc(j); 549 | end; 550 | end; 551 | 552 | function TBsonIterator.getDoubleArray() : TDoubleArray; 553 | var 554 | i : TBsonIterator; 555 | j, count : Integer; 556 | begin 557 | if kind() <> bsonArray then 558 | raise Exception.Create('Iterator does not point to an array'); 559 | i := subiterator(); 560 | count := 0; 561 | while i.next() do begin 562 | if i.kind() <> bsonDOUBLE then 563 | raise Exception.Create('Array component is not a Double'); 564 | inc(count); 565 | end; 566 | i := subiterator; 567 | j := 0; 568 | SetLength(Result, count); 569 | while i.next() do begin 570 | Result[j] := i.value(); 571 | inc(j); 572 | end; 573 | end; 574 | 575 | function TBsonIterator.getStringArray() : TStringArray; 576 | var 577 | i : TBsonIterator; 578 | j, count : Integer; 579 | begin 580 | if kind() <> bsonArray then 581 | raise Exception.Create('Iterator does not point to an array'); 582 | i := subiterator(); 583 | count := 0; 584 | while i.next() do begin 585 | if i.kind() <> bsonSTRING then 586 | raise Exception.Create('Array component is not a string'); 587 | inc(count); 588 | end; 589 | i := subiterator; 590 | j := 0; 591 | SetLength(Result, count); 592 | while i.next() do begin 593 | Result[j] := System.UTF8ToWideString(i.value()); 594 | inc(j); 595 | end; 596 | end; 597 | 598 | function TBsonIterator.getBooleanArray() : TBooleanArray; 599 | var 600 | i : TBsonIterator; 601 | j, count : Integer; 602 | begin 603 | if kind() <> bsonArray then 604 | raise Exception.Create('Iterator does not point to an array'); 605 | i := subiterator(); 606 | count := 0; 607 | while i.next() do begin 608 | if i.kind() <> bsonBOOL then 609 | raise Exception.Create('Array component is not a Boolean'); 610 | inc(count); 611 | end; 612 | i := subiterator; 613 | j := 0; 614 | SetLength(Result, count); 615 | while i.next() do begin 616 | Result[j] := i.value(); 617 | inc(j); 618 | end; 619 | end; 620 | 621 | function TBson.value(name : string) : Variant; 622 | var 623 | i : TBsonIterator; 624 | begin 625 | i := find(name); 626 | if i = nil then 627 | Result := Null 628 | else 629 | Result := i.value; 630 | i.Free; { Thanks to SamJokO } 631 | end; 632 | 633 | function TBson.iterator() : TBsonIterator; 634 | begin 635 | Result := TBsonIterator.Create(Self); 636 | end; 637 | 638 | constructor TBsonBuffer.Create(); 639 | begin 640 | inherited Create(); 641 | handle := bson_create(); 642 | bson_init(handle); 643 | end; 644 | 645 | destructor TBsonBuffer.Destroy(); 646 | begin 647 | bson_destroy(handle); 648 | bson_dispose(handle); 649 | inherited Destroy(); 650 | end; 651 | 652 | function TBsonBuffer.append(name : string; value: PAnsiChar) : Boolean; 653 | begin 654 | if handle = nil then 655 | raise Exception.Create('BsonBuffer already finished'); 656 | Result := (bson_append_string(handle, PAnsiChar(System.UTF8Encode(name)), value) = 0); 657 | end; 658 | 659 | function TBsonBuffer.appendCode(name : string; value: PAnsiChar) : Boolean; 660 | begin 661 | if handle = nil then 662 | raise Exception.Create('BsonBuffer already finished'); 663 | Result := (bson_append_code(handle, PAnsiChar(System.UTF8Encode(name)), value) = 0); 664 | end; 665 | 666 | function TBsonBuffer.appendSymbol(name : string; value: PAnsiChar) : Boolean; 667 | begin 668 | if handle = nil then 669 | raise Exception.Create('BsonBuffer already finished'); 670 | Result := (bson_append_symbol(handle, PAnsiChar(System.UTF8Encode(name)), value) = 0); 671 | end; 672 | 673 | function TBsonBuffer.append(name : string; value: Integer) : Boolean; 674 | begin 675 | if handle = nil then 676 | raise Exception.Create('BsonBuffer already finished'); 677 | Result := (bson_append_int(handle, PAnsiChar(System.UTF8Encode(name)), value) = 0); 678 | end; 679 | 680 | function TBsonBuffer.append(name : string; value: Int64) : Boolean; 681 | begin 682 | if handle = nil then 683 | raise Exception.Create('BsonBuffer already finished'); 684 | Result := (bson_append_long(handle, PAnsiChar(System.UTF8Encode(name)), value) = 0); 685 | end; 686 | 687 | function TBsonBuffer.append(name : string; value: Double) : Boolean; 688 | begin 689 | if handle = nil then 690 | raise Exception.Create('BsonBuffer already finished'); 691 | Result := (bson_append_double(handle, PAnsiChar(System.UTF8Encode(name)), value) = 0); 692 | end; 693 | 694 | function TBsonBuffer.append(name : string; value: TDateTime) : Boolean; 695 | begin 696 | if handle = nil then 697 | raise Exception.Create('BsonBuffer already finished'); 698 | Result := (bson_append_date(handle, PAnsiChar(System.UTF8Encode(name)), Trunc((value - 25569) * 1000 * 60 * 60 * 24)) = 0); 699 | end; 700 | 701 | function TBsonBuffer.append(name : string; value: Boolean) : Boolean; 702 | begin 703 | if handle = nil then 704 | raise Exception.Create('BsonBuffer already finished'); 705 | Result := (bson_append_bool(handle, PAnsiChar(System.UTF8Encode(name)), value) = 0); 706 | end; 707 | 708 | function TBsonBuffer.append(name : string; value: TBsonOID) : Boolean; 709 | begin 710 | if handle = nil then 711 | raise Exception.Create('BsonBuffer already finished'); 712 | Result := (bson_append_oid(handle, PAnsiChar(System.UTF8Encode(name)), @value.value) = 0); 713 | end; 714 | 715 | function TBsonBuffer.append(name : string; value: TBsonCodeWScope) : Boolean; 716 | begin 717 | if handle = nil then 718 | raise Exception.Create('BsonBuffer already finished'); 719 | Result := (bson_append_code_w_scope(handle, PAnsiChar(System.UTF8Encode(name)), PAnsiChar(System.UTF8Encode(value.code)), value.scope.handle) = 0); 720 | end; 721 | 722 | function TBsonBuffer.append(name : string; value: TBsonRegex) : Boolean; 723 | begin 724 | if handle = nil then 725 | raise Exception.Create('BsonBuffer already finished'); 726 | Result := (bson_append_regex(handle, PAnsiChar(System.UTF8Encode(name)), PAnsiChar(System.UTF8Encode(value.pattern)), PAnsiChar(System.UTF8Encode(value.options))) = 0); 727 | end; 728 | 729 | function TBsonBuffer.append(name : string; value: TBsonTimestamp) : Boolean; 730 | begin 731 | if handle = nil then 732 | raise Exception.Create('BsonBuffer already finished'); 733 | Result := (bson_append_timestamp2(handle, PAnsiChar(System.UTF8Encode(name)), Trunc((value.time - 25569) * 60 * 60 * 24), value.increment) = 0); 734 | end; 735 | 736 | function TBsonBuffer.append(name : string; value: TBsonBinary) : Boolean; 737 | begin 738 | if handle = nil then 739 | raise Exception.Create('BsonBuffer already finished'); 740 | Result := (bson_append_binary(handle, PAnsiChar(System.UTF8Encode(name)), value.kind, value.data, value.len) = 0); 741 | end; 742 | 743 | function TBsonBuffer.append(name : string; value : OleVariant) : Boolean; 744 | var 745 | d : double; 746 | begin 747 | case VarType(value) of 748 | varNull: Result := appendNull(name); 749 | varInteger: Result := append(name, Integer(value)); 750 | varSingle, varDouble, varCurrency: begin 751 | d := value; 752 | Result := append(name, d); 753 | end; 754 | varDate: Result := append(name, TDateTime(value)); 755 | varInt64: Result := append(name, Int64(value)); 756 | varBoolean: Result := append(name, Boolean(value)); 757 | varOleStr: Result := append(name, PAnsiChar(System.UTF8Encode(value))); 758 | else 759 | raise Exception.Create('TBson.append(variant): type not supported (' + IntToStr(VarType(value)) + ')'); 760 | end; 761 | end; 762 | 763 | function TBsonBuffer.appendNull(name : string) : Boolean; 764 | begin 765 | if handle = nil then 766 | raise Exception.Create('BsonBuffer already finished'); 767 | Result := (bson_append_null(handle, PAnsiChar(System.UTF8Encode(name))) = 0); 768 | end; 769 | 770 | function TBsonBuffer.appendUndefined(name : string) : Boolean; 771 | begin 772 | if handle = nil then 773 | raise Exception.Create('BsonBuffer already finished'); 774 | Result := (bson_append_undefined(handle, PAnsiChar(System.UTF8Encode(name))) = 0); 775 | end; 776 | 777 | function TBsonBuffer.appendBinary(name : string; kind : Integer; data : Pointer; length : Integer) : Boolean; 778 | begin 779 | if handle = nil then 780 | raise Exception.Create('BsonBuffer already finished'); 781 | Result := (bson_append_binary(handle, PAnsiChar(System.UTF8Encode(name)), kind, data, length) = 0); 782 | end; 783 | 784 | function TBsonBuffer.append(name : string; value : TBson) : Boolean; 785 | begin 786 | Result := (bson_append_bson(handle, PAnsiChar(System.UTF8Encode(name)), value.handle) = 0); 787 | end; 788 | 789 | function TBsonBuffer.appendArray(name : string; value : array of Integer) : Boolean; 790 | var 791 | success : Boolean; 792 | i, len : Integer; 793 | begin 794 | success := (bson_append_start_array(handle, PAnsiChar(System.UTF8Encode(name))) = 0); 795 | len := Length(value); 796 | i := 0; 797 | while success and (i < len) do begin 798 | success := (bson_append_int(handle, PAnsiChar(AnsiString(IntToStr(i))), value[i]) = 0); 799 | inc(i); 800 | end; 801 | if success then 802 | success := (bson_append_finish_object(handle) = 0); 803 | Result := success; 804 | end; 805 | 806 | function TBsonBuffer.appendArray(name : string; value : array of Double) : Boolean; 807 | var 808 | success : Boolean; 809 | i, len : Integer; 810 | begin 811 | success := (bson_append_start_array(handle, PAnsiChar(System.UTF8Encode(name))) = 0); 812 | len := Length(value); 813 | i := 0; 814 | while success and (i < len) do begin 815 | success := (bson_append_double(handle, PAnsiChar(AnsiString(IntToStr(i))), value[i]) = 0); 816 | inc(i); 817 | end; 818 | if success then 819 | success := (bson_append_finish_object(handle) = 0); 820 | Result := success; 821 | end; 822 | 823 | function TBsonBuffer.appendArray(name : string; value : array of Boolean) : Boolean; 824 | var 825 | success : Boolean; 826 | i, len : Integer; 827 | begin 828 | success := (bson_append_start_array(handle, PAnsiChar(System.UTF8Encode(name))) = 0); 829 | len := Length(value); 830 | i := 0; 831 | while success and (i < len) do begin 832 | success := (bson_append_bool(handle, PAnsiChar(AnsiString(IntToStr(i))), value[i]) = 0); 833 | inc(i); 834 | end; 835 | if success then 836 | success := (bson_append_finish_object(handle) = 0); 837 | Result := success; 838 | end; 839 | 840 | function TBsonBuffer.appendArray(name : string; value : array of string) : Boolean; 841 | var 842 | success : Boolean; 843 | i, len : Integer; 844 | begin 845 | success := (bson_append_start_array(handle, PAnsiChar(System.UTF8Encode(name))) = 0); 846 | len := Length(value); 847 | i := 0; 848 | while success and (i < len) do begin 849 | success := (bson_append_string(handle, PAnsiChar(AnsiString(IntToStr(i))), PAnsiChar(System.UTF8Encode(value[i]))) = 0); 850 | inc(i); 851 | end; 852 | if success then 853 | success := (bson_append_finish_object(handle) = 0); 854 | Result := success; 855 | end; 856 | 857 | function TBsonBuffer.startObject(name : string) : Boolean; 858 | begin 859 | if handle = nil then 860 | raise Exception.Create('BsonBuffer already finished'); 861 | Result := (bson_append_start_object(handle, PAnsiChar(System.UTF8Encode(name))) = 0); 862 | end; 863 | 864 | function TBsonBuffer.startArray(name : string) : Boolean; 865 | begin 866 | if handle = nil then 867 | raise Exception.Create('BsonBuffer already finished'); 868 | Result := (bson_append_start_array(handle, PAnsiChar(System.UTF8Encode(name))) = 0); 869 | end; 870 | 871 | function TBsonBuffer.finishObject() : Boolean; 872 | begin 873 | if handle = nil then 874 | raise Exception.Create('BsonBuffer already finished'); 875 | Result := (bson_append_finish_object(handle) = 0); 876 | end; 877 | 878 | function TBsonBuffer.size() : Integer; 879 | begin 880 | if handle = nil then 881 | raise Exception.Create('BsonBuffer already finished'); 882 | Result := bson_buffer_size(handle); 883 | end; 884 | 885 | function TBsonBuffer.finish() : TBson; 886 | begin 887 | if handle = nil then 888 | raise Exception.Create('BsonBuffer already finished'); 889 | if bson_finish(handle) = 0 Then begin 890 | Result := TBson.Create(handle); 891 | handle := nil; 892 | end 893 | else 894 | Result := nil; 895 | end; 896 | 897 | constructor TBson.Create(h : Pointer); 898 | begin 899 | handle := h; 900 | end; 901 | 902 | destructor TBson.Destroy(); 903 | begin 904 | bson_destroy(handle); 905 | bson_dispose(handle); 906 | inherited Destroy(); 907 | end; 908 | 909 | function TBson.size() : Integer; 910 | begin 911 | Result := bson_size(handle); 912 | end; 913 | 914 | function TBson.find(name : string) : TBsonIterator; 915 | var 916 | i : TBsonIterator; 917 | begin 918 | i := TBsonIterator.Create(); 919 | if bson_find(i.handle, handle, PAnsiChar(System.UTF8Encode(name))) = bsonEOO Then 920 | i := nil; 921 | Result := i; 922 | end; 923 | 924 | procedure _display(i : TBsonIterator; depth : Integer); 925 | var 926 | t : TBsonType; 927 | j,k : Integer; 928 | cws : TBsonCodeWScope; 929 | regex : TBsonRegex; 930 | ts : TBsonTimestamp; 931 | bin : TBsonBinary; 932 | p : PByte; 933 | begin 934 | while i.next() do begin 935 | t := i.kind(); 936 | if t = bsonEOO then 937 | break; 938 | for j:= 1 To depth do 939 | Write(' '); 940 | Write(i.key, ' (', Ord(t), ') : '); 941 | case t of 942 | bsonDOUBLE, 943 | bsonSTRING, bsonSYMBOL, bsonCODE, 944 | bsonBOOL, bsonDATE, bsonINT, bsonLONG : 945 | Write(i.value); 946 | bsonUNDEFINED : 947 | Write('UNDEFINED'); 948 | bsonNULL : 949 | Write('NULL'); 950 | bsonOBJECT, bsonARRAY : begin 951 | Writeln; 952 | _display(i.subiterator, depth+1); 953 | end; 954 | bsonOID : write(i.getOID().AsString()); 955 | bsonCODEWSCOPE : begin 956 | Write('CODEWSCOPE '); 957 | cws := i.getCodeWScope(); 958 | WriteLn(cws.code); 959 | _display(cws.scope.iterator, depth+1); 960 | end; 961 | bsonREGEX: begin 962 | regex := i.getRegex(); 963 | write(regex.pattern, ', ', regex.options); 964 | end; 965 | bsonTIMESTAMP: begin 966 | ts := i.getTimestamp(); 967 | write(DateTimeToStr(ts.time), ' (', ts.increment, ')'); 968 | end; 969 | bsonBINDATA: begin 970 | bin := i.getBinary(); 971 | Write('BINARY (', bin.kind, ')'); 972 | p := bin.data; 973 | for j := 0 to bin.len-1 do begin 974 | if j and 15 = 0 then begin 975 | WriteLn; 976 | for k := 1 To depth+1 do 977 | Write(' '); 978 | end; 979 | write(ByteToHex(p^), ' '); 980 | Inc(p); 981 | end; 982 | end; 983 | else 984 | Write('UNKNOWN'); 985 | end; 986 | Writeln; 987 | end; 988 | end; 989 | 990 | procedure TBson.display(); 991 | begin 992 | if Self = nil then 993 | WriteLn('nil BSON') 994 | else 995 | _display(iterator, 0); 996 | end; 997 | 998 | constructor TBsonCodeWScope.Create(code_ : string; scope_ : TBson); 999 | begin 1000 | code := code_; 1001 | scope := scope_; 1002 | end; 1003 | 1004 | constructor TBsonCodeWScope.Create(i : TBsonIterator); 1005 | var 1006 | b, c : Pointer; 1007 | begin 1008 | code := string(bson_iterator_code(i.handle)); 1009 | b := bson_create(); 1010 | bson_iterator_code_scope(i.handle, b); 1011 | c := bson_create(); 1012 | bson_copy(c, b); 1013 | scope := TBson.Create(c); 1014 | bson_dispose(b); 1015 | end; 1016 | 1017 | constructor TBsonRegex.Create(pattern_ : string; options_ : string); 1018 | begin 1019 | pattern := pattern_; 1020 | options := options_; 1021 | end; 1022 | 1023 | constructor TBsonRegex.Create(i : TBsonIterator); 1024 | begin 1025 | pattern := string(bson_iterator_regex(i.handle)); 1026 | options := string(bson_iterator_regex_opts(i.handle)); 1027 | end; 1028 | 1029 | 1030 | constructor TBsonTimestamp.Create(time_ : TDateTime; increment_ : Integer); 1031 | begin 1032 | time := time_; 1033 | increment := increment_; 1034 | end; 1035 | 1036 | constructor TBsonTimestamp.Create(i : TBsonIterator); 1037 | begin 1038 | time := bson_iterator_timestamp_time(i.handle) / (60.0 * 60 * 24) + 25569; 1039 | increment := bson_iterator_timestamp_increment(i.handle); 1040 | end; 1041 | 1042 | constructor TBsonBinary.Create(p: Pointer; length: Integer); 1043 | begin 1044 | GetMem(data, length); 1045 | Move(p^, data^, length); 1046 | kind := 0; 1047 | end; 1048 | 1049 | constructor TBsonBinary.Create(i : TBsonIterator); 1050 | var 1051 | p : Pointer; 1052 | begin 1053 | kind := bson_iterator_bin_type(i.handle); 1054 | len := bson_iterator_bin_len(i.handle); 1055 | p := bson_iterator_bin_data(i.handle); 1056 | GetMem(data, len); 1057 | Move(p^, data^, len); 1058 | end; 1059 | 1060 | destructor TBsonBinary.Destroy; 1061 | begin 1062 | FreeMem(data); 1063 | end; 1064 | 1065 | function ByteToHex(InByte : Byte) : string; 1066 | const digits : array[0..15] of Char = '0123456789ABCDEF'; 1067 | begin 1068 | result := digits[InByte shr 4] + digits[InByte and $0F]; 1069 | end; 1070 | 1071 | function BSON(x : array of OleVariant) : TBson; 1072 | var 1073 | len : Integer; 1074 | i : Integer; 1075 | bb : TBsonBuffer; 1076 | depth : Integer; 1077 | key : string; 1078 | value : string; 1079 | begin 1080 | bb := TBsonBuffer.Create(); 1081 | len := Length(x); 1082 | i := 0; 1083 | depth := 0; 1084 | while i < len do begin 1085 | key := VarToStr(x[i]); 1086 | if key = '}' then begin 1087 | if depth = 0 then 1088 | Raise Exception.Create('BSON(): unexpected "}"'); 1089 | bb.finishObject(); 1090 | dec(depth); 1091 | end 1092 | else begin 1093 | inc(i); 1094 | if i = Len then 1095 | raise Exception.Create('BSON(): expected value for ' + key); 1096 | value := VarToStr(x[i]); 1097 | if value = '{' then begin 1098 | bb.startObject(key); 1099 | inc(depth); 1100 | end 1101 | else 1102 | bb.append(key, x[i]); 1103 | end; 1104 | inc(i); 1105 | end; 1106 | if depth > 0 then 1107 | Raise Exception.Create('BSON: open subobject'); 1108 | Result := bb.finish(); 1109 | end; 1110 | 1111 | procedure err_handler(msg : PAnsiChar); 1112 | begin 1113 | Raise Exception.Create(string(msg)); 1114 | end; 1115 | 1116 | initialization 1117 | bsonEmpty := BSON([]); 1118 | set_bson_err_handler(Addr(err_handler)); 1119 | 1120 | end. 1121 | 1122 | -------------------------------------------------------------------------------- /MongoDB.pas: -------------------------------------------------------------------------------- 1 | { 2 | Copyright 2009-2011 10gen Inc. 3 | 4 | Licensed under the Apache License, Version 2.0 (the "License"); 5 | you may not use this file except in compliance with the License. 6 | You may obtain a copy of the License at 7 | 8 | http://www.apache.org/licenses/LICENSE-2.0 9 | 10 | Unless required by applicable law or agreed to in writing, software 11 | distributed under the License is distributed on an "AS IS" BASIS, 12 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 13 | See the License for the specific language governing permissions and 14 | limitations under the License. 15 | } 16 | { This unit implements the TMongo connection class for connecting to a MongoDB server 17 | and performing database operations on that server. } 18 | unit MongoDB; 19 | 20 | interface 21 | Uses 22 | MongoBson; 23 | 24 | const 25 | updateUpsert = 1; 26 | updateMulti = 2; 27 | updateBasic = 4; 28 | 29 | indexUnique = 1; 30 | indexDropDups = 4; 31 | indexBackground = 8; 32 | indexSparse = 16; 33 | 34 | { Create a tailable cursor. } 35 | cursorTailable = 2; 36 | { Allow queries on a non-primary node. } 37 | cursorSlaveOk = 4; 38 | { Disable cursor timeouts. } 39 | cursorNoTimeout = 16; 40 | { Momentarily block for more data. } 41 | cursorAwaitData = 32; 42 | { Stream in multiple 'more' packages. } 43 | cursorExhaust = 64; 44 | { Allow reads even if a shard is down. } 45 | cursorPartial = 128; 46 | 47 | type 48 | TMongoCursor = class; 49 | TStringArray = array of string; 50 | 51 | { TMongo objects establish a connection to a MongoDB server and are 52 | used for subsequent database operations on that server. } 53 | TMongo = class(TObject) 54 | { Pointer to externally managed data describing the connection. 55 | User code should not access this. It is public only for 56 | access from the GridFS unit. } 57 | var handle : Pointer; 58 | { Create a TMongo connection object. A connection is attempted on the 59 | MongoDB server running on the localhost '127.0.0.1:27017'. 60 | Check isConnected() to see if it was successful. } 61 | constructor Create(); overload; 62 | { Create a TMongo connection object. The host[:port] to connect to is given 63 | as the host string. port defaults to 27017 if not given. 64 | Check the result of isConnected() to see if it was successful. } 65 | constructor Create(host : string); overload; 66 | { Determine whether this TMongo is currently connected to a MongoDB server. 67 | Returns True if connected; False, if not. } 68 | function isConnected() : Boolean; 69 | { Check the connection. This returns True if isConnected() and the server 70 | responded to a 'ping'; otherwise, False. } 71 | function checkConnection() : Boolean; 72 | { Return True if the server reports that it is a master; otherwise, False. } 73 | function isMaster() : Boolean; 74 | { Temporarirly disconnect from the server. The connection may be reestablished 75 | by calling reconnect. This works on both normal connections and replsets. } 76 | procedure disconnect(); 77 | { Reconnect to the MongoDB server after having called disconnect to suspend 78 | operations. } 79 | function reconnect() : Boolean; 80 | { Get an error code indicating the reason a connection or network communication 81 | failed. See mongo-c-driver/src/mongo.h and mongo_error_t. } 82 | function getErr() : Integer; 83 | { Set the timeout in milliseconds of a network operation. The default of 0 84 | indicates that there is no timeout. } 85 | function setTimeout(millis : Integer) : Boolean; 86 | { Get the network operation timeout value in milliseconds. The default of 0 87 | indicates that there is no timeout. } 88 | function getTimeout() : Integer; 89 | { Get the host:post of the primary server that this TMongo is connected to. } 90 | function getPrimary() : string; 91 | { Get the TCP/IP socket number being used for network communication } 92 | function getSocket() : Integer; 93 | { Get a list of databases from the server as an array of string } 94 | function getDatabases() : TStringArray; 95 | { Given a database name as a string, get the namespaces of the collections 96 | in that database as an array of string. } 97 | function getDatabaseCollections(db : string) : TStringArray; 98 | { Rename a collection. from_ns is the current namespace of the collection 99 | to be renamed. to_ns is the target namespace. 100 | The collection namespaces (from_ns, to_ns) are in the form 'database.collection'. 101 | Returns True if successful; otherwise, False. Note that this function may 102 | be used to move a collection from one database to another. } 103 | function rename(from_ns : string; to_ns : string) : Boolean; 104 | { Drop a collection. Removes the collection of the given name from the server. 105 | Exercise care when using this function. 106 | The collection namespace (ns) is in the form 'database.collection'. } 107 | function drop(ns : string) : Boolean; 108 | { Drop a database. Removes the entire database of the given name from the server. 109 | Exercise care when using this function. } 110 | function dropDatabase(db : string) : Boolean; 111 | { Insert a document into the given namespace. 112 | The collection namespace (ns) is in the form 'database.collection'. 113 | See http://www.mongodb.org/display/DOCS/Inserting. 114 | Returns True if successful; otherwise, False. } 115 | function insert(ns : string; b : TBson) : Boolean; overload; 116 | { Insert a batch of documents into the given namespace (collection). 117 | The collection namespace (ns) is in the form 'database.collection'. 118 | See http://www.mongodb.org/display/DOCS/Inserting. 119 | Returns True if successful; otherwise, False. } 120 | function insert(ns : string; bs : array of TBson) : Boolean; overload; 121 | { Perform an update on the server. The collection namespace (ns) is in the 122 | form 'database.collection'. criteria indicates which records to update 123 | and objNew gives the replacement document. 124 | See http://www.mongodb.org/display/DOCS/Updating. 125 | Returns True if successful; otherwise, False. } 126 | function update(ns : string; criteria : TBson; objNew : TBson) : Boolean; overload; 127 | { Perform an update on the server. The collection namespace (ns) is in the 128 | form 'database.collection'. criteria indicates which records to update 129 | and objNew gives the replacement document. flags is a bit mask containing update 130 | options; updateUpsert, updateMulti, or updateBasic. 131 | See http://www.mongodb.org/display/DOCS/Updating. 132 | Returns True if successful; otherwise, False. } 133 | function update(ns : string; criteria : TBson; objNew : TBson; flags : Integer) : Boolean; overload; 134 | { Remove documents from the server. The collection namespace (ns) is in the 135 | form 'database.collection'. Documents that match the given criteria 136 | are removed from the collection. 137 | See http://www.mongodb.org/display/DOCS/Removing. 138 | Returns True if successful; otherwise, False. } 139 | function remove(ns : string; criteria : TBson) : Boolean; 140 | { Find the first document in the given namespace that matches a query. 141 | See http://www.mongodb.org/display/DOCS/Querying 142 | The collection namespace (ns) is in the form 'database.collection'. 143 | Returns the document as a TBson if found; otherwise, nil. } 144 | function findOne(ns : string; query : TBson) : TBson; overload; 145 | { Find the first document in the given namespace that matches a query. 146 | See http://www.mongodb.org/display/DOCS/Querying 147 | The collection namespace (ns) is in the form 'database.collection'. 148 | A subset of the documents fields to be returned is specified in fields. 149 | This can cut down on network traffic. 150 | Returns the document as a TBson if found; otherwise, nil. } 151 | function findOne(ns : string; query : TBson; fields : TBson) : TBson; overload; 152 | { Issue a query to the database. 153 | See http://www.mongodb.org/display/DOCS/Querying 154 | Requires a TMongoCursor that is used to specify optional parameters to 155 | the find and to step through the result set. 156 | The collection namespace (ns) is in the form 'database.collection'. 157 | Returns true if the query was successful and at least one document is 158 | in the result set; otherwise, false. 159 | Optionally, set other members of the TMongoCursor before calling 160 | find. The TMongoCursor must be destroyed after finishing with a query. 161 | Instatiate a new cursor for another query. 162 | Example: @longcode(# 163 | var cursor : TMongoCursor; 164 | begin 165 | (* This finds all documents in the collection that have 166 | name equal to 'John' and steps through them. *) 167 | cursor := TMongoCursor.Create(BSON(['name', 'John'])); 168 | if mongo.find(ns, cursor) then 169 | while cursor.next() do 170 | (* Do something with cursor.value() *) 171 | (* This finds all documents in the collection that have 172 | age equal to 32, but sorts them by name. *) 173 | cursor := TMongoCursor.Create(BSON(['age', 32])); 174 | cursor.sort := BSON(['name', True]); 175 | if mongo.find(ns, cursor) then 176 | while cursor.next() do 177 | (* Do something with cursor.value() *) 178 | end; 179 | #) } 180 | function find(ns : string; cursor : TMongoCursor) : Boolean; 181 | { Return the count of all documents in the given namespace. 182 | The collection namespace (ns) is in the form 'database.collection'. } 183 | function count(ns : string) : Double; overload; 184 | { Return the count of all documents in the given namespace that match 185 | the given query. 186 | The collection namespace (ns) is in the form 'database.collection'. } 187 | function count(ns : string; query : TBson) : Double; overload; 188 | { Create an index for the given collection so that accesses by the given 189 | key are faster. 190 | The collection namespace (ns) is in the form 'database.collection'. 191 | key is the name of the field on which to index. 192 | Returns nil if successful; otherwise, a TBson document that describes the error. } 193 | function distinct(ns : string; key : string) : TBson; 194 | { Returns a BSON document containing a field 'values' which 195 | is an array of the distinct values of the key in the given collection (ns). 196 | Example: 197 | var 198 | b : TBson; 199 | names : TStringArray; 200 | begin 201 | b := mongo.distinct('test.people', 'name'); 202 | names := b.find('values').GetStringArray(); 203 | end 204 | } 205 | function indexCreate(ns : string; key : string) : TBson; overload; 206 | { Create an index for the given collection so that accesses by the given 207 | key are faster. 208 | The collection namespace (ns) is in the form 'database.collection'. 209 | key is the name of the field on which to index. 210 | options specifies a bit mask of indexUnique, indexDropDups, indexBackground, 211 | and/or indexSparse. 212 | Returns nil if successful; otherwise, a TBson document that describes the error. } 213 | function indexCreate(ns : string; key : string; options : Integer) : TBson; overload; 214 | { Create an index for the given collection so that accesses by the given 215 | key are faster. 216 | The collection namespace (ns) is in the form 'database.collection'. 217 | key is a TBson document that (possibly) defines a compound key. 218 | For example, @longcode(# 219 | mongo.indexCreate(ns, BSON(['age', True, 'name', True])); 220 | (* speed up accesses of documents by age and then name *) 221 | #) 222 | Returns nil if successful; otherwise, a TBson document that describes the error. } 223 | function indexCreate(ns : string; key : TBson) : TBson; overload; 224 | { Create an index for the given collection so that accesses by the given 225 | key are faster. 226 | The collection namespace (ns) is in the form 'database.collection'. 227 | key is a TBson document that (possibly) defines a compound key. 228 | For example, @longcode(# 229 | mongo.indexCreate(ns, BSON(['age', True, 'name', True])); 230 | (* speed up accesses of documents by age and then name *) 231 | #) 232 | options specifies a bit mask of indexUnique, indexDropDups, indexBackground, 233 | and/or indexSparse. 234 | Returns nil if successful; otherwise, a TBson document that describes the error. } 235 | function indexCreate(ns : string; key : TBson; options : Integer) : TBson; overload; 236 | { Add a user name / password to the 'admin' database. This may be authenticated 237 | with the authenticate function. 238 | See http://www.mongodb.org/display/DOCS/Security+and+Authentication } 239 | function addUser(name : string; password : string) : Boolean; overload; 240 | { Add a user name / password to the given database. This may be authenticated 241 | with the authenticate function. 242 | See http://www.mongodb.org/display/DOCS/Security+and+Authentication } 243 | function addUser(name : string; password : string; db : string) : Boolean; overload; 244 | { Authenticate a user name / password with the 'admin' database. 245 | See http://www.mongodb.org/display/DOCS/Security+and+Authentication } 246 | function authenticate(name : string; password : string) : Boolean; overload; 247 | { Authenticate a user name / password with the given database. 248 | See http://www.mongodb.org/display/DOCS/Security+and+Authentication } 249 | function authenticate(name : string; password : string; db : string) : Boolean; overload; 250 | { Issue a command to the server. This supports all commands by letting you 251 | specify the command object as a TBson document. 252 | If successful, the response from the server is returned as a TBson document; 253 | otherwise, nil is returned. 254 | See http://www.mongodb.org/display/DOCS/List+of+Database+Commands } 255 | function command(db : string; command : TBson) : TBson; overload; 256 | { Issue a command to the server. This version of the command() function 257 | supports that subset of commands which may be described by a cmdstr and 258 | an argument. 259 | If successful, the response from the server is returned as a TBson document; 260 | otherwise, nil is returned. 261 | See http://www.mongodb.org/display/DOCS/List+of+Database+Commands } 262 | function command(db : string; cmdstr : string; arg : OleVariant) : TBson; overload; 263 | { Get the last error reported by the server. Returns a TBson document describing 264 | the error if there was one; otherwise, nil. } 265 | function getLastErr(db : string) : TBson; 266 | { Get the previous error reported by the server. Returns a TBson document describing 267 | the error if there was one; otherwise, nil. } 268 | function getPrevErr(db : string) : TBson; 269 | { Reset the error status of the server. After calling this function, both 270 | getLastErr() and getPrevErr() will return nil. } 271 | procedure resetErr(db : string); 272 | { Get the server error code. As a convenience, this is saved here after calling 273 | getLastErr() or getPrevErr(). } 274 | function getServerErr() : Integer; 275 | { Get the server error string. As a convenience, this is saved here after calling 276 | getLastErr() or getPrevErr(). } 277 | function getServerErrString() : string; 278 | { Destroy this TMongo object. Severs the connection to the server and releases 279 | external resources. } 280 | destructor Destroy(); override; 281 | end; 282 | 283 | { TMongoReplset is a superclass of the TMongo connection class that implements 284 | a different constructor and several functions for connecting to a replset. } 285 | TMongoReplset = class(TMongo) 286 | { Create a TMongoReplset object given the replset name. Unlike the constructor 287 | for TMongo, this does not yet establish the connection. Call addSeed() for each 288 | of the seed hosts and then call Connect to connect to the replset. } 289 | constructor Create(name : string); 290 | { Add a seed to the replset. The host string should be in the form 'host[:port]'. 291 | port defaults to 27017 if not given/ 292 | After constructing a TMongoReplset, call this for each seed and then call 293 | Connect(). } 294 | procedure addSeed(host : string); 295 | { Connect to the replset. The seeds added with addSeed() are polled to determine 296 | if they belong to the replset name given to the constructor. Their hosts 297 | are then polled to determine the master to connect to. 298 | Returns True if it successfully connected; otherwise, False. } 299 | function Connect() : Boolean; 300 | { Get the number of hosts reported by the seeds } 301 | function getHostCount() : Integer; 302 | { Get the Ith host as a 'host:port' string. } 303 | function getHost(i : Integer) : string; 304 | end; 305 | 306 | { Objects of class TMongoCursor are used with TMongo.find() to specify 307 | optional parameters of the find and also to step though the result set. 308 | A TMongoCursor object is also returned by GridFS.TGridfile.getChunks() which 309 | is used to step through the chunks of a gridfile. } 310 | TMongoCursor = class(TObject) 311 | var 312 | { Pointer to externally managed data. User code should not modify this. } 313 | handle : Pointer; 314 | { A TBson document describing the query. 315 | See http://www.mongodb.org/display/DOCS/Querying } 316 | query : TBson; 317 | { A TBson document describing the sort to be applied to the result set. 318 | See the example for TMongo.find(). Defaults to nil (no sort). } 319 | sort : TBson; 320 | { A TBson document listing those fields to be included in the result set. 321 | This can be used to cut down on network traffic. Defaults to nil \ 322 | (returns all fields of matching documents). } 323 | fields : TBson; 324 | { Specifies a limiting count on the number of documents returned. The 325 | default of 0 indicates no limit on the number of records returned.} 326 | limit : Integer; 327 | { Specifies the number of matched documents to skip. Default is 0. } 328 | skip : Integer; 329 | { Specifies cursor options. A bit mask of cursorTailable, cursorSlaveOk, 330 | cursorNoTimeout, cursorAwaitData, cursorExhaust , and/or cursorPartial. 331 | Defaults to 0 - no special handling. } 332 | options : Integer; 333 | { hold ref to the TMongo object of the find. Prevents release of the 334 | TMongo object until after this cursor is destroyed. } 335 | conn : TMongo; 336 | { Create a cursor with a empty query (which matches everything) } 337 | constructor Create(); overload; 338 | { Create a cursor with the given query. } 339 | constructor Create(query_ : TBson); overload; 340 | { Step to the first or next document in the result set. 341 | Returns True if there was a first or next document; otherwise, 342 | returns False when there are no more documents. } 343 | function next() : Boolean; 344 | { Return the current document of the result set } 345 | function value() : TBson; 346 | { Destroy this cursor. TMongoCursor objects should be released and destroyed 347 | after using them with TMongo.find(). This releases resources associated 348 | with the query on both the client and server ends. Construct a new 349 | TMongoCursor for another query. } 350 | destructor Destroy(); override; 351 | end; 352 | 353 | implementation 354 | Uses 355 | SysUtils; 356 | 357 | function mongo_env_sock_init() : Integer; cdecl; external 'mongoc.dll'; 358 | function mongo_create() : Pointer; cdecl; external 'mongoc.dll'; 359 | procedure mongo_dispose(c : Pointer); cdecl; external 'mongoc.dll'; 360 | function mongo_client(c : Pointer; host : PAnsiChar; port : Integer) : Integer; 361 | cdecl; external 'mongoc.dll'; 362 | procedure mongo_destroy(c : Pointer); cdecl; external 'mongoc.dll'; 363 | procedure mongo_replica_set_init(c : Pointer; name : PAnsiChar); cdecl; external 'mongoc.dll'; 364 | procedure mongo_replica_set_add_seed(c : Pointer; host : PAnsiChar; port : Integer); 365 | cdecl; external 'mongoc.dll'; 366 | function mongo_replica_set_client(c : Pointer) : Integer; cdecl; external 'mongoc.dll'; 367 | function mongo_is_connected(c : Pointer) : Boolean; cdecl; external 'mongoc.dll'; 368 | function mongo_get_err(c : Pointer) : Integer; cdecl; external 'mongoc.dll'; 369 | function mongo_set_op_timeout(c : Pointer; millis : Integer) : Integer; 370 | cdecl; external 'mongoc.dll'; 371 | function mongo_get_op_timeout(c : Pointer) : Integer; cdecl; external 'mongoc.dll'; 372 | function mongo_get_primary(c : Pointer) : PAnsiChar; cdecl; external 'mongoc.dll'; 373 | function mongo_check_connection(c : Pointer) : Integer; cdecl; external 'mongoc.dll'; 374 | procedure mongo_disconnect(c : Pointer); cdecl; external 'mongoc.dll'; 375 | function mongo_reconnect(c : Pointer) : Integer; cdecl; external 'mongoc.dll'; 376 | function mongo_cmd_ismaster(c : Pointer; b : Pointer) : Boolean; 377 | cdecl; external 'mongoc.dll'; 378 | function mongo_get_socket(c : Pointer) : Integer; cdecl; external 'mongoc.dll'; 379 | function mongo_get_host_count(c : Pointer) : Integer; cdecl; external 'mongoc.dll'; 380 | function mongo_get_host(c : Pointer; i : Integer) : PAnsiChar; cdecl; external 'mongoc.dll'; 381 | function mongo_insert(c : Pointer; ns : PAnsiChar; b : Pointer; wc : Pointer) : Integer; 382 | cdecl; external 'mongoc.dll'; 383 | function mongo_insert_batch(c : Pointer; ns : PAnsiChar; bsons : Pointer; count : Integer; wc : Pointer; flags : Integer) : Integer; 384 | cdecl; external 'mongoc.dll'; 385 | function mongo_update(c : Pointer; ns : PAnsiChar; cond : Pointer; op : Pointer; flags : Integer; wc : Pointer) : Integer; 386 | cdecl; external 'mongoc.dll'; 387 | function mongo_remove(c : Pointer; ns : PAnsiChar; criteria : Pointer; wc : Pointer) : Integer; 388 | cdecl; external 'mongoc.dll'; 389 | function mongo_find_one(c : Pointer; ns : PAnsiChar; query : Pointer; fields : Pointer; result : Pointer) : Integer; 390 | cdecl; external 'mongoc.dll'; 391 | function bson_create() : Pointer; external 'mongoc.dll'; 392 | procedure bson_dispose(b : Pointer); cdecl; external 'mongoc.dll'; 393 | procedure bson_copy(dest : Pointer; src : Pointer); cdecl; external 'mongoc.dll'; 394 | function mongo_cursor_create() : Pointer; cdecl; external 'mongoc.dll'; 395 | procedure mongo_cursor_dispose(cursor : Pointer); cdecl; external 'mongoc.dll'; 396 | procedure mongo_cursor_destroy(cursor : Pointer); cdecl; external 'mongoc.dll'; 397 | function mongo_find(c : Pointer; ns : PAnsiChar; query : Pointer; fields : Pointer; 398 | limit, skip, options : Integer) : Pointer; cdecl; external 'mongoc.dll'; 399 | function mongo_cursor_next(cursor : Pointer) : Integer; cdecl; external 'mongoc.dll'; 400 | function mongo_cursor_bson(cursor : Pointer) : Pointer; cdecl; external 'mongoc.dll'; 401 | function mongo_cmd_drop_collection(c : Pointer; db : PAnsiChar; collection : PAnsiChar; result : Pointer) : Integer; 402 | cdecl; external 'mongoc.dll'; 403 | function mongo_cmd_drop_db(c : Pointer; db : PAnsiChar) : Integer; cdecl; external 'mongoc.dll'; 404 | function mongo_count(c : Pointer; db : PAnsiChar; collection : PAnsiChar; query : Pointer) : Double; 405 | cdecl; external 'mongoc.dll'; 406 | function mongo_create_index(c : Pointer; ns : PAnsiChar; key : Pointer; options : Integer; res : Pointer) : Integer; 407 | cdecl; external 'mongoc.dll'; 408 | function mongo_cmd_add_user(c : Pointer; db : PAnsiChar; name : PAnsiChar; password : PAnsiChar) : Integer; 409 | cdecl; external 'mongoc.dll'; 410 | function mongo_cmd_authenticate(c : Pointer; db : PAnsiChar; name : PAnsiChar; password : PAnsiChar) : Integer; 411 | cdecl; external 'mongoc.dll'; 412 | function mongo_run_command(c : Pointer; db : PAnsiChar; command : Pointer; res: Pointer) : Integer; 413 | cdecl; external 'mongoc.dll'; 414 | function mongo_cmd_get_last_error(c : Pointer; db : PAnsiChar; res: Pointer) : Integer; 415 | cdecl; external 'mongoc.dll'; 416 | function mongo_cmd_get_prev_error(c : Pointer; db : PAnsiChar; res: Pointer) : Integer; 417 | cdecl; external 'mongoc.dll'; 418 | function mongo_get_server_err(c : Pointer) : Integer; cdecl; external 'mongoc.dll'; 419 | function mongo_get_server_err_string(c : Pointer) : PAnsiChar; cdecl; external 'mongoc.dll'; 420 | 421 | procedure parseHost(host : string; var hosturl : string; var port : Integer); 422 | var i : Integer; 423 | begin 424 | i := Pos(':', host); 425 | if i = 0 then begin 426 | hosturl := host; 427 | port := 27017; 428 | end 429 | else begin 430 | hosturl := Copy(host, 1, i - 1); 431 | port := StrToInt(Copy(host, i + 1, Length(host) - i)); 432 | end; 433 | end; 434 | 435 | constructor TMongo.Create(); 436 | begin 437 | handle := mongo_create(); 438 | mongo_client(handle, '127.0.0.1', 27017); 439 | end; 440 | 441 | constructor TMongo.Create(host : string); 442 | var 443 | hosturl : string; 444 | port : Integer; 445 | begin 446 | handle := mongo_create(); 447 | parseHost(host, hosturl, port); 448 | mongo_client(handle, PAnsiChar(System.UTF8Encode(hosturl)), port); 449 | end; 450 | 451 | destructor TMongo.Destroy(); 452 | begin 453 | mongo_destroy(handle); 454 | mongo_dispose(handle); 455 | end; 456 | 457 | constructor TMongoReplset.Create(name: string); 458 | begin 459 | handle := mongo_create(); 460 | mongo_replica_set_init(handle, PAnsiChar(System.UTF8Encode(name))); 461 | end; 462 | 463 | procedure TMongoReplset.addSeed(host : string); 464 | var 465 | hosturl : string; 466 | port : Integer; 467 | begin 468 | parseHost(host, hosturl, port); 469 | mongo_replica_set_add_seed(handle, PAnsiChar(System.UTF8Encode(hosturl)), port); 470 | end; 471 | 472 | function TMongoReplset.Connect() : Boolean; 473 | begin 474 | Result := (mongo_replica_set_client(handle) = 0); 475 | end; 476 | 477 | function TMongo.isConnected() : Boolean; 478 | begin 479 | Result := mongo_is_connected(handle); 480 | end; 481 | 482 | function TMongo.checkConnection() : Boolean; 483 | begin 484 | Result := (mongo_check_connection(handle) = 0); 485 | end; 486 | 487 | function TMongo.isMaster() : Boolean; 488 | begin 489 | Result := mongo_cmd_ismaster(handle, nil); 490 | end; 491 | 492 | procedure TMongo.disconnect(); 493 | begin 494 | mongo_disconnect(handle); 495 | end; 496 | 497 | function TMongo.reconnect() : Boolean; 498 | begin 499 | Result := (mongo_reconnect(handle) = 0); 500 | end; 501 | 502 | function TMongo.getErr() : Integer; 503 | begin 504 | Result := mongo_get_err(handle); 505 | end; 506 | 507 | function TMongo.setTimeout(millis: Integer) : Boolean; 508 | begin 509 | Result := (mongo_set_op_timeout(handle, millis) = 0); 510 | end; 511 | 512 | function TMongo.getTimeout() : Integer; 513 | begin 514 | Result := mongo_get_op_timeout(handle); 515 | end; 516 | 517 | function TMongo.getPrimary() : string; 518 | begin 519 | Result := string(mongo_get_primary(handle)); 520 | end; 521 | 522 | function TMongo.getSocket() : Integer; 523 | begin 524 | Result := mongo_get_socket(handle); 525 | end; 526 | 527 | function TMongoReplset.getHostCount() : Integer; 528 | begin 529 | Result := mongo_get_host_count(handle); 530 | end; 531 | 532 | function TMongoReplset.getHost(i : Integer) : string; 533 | begin 534 | Result := string(mongo_get_host(handle, i)); 535 | end; 536 | 537 | function TMongo.getDatabases() : TStringArray; 538 | var 539 | b : TBson; 540 | it, databases, database : TBsonIterator; 541 | name : string; 542 | count, i : Integer; 543 | begin 544 | b := command('admin', 'listDatabases', True); 545 | if b = nil then 546 | Result := nil 547 | else begin 548 | it := b.iterator; 549 | it.next(); 550 | count := 0; 551 | databases := it.subiterator(); 552 | while databases.next() do begin 553 | database := databases.subiterator(); 554 | database.next(); 555 | name := database.value(); 556 | if (name <> 'admin') and (name <> 'local') then 557 | inc(count); 558 | end; 559 | SetLength(Result, count); 560 | i := 0; 561 | databases := it.subiterator(); 562 | while databases.next() do begin 563 | database := databases.subiterator(); 564 | database.next(); 565 | name := database.value(); 566 | if (name <> 'admin') and (name <> 'local') then begin 567 | Result[i] := name; 568 | inc(i); 569 | end; 570 | end; 571 | end; 572 | end; 573 | 574 | function TMongo.getDatabaseCollections(db : string) : TStringArray; 575 | var 576 | cursor : TMongoCursor; 577 | count, i : Integer; 578 | ns, name : string; 579 | b : TBson; 580 | begin 581 | count := 0; 582 | ns := db + '.system.namespaces'; 583 | cursor := TMongoCursor.Create(); 584 | if find(ns, cursor) then 585 | while cursor.next() do begin 586 | b := cursor.value(); 587 | name := b.value('name'); 588 | if (Pos('.system.', name) = 0) and (Pos('$', name) = 0) then 589 | inc(count); 590 | end; 591 | SetLength(Result, count); 592 | i := 0; 593 | cursor := TMongoCursor.Create(); 594 | if find(ns, cursor) then 595 | while cursor.next() do begin 596 | b := cursor.value(); 597 | name := b.value('name'); 598 | if (Pos('.system.', name) = 0) and (Pos('$', name) = 0) then begin 599 | Result[i] := name; 600 | inc(i); 601 | end; 602 | end; 603 | end; 604 | 605 | function TMongo.rename(from_ns : string; to_ns : string) : Boolean; 606 | begin 607 | Result := (command('admin', BSON(['renameCollection', from_ns, 'to', to_ns])) <> nil); 608 | end; 609 | 610 | function TMongo.drop(ns : string) : Boolean; 611 | var 612 | db : string; 613 | collection : string; 614 | i : Integer; 615 | begin 616 | i := Pos('.', ns); 617 | if i = 0 then 618 | Raise Exception.Create('TMongo.drop: expected a ''.'' in the namespace.'); 619 | db := Copy(ns, 1, i - 1); 620 | collection := Copy(ns, i+1, Length(ns) - i); 621 | Result := (mongo_cmd_drop_collection(handle, PAnsiChar(System.UTF8Encode(db)), 622 | PAnsiChar(System.UTF8Encode(collection)), nil) = 0); 623 | end; 624 | 625 | function TMongo.dropDatabase(db : string) : Boolean; 626 | begin 627 | Result := (mongo_cmd_drop_db(handle, PAnsiChar(System.UTF8Encode(db))) = 0); 628 | end; 629 | 630 | function TMongo.insert(ns: string; b: TBson) : Boolean; 631 | begin 632 | Result := (mongo_insert(handle, PAnsiChar(System.UTF8Encode(ns)), b.handle, nil) = 0); 633 | end; 634 | 635 | function TMongo.insert(ns: string; bs: array of TBson) : Boolean; 636 | var 637 | ps : array of Pointer; 638 | i : Integer; 639 | len : Integer; 640 | begin 641 | len := Length(bs); 642 | SetLength(ps, Len); 643 | for i := 0 to Len-1 do 644 | ps[i] := bs[i].handle; 645 | Result := (mongo_insert_batch(handle, PAnsiChar(System.UTF8Encode(ns)), &ps, len, nil, 0) = 0); 646 | end; 647 | 648 | function TMongo.update(ns : string; criteria : TBson; objNew : TBson; flags : Integer) : Boolean; 649 | begin 650 | Result := (mongo_update(handle, PAnsiChar(System.UTF8Encode(ns)), criteria.handle, objNew.handle, flags, nil) = 0); 651 | end; 652 | 653 | function TMongo.update(ns : string; criteria : TBson; objNew : TBson) : Boolean; 654 | begin 655 | Result := update(ns, criteria, objNew, 0); 656 | end; 657 | 658 | function TMongo.remove(ns : string; criteria : TBson) : Boolean; 659 | begin 660 | Result := (mongo_remove(handle, PAnsiChar(System.UTF8Encode(ns)), criteria.handle, nil) = 0); 661 | end; 662 | 663 | function TMongo.findOne(ns : string; query : TBson; fields : TBson) : TBson; 664 | var 665 | res : Pointer; 666 | begin 667 | res := bson_create(); 668 | if (mongo_find_one(handle, PAnsiChar(System.UTF8Encode(ns)), query.handle, fields.handle, res) = 0) then 669 | Result := TBson.Create(res) 670 | else begin 671 | mongo_dispose(res); 672 | Result := nil; 673 | end; 674 | end; 675 | 676 | function TMongo.findOne(ns : string; query : TBson) : TBson; 677 | begin 678 | Result := findOne(ns, query, TBson.Create(nil)); 679 | end; 680 | 681 | constructor TMongoCursor.Create(); 682 | begin 683 | handle := nil; 684 | query := nil; 685 | sort := nil; 686 | fields := nil; 687 | limit := 0; 688 | skip := 0; 689 | options := 0; 690 | conn := nil; 691 | end; 692 | 693 | constructor TMongoCursor.Create(query_ : TBson); 694 | begin 695 | handle := nil; 696 | query := query_; 697 | sort := nil; 698 | fields := nil; 699 | limit := 0; 700 | skip := 0; 701 | options := 0; 702 | conn := nil; 703 | end; 704 | 705 | destructor TMongoCursor.Destroy(); 706 | begin 707 | mongo_cursor_destroy(handle); 708 | // mongo_cursor_dispose(handle); 709 | end; 710 | 711 | function TMongo.find(ns : string; cursor : TMongoCursor) : Boolean; 712 | var 713 | q : TBson; 714 | bb : TBsonBuffer; 715 | ch : Pointer; 716 | begin 717 | if cursor.fields = nil then 718 | cursor.fields := TBson.Create(nil); 719 | q := cursor.query; 720 | if q = nil then 721 | q := bsonEmpty; 722 | if cursor.sort <> nil then begin 723 | bb := TBsonBuffer.Create(); 724 | bb.append('$query', cursor.query); 725 | bb.append('$orderby', cursor.sort); 726 | q := bb.finish; 727 | end; 728 | cursor.conn := Self; 729 | ch := mongo_find(handle, PAnsiChar(System.UTF8Encode(ns)), q.handle, cursor.fields.handle, 730 | cursor.limit, cursor.skip, cursor.options); 731 | if ch <> nil then begin 732 | cursor.handle := ch; 733 | Result := True; 734 | end 735 | else 736 | Result := False; 737 | end; 738 | 739 | 740 | function TMongoCursor.next() : Boolean; 741 | begin 742 | Result := (mongo_cursor_next(handle) = 0); 743 | end; 744 | 745 | function TMongoCursor.value() : TBson; 746 | var 747 | b : TBson; 748 | h : Pointer; 749 | begin 750 | h := bson_create(); 751 | b := TBson.Create(h); 752 | bson_copy(h, mongo_cursor_bson(handle)); 753 | Result := b; 754 | end; 755 | 756 | function TMongo.count(ns : string; query : TBson) : Double; 757 | var 758 | db : string; 759 | collection : string; 760 | i : Integer; 761 | begin 762 | i := Pos('.', ns); 763 | if i = 0 then 764 | Raise Exception.Create('TMongo.drop: expected a ''.'' in the namespace.'); 765 | db := Copy(ns, 1, i - 1); 766 | collection := Copy(ns, i+1, Length(ns) - i); 767 | Result := mongo_count(handle, PAnsiChar(System.UTF8Encode(db)), 768 | PAnsiChar(System.UTF8Encode(collection)), query.handle); 769 | end; 770 | 771 | function TMongo.count(ns : string) : Double; 772 | begin 773 | Result := count(ns, TBson.Create(nil)); 774 | end; 775 | 776 | function TMongo.indexCreate(ns : string; key : TBson; options : Integer) : TBson; 777 | var 778 | res : TBson; 779 | created : Boolean; 780 | begin 781 | res := TBson.Create(bson_create()); 782 | created := (mongo_create_index(handle, PAnsiChar(System.UTF8Encode(ns)), key.handle, options, res.handle) = 0); 783 | if not created then 784 | Result := res 785 | else 786 | begin 787 | res.Free; 788 | Result := nil; 789 | end; 790 | end; 791 | 792 | function TMongo.indexCreate(ns : string; key : TBson) : TBson; 793 | begin 794 | Result := indexCreate(ns, key, 0); 795 | end; 796 | 797 | function TMongo.indexCreate(ns : string; key : string; options : Integer) : TBson; 798 | begin 799 | Result := indexCreate(ns, BSON([key, True]), options); 800 | end; 801 | 802 | function TMongo.indexCreate(ns : string; key : string) : TBson; 803 | begin 804 | Result := indexCreate(ns, key, 0); 805 | end; 806 | 807 | function TMongo.addUser(name : string; password : string; db : string) : Boolean; 808 | begin 809 | Result := (mongo_cmd_add_user(handle, PAnsiChar(System.UTF8Encode(db)), 810 | PAnsiChar(System.UTF8Encode(name)), 811 | PAnsiChar(System.UTF8Encode(password))) = 0); 812 | end; 813 | 814 | function TMongo.addUser(name : string; password : string) : Boolean; 815 | begin 816 | Result := addUser(name, password, 'admin'); 817 | end; 818 | 819 | function TMongo.authenticate(name : string; password : string; db : string) : Boolean; 820 | begin 821 | Result := (mongo_cmd_authenticate(handle, PAnsiChar(System.UTF8Encode(db)), 822 | PAnsiChar(System.UTF8Encode(name)), 823 | PAnsiChar(System.UTF8Encode(password))) = 0); 824 | end; 825 | 826 | function TMongo.authenticate(name : string; password : string) : Boolean; 827 | begin 828 | Result := authenticate(name, password, 'admin'); 829 | end; 830 | 831 | function TMongo.command(db : string; command : TBson) : TBson; 832 | var 833 | b : TBson; 834 | res : Pointer; 835 | begin 836 | res := bson_create(); 837 | if mongo_run_command(handle, PAnsiChar(System.UTF8Encode(db)), command.handle, res) = 0 then begin 838 | b := TBson.Create(bson_create()); 839 | bson_copy(b.handle, res); 840 | Result := b; 841 | end 842 | else 843 | Result := nil; 844 | bson_dispose(res); 845 | end; 846 | 847 | function TMongo.distinct(ns : string; key : string) : TBson; 848 | var b : TBson; 849 | buf : TBsonBuffer; 850 | p : Integer; 851 | db, collection : string; 852 | begin 853 | p := pos('.', ns); 854 | if p = 0 then 855 | Raise Exception.Create('Expected a ''.'' in the namespace'); 856 | db := Copy(ns, 1, p-1); 857 | collection := Copy(ns, p+1, Length(ns) - p); 858 | buf := TBsonBuffer.Create(); 859 | buf.append('distinct', collection); 860 | buf.append('key', key); 861 | b := buf.finish; 862 | Result := command(db, b); 863 | end; 864 | 865 | function TMongo.command(db : string; cmdstr : string; arg : OleVariant) : TBson; 866 | begin 867 | Result := command(db, BSON([cmdstr, arg])); 868 | end; 869 | 870 | function TMongo.getLastErr(db : string) : TBson; 871 | var 872 | b : TBson; 873 | res : Pointer; 874 | begin 875 | res := bson_create(); 876 | if mongo_cmd_get_last_error(handle, PAnsiChar(System.UTF8Encode(db)), res) <> 0 then begin 877 | b := TBson.Create(bson_create()); 878 | bson_copy(b.handle, res); 879 | Result := b; 880 | end 881 | else 882 | Result := nil; 883 | bson_dispose(res); 884 | end; 885 | 886 | function TMongo.getPrevErr(db : string) : TBson; 887 | var 888 | b : TBson; 889 | res : Pointer; 890 | begin 891 | res := bson_create(); 892 | if mongo_cmd_get_prev_error(handle, PAnsiChar(System.UTF8Encode(db)), res) <> 0 then begin 893 | b := TBson.Create(bson_create()); 894 | bson_copy(b.handle, res); 895 | Result := b; 896 | end 897 | else 898 | Result := nil; 899 | bson_dispose(res); 900 | end; 901 | 902 | procedure TMongo.resetErr(db : string); 903 | begin 904 | command(db, 'reseterror', True); 905 | end; 906 | 907 | function TMongo.getServerErr() : Integer; 908 | begin 909 | Result := mongo_get_server_err(handle); 910 | end; 911 | 912 | function TMongo.getServerErrString() : string; 913 | begin 914 | Result := string(mongo_get_server_err_string(handle)); 915 | end; 916 | 917 | initialization 918 | mongo_env_sock_init(); 919 | end. 920 | 921 | -------------------------------------------------------------------------------- /MongoDelphiDriver.dpk: -------------------------------------------------------------------------------- 1 | package MongoDelphiDriver; 2 | 3 | {$R *.res} 4 | {$IFDEF IMPLICITBUILDING This IFDEF should not be used by users} 5 | {$ALIGN 8} 6 | {$ASSERTIONS ON} 7 | {$BOOLEVAL OFF} 8 | {$DEBUGINFO ON} 9 | {$EXTENDEDSYNTAX ON} 10 | {$IMPORTEDDATA ON} 11 | {$IOCHECKS ON} 12 | {$LOCALSYMBOLS ON} 13 | {$LONGSTRINGS ON} 14 | {$OPENSTRINGS ON} 15 | {$OPTIMIZATION OFF} 16 | {$OVERFLOWCHECKS OFF} 17 | {$RANGECHECKS OFF} 18 | {$REFERENCEINFO ON} 19 | {$SAFEDIVIDE OFF} 20 | {$STACKFRAMES ON} 21 | {$TYPEDADDRESS OFF} 22 | {$VARSTRINGCHECKS ON} 23 | {$WRITEABLECONST OFF} 24 | {$MINENUMSIZE 1} 25 | {$IMAGEBASE $400000} 26 | {$DEFINE DEBUG} 27 | {$ENDIF IMPLICITBUILDING} 28 | {$IMPLICITBUILD ON} 29 | 30 | requires 31 | rtl; 32 | 33 | contains 34 | MongoBson in 'MongoBson.pas', 35 | MongoDB in 'MongoDB.pas', 36 | GridFS in 'GridFS.pas'; 37 | 38 | end. 39 | -------------------------------------------------------------------------------- /MongoDelphiDriver.dproj: -------------------------------------------------------------------------------- 1 | 2 | 3 | {F9C9AC27-5CCA-400D-97FA-2E6931FA838E} 4 | MongoDelphiDriver.dpk 5 | 13.4 6 | None 7 | True 8 | Debug 9 | Win32 10 | 3 11 | Package 12 | 13 | 14 | true 15 | 16 | 17 | true 18 | Base 19 | true 20 | 21 | 22 | true 23 | Base 24 | true 25 | 26 | 27 | true 28 | Base 29 | true 30 | 31 | 32 | true 33 | Cfg_1 34 | true 35 | true 36 | 37 | 38 | true 39 | Cfg_1 40 | true 41 | true 42 | 43 | 44 | true 45 | Base 46 | true 47 | 48 | 49 | All 50 | true 51 | true 52 | System;Xml;Data;Datasnap;Web;Soap;$(DCC_Namespace) 53 | .\$(Platform)\$(Config) 54 | .\$(Platform)\$(Config) 55 | false 56 | false 57 | false 58 | false 59 | false 60 | 61 | 62 | true 63 | Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;$(DCC_Namespace) 64 | 1033 65 | CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments= 66 | 67 | 68 | true 69 | Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) 70 | 1033 71 | CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments= 72 | 73 | 74 | DEBUG;$(DCC_Define) 75 | false 76 | true 77 | true 78 | true 79 | 80 | 81 | true 82 | 1033 83 | 84 | 85 | true 86 | 1033 87 | false 88 | 89 | 90 | false 91 | RELEASE;$(DCC_Define) 92 | 0 93 | false 94 | 95 | 96 | 97 | MainSource 98 | 99 | 100 | 101 | 102 | 103 | 104 | Cfg_2 105 | Base 106 | 107 | 108 | Base 109 | 110 | 111 | Cfg_1 112 | Base 113 | 114 | 115 | 116 | Delphi.Personality.12 117 | Package 118 | 119 | 120 | 121 | MongoDelphiDriver.dpk 122 | 123 | 124 | True 125 | False 126 | 1 127 | 0 128 | 0 129 | 0 130 | False 131 | False 132 | False 133 | False 134 | False 135 | 1033 136 | 1252 137 | 138 | 139 | 140 | 141 | 1.0.0.0 142 | 143 | 144 | 145 | 146 | 147 | 1.0.0.0 148 | 149 | 150 | 151 | Microsoft Office 2000 Sample Automation Server Wrapper Components 152 | Microsoft Office XP Sample Automation Server Wrapper Components 153 | 154 | 155 | 156 | 157 | True 158 | False 159 | True 160 | 161 | 162 | 12 163 | 164 | 165 | 166 | 167 | -------------------------------------------------------------------------------- /MongoDelphiDriver.groupproj: -------------------------------------------------------------------------------- 1 | 2 | 3 | {A85C4061-9C73-443B-9DD9-773DB55C4F7E} 4 | 5 | 6 | 7 | 8 | 9 | 10 | MongoDelphiDriver.dproj 11 | 12 | 13 | 14 | 15 | 16 | 17 | Default.Personality.12 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | 44 | 45 | 46 | 47 | 48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57 | 58 | 59 | 60 | 61 | -------------------------------------------------------------------------------- /MongoDelphiDriver.groupproj.local: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | -------------------------------------------------------------------------------- /MongoDelphiDriver.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/gerald-lindsly/mongo-delphi-driver/6f4e145bab99ad3d737c484a8d0c3f284828a6f6/MongoDelphiDriver.res -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | This is a Delphi package supporting access to MongoDB. 2 | 3 | After downloading this repo, download and build [mongo-c-driver](http://github.com/mongodb/mongo-c-driver) with scons. 4 | Use the --m32 option with SCons to generate a 32-bit dll. 5 | Copy the produced mongoc.dll to C:\10gen\mongo-delphi-driver\Win32\Debug or ...\Release as appropriate. 6 | 7 | Load the project group, MongoDelphiDriver.groupproj, into RAD Studio. 8 | 9 | To run the examples, in the Project Manager, right-click on either Test.exe or 10 | AddressBook.exe and Activate. Hit F9 to build and run. 11 | 12 | The documentation for package is in the 3 unit files: MongoDB.pas, MongoBson.pas, and GridFS.pas 13 | 14 | -------------------------------------------------------------------------------- /Test.dpr: -------------------------------------------------------------------------------- 1 | { 2 | Copyright 2009-2011 10gen Inc. 3 | 4 | Licensed under the Apache License, Version 2.0 (the "License"); 5 | you may not use this file except in compliance with the License. 6 | You may obtain a copy of the License at 7 | 8 | http://www.apache.org/licenses/LICENSE-2.0 9 | 10 | Unless required by applicable law or agreed to in writing, software 11 | distributed under the License is distributed on an "AS IS" BASIS, 12 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 13 | See the License for the specific language governing permissions and 14 | limitations under the License. 15 | } 16 | program Test; 17 | 18 | {$APPTYPE CONSOLE} 19 | 20 | {$R *.res} 21 | 22 | uses 23 | System.SysUtils, 24 | Variants, 25 | MongoBson, MongoDB, GridFS; 26 | 27 | var 28 | bb : TBsonBuffer; 29 | cws : TBsonCodeWScope; 30 | b, b2, x, y, z, criteria, query, cmd : TBson; 31 | i : TBsonIterator; 32 | oid : TBsonOID; 33 | ts : TBsonTimestamp; 34 | bin : TBsonBinary; 35 | sing : Single; 36 | mongo : TMongo; 37 | j : Integer; 38 | cursor : TMongoCursor; 39 | databases : TStringArray; 40 | gfs : TGridFS; 41 | gfw : TGridfileWriter; 42 | gf : TGridfile; 43 | buf : array[0..100] of AnsiChar; 44 | ia1 : array[0..4] of Integer; 45 | ia2 : TIntegerArray; 46 | 47 | const 48 | db = 'test'; 49 | ns = db + '.people'; 50 | 51 | procedure displayCollections(db : string); 52 | var 53 | collections : TStringArray; 54 | j : Integer; 55 | begin 56 | collections := mongo.getDatabaseCollections(db); 57 | for j := 0 to Length(collections)-1 do 58 | Writeln(collections[j]); 59 | end; 60 | 61 | procedure ExtractFile(gfs : TGridFS; gfsname : string; filename : string = ''); 62 | var chunk : Integer; 63 | gf : TGridfile; 64 | f : File; 65 | b : TBson; 66 | bin : TBsonBinary; 67 | begin 68 | if filename = '' then filename := gfsname; 69 | gf := gfs.find(gfsname); 70 | Assign(f, filename); 71 | Rewrite(f, 1); 72 | for chunk := 0 to gf.getChunkCount - 1 do 73 | begin 74 | b := gf.getChunk(chunk); 75 | bin := b.find('data').getBinary; 76 | BlockWrite(f, bin.data^, bin.len); 77 | end; 78 | Close(f); 79 | end; 80 | 81 | begin 82 | try 83 | 84 | bb := TBsonBuffer.Create(); 85 | ia1[0] := 5; 86 | ia1[1] := 7; 87 | ia1[2] := 9; 88 | ia1[3] := 11; 89 | ia1[4] := 13; 90 | bb.appendArray('ia', ia1); 91 | b := bb.finish; 92 | i := b.iterator; 93 | ia2 := i.getIntegerArray(); 94 | for j := 0 to Length(ia2) - 1 do 95 | WriteLn(ia2[j]); 96 | 97 | bb := TBsonBuffer.Create(); 98 | bb.append('test', 'testing'); 99 | cws := TBsonCodeWScope.Create('Code for scope', bb.finish()); 100 | 101 | bb := TBsonBuffer.Create(); 102 | bb.append('name', 'Gerald'); 103 | bb.append('age', 35); 104 | bb.append('long', Int64(89)); 105 | bb.append('bool', True); 106 | bb.append('date', StrToDate('1/3/1970')); 107 | bb.startObject('object'); 108 | bb.append('sub1', 'sub1'); 109 | bb.append('sub2', False); 110 | bb.finishObject(); 111 | oid := TBsonOID.Create(); 112 | writeln(oid.AsString()); 113 | bb.append('oid1', oid); 114 | bb.append('oid2', TBsonOID.Create('4eb6a93dad14000000000099')); 115 | bb.appendCode('code', '{ this = is + code; }'); 116 | bb.appendSymbol('symbol', 'symbol'); 117 | bb.append('cws', cws); 118 | bb.append('regex', TBsonRegex.Create('pattern', 'options')); 119 | ts := TBsonTimestamp.Create(now, 21); 120 | bb.append('timestamp', ts); 121 | bb.appendBinary('binary', 0, @ts, sizeof(ts)); 122 | 123 | b := bb.finish; 124 | Writeln(b.size()); 125 | 126 | b.display(); 127 | 128 | Writeln(b.value('long')); 129 | i := b.find('oid1'); 130 | WriteLn(i.getOID().AsString()); 131 | 132 | i := b.find('binary'); 133 | bin := i.getBinary(); 134 | 135 | WriteLn(bin.len); 136 | sing := 3.14159; 137 | 138 | b2 := BSON(['test', 'testing', 'age', 32, 139 | 'subobj', '{', 140 | 'single', sing, 141 | '}', 142 | 'int64', Int64(1234567890123), 143 | 'double', 98.7, 'null', Null, 'logical', False, 'now', now ]); 144 | b2.display(); 145 | 146 | mongo := TMongo.Create(); 147 | if mongo.isConnected() then begin 148 | mongo.setTimeout(0); 149 | WriteLn('Timeout = ', mongo.getTimeout()); 150 | WriteLn('Primary = ', mongo.getPrimary()); 151 | WriteLn('IsMaster = ', mongo.isMaster()); 152 | WriteLn('Socket = ', mongo.getSocket()); 153 | WriteLn('Check = ', mongo.checkConnection()); 154 | WriteLn('disconnect'); 155 | mongo.disconnect(); 156 | WriteLn(' Check = ', mongo.checkConnection()); 157 | WriteLn('reconnect'); 158 | mongo.reconnect(); 159 | WriteLn(' Check = ', mongo.checkConnection()); 160 | 161 | databases := mongo.getDatabases(); 162 | for j := 0 to Length(databases)-1 do 163 | Writeln(databases[j]); 164 | 165 | displayCollections(db); 166 | mongo.rename(ns, 'test.renamed'); 167 | displayCollections(db); 168 | mongo.rename('test.renamed', ns); 169 | displayCollections(db); 170 | 171 | 172 | WriteLn('Drop = ', mongo.drop(ns)); 173 | 174 | mongo.indexCreate(ns, 'name', indexUnique); 175 | 176 | (* display hosts for a TMongoReplset 177 | Count := mongo.getHostCount(); 178 | WriteLn('Replset Host Count = ', Count); 179 | for j := 0 to count - 1 do 180 | WriteLn('Host = ', mongo.getHost(j)); 181 | *) 182 | 183 | (* insert the collage document *) 184 | mongo.insert(ns, b); 185 | 186 | (* Insert a couple more people *) 187 | bb := TBsonBuffer.Create(); 188 | bb.append('name', 'Abe'); 189 | bb.append('age', 32); 190 | bb.append('city', 'Washington'); 191 | x := bb.finish; 192 | x.display(); 193 | Writeln(mongo.insert(ns, x)); 194 | 195 | bb := TBsonBuffer.Create(); 196 | bb.append('name', 'Joe'); 197 | bb.append('age', 35); 198 | bb.append('city', 'Natick'); 199 | x := bb.finish; 200 | x.display(); 201 | Writeln(mongo.insert(ns, x)); 202 | 203 | (* Batch insert 3 people *) 204 | bb := TBsonBuffer.Create(); 205 | bb.append('name', 'Jeff'); 206 | bb.append('age', 19); 207 | bb.append('city', 'Florence'); 208 | x := bb.finish; 209 | x.display(); 210 | 211 | bb := TBsonBuffer.Create(); 212 | bb.append('name', 'Harry'); 213 | bb.append('age', 36); 214 | bb.append('city', 'Fort Aspenwood'); 215 | y := bb.finish; 216 | y.display(); 217 | 218 | bb := TBsonBuffer.Create(); 219 | bb.append('name', 'John'); 220 | bb.append('age', 21); 221 | bb.append('city', 'Cincinnati'); 222 | z := bb.finish; 223 | z.display(); 224 | Writeln(mongo.insert(ns, [x, y, z])); 225 | 226 | (* update Joe's document with a new one *) 227 | bb := TBsonBuffer.Create(); 228 | bb.append('name', 'Joe'); 229 | bb.append('age', 36); 230 | bb.append('city', 'Austin'); 231 | x := bb.finish; 232 | criteria := BSON(['name', 'Joe']); 233 | x.display(); 234 | Writeln(mongo.update(ns, criteria, x)); 235 | 236 | (* do an upsert *) 237 | bb := TBsonBuffer.Create(); 238 | bb.append('name', 'Paul'); 239 | bb.append('age', 53); 240 | bb.append('city', 'Seattle'); 241 | x := bb.finish; 242 | criteria := BSON(['name', 'Paul']); 243 | criteria.display(); 244 | x.display(); 245 | Writeln(mongo.update(ns, criteria, x, updateUpsert)); 246 | 247 | (* Remove a record *) 248 | WriteLn(mongo.remove(ns, BSON(['name', 'John']))); 249 | 250 | (* successful findOne *) 251 | x := mongo.findOne(ns, criteria); 252 | x.display(); 253 | 254 | (* unsuccessful findOne *) 255 | x := mongo.findOne(ns, BSON(['name', 'unknown'])); 256 | x.display(); 257 | 258 | (* display all people *) 259 | cursor := TMongoCursor.Create(); 260 | if mongo.find(ns, cursor) then 261 | while cursor.next() do 262 | cursor.value.display(); 263 | 264 | (* display all people age 36 *) 265 | query := BSON(['age', 36]); 266 | cursor := TMongoCursor.Create(query); 267 | if mongo.find(ns, cursor) then 268 | while cursor.next() do 269 | cursor.value.display(); 270 | 271 | WriteLn(mongo.count(ns)); 272 | cmd := BSON(['count', 'people']); 273 | b := mongo.command(db, cmd); 274 | WriteLn(b.value('n')); 275 | b := mongo.command(db, 'count', 'people'); 276 | WriteLn(b.value('n')); 277 | 278 | WriteLn(mongo.count(ns, query)); 279 | 280 | (* get distinct names *) 281 | x := mongo.distinct(ns, 'name'); 282 | i := x.find('values').subiterator; 283 | while i.next do 284 | writeln(i.value); 285 | 286 | (* add a user to database 'admin' *) 287 | mongo.addUser('Gerald', 'P97gwep16'); 288 | 289 | (* authenticate with correct credentials *) 290 | WriteLn(mongo.authenticate('Gerald', 'P97gwep16')); 291 | 292 | (* try authenicate with bad password *) 293 | WriteLn(mongo.authenticate('Gerald', 'BadPass21')); 294 | 295 | (* try authenticate with bad user *) 296 | WriteLn(mongo.authenticate('Unsub', 'BadUser67')); 297 | 298 | b := BSON(['name', 'dupkey']); 299 | mongo.insert(ns, b); 300 | mongo.insert(ns, b); 301 | b := mongo.getLastErr(db); 302 | b.display(); 303 | 304 | b := BSON(['name', '{', '$badop', true, '}' ]); 305 | b2 := mongo.findOne(ns, b); 306 | b2.display(); 307 | b := mongo.getLastErr(db); 308 | b.display(); 309 | b := mongo.getPrevErr(db); 310 | b.display(); 311 | WriteLn(mongo.getServerErr()); 312 | WriteLn(mongo.getServerErrString()); 313 | 314 | mongo.resetErr(db); 315 | b := mongo.getLastErr(db); 316 | b.display(); 317 | 318 | gfs := TGridFS.Create(mongo, 'grid'); 319 | WriteLn('Store test.exe = ', gfs.storeFile('test.exe')); 320 | 321 | WriteLn('Store bin = ', gfs.store(bin.data, bin.len, 'bin')); 322 | 323 | gfs.removeFile('bin'); 324 | 325 | gfw := gfs.writerCreate('writer'); 326 | gfw.write(bin.data, bin.len); 327 | gfw.write(bin.data, bin.len); 328 | gfw.finish(); 329 | 330 | gf := gfs.find('writer'); 331 | 332 | WriteLn('name = ', gf.getFilename()); 333 | WriteLn('length = ', gf.getLength()); 334 | WriteLn('chunkSize = ', gf.getChunkSize()); 335 | WriteLn('chunkCount = ', gf.getChunkCount()); 336 | WriteLn('contentType = ', gf.getContentType()); 337 | WriteLN('uploadDate = ', DateTimeToStr(gf.getUploadDate())); 338 | WriteLN('md5 = ', gf.getMD5()); 339 | b := gf.getDescriptor(); 340 | b.display(); 341 | 342 | gf.read(@j, sizeof(j)); 343 | WriteLn(j); 344 | 345 | gf := gfs.find('test.exe'); 346 | cursor := gf.getChunks(1, 5); 347 | while cursor.next() do 348 | Writeln(cursor.value.size()); 349 | 350 | WriteLn(gf.seek(100000)); 351 | 352 | gfs.storeFile('../../MongoDB.pas', 'MongoDB.pas'); 353 | gf := gfs.find('MongoDB.pas'); 354 | gf.seek(100); 355 | gf.read(@buf, 20); 356 | buf[20] := Chr(0); 357 | WriteLn(buf); 358 | 359 | ExtractFile(gfs, 'MongoDB.pas'); 360 | WriteLn('Done'); 361 | ReadLn; 362 | end 363 | else 364 | WriteLn('No Connection, Err = ', mongo.getErr()); 365 | 366 | except 367 | on E: Exception do 368 | Writeln(E.ClassName, ': ', E.Message); 369 | end; 370 | end. 371 | -------------------------------------------------------------------------------- /Test.dproj: -------------------------------------------------------------------------------- 1 | 2 | 3 | {FAAEB811-D3CA-4036-A456-D65CA8564F65} 4 | 13.4 5 | None 6 | Test.dpr 7 | True 8 | Debug 9 | Win32 10 | 3 11 | Console 12 | 13 | 14 | true 15 | 16 | 17 | true 18 | Base 19 | true 20 | 21 | 22 | true 23 | Base 24 | true 25 | 26 | 27 | true 28 | Base 29 | true 30 | 31 | 32 | true 33 | Cfg_1 34 | true 35 | true 36 | 37 | 38 | true 39 | Base 40 | true 41 | 42 | 43 | bindcompfmx;fmx;rtl;dbrtl;IndySystem;DbxClientDriver;bindcomp;inetdb;DBXInterBaseDriver;DataSnapCommon;DataSnapClient;DataSnapServer;DataSnapProviderClient;xmlrtl;ibxpress;DbxCommonDriver;IndyProtocols;DBXMySQLDriver;dbxcds;bindengine;FMXTee;soaprtl;DBXOracleDriver;dsnap;DBXInformixDriver;IndyCore;fmxase;CloudService;FmxTeeUI;DBXFirebirdDriver;inet;fmxobj;inetdbxpress;DBXSybaseASADriver;fmxdae;dbexpress;DataSnapIndy10ServerTransport;IPIndyImpl;$(DCC_UsePackage) 44 | System;Xml;Data;Datasnap;Web;Soap;$(DCC_Namespace) 45 | .\$(Platform)\$(Config) 46 | .\$(Platform)\$(Config) 47 | false 48 | false 49 | false 50 | false 51 | false 52 | 53 | 54 | TeeDB;vclib;Tee;DBXOdbcDriver;DBXSybaseASEDriver;vclimg;TeeUI;vclactnband;vcldb;vcldsnap;bindcompvcl;vclie;vcltouch;DBXDb2Driver;websnap;vclribbon;VclSmp;vcl;DataSnapConnectors;DBXMSSQLDriver;dsnapcon;vclx;webdsnap;adortl;$(DCC_UsePackage) 55 | Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;$(DCC_Namespace) 56 | 1033 57 | CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments= 58 | 59 | 60 | vcldbx;frx16;TeeDB;Rave100VCL;vclib;Tee;inetdbbde;DBXOdbcDriver;svnui;DBXSybaseASEDriver;vclimg;frxDB16;intrawebdb_120_160;fmi;fs16;TeeUI;vclactnband;vcldb;vcldsnap;bindcompvcl;vclie;vcltouch;Intraweb_120_160;DBXDb2Driver;websnap;vclribbon;frxe16;VclSmp;fsDB16;vcl;DataSnapConnectors;DBXMSSQLDriver;CodeSiteExpressPkg;dsnapcon;vclx;webdsnap;svn;bdertl;adortl;$(DCC_UsePackage) 61 | Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) 62 | 1033 63 | CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments= 64 | 65 | 66 | DEBUG;$(DCC_Define) 67 | false 68 | true 69 | true 70 | true 71 | 72 | 73 | false 74 | 75 | 76 | false 77 | RELEASE;$(DCC_Define) 78 | 0 79 | false 80 | 81 | 82 | 83 | MainSource 84 | 85 | 86 | Cfg_2 87 | Base 88 | 89 | 90 | Base 91 | 92 | 93 | Cfg_1 94 | Base 95 | 96 | 97 | 98 | Delphi.Personality.12 99 | 100 | 101 | 102 | 103 | False 104 | False 105 | 1 106 | 0 107 | 0 108 | 0 109 | False 110 | False 111 | False 112 | False 113 | False 114 | 1033 115 | 1252 116 | 117 | 118 | 119 | 120 | 1.0.0.0 121 | 122 | 123 | 124 | 125 | 126 | 1.0.0.0 127 | 128 | 129 | 130 | Test.dpr 131 | 132 | 133 | 134 | 135 | True 136 | False 137 | True 138 | 139 | 140 | 12 141 | 142 | 143 | 144 | 145 | -------------------------------------------------------------------------------- /Test.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/gerald-lindsly/mongo-delphi-driver/6f4e145bab99ad3d737c484a8d0c3f284828a6f6/Test.res -------------------------------------------------------------------------------- /mongo-c-driver.zip: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/gerald-lindsly/mongo-delphi-driver/6f4e145bab99ad3d737c484a8d0c3f284828a6f6/mongo-c-driver.zip --------------------------------------------------------------------------------