Execute News

Des nouvelles fraîches de http://www.execute.frRSS « Avant | Après » | Delphi[×]

Formater un texte que l'on colle

Publié le 18/06/2018 [Delphi]
Voici un petit bout de code que j'utilise dans une application qui attends un numéro de téléphone sur 10 chiffres maxi et qui reçoit des copier/coller d'une application qui place des espaces tous les deux caractères.

en ajoutant cette unité dans la partie interface des forms qui utilisent des TEdit dont la taille est limité à 10 caractères, ceux-ci acceptent le texte espacé (à adapter pour d'autres formats ou contraintes).

unit UEditPhone;

interface

uses
  Winapi.Messages,
  System.SysUtils,
  Vcl.StdCtrls;

type
  TEdit = class(Vcl.StdCtrls.TEdit)
    procedure WMPaste(var Msg: TMessage); message WM_PASTE;
  end;

implementation

uses
  Vcl.Clipbrd;

{ TEdit }

procedure TEdit.WMPaste(var Msg: TMessage);
var
  Str: string;
begin
  if MaxLength = 10 then
  begin
    Str := Clipboard.AsText;
    Clipboard.AsText := StringReplace(Str, ' ', '', [rfReplaceAll]);
    inherited;
    Clipboard.AsText := Str;
  end else begin
    inherited;
  end;
end;

end.

J'adore quand un plan se déroule sans accroc !

Publié le 06/06/2018 [Delphi] [Expérience]
Depuis fort longtemps je bosse sur des base MySQL, notamment car elles sont disponibles chez OVH.

Depuis quelques années je bosse sur des bases Firebird avec Delphi, et bien il n'y a pas à dire...quand j'ai un problème de performance sur une requête SQL sous MySQL, je cherche les index en cause, je crée ceux qui manquent et hop c'est rapide ! Quand j'ai ce même problème sous Firebird, je cherche les index en cause, je crée les index et j'ai toujours un problème de performance :(

Alors c'est sans doute mon code, ma requête ou mes index qui sont inappropriés, mais n'empêche que c'est hyper frustrant !

Petite fonction de cryptage sous Windows

Publié le 06/06/2018 [Delphi]
On a toujours besoin d'une petite fonction de cryptage rapide pour sauvegarder une mot de passe ou autre...voici une petite unité sous Windows qui répond à ce besoin.

unit Execute.Win.CryptString;

{
  (c)2018 Execute SARL 
}

interface

uses
  Winapi.Windows,
  System.SysUtils;

function CryptString(const Str: string): TBytes;
function DecryptString(const Data: TBytes): string;

implementation

type
  DATA_BLOB = record
    cbData :DWORD;
    pbData :PAnsiChar; // PBYTE but PAnsiChar is better for debug purpose
  end;
  PDATA_BLOB = ^DATA_BLOB;

function CryptProtectData(
  var pDataIn         : DATA_BLOB;
      ppszDataDescr   : PChar;
      pOptionalEntropy: PDATA_BLOB;
      pvReserved      : Integer;
      pPromptStruct   : Pointer; // PCRYPTPROTECT_PROMPTSTRUCT;
      dwFlags         : DWORD;
  var pDataOut        : DATA_BLOB
): BOOL; stdcall; external 'crypt32.dll';

function CryptUnprotectData(
  var pDataIn         : DATA_BLOB;
      ppszDataDescr   : PPChar;
      pOptionalEntropy: PDATA_BLOB;
      pvReserved      : Integer;
      pPromptStruct   : Pointer; // PCRYPTPROTECT_PROMPTSTRUCT;
      dwFlags         : DWORD;
  var pDataOut        : DATA_BLOB
): BOOL; stdcall; external 'crypt32.dll';

function CryptString(const Str: string): TBytes;
var
  DataIn  : DATA_BLOB;
  DataOut : DATA_BLOB;
begin
  if Str = '' then
    Exit(nil);

  DataIn.cbData := Length(Str) * SizeOf(Char);
  DataIn.pbData := Pointer(Str);

  if CryptProtectData(DataIn, 'Execute.Win.CryptString', nil, 0, nil, 0, DataOut) = False then
    RaiseLastOSError;

  SetLength(Result, DataOut.cbData);
  Move(DataOut.pbData^, Result[0], DataOut.cbData);
  LocalFree(NativeUInt(DataOut.pbData));
end;

function DecryptString(const Data: TBytes): string;
var
  DataIn  : DATA_BLOB;
  DataOut : DATA_BLOB;
begin
  if Data = nil then
    Exit('');

  DataIn.cbData := Length(Data);
  DataIn.pbData := Pointer(Data);

  if CryptUnprotectData(DataIn, nil, nil, 0, nil, 0, DataOut) = False then
    RaiseLastOSError;

  SetLength(Result, DataOut.cbData div SizeOf(Char));
  Move(DataOut.pbData^, Pointer(Result)^, DataOut.cbData);
  LocalFree(NativeUInt(DataOut.pbData));
end;

end.

TFormatSettings Windows 7 et un suisse sont dans un bateau

Publié le 01/06/2018 [Delphi] [BugList]
Bonjour,

Un petite info sur un bug Delphi référencé par Olivier sur lequel je suis tombé (le bug, pas Olivier).

J'ai une appli développée sous Delphi XE3 dans une machine virtuelle Windows 7 qui a été déployée chez des suisses sous Windows 10...et là grosse blague, les suisses utilisent le point comme séparateur de date et non le slash...vu que le code n'y prenait garde je n'étais pas étonné que ça ne marche pas, mais quand j'ai basculé la préférences locales de ma machine en Suisse, mon appli continuait à utiliser des slash...car, en effet il y a un bug dans Delphi qui fait que ça ne fonctionne pas sous Windows 7.

Bon à savoir !

Personnage 3D sous Firemonkey

Publié le 13/02/2018 [Delphi] [Firemonkey]
C'est une démo que j'avais posté sur le site Embarcadero il y a quelques temps, je la recycle sur Github

CubeMan3D, animation FMX sans une seule ligne de code :)