Archive

Archive for the ‘Did You Know’ Category

Custom MessageDlg: Centered Message

August 12, 2008 3 comments

Salah seorang pejuang Delphi menanggapi artikel saya mengenai Custom MessageDlg. Ybs menanyakan apakah mungkin teks pesan pada MessageDlg diubah perataannya, yaitu rata tengah (Ridwan’s Comment).

Realisasinya gimana nih?

Advertisements

Custom MessageDlg

August 7, 2008 5 comments

Artikel ini merupakan lanjutan dari Meng-Indonesia-kan MessageDlg yang pernah saya publikasikan beberapa bulan yang lalu (lebih tepatnya tahun yang lalu). Sebenarnya saya ingin mengangkat tema lain yang menurut saya lebih menarik, namun berhubung ada diskusi di forum Delphi Indonesia (Delphi-ID) mengenai membuat MessageDlg sesuai dengan keinginan secara dinamis, maka saya putuskan untuk menulisnya terlebih dahulu.

Selengkapnya..

MESSAGE Directive

July 18, 2008 1 comment

Delphi dilengkapi dengan compiler directive (direktif kompiler) yang memungkinkan kita melakukan perubahan terhadap bagaimana compiler menangani proses kompilasi kode program. Salah satu direktif yang mungkin jarang kita gunakan adalah MESSAGE. Mau tahu apa dan bagaimana direktif MESSAGE ?

Read more…

Change Delphi 2007 IDE Title

March 11, 2008 2 comments

Pernahkah Anda berpikiran untuk mengubah judul jendela IDE Delphi, dalam hal ini IDE untuk keluarga BDS (Borland Developer Studio) dan CodeGear RAD Studio? Ah mungkin ada yang berpendapat hal ini cuma buang – buang waktu, kerjaan orang iseng saja. Ya betul, ini adalah buah dari ke-iseng-an saya di kala pikiran sedang jenuh.

Judul Asli Jendela IDE Delphi 2007

Sebetulnya untuk mengubah jendela suatu aplikasi sangatlah mudah, cukup cari handle dari jendela yang ingin diubah judulnya menggunakan WinAPI FindWindow. Setelah mendapatkan handle nya, gunakan API yang berfungsi untuk mengubah judul / title / caption dari suatu jendela berdasarkan handle yang diberikan, misalnya SetWindowText.

Nah jika Anda ingin mengubah judul jendela IDE Delphi, tentunya harus diketahui handle dari jendela IDE tersebut. Jika menggunakan WinAPI FindWindow, maka Anda harus menyertakan parameter nama kelas dan atau judul dari jendela yang diinginkan, Dalam hal ini Delphi yang saya gunakan, yaitu Delphi 2007 win32, nama kelasnya adalah “TAppBuilder” dengan judul “CodeGear Delphi for Microsoft Windows“. Nah Setelah handle-nya didapatkan, terserah akan dimodifikasi judulnya.

Akan tetapi dapatkah hal tersebut dilakukan dengan menggunakan cara di atas? Mendapatkan handle jendela IDE Delphi tentu saja dapat, akan tetapi mengubah judulnya? belum tentu! Sepertinya IDE Delphi melindungi dirinya untuk tidak terjadi modifikasi judul jendela yang dilakukan oleh selain dirinya sendiri. Dan seandainya proteksi tersebut dapat ditembus, ada permasalahan lain yang menghadang, yaitu masalah penyesuaian judul jendela terhadap file sumber yang sedang dibuka. Judul IDE Delphi secara otomatis akan berubah sesuai dengan file yang sedang dibuka dan dimuat oleh Code Editor. Misalnya jika sedang membuka unit1 pada project1, maka judulnya menjadi: “project1 – CodeGear Delphi for Microsoft Windows – Unit1”. Kemudian Anda membuka unit2, maka judulnya secara otomatis berubah menjadi “project1 – CodeGear Delphi for Microsoft Windows – Unit2”. Dan ketika Anda berpindah kembali ke unit1, maka judul IDE Delphi secara otomatis akan menyesuaikan.

Nah lalu bagaimana mengubah judul jendela IDE Delphi, misalnya seperti gambar berikut?

Judul Modifikasi Jendela IDE Delphi 2007

Sebenarnya amat sangat mudah sekali. BDS menyediakan banyak undocumented command line switch yang salah satunya adalah untuk mengubah judul jendela IDE. Cukup gunakan switch idecaption yang diikuti dengan judul jendela yang diinginkan dalam tanda petik dua.

Untuk mencobanya, silahkan menuju ke folder bin pada instalasi Delphi Anda melalui command prompt. kemudian ketikkan teks bds.exe dan jangan lupa untuk menambahkan switch idecaption diikuti dengan judul yang diinginkan, sehingga perintah selengkapnya menjadi: bds.exe -pDelphi -idecaption=”Bayu Prasetio’s CodeGear Delphi for Microsoft Windows”.

Dan tadaaa.. judul jendela IDE Delphi akan sesuai dengan yang Anda inginkan.

Agar lebih praktis judul jendela IDE Delphi sesuai dengan yang Anda inginkan setiap IDE dijalankan, Anda dapat mengubah shortcut pada start menu dengan menyertakan switch idecaption seperti gambar berikut:

Tambahan command line switch idecaption

Selamat menikmati. 🙂

Categories: Delphi, Did You Know

Menampilkan Informasi Package pada BDS About Box

January 22, 2008 2 comments

Tahun lalu, saya pernah membahas trik bagaimana Menampilkan Informasi Package pada BDS SplashScreen. Pembahasan tersebut sebetulnya belum selesai, karena ada satu hal lagi yang lupa saya sampaikan, yaitu trik bagaimana Menampilkan Informasi Package pada BDS / GodeGear About Box.

Oke, tanpa ba-bi-bu, langsung aja, bagaimana menampilkan entri seperti yang disajikan pada gambar berikut?
CodeGeare Aboutbox

Intinya masih tetap sama, menggunakan OTA (Open Tools API). Kali ini method yang digunakan adalah AddPluginInfo dan AddProductInfo.

ToolsAPI Documentation:
Call AddPluginInfo to provide information specific to a particular plugin.
The caller should save the returned index in order to later remove the
plug-in info using RemovePluginInfo. Title is displayed in a listbox in
which the user can select. Description is displayed in a memo which
should describe the plugin. And the Image is displayed next to the
Description when the title is selected. The Image should follow the same
size and rules as required for a plugin image in the splash screen. See
IOTASplashScreenServices. If IsUnRegistered is true, the title will be
painted red. LicenseStatus will be shown in a label when the title is
selected. SKUName will also be shown in a label when the title is selected

AddProductInfo follows the same rules as AddPluginInfo, except for
providing the About box Dialog title, copyright string and the extra
about box graphic. ACopyright should include both the product name,
version, and copyright info. This information is displayed at the top of
the about box. The Product image has the same rules as the image
passed to AddPluginInfo. If IsUnRegistered is true, the title will be
painted red. LicenseStatus will be shown in a label when the title is
selected. SKUName will also be shown in a label when the title is selected

  function AddPluginInfo(const ATitle, ADescription: string; AImage: HBITMAP;
    AIsUnRegistered: Boolean = False; const ALicenseStatus: string = '';
    const ASKUName: string = ''): Integer;

  function AddProductInfo(const ADialogTitle, ACopyright, ATitle, ADescription: string;
     AAboutImage, AProductImage: HBITMAP; AIsUnRegistered: Boolean = False;
     const ALicenseStatus: string = ''; const ASKUName: string = ''): Integer;

Yang perlu diingat adalah, ketika suatu package menambahkan entri informasi pada jendela About Box, maka entri tersebut juga harus dihapus ketika package tersebut di-unload. Untuk menghapus entri, menggunakan method berikut:

  { When a plugin is unloaded, it should actively remove itself from the
    AboutBoxServices but specifying the index returned from AddPluginInfo }
  procedure RemovePluginInfo(Index: Integer);
  { When a product personality is unloaded, it should actively remove itself
    from the AboutBoxServices but specifying the index returned from
    AddProductInfo }
  procedure RemoveProductInfo(Index: Integer);

Nah bentuk implementasinya seperti ini:

unit RegisterMyPackage;

interface

implementation

uses
  ToolsAPI, Windows, Graphics, SysUtils;

var
  AboutBoxServices : IOTAAboutBoxServices = nil;
  AboutBoxIndex : Integer = 0;

resourcestring
  resPackageName = 'Bayu Prasetio''s Components Collection';
  resLicense = 'Internal Usage';
  resAboutCopyright = 'Copyright Bayu Prasetio';
  resAboutTitle = 'Bayu Prasetio''s Components Collection';
  resAboutDescription = 'This package contains some components' + #13#10 +
                        'created and developed by Bayu Prasetio';

procedure RegisterSplashScreen;
var
  bmp: TBitmap;
begin
  bmp := TBitmap.Create;
  bmp.LoadFromResourceName(HInstance, 'SPLASH');
  SplashScreenServices.AddPluginBitmap(resPackageName, bmp.Handle, False, resLicense, '');
  bmp.Free;
end;

procedure RegisterAboutBox;
var
  ProductImage: HBITMAP;
begin
  Supports(BorlandIDEServices,IOTAAboutBoxServices, AboutBoxServices);
  ProductImage := LoadBitmap(FindResourceHInstance(HInstance), 'SPLASH');
  AboutBoxIndex := AboutBoxServices.AddPluginInfo(resPackageName, resAboutDescription,
    ProductImage, False, resLicense);
end;

procedure UnregisterAboutBox;
begin
  if (AboutBoxIndex <> 0) and Assigned(AboutBoxServices) then
  begin
    AboutBoxServices.RemovePluginInfo(AboutBoxIndex);
    AboutBoxIndex := 0;
    AboutBoxServices := nil;
  end;
end;

initialization
  RegisterSplashScreen;
  RegisterAboutBox;

finalization
  UnRegisterAboutBox;

end.

Semoga bermanfaat.

Categories: Delphi, Did You Know

Meng-Indonesia-kan MessageDlg

October 22, 2007 5 comments

Secara standar, bahasa yang digunakan oleh Delphi untuk menampilkan pesan pada kotak dialog pada MessageDlg adalah bahasa Inggris.

  MessageDlg('Professional SKU', mtInformation, [mbOK], 0);

Kode diatas akan menampilkan kotak dialog seperti gambar berikut:
MessagDlg Standard

Nah lalu bagaimanakah kode yang dibuat untuk menampilkan kotak dialog seperti gambar berikut?
MessagDlg ala Indonesia

Built From Scratch ?
Alternatif pertama adalah dengan membuat sendiri pustaka untuk menampilkan kotak dialog dengan bahasa Indonesia. Disini, diperlukan form dan konstanta tombol berbahasa Indonesia, membuat rutin yang berkaitan dengan User Interface, membuat event handler yang dibutuhkan dan sebagainya. Ah.. sudah terbayang betapa merepotkannya!

Modify The Source ?
Alternatif kedua, memodifikasi bahasa / teks yang digunakan oleh rutin MessageDlg yang disimpan pada unit Consts. Namun opsi ini menuntut Anda untuk mengkompilasi ulang source unit Delphi, sangat banyak dan beresiko terutama jika terdapat unit yang Anda tidak memiliki source-code nya.

Facade Pattern CreateMessageDialog
Alternatif yang lebih elegan adalah dengan membuat facade pattern dari fungsi CreateMessageDialog yang boleh jadi merupakan inti dari pembuatan kotak dialog. Kotak dialog dapat lebih variatif, seperti yang ditunjukkan oleh rekan Wisnu Widiarta pada tulisannya: classIndonesianDialog.

Nah.. menurut Anda saya menggunakan teknik yang mana? hmm tidak satupun, saya menggunakan teknik dan pendekatan yang berbeda, yaitu mengubah teks yang digunakan oleh MessageDlg di memori pada saat runtime.

Mengapa Modifikasi Memori ?
Tentu saja alasan saya modifikasi memori adalah saya tidak perlu susah payah membangun dari awal (built from scratch), memodifikasi source dan mengkompilasi ulang dan saya tidak perlu membuat facade pattern dari CreateMessageDlg. Saya cukup sekali saja mengganti teks yang digunakan oleh MessageDlg pada saat runtime, hasil modifikasi akan terus berlaku sampai aplikasi ditutup dan tentu saja tetap dengan memanggil fungsi MessageDlg. Dan hasilnya cukup efektif.

Langkah Pertama
Langkah pertama meng-Indonesia-kan MessageDlg adalah dengan menentukan dan mendeklarasikan pesan teks baru yang akan digunakan pada MessageDlg. Selengkapnya mengenai konstanta teks yang digunakan dapat disimak pada unit consts.pas. Sebagai petunjuk, konstanta yang terkait dengan MessageDlg adalah konstanta yang mengandung awalan (prefix) SMsgDlg. Berikut pendeklarasian konstanta yang baru:

const
  _NewSMsgDlgWarning = 'Peringatan';
  _NewSMsgDlgError = 'Kesalahan';
  _NewSMsgDlgInformation = 'Informasi';
  _NewSMsgDlgConfirm = 'Konfirmasi';
  _NewSMsgDlgYes = '&Ya';
  _NewSMsgDlgNo = '&Tidak';
  _NewSMsgDlgOK = 'OK';
  _NewSMsgDlgCancel = 'Batal';
  _NewSMsgDlgHelp = '&Panduan';
  _NewSMsgDlgHelpNone = 'Panduan tidak tersedia';
  _NewSMsgDlgHelpHelp = 'Panduan';
  _NewSMsgDlgAbort = '&Batal';
  _NewSMsgDlgRetry = '&Ulang';
  _NewSMsgDlgIgnore = 'A&cuh';
  _NewSMsgDlgAll = '&Semua';
  _NewSMsgDlgNoToAll = 'T&idak untuk Semua';
  _NewSMsgDlgYesToAll = 'Ya untuk S&emua';

Yang Kedua
Nah, disinilah bagian yang paling menarik, yaitu pembuatan kode untuk memanipulasi isi memori, terutama yang berkaitan dengan teks pada MessageDlg.

 1| procedure ReplaceResourceString(RStringRec: PResStringRec; AString: PChar);
 2| var
 3|   OldProtect: Cardinal;
 4| begin
 5|   if RStringRec = nil then Exit;
 6|   if VirtualProtect(RStringRec, SizeOf(RStringRec^), PAGE_EXECUTE_READWRITE, OldProtect) then
 7|   begin
 8|     RStringRec^.Identifier := Integer(AString);
 9|     VirtualProtect(RStringRec, SizeOf(RStringRec^), OldProtect, @OldProtect);
10|   end;
11| end;

Prosedur ReplaceResourceString memiliki 2 parameter. Parameter 1 bertipe PResStringRec, yaitu pointer untuk resource-string teks standar yang digunakan oleh MessageDlg. Sedangkan parameter 2 bertipe PChar, berisi teks yang akan digunakan untuk memodifikasi MessageDlg.

Pada baris 6 dan 9 terdapat rutin WindowsAPI VirtualProtect. API ini digunakan untuk mengubah proteksi akses suatu blok memori, apakah hanya baca saja, tulis saja, baca-tulis dan sebagainya. Berikut kutipan dari dokumentasi VirtualProtect.

The VirtualProtect function changes the access protection on a region of committed pages in the virtual address space of the calling process.

BOOL VirtualProtect(
LPVOID lpAddress, // address of region of committed pages
DWORD dwSize, // size of the region
DWORD flNewProtect, // desired access protection
PDWORD lpflOldProtect // address of variable to get old protection
);

Return Values

If the function succeeds, the return value is nonzero.
If the function fails, the return value is zero. To get extended error information, call GetLastError.

Penggunaan VirtualProtect pada baris 6 bertujuan untuk mengubah proteksi akses blok memori menjadi baca-tulis pada alamat yang ditunjuk, dalam hal ini alamat resource-string tertentu. Hal ini dilakukan untuk memastikan bahwa blok memori tersebut dapat dimodifikasi. Baris 8 digunakan untuk mengubah teks pesan pada resource-string yang ditunjuk. Sedangkan pada baris 9 digunakan untuk mengembalikan proteksi akses blok memori sebelum modifikasi.

Terapkan Modifikasi
Tentu saja prosedur ReplaceResourceString tidak hanya sebatas dideklarasikan, namun harus digunakan. Agar efek modifikasi teks dapat langsung diterapkan, maka pemanggilan prosedur dilakukan pada bagian initialization unit.

initialization
  ReplaceResourceString(@SMsgDlgWarning, _NewSMsgDlgWarning);
  ReplaceResourceString(@SMsgDlgError, _NewSMsgDlgError);
  ReplaceResourceString(@SMsgDlgInformation, _NewSMsgDlgInformation);
  ReplaceResourceString(@SMsgDlgConfirm, _NewSMsgDlgConfirm);
  ReplaceResourceString(@SMsgDlgYes, _NewSMsgDlgYes);
  ReplaceResourceString(@SMsgDlgNo, _NewSMsgDlgNo);
  ReplaceResourceString(@SMsgDlgOK, _NewSMsgDlgOK);
  ReplaceResourceString(@SMsgDlgCancel, _NewSMsgDlgCancel);
  ReplaceResourceString(@SMsgDlgHelp, _NewSMsgDlgHelp);
  ReplaceResourceString(@SMsgDlgHelpNone, _NewSMsgDlgHelpNone);
  ReplaceResourceString(@SMsgDlgHelpHelp, _NewSMsgDlgHelpHelp);
  ReplaceResourceString(@SMsgDlgAbort, _NewSMsgDlgAbort);
  ReplaceResourceString(@SMsgDlgRetry, _NewSMsgDlgRetry);
  ReplaceResourceString(@SMsgDlgIgnore, _NewSMsgDlgIgnore);
  ReplaceResourceString(@SMsgDlgAll, _NewSMsgDlgAll);
  ReplaceResourceString(@SMsgDlgNoToAll, _NewSMsgDlgNoToAll);
  ReplaceResourceString(@SMsgDlgYesToAll, _NewSMsgDlgYesToAll);

end.

Sediakan Demo
Selanjutnya, persiapkan demo MessageDlg generator untuk menguji apakah modifikasi yang dilakukan berjalan dengan baik.

procedure TfrmDialogIndonesia.btnTampilClick(Sender: TObject);
var
  JenisDialog   : TMsgDlgType;
  PilihanTombol : set of TMsgDlgBtn;
  I             : Integer;
begin
  JenisDialog := TMsgDlgType(rgJenisDialog.ItemIndex);
  PilihanTombol := [];
  for I := 0 to chklbPilihanTombol.Count - 1 do
    if chklbPilihanTombol.Checked[I] then Include(PilihanTombol, TMsgDlgBtn(I));
  MessageDlg(mmoPesan.Text, JenisDialog, PilihanTombol, 0);
end;

Full .pas Code
Berikut kode kustomisasi MessageDlg selengkapnya:

{-----------------------------------------------------------------------------
The contents of this file are subject to the Mozilla Public License
Version 1.1 (the "License"); you may not use this file except in compliance
with the License. You may obtain a copy of the License at
http://www.mozilla.org/MPL/MPL-1.1.html

Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
the specific language governing rights and limitations under the License.

The Original Code is: DialogIndonesia.pas, released on 2007-10-18

The Initial Developer of the Original Code is Bayu Prasetio
Portions created by Bayu Prasetio are Copyright (C) 2007 Bayu Prasetio.
All Rights Reserved.
-----------------------------------------------------------------------------}

unit DialogIndonesia;

interface

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

type
  TfrmDialogIndonesia = class(TForm)
    StatusBar1: TStatusBar;
    rgJenisDialog: TRadioGroup;
    gbPilihanTombol: TGroupBox;
    chklbPilihanTombol: TCheckListBox;
    GroupBox2: TGroupBox;
    mmoPesan: TMemo;
    bvTombol: TBevel;
    btnTampil: TButton;
    btnKeluar: TButton;
    procedure btnTampilClick(Sender: TObject);
    procedure btnKeluarClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frmDialogIndonesia: TfrmDialogIndonesia;

implementation

{$R *.dfm}

uses
  Consts;

procedure TfrmDialogIndonesia.btnKeluarClick(Sender: TObject);
begin
  Close;
end;

procedure TfrmDialogIndonesia.btnTampilClick(Sender: TObject);
var
  JenisDialog   : TMsgDlgType;
  PilihanTombol : set of TMsgDlgBtn;
  I             : Integer;
begin
  JenisDialog := TMsgDlgType(rgJenisDialog.ItemIndex);
  PilihanTombol := [];
  for I := 0 to chklbPilihanTombol.Count - 1 do
    if chklbPilihanTombol.Checked[I] then Include(PilihanTombol, TMsgDlgBtn(I));
  MessageDlg(mmoPesan.Text, JenisDialog, PilihanTombol, 0);
end;

//------------------------------------------------------------------------------

const
  _NewSMsgDlgWarning = 'Peringatan';
  _NewSMsgDlgError = 'Kesalahan';
  _NewSMsgDlgInformation = 'Informasi';
  _NewSMsgDlgConfirm = 'Konfirmasi';
  _NewSMsgDlgYes = '&Ya';
  _NewSMsgDlgNo = '&Tidak';
  _NewSMsgDlgOK = 'OK';
  _NewSMsgDlgCancel = 'Batal';
  _NewSMsgDlgHelp = '&Panduan';
  _NewSMsgDlgHelpNone = 'Panduan tidak tersedia';
  _NewSMsgDlgHelpHelp = 'Panduan';
  _NewSMsgDlgAbort = '&Batal';
  _NewSMsgDlgRetry = '&Ulang';
  _NewSMsgDlgIgnore = 'A&cuh';
  _NewSMsgDlgAll = '&Semua';
  _NewSMsgDlgNoToAll = 'T&idak untuk Semua';
  _NewSMsgDlgYesToAll = 'Ya untuk S&emua';


{-- taken from bpCodeReplacement.pas by Bayu Prasetio}
procedure ReplaceResourceString(RStringRec: PResStringRec; AString: PChar);
var
  OldProtect: Cardinal;
begin
  if RStringRec = nil then Exit;
  if VirtualProtect(RStringRec, SizeOf(RStringRec^), PAGE_EXECUTE_READWRITE, OldProtect) then
  begin
    RStringRec^.Identifier := Integer(AString);
    VirtualProtect(RStringRec, SizeOf(RStringRec^), OldProtect, @OldProtect);
  end;
end;

initialization
  ReplaceResourceString(@SMsgDlgWarning, _NewSMsgDlgWarning);
  ReplaceResourceString(@SMsgDlgError, _NewSMsgDlgError);
  ReplaceResourceString(@SMsgDlgInformation, _NewSMsgDlgInformation);
  ReplaceResourceString(@SMsgDlgConfirm, _NewSMsgDlgConfirm);
  ReplaceResourceString(@SMsgDlgYes, _NewSMsgDlgYes);
  ReplaceResourceString(@SMsgDlgNo, _NewSMsgDlgNo);
  ReplaceResourceString(@SMsgDlgOK, _NewSMsgDlgOK);
  ReplaceResourceString(@SMsgDlgCancel, _NewSMsgDlgCancel);
  ReplaceResourceString(@SMsgDlgHelp, _NewSMsgDlgHelp);
  ReplaceResourceString(@SMsgDlgHelpNone, _NewSMsgDlgHelpNone);
  ReplaceResourceString(@SMsgDlgHelpHelp, _NewSMsgDlgHelpHelp);
  ReplaceResourceString(@SMsgDlgAbort, _NewSMsgDlgAbort);
  ReplaceResourceString(@SMsgDlgRetry, _NewSMsgDlgRetry);
  ReplaceResourceString(@SMsgDlgIgnore, _NewSMsgDlgIgnore);
  ReplaceResourceString(@SMsgDlgAll, _NewSMsgDlgAll);
  ReplaceResourceString(@SMsgDlgNoToAll, _NewSMsgDlgNoToAll);
  ReplaceResourceString(@SMsgDlgYesToAll, _NewSMsgDlgYesToAll);

end.

Dan berikut salah satu aksi dari kode di atas.
MessagDlg ala Indonesia

Source Code: MessageDlgIndonesia.7z

Semoga bermanfaat.

Categories: Delphi, Did You Know

Delphi Product SKU Related Functions

September 24, 2007 Leave a comment

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’.

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:

SKU Demo

{
  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:

Check SKU pada Delphi7 Ent
Aksi tombol ‘Check SKU’ pada Delphi 7 Enterprise

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

Force Call Professional Function(RPR) pada Delphi7 Ent
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.

Check SKU pada Turbo Delphi 2006 Professional
Aksi tombol ‘Check SKU’ pada Turbo Delphi 2006 Professional

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

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

Semoga bermanfaat.

Categories: Delphi, Did You Know