Delphi Product SKU Related Functions

Jika pada artikel sebelumnya kita membahas bagaimana mengetahui apakah suatu aplikasi dikompilasi dengan menggunakan Delphi beserta versi SKU Delphi yang digunakan, maka pada kesempatan kali ini membahas fungsi / prosedur apa saja yang berkaitan dengan pengenalan versi SKU terhadap pembatasan akses komponen / package pada saat runtime yang digunakan oleh internal Delphi.

Delphi merilis beberapa versi produk yang ditujukan untuk segmen pasar tertentu, misalnya versi Architect / Enterprise, Professional dan Personal. Perbedaan masing – masing versi ini adalah terletak pada fasilitas yang disediakan serta akses komponen / package pada saat runtime. Misalnya akses komponen Multitier hanya untuk versi Enterprise.

Pada saat runtime, komponen / object tertentu melakukan pengecekan versi SKU pada event OnCreate untuk memastikan bahwa komponen / object tersebut hanya diperuntukkan oleh aplikasi yang dikompilasi dengan veri SKU tertentu saja.

Jika versi yang diperiksa diperbolehkan mengakses object tersebut, maka proses dilanjutkan, namun jika tidak akan tampil pesan kesalahan ‘Application is not licensed to use this feature’.

Nah tentunya Anda penasaran bagaimana Delphi melakukan pengecekan versi SKU. Sebenarnya cukup sederhana. Delphi membandingkan nilai pengenal versi SKU yang disimpan sebagai resource pada aplikasi, yaitu DVCLAL dengan untaian kode yang sudah disiapkan. Tentunya perbandingan ini dilakukan setelah proses dekripsi seperlunya.

Proses pengecekan versi SKU dilakukan oleh 2 prosedur yang terletak pada unit SysUtils, yaitu RCS untuk mengecek versi Enterprise dan RPR untuk versi Professional. Prosedur RCS akan melemparkan eksepsi jika aplikasi yang diperiksa tidak dikompilasi dengan versi Enterprise. Demikian pula dengan prosedur RPR, akan melemparkan eksepsi jika aplikasi yang diperiksa tidak dikompilasi dengan versi Professional atau versi Enterprise.

Untuk lebih jelasnya bagaimana prosedur RCS dan RPR bekerja, silahkan Anda simak sendiri didalam unit SysUtils, atau singkatnya berikut cuplikan kodenya:

function AL1(const P): LongWord;
asm
        MOV     EDX,DWORD PTR [P]
        XOR     EDX,DWORD PTR [P+4]
        XOR     EDX,DWORD PTR [P+8]
        XOR     EDX,DWORD PTR [P+12]
        MOV     EAX,EDX
end;

function AL2(const P): LongWord;
asm
        MOV     EDX,DWORD PTR [P]
        ROR     EDX,5
        XOR     EDX,DWORD PTR [P+4]
        ROR     EDX,5
        XOR     EDX,DWORD PTR [P+8]
        ROR     EDX,5
        XOR     EDX,DWORD PTR [P+12]
        MOV     EAX,EDX
end;

const
  AL1s: array[0..3] of LongWord = ($FFFFFFF0, $FFFFEBF0, 0, $FFFFFFFF);
  AL2s: array[0..3] of LongWord = ($42C3ECEF, $20F7AEB6, $D1C2F74E, $3F6574DE);

procedure ALV;
begin
  raise Exception.CreateRes(@SNL);
end;

function ALR: Pointer;
var
  LibModule: PLibModule;
begin
  if MainInstance <> 0 then
    Result := Pointer(LoadResource(MainInstance, FindResource(MainInstance, 'DVCLAL',
      RT_RCDATA)))
  else
  begin
    Result := nil;
    LibModule := LibModuleList;
    while LibModule <> nil do
    begin
      with LibModule^ do
      begin
        Result := Pointer(LoadResource(Instance, FindResource(Instance, 'DVCLAL',
          RT_RCDATA)));
        if Result <> nil then Break;
      end;
      LibModule := LibModule.Next;
    end;
  end;
end;

function GDAL: LongWord;
type
  TDVCLAL = array[0..3] of LongWord;
  PDVCLAL = ^TDVCLAL;
var
  P: Pointer;
  A1, A2: LongWord;
  PAL1s, PAL2s: PDVCLAL;
  ALOK: Boolean;
begin
  P := ALR;
  if P <> nil then
  begin
    A1 := AL1(P^);
    A2 := AL2(P^);
    Result := A1;
    PAL1s := @AL1s;
    PAL2s := @AL2s;
    ALOK := ((A1 = PAL1s[0]) and (A2 = PAL2s[0])) or
            ((A1 = PAL1s[1]) and (A2 = PAL2s[1])) or
            ((A1 = PAL1s[2]) and (A2 = PAL2s[2]));
    FreeResource(Integer(P));
    if not ALOK then ALV;
  end else Result := AL1s[3];
end;

procedure RCS;
var
  P: Pointer;
  ALOK: Boolean;
begin
  P := ALR;
  if P <> nil then
  begin
    ALOK := (AL1(P^) = AL1s[2]) and (AL2(P^) = AL2s[2]);
    FreeResource(Integer(P));
  end else ALOK := False;
  if not ALOK then ALV;
end;

procedure RPR;
var
  AL: LongWord;
begin
  AL := GDAL;
  if (AL <> AL1s[1]) and (AL <> AL1s[2]) then ALV;
end;

Nah untuk membuktikan kode diatas bekerja, saya telah membuat demo aplikasi yang saya kompilasi dengan Delphi 7 Enterprise dan Turbo Delphi 2006 Professional. Berikut cuplikan kodenya:

{
  Delphi SKU Related Function Demo
  Created by Bayu Prasetio
}

unit SKUDemoUnit;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls;

type
  TfrmSKUDependent = class(TForm)
    btnCheckSKU: TButton;
    lblLegend: TLabel;
    btnCallEnterprise: TButton;
    btnCallProfessional: TButton;
    stbAbout: TStatusBar;
    procedure btnCheckSKUClick(Sender: TObject);
    procedure btnCallEnterpriseClick(Sender: TObject);
    procedure btnCallProfessionalClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frmSKUDependent: TfrmSKUDependent;

implementation

{$R *.dfm}

procedure TfrmSKUDependent.btnCallEnterpriseClick(Sender: TObject);
begin
  try
    RCS;
    MessageDlg('This demo is compiled by Delphi Enterprise SKU', mtInformation, [mbOK], 0);
  except
    Raise;
  end;
end;

procedure TfrmSKUDependent.btnCheckSKUClick(Sender: TObject);
begin
  try
    RCS;  // check for Enterprise / Client-Server SKU
    MessageDlg('Enterprise SKU', mtInformation, [mbOK], 0);
  except
    try
      RPR;  //check for Professional SKU
      MessageDlg('Professional SKU', mtInformation, [mbOK], 0);
    except
      MessageDlg('Personal SKU', mtInformation, [mbOK], 0);
    end;
  end;
end;

procedure TfrmSKUDependent.btnCallProfessionalClick(Sender: TObject);
begin
  try
    RPR;
    MessageDlg('This demo is compiled by Delphi Enterprise or Professional SKU', mtInformation, [mbOK], 0);
  except
    Raise;
  end;
end;

end.

Nah, jika kode diatas dikompilasi dengan Delphi 7 Enterprise, pada saat dijalankan berikut hasilnya:

Aksi tombol ‘Check SKU’ pada Delphi 7 Enterprise

Aksi tombol ‘Force Call Enterprise Function(RCS)’ pada Delphi 7 Enterprise

Aksi tombol ‘Force Call Professional Function(RPR)’ pada Delphi 7 Enterprise

Nah, jika kode dikompilasi dengan Turbo Delphi 2006 Professional, hasil yang diperoleh akan berbeda.

Aksi tombol ‘Check SKU’ pada Turbo Delphi 2006 Professional

Aksi tombol ‘Force Call Enterprise Function(RCS)’ pada Turbo Delphi 2006 Professional

Aksi tombol ‘Force Call Professional Function(RPR)’ pada Turbo Delphi 2006 Professional

Semoga bermanfaat.