JohnF

Hi, Using D12. I've just started playing with openssl, and thought how hard would it be calling the openssl libcrypto-3.dll. Its a learning exercise more than anything. I'm trying to make a self signed X509 certifcate via the dll rather than the command line. I havent played with returning struct from a C dll before. Currently some of the call including the X509_set_version(Cert, 2) call appears to work (not throw an error) but the X509_set_serialNumber(Cert, 1) and the X509_set_pubkey(Cert, PKey) throws an exceptions. can I use a pointer to hold the return value to X509_new function? can I use that pointer to pass into the other function? or do I have to have a record that the struct is copied back into and then use that (I hope not) TIA Const LIB_CRYPTO = 'libcrypto-3.dll'; type PX509 = Pointer; PBIO = Pointer; PEVP_PKEY = Pointer; PEVP_MD = Pointer; PX509_NAME = Pointer; // OpenSSL X509 functions function X509_new: PX509; cdecl; external LIB_CRYPTO name 'X509_new'; procedure X509_free(cert: PX509); cdecl; external LIB_CRYPTO name 'X509_free'; function X509_set_version(cert: PX509; version: Integer; ): Integer; cdecl; external LIB_CRYPTO name 'X509_set_version'; function X509_set_serialNumber(cert: PX509; serial: Integer; ): Integer; cdecl; external LIB_CRYPTO name 'X509_set_serialNumber'; function X509_set_subject_name(cert: PX509; name: PX509_NAME): Integer; cdecl; external LIB_CRYPTO name 'X509_set_subject_name'; function X509_set_issuer_name(cert: PX509; name: PX509_NAME): Integer; cdecl; external LIB_CRYPTO name 'X509_set_issuer_name'; function X509_set_pubkey(cert: PX509; pkey: PEVP_PKEY): Integer; cdecl; external LIB_CRYPTO name 'X509_set_pubkey'; function X509_sign(cert: PX509; pkey: PEVP_PKEY; md: PEVP_MD): Integer; cdecl; external LIB_CRYPTO name 'X509_sign'; // Key management functions function EVP_PKEY_new: PEVP_PKEY; cdecl; external LIB_CRYPTO name 'EVP_PKEY_new'; procedure EVP_PKEY_free(pkey: PEVP_PKEY); cdecl; external LIB_CRYPTO name 'EVP_PKEY_free'; function EVP_PKEY_generate_key: PEVP_PKEY; cdecl; external LIB_CRYPTO name 'EVP_PKEY_keygen'; function CreateSelfSignedCert(CommonName, Country, Organization, OrganizationalUnit: string; ValidDays: Integer; out ACertificate, APrivateKey: TBytes): Boolean; implementation function CreateSelfSignedCert(CommonName, Country, Organization, OrganizationalUnit: string; ValidDays: Integer; out ACertificate, APrivateKey: TBytes): Boolean; var Cert: PX509; PKey: PEVP_PKEY; Name: PX509_NAME; Digest: PEVP_MD; CertBio, KeyBio: PBIO; begin Result := False; Cert := X509_new; if Cert = nil then Exit; try // Set certificate version to v3 as its self signed if X509_set_version(Cert, 2) <> 1 then Exit; // Set serial number if X509_set_serialNumber(Cert, 1) <> 1 then Exit; // Generate a new key PKey := EVP_PKEY_new; if PKey = nil then Exit; try PKey := EVP_PKEY_generate_key(); if PKEY = nil then Exit; // Set public key for the certificate if X509_set_pubkey(Cert, PKey) <> 1 then Exit; // Set certificate subject and issuer (self-signed, so both are the same) // Set validity period // Sign the certificate // Write the certificate to TBytes Result := True; finally EVP_PKEY_free(PKey); end; finally X509_free(Cert); end; end;

That was very helpful, better than the awesome documentation floating about; Things I learnt. The CustomFormat property on a TPrototypeBindSource field is not used when binding to a StringGrid, If you are binding to bothat a Grid and control, set the CustomFormat on the grid as well. I wrote a couple of procedure to populate the BindSource fields and the Grid columns. A bit of inspiration/plagiarism for the binding method 🙂 I hope someone may find it useful. Cheers ps: the const I used for replacing the Date with a "blank" currently say '<Blank>' just for proof of concept/testing purposes. Please change it/anything else as required. And If I have any brain farts in the code. Please let me know 🙂 unit my.System.BindUtil; interface uses System.Classes , System.SysUtils , System.Bindings.Methods , System.Bindings.EvalProtocol , System.Bindings.Consts , Data.Bind.Components , Data.Bind.Grid , Data.Bind.ObjectScope ; { https://docwiki.embarcadero.com/RADStudio/Alexandria/en/Creating_Custom_LiveBindings_Methods } const _sID_BindMethod_BlankDateToString = 'BlankDateToString'; _sBlankDate = '<BLANK>'; _BlankInputDate = 0; _FormatBlankDateToString = _sID_BindMethod_BlankDateToString +'(%s)'; Type TBindingUtil = Class /// Class Procs for setting CustomFormats for TDate properties /// /// useful for the TProtoTypeBindSource and the TAdapterBindSource /// /// Use this to Map a Class to a Collection of FieldDef. It populates the /// BindSource fields and sets the CustomFormat for and TDate Fields /// /// TBindingUtil.MapFieldDefs(fListBindSource.FieldDefs, fImportClass); /// /// /// Once the Gridlink is established if you dont want to hand populate it /// and want to see all the fields, then call this. It populates the grid /// columns and sets the CustomFormat for and TDate Fields /// /// TBindingUtil.CreateGridColumns(FGridLink, 150); /// class Procedure MapFieldDefs (FieldDefs: TGeneratorFieldDefs; AClass:TClass); class Procedure CreateGridColumns (Link : TLinkGridToDataSource; DefWidth: Integer = 0); End; TBindMethods = Class class function MethodBlankDateToString: IInvokable; end; implementation uses REST.Response.Adapter , System.TypInfo , System.Rtti , Data.DB , Data.Bind.DBScope ; { TBindingUtil } class procedure TBindingUtil.CreateGridColumns(Link: TLinkGridToDataSource; DefWidth: Integer); var DS: TBaseLinkingBindSource; GenFieldDefs: TGeneratorFieldDefs; FieldDefs: TFieldDefs; P: TPrototypeBindSource; GFld: TGeneratorFieldDef; DBFldDef: Data.DB.TFieldDef; Clm: TLinkGridToDataSourceColumn; I: Integer; begin DS := Link.DataSource; FieldDefs := Nil; GenFieldDefs := Nil; If DS Is TPrototypeBindSource Then Begin GenFieldDefs := TPrototypeBindSource(DS).FieldDefs; End; /// /// If DS Is TAdapterBindSource Then begin if Assigned(TAdapterBindSource(DS).Adapter) then begin if TAdapterBindSource(DS).Adapter is TDataGeneratorAdapter then GenFieldDefs := TDataGeneratorAdapter(TAdapterBindSource(DS).Adapter).FieldDefs; end; end; If DS Is TBindSourceDB Then begin if Assigned(TBindSourceDB(DS).DataSet) then FieldDefs := TBindSourceDB(DS).DataSet.FieldDefs; end; /// Make sure we have a valid collection before we go forward /// if GenFieldDefs <> Nil then Begin Link.Columns.Clear; For GFld In GenFieldDefs Do Begin Clm := Link.Columns.Add; Clm.Header := GFld.Name; Clm.MemberName := GFld.Name; If DefWidth <> 0 Then Clm.Width := DefWidth Else Clm.Width := Link.DefaultColumnWidth; If (GFld.FieldType = TGeneratorFieldType.ftDate) Or ((GFld.FieldType = TGeneratorFieldType.ftDateTime)) Then Clm.CustomFormat := _FormatBlankDateToString End; End else if FieldDefs <> Nil then Begin Link.Columns.Clear; /// For DFld In FieldDefs Do /// /// Didnt work, for some reason FieldDef -> namedItem -> CollectionItem /// /// Cannot be seen as a CollectionItem ????? /// for I := 0 to FieldDefs.Count-1 do Begin DBFldDef := FieldDefs[I]; Clm := Link.Columns.Add; Clm.Header := DBFldDef.Name; Clm.MemberName := DBFldDef.Name; If DefWidth <> 0 Then Clm.Width := DefWidth Else Clm.Width := Link.DefaultColumnWidth; If (DBFldDef.DataType = TFieldType.ftDate) Or ((DBFldDef.DataType = TFieldType.ftDateTime)) Then Clm.CustomFormat := _FormatBlankDateToString End; End; End; class procedure TBindingUtil.MapFieldDefs(FieldDefs: TGeneratorFieldDefs; AClass: TClass); var Ctx: TRttiContext; Typ: TRttiType; Prps: TArray<TRttiProperty>; I: Integer; Prp: TRttiProperty; PrpTypInfo: PTypeInfo; F:TGeneratorFieldDef; X: Integer; begin if FieldDefs.Count = 0 then begin Ctx := TRttiContext.Create; Typ := Ctx.GetType(AClass); Prps := Typ.GetProperties; /// loop through the properties to add the fieldds to the /// fielddef collection. /// For I := 0 To Length(Prps) - 1 Do Begin Prp := Prps[I]; PrpTypInfo := Prp.PropertyType.Handle; /// if the Field does not exist, Add it and then fill in the name and /// read only property /// /// Dont use FieldDefs.Find(Prp.Name) as it throws a exception if it doesnt /// find anything, also it uses IndexOf anyway /// X := FieldDefs.IndexOf(Prp.Name); if X<0 then F := Nil else F := FieldDefs[I]; if not Assigned(F) then begin F := FieldDefs.AddFieldDef; F.Name := Prp.Name;; F.ReadOnly := not Prp.IsWritable; end; /// make sure the FieldType is set, if its a Date then set the custom format /// Case PrpTypInfo.Kind Of tkEnumeration, tkInteger, tkInt64: F.FieldType := TGeneratorFieldType.ftInteger; tkFloat: Begin F.FieldType := TGeneratorFieldType.ftSingle; If PrpTypInfo = System.TypeInfo(TDate) Then Begin F.FieldType := TGeneratorFieldType.ftDate; F.CustomFormat := _FormatBlankDateToString; End; If PrpTypInfo = System.TypeInfo(TTime) Then Begin F.FieldType := TGeneratorFieldType.ftTime; F.CustomFormat := _FormatBlankDateToString; End; If PrpTypInfo = System.TypeInfo(TDateTime) Then Begin F.FieldType := TGeneratorFieldType.ftDateTime; F.CustomFormat := _FormatBlankDateToString; End; End; tkVariant, tkChar, tkWChar, tkString, tkLString, tkWString, tkUString: F.FieldType := TGeneratorFieldType.ftString; End; End; End; End; { TBindMethods } class function TBindMethods.MethodBlankDateToString: IInvokable; begin Result := MakeInvokable( function(Args: TArray<IValue>): IValue var InputValue: IValue; OutputString: String; begin // Ensure only one argument is received. if Length(Args) <> 1 then raise EEvaluatorError.Create(sFormatArgError); // Ensure that the received argument is a Float and of Type Date/DateTime. InputValue := Args[0]; If InputValue.GetType.Kind = tkFloat Then Begin If (InputValue.GetType = System.TypeInfo(TDate)) Or (InputValue.GetType = System.TypeInfo(TDateTime)) Then Begin /// if the value is 0 then its blank and assign the output to be the blank string /// from the consts /// If InputValue.GetValue.AsExtended = 0 Then OutputString := _sBlankDate Else OutputString := DateToStr(InputValue.GetValue.AsExtended) End Else OutputString := InputValue.GetValue.ToString; End Else OutputString := InputValue.GetValue.ToString; // Return the output string. Result := TValueWrapper.Create(OutputString); End); end; initialization if not TBindingMethodsFactory.HasMethod(_sID_BindMethod_BlankDateToString) then TBindingMethodsFactory.RegisterMethod( { AMethodDescription : TMethodDescription } TMethodDescription.Create( { } TBindMethods.MethodBlankDateToString, { AInvokable : IInvokable } _sID_BindMethod_BlankDateToString, { AID : string } _sID_BindMethod_BlankDateToString, { Name : string } 'my.System.BindUtil', { AUnitName : string } true, { ADefaultEnabled : boolean } sFormatDesc, { ADescription : string } nil { AFrameWorkClass : TPersistentClass } ) { } ); finalization TBindingMethodsFactory.UnRegisterMethod(_sID_BindMethod_BlankDateToString); end.

I'm sure this has been covered somewhere before, but I have been unable to locate a solution TDate fields in an object showing the default date (value 0.0) of 30/12/1899 when bound to a string. D11.3 I have Objects that arebeing populated from a JSON source. I have several TDate fields. The default value set is 0 which equates to 30/12/1899. Using live bindings to display the objects using a TPrototypeBindSource and a TListBindSourceAdapter<myObject> I would like to override the default date conversion and show an empty string. I was tTrying to have a way to convert all of the date/dateimes to string with an empty string for whatever default you want to use. Would prefer a global approach to the conversion. The UI looks a bit crap with the 1899 dates where the JSON had an empty date. I've looked at the TValueRefConverterFactory and overriding the Date to String converter but the it didnt work as the adapters have their own conversion functions; in Data.Bind.ObjectScope; function ConvToText(const ASource: TValue; AType: TScopeMemberType; out AResult: TValue): Boolean; begin AResult := ASource.ToString; Result := True; end; Which gets called from here... procedure TBindSourceAdapterEnumerator.GetMemberValue(const AMemberName: string; const AType: TScopeMemberType; const ACallback: TValueCallback); const LObjectTypes: TScopeMemberTypes = [TScopeMemberType.mtObject, TScopeMemberType.mtBitmap]; var LMember: TObject; LMemberType: TScopeMemberType; LValue: TValue; LConverter: TConvertFunc; LResult: TValue; begin LMember := FBindSourceAdapter.GetMember(AMemberName); if (LMember is TBindSourceAdapterField) and TBindSourceAdapterField(LMember).GetMemberType(LMemberType) then begin LConverter := Conversions[LMemberType, AType]; LValue := TBindSourceAdapterField(LMember).GetTValue; Assert(@LConverter <> @ConvFail); if @LConverter <> @ConvNone then begin if LConverter(LValue, AType, LResult) then ACallback(LResult, AType) else Assert(False); end else ACallback(LValue, AType) end; end; But that Type declaration and code sits in the implemetation section so I cant see a way to get to it..... If there was a way to alter the const Conversions: array[TScopeMemberType,TScopeMemberType] of TConvertFunc = (....); that would be all you need.... Or is there something really basic that Im just missing here. Ideas anyone?