InraPorc

unit UUtil;

{$WARN SYMBOL_PLATFORM OFF}

interface

uses

  Windows, Forms, SysUtils, Messages, UVariables, lbCipher;

function BdRReadString(RegKey, RegValue, Default: String): String;

function BdRReadInteger(RegKey, RegValue: String; Default: Integer): Integer;

function BdRReadFloat(RegKey, RegValue: String; Default: Double): Double;

function BdRReadBoolean(RegKey, RegValue: String; Default: Boolean): Boolean;

procedure BdRWriteString(RegKey, RegValue, Value: String);

procedure BdRWriteInteger(RegKey, RegValue: String; Value: Integer);

procedure BdRWriteFloat(RegKey, RegValue: String; Value: Double);

procedure BdRWriteBoolean(RegKey, RegValue: String; Value: Boolean);

function WideToBool(Value: String): Boolean;

function BoolToWide(Value: Boolean): String;

function DblToStr(Value: Double; Digits: Integer): String;

function ExtToLCID(Ext: String): Cardinal;

function ExtToName(Ext: String): String;

function DefaultCurrency: String;

function DecimalSeparator: String;

function ThousandSeparator: String;

function ListSeparator: String;

function DriveType(Drive: String): UINT;

function MD5Str(Digest: TMD5Digest): String;

function CompleteKey: String;

function EducationKey: String;

function TooMuchRecords: Boolean;

function IsComplete: Boolean;

function IsEducation: Boolean;

function IsEvaluation: Boolean;

implementation

type

  WindowsString = type AnsiString(1252);

function BdRReadString(RegKey, RegValue, Default: String): String;

begin

  if Reg.OpenKeyReadOnly(RegKey)

  and Reg.ValueExists(RegValue)

  then

    Result := Reg.ReadString(RegValue)

  else

    Result := Default;

  Reg.CloseKey;

end;

function BdRReadInteger(RegKey, RegValue: String; Default: Integer): Integer;

begin

  if Reg.OpenKeyReadOnly(RegKey)

  and Reg.ValueExists(RegValue)

  then

    Result := Reg.ReadInteger(RegValue)

  else

    Result := Default;

  Reg.CloseKey;

end;

function BdRReadFloat(RegKey, RegValue: String; Default: Double): Double;

begin

  if Reg.OpenKeyReadOnly(RegKey)

  and Reg.ValueExists(RegValue)

  then

    Result := Reg.ReadFloat(RegValue)

  else

    Result := Default;

  Reg.CloseKey;

end;

function BdRReadBoolean(RegKey, RegValue: String; Default: Boolean): Boolean;

begin

  if Reg.OpenKeyReadOnly(RegKey)

  and Reg.ValueExists(RegValue)

  then

//    Result := Reg.ReadBool(RegValue);

    // TRegistry stocke les valeurs Boolean en tant que Integer (REG_DWORD)

    // TRegistryIniFile utilisait le type String (REG_SZ)

    // pour garder la compatibilit? avec l'ancienne version,

    // je lis une valeur String que je convertis en Boolean

    Result := WideToBool(Reg.ReadString(RegValue))

  else

    Result := Default;

  Reg.CloseKey;

end;

procedure BdRWriteString(RegKey, RegValue, Value: String);

begin

  Reg.Access := KEY_WRITE;

  if Reg.OpenKey(RegKey, True)

  then

    Reg.WriteString(RegValue, Value);

  Reg.CloseKey;

end;

procedure BdRWriteInteger(RegKey, RegValue: String; Value: Integer);

begin

  Reg.Access := KEY_WRITE;

  if Reg.OpenKey(RegKey, True)

  then

    Reg.WriteInteger(RegValue, Value);

  Reg.CloseKey;

end;

procedure BdRWriteFloat(RegKey, RegValue: String; Value: Double);

begin

  Reg.Access := KEY_WRITE;

  if Reg.OpenKey(RegKey, True)

  then

    Reg.WriteFloat(RegValue, Value);

  Reg.CloseKey;

end;

procedure BdRWriteBoolean(RegKey, RegValue: String; Value: Boolean);

begin

  Reg.Access := KEY_WRITE;

  if Reg.OpenKey(RegKey, True)

  then

//    Reg.WriteBool(RegValue, Value);

    // TRegistry stocke les valeurs Boolean en tant que Integer (REG_DWORD)

    // TRegistryIniFile utilisait le type String (REG_SZ)

    // pour garder la compatibilit? avec l'ancienne version,

    // je convertis les valeurs Boolean en String avant de l'enregistrer

    Reg.WriteString(RegValue, BoolToWide(Value));

  Reg.CloseKey;

end;

function WideToBool(Value: String): Boolean;

begin

  Result := Value <> '0';

end;

function BoolToWide(Value: Boolean): String;

const

  Values: array[Boolean] of string = ('0', '1');

begin

  Result := Values[Value];

end;

function DblToStr(Value: Double; Digits: Integer): String;

var

  s: String;

  l: Integer;

begin

  s := FloatToStrF(Value, ffFixed, 15, Digits); // Conversion en cha?ne

  s := Trim(s); // Suppression des espaces

  l := Length(s);

  if Pos('.', s) > 0

  then

    while (l > 0) and (s[l] = '0') do Dec(l); // Suppression des z?ros

  if (l > 0) and (s[l] = '.') then Dec(l); // Suppression du point

  Result := Copy(s, 1, l);

end;

function ExtToLCID(Ext: String): Cardinal;

var

  i: Integer;

begin

  // Recherche du LCID correspondant ? l'extension

  i := 0;

  while (i < Languages.Count) and (UpperCase(Languages.Ext[i]) <> Ext) do

    Inc(i);

  if i = Languages.Count

  then // Introuvable

    Result := 0

  else

    Result := Languages.LocaleID[i];

end;

function ExtToName(Ext: String): String;

var

  i: Integer;

begin

  i := 0;

  while (i < Languages.Count) and (Languages.Ext[i] <> Ext) do

    Inc(i);

  if i = Languages.Count

  then // Introuvable

    Result := ''

  else

    Result := Languages.Name[i];

end;

function DefaultCurrency: String;

begin

  Result := GetLocaleStr(LOCALE_USER_DEFAULT, LOCALE_SCURRENCY, '$');

end;

function DecimalSeparator: String;

begin

  Result := GetLocaleStr(LOCALE_USER_DEFAULT, LOCALE_SDECIMAL, '.');

end;

function ThousandSeparator: String;

begin

  Result := GetLocaleStr(LOCALE_USER_DEFAULT, LOCALE_STHOUSAND, '');

end;

function ListSeparator: String;

begin

  Result := GetLocaleStr(LOCALE_USER_DEFAULT, LOCALE_SLIST, ';');

end;

function DriveType(Drive: String): UINT;

begin

  Result := GetDriveType(PChar(Drive));

end;

function MD5Str(Digest: TMD5Digest): String;

var

        i: Byte;

  sb: TStringBuilder;

const

        Digits: array[0..15] of Char =

                ('0', '1', '2', '3', '4', '5', '6', '7', '8', '9', 'A', 'B', 'C', 'D', 'E', 'F');

begin

  sb := TStringBuilder.Create;

  for i := 0 to 15 do

    sb.Append(Digits[(Digest[I] shr 4) and $0f]).Append(Digits[Digest[I] and $0f]);

  sb.Insert(24, '-').Insert(16, '-').Insert(8, '-');

  Result := sb.ToString;

  FreeAndNil(sb);

end;

function CompleteKey: String;

var

  sb: TStringBuilder;

  Digest: TMD5Digest;

begin

  sb := TStringBuilder.Create;

  sb.Append(Format('InraPorc version %d : ', [MajorVersion]));

  sb.Append(Format('licence num?ro %d ', [LicenseNumber]));

  sb.Append(Format('sur le volume %s ', [Volume]));

  sb.Append(Format('accord?e ? %s %s (%s) ', [FirstName, LastName, Company]));

  sb.Append(Format('valable jusqu''au %s', [FinalDate]));

  StringHashMD5(Digest, WindowsString(sb.ToString));

  FreeAndNil(sb);

  Result := MD5Str(Digest);

end;

function EducationKey: String;

var

  sb: TStringBuilder;

  Digest: TMD5Digest;

begin

  sb := TStringBuilder.Create;

  sb.Append(Format('InraPorc version %d : ', [MajorVersion]));

  sb.Append('licence limit?e ? l''?ducation ');

  sb.Append(Format('sur le volume %s ', [Volume]));

  sb.Append(Format('accord?e ? %s %s (%s) ', [FirstName, LastName, Company]));

  sb.Append(Format('valable jusqu''au %s', [FinalDate]));

  StringHashMD5(Digest, WindowsString(sb.ToString));

  FreeAndNil(sb);

  Result := MD5Str(Digest);

end;

function TooMuchRecords: Boolean;

begin

  Result := (ListMatiere.Count - NumMatInraAfz > 10)

    or (ListAliment.Count > 10)

    or (ListSeqAliT.Count > 5)

    or (ListRationT.Count > 5)

    or (ListLogeT.Count > 5)

    or (ListProfilT.Count > 5)

    or (ListSimulT.Count > 5)

    or (ListSeqAliP.Count > 5)

    or (ListRationP.Count > 5)

    or (ListProfilP.Count > 5)

    or (ListSimulP.Count > 5);

end;

function IsComplete: Boolean;

begin

  Result := (LicenseType = 2)

    and (LicenseNumber > 0)

    and (Length(FirstName) > 0)

    and (Length(LastName) > 0)

    and (StrToInt(FormatDateTime('yyyymmdd', Date)) <= StrToInt(Copy(FinalDate, 7, 4) + Copy(FinalDate, 4, 2) + Copy(FinalDate, 1, 2)))

    and (DriveType(Drive) = DRIVE_FIXED)

    and AnsiSameText(SoftwareEnableKey, CompleteKey);

end;

function IsEducation: Boolean;

begin

  Result := (LicenseType = 1)

    and (Length(FirstName) > 0)

    and (Length(LastName) > 0)

    and (Length(Company) > 0)

    and (StrToInt(FormatDateTime('yyyymmdd', Date)) <= StrToInt(Copy(FinalDate, 7, 4) + Copy(FinalDate, 4, 2) + Copy(FinalDate, 1, 2)))

    and AnsiSameText(SoftwareEnableKey, EducationKey)

    and not TooMuchRecords;

end;

function IsEvaluation: Boolean;

begin

  Result := (LicenseType = 0)

    and not TooMuchRecords;

end;

end.