mORMot Open Source

  THttpRequestExtendedOptions = record
    /// let HTTPS be less paranoid about SSL certificates
    // - IgnoreSSLCertificateErrors is handled by TWinHttp and TCurlHTTP
    IgnoreSSLCertificateErrors: Boolean;

    proxy_username,proxy_password:ansistring;  // add this
    /// allow HTTP authentication to take place at connection
    // - Auth.Scheme and UserName/Password properties are handled
    // by the TWinHttp class only by now
    Auth: record
      UserName: SynUnicode;
      Password: SynUnicode;
      Scheme: THttpRequestAuthentication;
    end;
  end;

    property Proxy_username: ansistring // ansistring is
      read fExtendedOptions.Proxy_username
      write fExtendedOptions.Proxy_username;

    property Proxy_password: ansistring
      read fExtendedOptions.Proxy_password
      write fExtendedOptions.Proxy_password;

const
  WINHTTP_OPTION_PROXY_USERNAME = $1002;
  WINHTTP_OPTION_PROXY_PASSWORD = $1003;

procedure TWinHTTP.InternalSendRequest(const aData: SockString);
var L: integer;
    winAuth: DWORD;
begin
  with fExtendedOptions do
  if AuthScheme<>wraNone then begin
    case AuthScheme of
    wraBasic: winAuth := WINHTTP_AUTH_SCHEME_BASIC;
    wraDigest: winAuth := WINHTTP_AUTH_SCHEME_DIGEST;
    wraNegotiate: winAuth := WINHTTP_AUTH_SCHEME_NEGOTIATE;
    else raise EWinHTTP.CreateFmt('Unsupported AuthScheme=%d',[ord(AuthScheme)]);
    end;
    if not WinHttpSetCredentials(fRequest,WINHTTP_AUTH_TARGET_SERVER,
       winAuth,pointer(AuthUserName),pointer(AuthPassword),nil) then
      RaiseLastModuleError(winhttpdll,EWinHTTP);
	  
// add this:	  
   if PROXY_USERNAME<>'' then
   begin
    if not WinHttpSetOption( fRequest, WINHTTP_OPTION_PROXY_USERNAME, PWidechar(WideString(PROXY_USERNAME)), length(PROXY_USERNAME)) then
     RaiseLastModuleError(winhttpdll,EWinHTTP);
    end;

   if PROXY_PASSWORD<>'' then
   begin
    if not WinHttpSetOption( fRequest, WINHTTP_OPTION_PROXY_PASSWORD, PWidechar(WideString(PROXY_PASSWORD)), length(PROXY_PASSWORD)) then
    RaiseLastModuleError(winhttpdll,EWinHTTP);
   end;	 
  end;
 // end add
  
  if fHTTPS and IgnoreSSLCertificateErrors then
    if not WinHttpSetOption(fRequest, WINHTTP_OPTION_SECURITY_FLAGS,
       @SECURITY_FLAT_IGNORE_CERTIFICATES, SizeOf(SECURITY_FLAT_IGNORE_CERTIFICATES)) then
      RaiseLastModuleError(winhttpdll,EWinHTTP);
  L := length(aData);
  if not WinHttpSendRequest(fRequest, nil, 0, pointer(aData), L, L, 0) or
     not WinHttpReceiveResponse(fRequest,nil) then
    RaiseLastModuleError(winhttpdll,EWinHTTP);
end;

// used by TBSONElement.ToVariant() method and BSONToDoc() procedure
procedure BSONItemsToDocVariant(Kind: TBSONElementType; BSON: PByte;
  var Doc: TDocVariantData; Option: TBSONDocArrayConversion);
const OPTIONS: array[TBSONDocArrayConversion] of TDocVariantOptions =
    ([],[dvoReturnNullForUnknownProperty],
        [dvoValueCopiedByReference,dvoReturnNullForUnknownProperty]);
var k: TDocVariantKind;
    i,n,cap: integer;
    items: array[0..63] of TBSONElement;
begin // very fast optimized code
  if not (Kind in [betDoc,betArray]) then
    VarCastError;
  if (BSON=nil) {or (BSON^=byte(betEOF))} then // I remove this, a empty array is not null (I think)
    TVarData(Doc).VType := varNull else begin
    if Kind=betDoc then
      k := dvObject else
      k := dvArray;
    Doc.Init(OPTIONS[Option],k);
    cap := 0;
    repeat
      n := 0;
      while items[n].FromNext(BSON) do begin
        inc(n);
        if n=length(items) then
          break;
      end;
      if n=0 then
        break;
      inc(cap,n);
      if cap<512 then
        Doc.Capacity := cap else
        if Doc.Capacity<cap then
          Doc.Capacity := cap+cap shr 3; // faster for huge arrays
      for i := 0 to n-1 do begin
        if Kind=betDoc then
          SetString(Doc.Names[i+Doc.Count],PAnsiChar(items[i].Name),items[i].NameLen);
        items[i].ToVariant(Doc.Values[i+Doc.Count],Option);
      end;
      Doc.SetCount(Doc.Count+n);
    until (BSON=nil) or (BSON^=byte(betEOF));
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
 t:integer;
 Coll: TMongoCollection;
 Docs: TVariantDynArray;
begin
 log('Start');
 try
  fClient:=TMongoClient.Create('localhost',27017);

  fDB:=fClient.Database['test25'];
  Coll := fDB.CollectionOrCreate['testColl'];

  coll.Insert('{"Age":?,Name: ?}',[1,'test1']);
  coll.Insert('{"Age":?,Name: ?}',[2,'test2']);

  if BADjson.Checked then
  begin
   try
    coll.FindDocs('{Age:{$gt,1}}',[],docs,null); // <------------------------ bad syntax
    for t:=Low(docs) to High(docs) do if not varisnull(docs[t].Name) then Log('Docs:'+docs[t].Name);
   except
    on e: exception do  log('EXC1: '+e.Message);
   end;
  end;

  Coll := fDB.CollectionOrCreate['testColl'];

  try
   coll.FindDocs('{Age:{$gt:1}}',[],docs,null); // <------------------------ right syntax
   for t:=Low(docs) to High(docs) do if not varisnull(docs[t].Name) then Log('Docs:'+docs[t].Name);
  except
   on e: exception do  log('EXC2: '+e.Message);
  end;


 finally
  FreeAndNil(fClient);
  log('end');
 end;
end;