Leaderboard
Popular Content
Showing content with the highest reputation on 09/26/19 in Posts
-
I released quite a bit of interesting code to github over the years: YouTube DATA API v3 parsing: https://github.com/bLightZP/Delphi-YouTube-Channel-parsing-plugin-for-Zoom-Player Basic RSS feed parsing code: https://github.com/bLightZP/Delphi-RSS-feed-parsing-plugin-for-Zoom-Player TheAudioDB MetaData/Image scraping code: https://github.com/bLightZP/Delphi-theaudiodb.com-Zoom-Player-media-scraping-plug-in TheMovieDB MetaData/Image scraping code: https://github.com/bLightZP/Delphi-themoviedb.org-Zoom-Player-media-scraping-plug-in OpenSubtitles.org subtitle search & scrape code: https://github.com/bLightZP/Delphi-OpenSubtitles.org-API-support-for-Zoom-Player A basic cross-platform calculator https://github.com/bLightZP/ElegantCalculator https://play.google.com/store/apps/details?id=com.inmatrix.ElegantCalculator Adapted old code to work as cross-platform pure-pascal image scaling with filters (bicubic, bilinear, etc): https://github.com/bLightZP/ImageInterpolation Adapted old code to work as a cross-platform drawing of an anti-aliased circle (can be modified to draw rount-rect as well): https://github.com/bLightZP/AntiAliasedCircle I forked a QRCode generating source code and greatly optimized it (~ x50 faster): https://github.com/bLightZP/DelphiZXingQRCode The original Delphi scanline color-conversion implementation was very slow, so I optimized it: https://github.com/bLightZP/OptimizedDelphiFMXScanline
-
I wish I had RTTI for constants and/or a compiler magic NameOf()
Stefan Glienke replied to Lars Fosdal's topic in RTL and Delphi Object Pascal
Keep voting: https://quality.embarcadero.com/browse/RSP-13290 And given that the compiler already knows line numbers and the filepath it's working on for Assert it should be almost no effort to implement something like this as well: https://docs.microsoft.com/en-gb/dotnet/api/system.runtime.compilerservices.callermembernameattribute?view=netframework-4.7.1 -
I failed to find a way to manually provide key and IV for AES256-CBC as byte values for that component set. However, as already indicated I use CryptoLib4Pascal successfully on VCL and FMX with help from @Ugochukwu Mmaduekwe
-
Blocking the Windows Screen Saver in Delphi
Remy Lebeau replied to dummzeuch's topic in Tips / Blogs / Tutorials / Videos
The *correct* way to block the screen saver on XP and later is to use SetThreadExecutionState() with the ES_DISPLAY_REQUIRED flag: PBT_APMQUERYSUSPEND is just a *request for permission* to suspend the system. The system is not actually suspended yet. So you should not be setting your SystemSuspended flag to True in reply to PBT_APMQUERYSUSPEND, only for PBT_APMSUSPEND. And then clearing the Flag in reply to PBT_APMRESUMESUSPEND and PBT_APMRESUMECRITICAL, not just for PBT_APMRESUMEAUTOMATIC. SC_SCREENSAVE and SC_MONITORPOWER are not window messages, they are flags of WM_SYSCOMMAND, so your 1st "If" block will never evaluate as True. Same with the last "If" block here, too. Also, per the WM_SYSCOMMAND documentation: -
You can find similar functionality in CnPack Enable wizard IDE Main Form Enhancements in CnPack -> Options -> Advanced And then enable this setting in this priority: 01. CnPack Options.png 02. IDE Enhancements Wizard.png 03. Lock IDE Tollbars to Disable Drag.png 04. Lock Toolbars.png Not sure, but maybe CnPack's solutions Lock all toolbars, including MMX and CnPack Procedure List, while Lynatan plugin Lock only Standard IDE Toolbar
-
Just an update on this - I've been moving my persistence code (app settings, project definitions etc) from XML to JSON. So far Neon is the only library that's coped with all of my classes. I've tried maybe 6 or 7 other libraries (both commercial and open-source).
-
I knew I can find a better solution not involving bitmaps in the datasource . Here is the new code procedure TForm1.ListView1UpdatingObjects(const Sender: TObject; const AItem: TListViewItem; var AHandled: Boolean); var AListItemBitmap : TListItemImage; AListItemText : TListItemText; AColor : TAlphaColor; i : Word; begin AListItemBitmap:=AItem.Objects.FindObjectT<TListItemImage>('Image2'); AListItemText:=AItem.Objects.FindObjectT<TListItemText>('Text1'); if Assigned(AListItemBitmap) then begin AListItemBitmap.OwnsBitmap:=True; // this is the trick AListItemBitmap.Bitmap:=TBitmap.Create(40,40); try AColor:=StringToAlphaColor(AListItemText.Text) except // certaines couleurs sont inconnues! i.e. monneygreen, ltgrey AColor:=TAlphaColorRec.Null; end; AListItemBitmap.Bitmap.Clear(Acolor); //:=ABitmap; end; {$ENDIF} end; See line 12. Icing on the cake freeing bitmaps created is not needed anymore ! Tested on Windows10 and Android, hope it works on OSX and iOS
-
Best components for creating windows service apps
Angus Robertson replied to microtronx's topic in VCL
DDService adds the following according to the readme: I'll put it in my SVN repository next week, Arno would be pleased, he put a lot of effort into DDService. I handle power, time and device events in my services using the normal Windows messages, wrote a hardware component that does it all. Angus -
A Handler callback (what TService uses) can receive only the following control codes from the SCM: SERVICE_CONTROL_CONTINUE SERVICE_CONTROL_INTERROGATE SERVICE_CONTROL_NETBINDADD SERVICE_CONTROL_NETBINDDISABLE SERVICE_CONTROL_NETBINDENABLE SERVICE_CONTROL_NETBINDREMOVE SERVICE_CONTROL_PARAMCHANGE SERVICE_CONTROL_PAUSE SERVICE_CONTROL_PRESHUTDOWN SERVICE_CONTROL_SHUTDOWN SERVICE_CONTROL_STOP User-defined codes A HandlerEx callback can receive all of the above controls codes, as well as the following additional control codes: SERVICE_CONTROL_DEVICEEVENT SERVICE_CONTROL_HARDWAREPROFILECHANGE SERVICE_CONTROL_POWEREVENT SERVICE_CONTROL_SESSIONCHANGE SERVICE_CONTROL_TIMECHANGE SERVICE_CONTROL_TRIGGEREVENT SERVICE_CONTROL_USERMODEREBOOT In addition, when a service registers its HandlerEx callback, a user-defined context value can be passed to the HandlerEx whenever it is called by the SCM. That option is not available when registering a Handler callback. Also, there are newer APIs for apps to interact with the SCM, like ChangeServiceConfig2(), ControlServiceEx(), EnumServicesStatusEx(), QueryServiceConfig2(), QueryServiceStatusEx(), etc.
-
That is still the case. And that is my only complaint I have about TService - lack of access to newer SCM features introduced since Win2K (and I have complained about it for years, and posted several QC tickets about it, which are now lost and I don't care to repost them). Most things I can just work around in my own code by calling various APIs directly. But TService's use of an old Handler() callback instead of a newer HandlerEx() callback is still an issue for some features to work correctly.
-
In Unicode environments (Delphi/C++Builder 2009+, and FreePascal in UNICODESTRINGS mode), Indy encodes the Subject (and other headers) using UTF-8 by default (which can be overridden using the TIdMessage.OnInitializeISO event). But for the message body, you need to manually set the TIdMessage.CharSet and/or TIdText.CharSet property to 'utf-8', as they default to 'us-ascii' if left blank and the corresponding ContentType property is set to a 'text/...' media type, like 'text/html' (I am open to consider changing this default to UTF-8 instead). Note that the TIdMessageBuilder... classes already default the CharSet properties to UTF-8 in Unicode environments. No, it doesn't matter. That has no effect on how Indy encodes the email. And in fact, since the TIdMessage.Body and TIdText.Body properties are TStrings objects, you can't store UTF-8 text in the them anyway, only UTF-16 text. So if you want the text encoded as UTF-8 during transmission, make sure the corresponding CharSet properties are set to 'utf-8'. But, are you loading that file as UTF-8? Does the file have a UTF-8 BOM? If not, you must explicitly make use of TEncoding.UTF8 or equivalent when loading the file. What does your loading code look like? That is not true at all. TIdMessageBuilderPlain has a PlainText property for the body, just as TIdMessageBuilderHtml has an Html property for the body. I think you are just confused because the PlainText property is not declared in the TIdMessageBuilderPlain class, it is actually inherited from the TIdCustomMessageBuilder class (which means TIdMessageBuilderHtml also has the PlainText property, so that you can provide alternative plain text for HTML-unaware readers). You should read my articles on this topic on Indy's website: HTML Messages New HTML Message Builder class I have posted an update to my answer on that question. As of 2 months ago, the order in which ContentType and CharSet proerties is set is no longer important. No, you do not. However, if you do need to specify a CharSet explicitly, you should do so on the MessageBuilder classes themselves. TIdMessageBuilderPlain has a PlainTextCharSet property, and TIdMessageBuilderHtml has PlainTextCharSet and HtmlCharSet properties. With that said, try something more like this: procedure SendEmailIndy( const SMTPServer: string; const SMTPPort: integer; const SMTPUserName : string; const SMTPPassword : string; const FromName, FromAddress: string; const ToAddresses: string; //comma "," separated list of e-mail addresses const CCAddresses: string; //comma "," separated list of e-mail addresses const BCCAddresses: string; //comma "," separated list of e-mail addresses const Subject: string; const EmailBody: string; const IsBodyHtml: Boolean; //verses Plain Text const Attachments: TStrings; UseTLS : Boolean); var smtp: TIdSMTP; // IdSmtp.pas TLSHandler : TIdSSLIOHandlerSocketOpenSSL; // TLS support msg: TidMessage; // IdMessage.pas builder: TIdCustomMessageBuilder; //IdMessageBuilder.pas s: string; emailAddress: string; begin msg := TIdMessage.Create(nil); try if IsBodyHtml then begin builder := TIdMessageBuilderHtml.Create; end else begin builder := TIdMessageBuilderPlain.Create; end; try try if IsBodyHtml then begin TIdMessageBuilderHtml(builder).Html.Text := EmailBody; TIdMessageBuilderHtml(builder).HtmlCharSet := 'utf-8'; TIdMessageBuilderHtml(builder).HtmlContentTransfer := '8bit'; end else begin TIdMessageBuilderPlain(builder).PlainText.Text := EmailBody; TIdMessageBuilderPlain(builder).PlainTextCharSet := 'utf-8'; TIdMessageBuilderPlain(builder).PlainTextContentTransfer := '8bit'; end; if Attachments <> nil then begin for s in Attachments do builder.Attachments.Add(s); end; builder.FillMessage(msg); except {$IFDEF TRACEDEBUG} on E : Exception do begin AddDebugEntry('Email Builder Exception : ' + E.Message); Exit; end; {$ELSE} Exit; {$ENDIF} end; finally builder.Free; end; msg.From.Name := FromName; msg.From.Address := FromAddress; msg.Subject := Subject; for s in ToAddresses.Split([',']) do begin emailAddress := Trim(s); if emailAddress <> '' then msg.Recipients.Add.Address := emailAddress; end; for s in CCAddresses.Split([',']) do begin emailAddress := Trim(s); if emailAddress <> '' then msg.CCList.Add.Address := emailAddress; end; for s in BCCAddresses.Split([',']) do begin emailAddress := Trim(s); if emailAddress <> '' then msg.BccList.Add.Address := emailAddress; end; smtp := TIdSMTP.Create(nil); try smtp.Host := SMTPServer; smtp.Port := SMTPPort; smtp.Username := SMTPUserName; smtp.Password := SMTPPassword; if UseTLS then begin TLSHandler := TIdSSLIOHandlerSocketOpenSSL.Create(smtp); smtp.IOHandler := TLSHandler; if SMTPPort = 465 then begin smtp.UseTLS := TIdUseTLS.utUseImplicitTLS; end else begin smtp.UseTLS := TIdUseTLS.utUseExplicitTLS; end; end; try smtp.Connect; except {$IFDEF TRACEDEBUG} on E : Exception do begin AddDebugEntry('SMTP Connect Exception : '+E.Message); Exit; end; {$ELSE} Exit; {$ENDIF} end; try try smtp.Send(msg) except {$IFDEF TRACEDEBUG} on E : Exception do AddDebugEntry('SMTP Send Exception : '+E.Message); {$ENDIF} end; finally smtp.Disconnect; end; finally smtp.Free; end; finally msg.Free; end; end; Note that TIdMessageBuilderHtml CAN create plain-text emails as well, if no HTML is assigned, so you can alternatively use this instead: procedure SendEmailIndy( const SMTPServer: string; const SMTPPort: integer; const SMTPUserName : string; const SMTPPassword : string; const FromName, FromAddress: string; const ToAddresses: string; //comma "," separated list of e-mail addresses const CCAddresses: string; //comma "," separated list of e-mail addresses const BCCAddresses: string; //comma "," separated list of e-mail addresses const Subject: string; const EmailBody: string; const IsBodyHtml: Boolean; //verses Plain Text const Attachments: TStrings; UseTLS : Boolean); var smtp: TIdSMTP; // IdSmtp.pas TLSHandler : TIdSSLIOHandlerSocketOpenSSL; // TLS support msg: TidMessage; // IdMessage.pas builder: TIdMessageBuilderHtml; //IdMessageBuilder.pas s: string; emailAddress: string; begin msg := TIdMessage.Create(nil); try builder := TIdMessageBuilderHtml.Create; try try if IsBodyHtml then begin builder.Html.Text := EmailBody; builder.HtmlCharSet := 'utf-8'; builder.HtmlContentTransfer := '8bit'; end else begin builder.PlainText.Text := EmailBody; builder.PlainTextCharSet := 'utf-8'; builder.PlainTextContentTransfer := '8bit'; end; if Attachments <> nil then begin for s in Attachments do builder.Attachments.Add(s); end; builder.FillMessage(msg); except {$IFDEF TRACEDEBUG} on E : Exception do begin AddDebugEntry('Email Builder Exception : ' + E.Message); Exit; end; {$ELSE} Exit; {$ENDIF} end; finally builder.Free; end; msg.From.Name := FromName; msg.From.Address := FromAddress; msg.Subject := Subject; for s in ToAddresses.Split([',']) do begin emailAddress := Trim(s); if emailAddress <> '' then msg.Recipients.Add.Address := emailAddress; end; for s in CCAddresses.Split([',']) do begin emailAddress := Trim(s); if emailAddress <> '' then msg.CCList.Add.Address := emailAddress; end; for s in BCCAddresses.Split([',']) do begin emailAddress := Trim(s); if emailAddress <> '' then msg.BccList.Add.Address := emailAddress; end; smtp := TIdSMTP.Create(nil); try smtp.Host := SMTPServer; smtp.Port := SMTPPort; smtp.Username := SMTPUserName; smtp.Password := SMTPPassword; if UseTLS then begin TLSHandler := TIdSSLIOHandlerSocketOpenSSL.Create(smtp); smtp.IOHandler := TLSHandler; if SMTPPort = 465 then begin smtp.UseTLS := TIdUseTLS.utUseImplicitTLS; end else begin smtp.UseTLS := TIdUseTLS.utUseExplicitTLS; end; end; try smtp.Connect; except {$IFDEF TRACEDEBUG} on E : Exception do begin AddDebugEntry('SMTP Connect Exception : '+E.Message); Exit; end; {$ELSE} Exit; {$ENDIF} end; try try smtp.Send(msg) except {$IFDEF TRACEDEBUG} on E : Exception do AddDebugEntry('SMTP Send Exception : '+E.Message); {$ENDIF} end; finally smtp.Disconnect; end; finally smtp.Free; end; finally msg.Free; end; end;