The Spirit of Delphi

Boyer-Moore Horspool return all occurrences in one go

2011-05-09T01:12:00.000+03:00

First I would like to say that I'm sorry for not posting for quite some time now, but thanks to Simon H. who found a bug in original algorithm found here, I've managed to also extend the function to return all occurrences of a pattern in a string, without further introduction here's the code!

type
  TFSResults = array of Integer;

function FindStringMulti(const Value, Pattern: string;
  const CaseSensitive: Boolean = True;
  const StartPos: Integer = 1): TFSResults;
var
  Index: Integer;
  jIndex: Integer;
  kIndex: Integer;
  LLenPattern: Integer;
  LLenValue: Integer;
  LSkipTable: array[Char] of Integer;
  LChar: Char;

    function __SameChar: Boolean;
    begin
      if CaseSensitive then
        Result := (Value[Index] = Pattern[jIndex])
      else
        Result := (CompareText(Value[Index], Pattern[jIndex]) = 0);
    end; // function __SameChar: Boolean;

begin
  LLenPattern := Length(Pattern);
  if LLenPattern = 0 then
    Exit;
  for LChar := Low(Char) to High(Char) do
    LSkipTable[LChar] := LLenPattern;
  if CaseSensitive then begin
    for kIndex := 1 to LLenPattern -1 do
      LSkipTable[Pattern[kIndex]] := LLenPattern -kIndex;
  end else begin
    for kIndex := 1 to LLenPattern -1 do
      LSkipTable[Windows.CharLower(@Pattern[kIndex])^] := LLenPattern -kIndex;
  end; // if CaseSensitive then begin
  kIndex := LLenPattern + (StartPos -1);
  LLenValue := Length(Value);
  while (kIndex <= LLenValue) do begin
    Index := kIndex;
    jIndex := LLenPattern;
    while (jIndex >= 1) do begin
      if __SameChar then begin
        jIndex := jIndex -1;
        Index := Index -1;
      end else
        jIndex := -1;
      if jIndex = 0 then begin
        SetLength(Result, Length(Result) +1);
        Result[High(Result)] := Index +1;
        jIndex := -1;
      end; // if jIndex = 0 then begin
      kIndex := kIndex + LSkipTable[Value[kIndex]];
    end; // while (jIndex >= 1) do begin
  end; // while (kIndex <= LLenValue) do begin
end;

Enjoy!

Remember: anything but random!!

2011-02-05T00:34:00.001+02:00

...as I was saying on December 13th 2010: „Politics is anything but random¯...
Well... here's something new Lawyers for WikiLeaks founder Julian Assange have set up a Facebook page asking for donations to his legal defense fund.(source: CNN)

Basically, the reason for this post is that I want to remind some of you the fact that Wikileaks is a total hoax, as I stated before... no real leaks were actually released and if there will be any then it means that the Internet will be regulated because of „national/international/interracial/etc. security threat¯ -- you know the two towers that were actually 3(three, tres, trei, drei) and then the no warrant thingy? -- but yet, the entire world lost it's focus on the real matters like: the economy, tens of millions of unemployed around the world, people struggling to survive and other unimportant shit like that... -- I hope you can smell my irony!!

Oh and another thing regarding Egypt and Tunisia, I hope they won't have to deal with what Zimbabwe had to... keep IMF out of your boarders!

P.S. Big shout out to 198.81.128.[xxx].

Breaking News: 1st November 2011 RAD Studio deal!

2011-02-02T16:52:00.002+02:00

Here's something that leaked from Embarcadero's future plans:

As of 1st November 2011 Embarcadero is proud to announce the release of Embarcadero RAD Studio XE Second Edition for as low as $100,— per year developer license. We will also include some new community based free services for registered customers, the services are: ednMigrate, ednBlogger, ednHelp.

What is included in the Embarcadero RAD Studio XE Second Edition:
- Delphi XE SE
- C++ Builder XE SE
- Rad PHP XE SE
- Delphi Prism XE SE
- cross platform: Windows, Mac and Linux
- full source code for VCL, RTL
- over 200 demo applications to help you get started
- latest updates included in the license

What is ednMigrate:
ednMigrate is a new community based service available for Embarcadero registered customers that will help you migrate your code from a earlier version of Delphi for example to the latest, you don't have to worry anymore about code compatibility.
You can access ednMigrate at http://ednmigrate.embarcadero.com/ and log in using your Embarcadero customer account.

What is ednBlogger:
We know that you want to share your knowledge with other developers, therefore Embarcadero will host your blog free of charge(applicable for customers only) for any Embarcadero product.
You can access ednBlogger at http://ednblogger.embarcadero.com/ and log in using your Embarcadero customer account.

What is ednHelp:
ednHelp is a new community based service available for Embarcadero registered customers that will host questions and answers related to application development, you can ask and answer as many questions as you like, the service is free of charge for all customers.
You can access ednHelp at http://ednhelp.embarcadero.com/ and log in using your Embarcadero customer account.

We have done everything we could in order to provide you with best prices for independent developers, students, new companies and existing customers:
Here are our latest prices:

Target Price

Independent Developers $200,—/year

Students $100,—/year

New companies $100,—/developer first year and $150,—/year starting from 2nd year

Existing customers $150,—/year

Schools $50,—/year

If you would like to do a test drive of any of our products before purchasing you can do so by navigating to http://testdrive.embarcadero.com/ select a product to download and don't forget that you can always write us a feedback at http://testdrive.embarcadero.com/feedback/ if you care to help us improve our services.

Because Embarcadero truly cares about it's customers, as of 1st February 2012 we will hold conferences all around the world so that developers can have a taste of latest technologies or share their knowledge, this is also a good opportunity for new businesses to find partners or students and independent developers to find jobs.

OK, OK you got me, it's NOT true, unfortunately... but it would be nice if Embarcadero would do something similar not the "Starter edition" stuff... which I personally disagree with it, first because it comes without source code or debugger(ewww...) and second because the price is still pretty high for students for example.
Personal appeal to Embarcadero, let's support schools and students shall we guys?! in some schools in Romania the pascal language is STILL present, however I'm NOT sure if that will be true in 1 or 2 years from now, given the fact that Microsoft is doing a terrific job spreading it's software all around the world, I would NOT be surprised if they will have Visual Studio in most schools.

And another thing, I get more than 60% of my blog hits from searches like "Delphi distiller", "Delphi XE distiller" and similar keywords, what does THAT mean to Embarcadero?! shit load of customers and money TOTALLY WASTED, is Embarcadero that rich?! probably...

One more thing, before people will start criticise me, please DO NOT THINK that $140,— per start edition or whatever the price is or will be is NOT a lot of money, you don't take into account countries that have thousands of Delphi developers which earn ~$500,—/month or less, so yes $140,— might not be a lot for US or European citizens but for other parts of the world it is.

Laptop specific functions

2011-02-01T07:44:00.001+02:00

First I would like to thank each and every one of the developers from stackoverflow who helped me out in detecting if application is running on laptop by answering my question.
I have pushed the envelop further by defining some helper functions which retrieves laptop specific information and some other as well, so without further introduction here's the unit that I've wrote, feel free to use it in commercial and/or personal applications AT YOUR OWN RISK of course, also if you find some flaws(high probability -- haven't tested enough) please feel free to drop a comment.

unit uDGMobileUtils;

interface

(*******************************************************************************

  Author:
    Dorin Duminica

  Note:
    That Parts of the code are Copyright© of Microsoft Corporation.
    All Rights Reserved.

  Disclaimer:
    Using the following code represents your acknowledgement that YOU TAKE
    FULL RESPONSABILITY of any damage it can and/or might cause to your
    system, country, pets, etc.

  Requirements:
    According to Microsoft the following code should work starting from
    Windows 2000 Professional and Server

*******************************************************************************)

uses
  Windows;

{$Z4} // required in order to have 4 byte enumerated type

type
  SYSTEM_POWER_STATE =(
    PowerSystemUnspecified,
    PowerSystemWorking,
    PowerSystemSleeping1,
    PowerSystemSleeping2,
    PowerSystemSleeping3,
    PowerSystemHibernate,
    PowerSystemShutdown,
    PowerSystemMaximum);

{$Z1} // restore enumerated type to 1 byte

const
  SYSTEM_POWER_STATE_NAMES: array[SYSTEM_POWER_STATE] of string = (
    'Unspecified',
    'Working',
    'Sleeping 1',
    'Sleeping 2',
    'Sleeping 3',
    'Hibernate',
    'Shutdown',
    'Maximum');

type
  BATTERY_REPORTING_SCALE = record
    Granularity: ULONG;
    Capacity: ULONG;
  end;

  PBATTERY_REPORTING_SCALE = ^BATTERY_REPORTING_SCALE;

type
  SYSTEM_POWER_CAPABILITIES = record
    // If this member is TRUE, there is a system power button.
    PowerButtonPresent: Boolean;
    // If this member is TRUE, there is a system sleep button.
    SleepButtonPresent: Boolean;
    // If this member is TRUE, there is a lid switch.
    LidPresent: Boolean;
    // for S1 —> S5 check microsoft site
    SystemS1: Boolean;
    SystemS2: Boolean;
    SystemS3: Boolean;
    SystemS4: Boolean;
    SystemS5: Boolean;
    // If this member is TRUE, the operating system supports power off state S5 (soft off).
    HiberFilePresent: Boolean;
    // If this member is TRUE, the system supports wake capabilities.
    FullWake: Boolean;
    // If this member is TRUE, the system supports video display dimming capabilities.
    VideoDimPresent: Boolean;
    // If this member is TRUE, the system supports APM BIOS power management features.
    ApmPresent: Boolean;
    // If this member is TRUE, there is an uninterruptible power supply (UPS).
    UpsPresent: Boolean;
    // If this member is TRUE, the system supports thermal zones.
    ThermalControl: Boolean;
    // If this member is TRUE, the system supports processor throttling.
    ProcessorThrottle: Boolean;
    // The minimum level of system processor throttling supported,
    // expressed as a percentage.
    ProcessorMinThrottle: UCHAR;
    // The maximum level of system processor throttling supported,
    // expressed as a percentage.
    ProcessorMaxThrottle: UCHAR;
    // If this member is TRUE, the system supports the hybrid sleep state.
    // Windows Server 2003 and Windows XP:  Hybrid sleep is not supported.
    // Windows 2000:  This member is not supported.
    FastSystemS4: Boolean;
    // reserved
    spare2: array [0 .. 3] of UCHAR;
    // If this member is TRUE, the system supports allowing the removal of power
    // to fixed disk devices.
    DiskSpinDown: Boolean;
    // reserved
    spare3: array [0 .. 7] of UCHAR;
    // If this member is TRUE, there are one or more batteries in the system.
    SystemBatteriesPresent: Boolean;
    // If this member is TRUE, the system batteries are short-term.
    // Short-term batteries are used in uninterruptible power supplies (UPS).
    BatteriesAreShortTerm: Boolean;
    // A BATTERY_REPORTING_SCALE structure that contains information about
    // how system battery metrics are reported.
    BatteryScale: array [0 .. 2] of BATTERY_REPORTING_SCALE;
    // The lowest system sleep state (Sx) that will generate a wake event when
    // the system is on AC power. This member must be one of the
    // SYSTEM_POWER_STATE enumeration type values.
    AcOnLineWake: SYSTEM_POWER_STATE;
    // The lowest system sleep state (Sx) that will generate a wake event via
    // the lid switch. This member must be one of the SYSTEM_POWER_STATE
    // enumeration type values.
    SoftLidWake: SYSTEM_POWER_STATE;
    // To wake the computer using the RTC, the operating system must also
    // support waking from the sleep state the computer is in when the RTC
    // generates the wake event. Therefore, the effective lowest sleep state
    // from which an RTC wake event can wake the computer is the lowest sleep
    // state supported by the operating system that is equal to or higher than
    // the value of RtcWake. To determine the sleep states that the operating
    // system supports, check the SystemS1, SystemS2, SystemS3, and SystemS4 members.
    RtcWake: SYSTEM_POWER_STATE;
    // The minimum allowable system power state supporting wake events.
    // This member must be one of the SYSTEM_POWER_STATE enumeration type values.
    // Note that this state may change as different device drivers are
    // installed on the system.
    MinDeviceWakeState: SYSTEM_POWER_STATE;
    // The default system power state used if an application calls
    // RequestWakeupLatency with LT_LOWEST_LATENCY. This member must be one of
    // the SYSTEM_POWER_STATE enumeration type values.
    DefaultLowLatencyWake: SYSTEM_POWER_STATE;
  end;

  PSYSTEM_POWER_CAPABILITIES = ^SYSTEM_POWER_CAPABILITIES;

type
  TACLineStatus = (
    // battery
    acsOffline = 0,
    // plugged in
    acsOnline = 1,
    acsUnknown = 255);

type
  TBatteryState = (
    // High—the battery capacity is at more than 66 percent
    bsHigh = 1,
    // Low—the battery capacity is at less than 33 percent
    bsLow = 2,
    // Critical—the battery capacity is at less than five percent
    bsCritical = 4,
    bsCharging = 8,
    bsNoSystemBattery = 128,
    // Unknown status—unable to read the battery flag information
    bsUnknown = 255);

  TBatteryStatus = set of TBatteryState;

  function GetPwrCapabilities(lpSystemPowerCapabilities: PSYSTEM_POWER_CAPABILITIES): Boolean; stdcall;
  function IsAdminOverrideActive: Boolean; stdcall;
  function IsPwrHibernateAllowed: Boolean; stdcall;
  function IsPwrShutdownAllowed: Boolean; stdcall;
  function IsPwrSuspendAllowed: Boolean; stdcall;

  // utility
  function IsLidPresent: Boolean;
  function IsRunningMobile: Boolean;
  function IsRunningOnBattery: Boolean;
  function IsPowerBtnPresent: Boolean;
  function IsApmPresent: Boolean;
  function IsUpsPresent: Boolean;
  function IsThermalControl: Boolean;
  function GetACLineStatus: TACLineStatus;
  function GetACLineStatusName(const AACLineStatus: TACLineStatus): string;
  function GetBatteryStatus: TBatteryStatus;
  function GetBatteryStateName(const ABatteryState: TBatteryState): string;
  function GetBatteryStatusStr(const ABatteryState: TBatteryStatus;
    const ADelimiter: Char = ','): string;
  function GetBatteryLifePercent: Byte;
  function GetBatteryLifeTime: DWORD;
  function GetBatteryLifeTimeFull: DWORD;
  function GetNumberOfProcessors: DWORD;
  function GetSystemPowerStateName(const ASystemPowerState: SYSTEM_POWER_STATE): string;

implementation

uses
  SysUtils,
  Classes;

const
  powrproflib = 'powrprof.dll';

function GetPwrCapabilities(lpSystemPowerCapabilities: PSYSTEM_POWER_CAPABILITIES): Boolean; external powrproflib name 'GetPwrCapabilities';
function IsAdminOverrideActive: Boolean; external powrproflib name 'IsAdminOverrideActive';
function IsPwrHibernateAllowed: Boolean; external powrproflib name 'IsPwrHibernateAllowed';
function IsPwrShutdownAllowed: Boolean; external powrproflib name 'IsPwrShutdownAllowed';
function IsPwrSuspendAllowed: Boolean; external powrproflib name 'IsPwrSuspendAllowed';

function IsLidPresent: Boolean;
var
  LSYSTEM_POWER_CAPABILITIES: SYSTEM_POWER_CAPABILITIES;
begin
  Result := GetPwrCapabilities(@LSYSTEM_POWER_CAPABILITIES);
  if Result then
    Result := LSYSTEM_POWER_CAPABILITIES.LidPresent;
end;

function IsRunningMobile: Boolean;
begin
  Result := IsLidPresent or IsRunningOnBattery;
end;

function IsRunningOnBattery: Boolean;
begin
  Result := (GetACLineStatus = acsOffline);
end;

function IsPowerBtnPresent: Boolean;
var
  LSYSTEM_POWER_CAPABILITIES: SYSTEM_POWER_CAPABILITIES;
begin
  Result := GetPwrCapabilities(@LSYSTEM_POWER_CAPABILITIES);
  if Result then
    Result := LSYSTEM_POWER_CAPABILITIES.PowerButtonPresent;
end;

function IsApmPresent: Boolean;
var
  LSYSTEM_POWER_CAPABILITIES: SYSTEM_POWER_CAPABILITIES;
begin
  Result := GetPwrCapabilities(@LSYSTEM_POWER_CAPABILITIES);
  if Result then
    Result := LSYSTEM_POWER_CAPABILITIES.ApmPresent;
end;

function IsUpsPresent: Boolean;
var
  LSYSTEM_POWER_CAPABILITIES: SYSTEM_POWER_CAPABILITIES;
begin
  Result := GetPwrCapabilities(@LSYSTEM_POWER_CAPABILITIES);
  if Result then
    Result := LSYSTEM_POWER_CAPABILITIES.UpsPresent;
end;

function IsThermalControl: Boolean;
var
  LSYSTEM_POWER_CAPABILITIES: SYSTEM_POWER_CAPABILITIES;
begin
  Result := GetPwrCapabilities(@LSYSTEM_POWER_CAPABILITIES);
  if Result then
    Result := LSYSTEM_POWER_CAPABILITIES.ThermalControl;
end;

function GetACLineStatus: TACLineStatus;
var
  LSystemPowerStatus: TSystemPowerStatus;
begin
  Result := acsUnknown;
  if GetSystemPowerStatus(LSystemPowerStatus) then
    Result := TACLineStatus(LSystemPowerStatus.ACLineStatus);
end;

function GetACLineStatusName(const AACLineStatus: TACLineStatus): string;
begin
  Result := 'Unknown';
  case AACLineStatus of
    acsOffline: Result := 'Offline';
    acsOnline: Result := 'Online';
  end; // case AACLineStatus of
end;

function GetBatteryStatus: TBatteryStatus;
var
  LSystemPowerStatus: TSystemPowerStatus;

    procedure CheckState(const ABatteryState: TBatteryState);
    begin
      if (LSystemPowerStatus.BatteryFlag and Ord(ABatteryState)) = Ord(ABatteryState) then
        Include(Result, ABatteryState);
    end; // procedure CheckState(const ABatteryState: TBatteryState);

begin
  Result := [];
  if GetSystemPowerStatus(LSystemPowerStatus) then begin
    CheckState(bsHigh);
    CheckState(bsLow);
    CheckState(bsCritical);
    CheckState(bsCharging);
    CheckState(bsNoSystemBattery);
    CheckState(bsUnknown);
  end else
    Result := [bsUnknown];
end;

function GetBatteryStateName(const ABatteryState: TBatteryState): string;
begin
  case ABatteryState of
    bsHigh: Result := 'High';
    bsLow: Result := 'Low';
    bsCritical: Result := 'Critical';
    bsCharging: Result := 'Charging';
    bsNoSystemBattery: Result := 'No system battery';
    bsUnknown: Result := 'Unknown';
  end; // case ABatteryState of
end;

function GetBatteryStatusStr(const ABatteryState: TBatteryStatus;
  const ADelimiter: Char): string;
var
  LBatteryState: TBatteryState;
  LNames: TStringList;
begin
  Result := EmptyStr;
  LNames := TStringList.Create;
  try
    LNames.Delimiter := ADelimiter;
    for LBatteryState in ABatteryState do
      LNames.Add(GetBatteryStateName(LBatteryState));
    Result := LNames.DelimitedText;
  finally
    FreeAndNil(LNames);
  end; // tryf
end;

function GetBatteryLifePercent: Byte;
var
  LSystemPowerStatus: TSystemPowerStatus;
begin
  Result := 0;
  if GetSystemPowerStatus(LSystemPowerStatus) then
    // The percentage of full battery charge remaining.
    // This value in the range 0 to 100 or 255 if status is unknown.
    Result := LSystemPowerStatus.BatteryLifePercent;
end;

function GetBatteryLifeTime: DWORD;
var
  LSystemPowerStatus: TSystemPowerStatus;
begin
  Result := DWORD(-1);
  if GetSystemPowerStatus(LSystemPowerStatus) then
    // The number of seconds of battery life remaining,
    // or –1 if remaining seconds are unknown.
    Result := LSystemPowerStatus.BatteryLifeTime;
end;

function GetBatteryLifeTimeFull: DWORD;
var
  LSystemPowerStatus: TSystemPowerStatus;
begin
  Result := DWORD(-1);
  if GetSystemPowerStatus(LSystemPowerStatus) then
    // The number of seconds of battery life when at full charge,
    // or –1 if full battery lifetime is unknown.
    Result := LSystemPowerStatus.BatteryFullLifeTime;
end;

function GetNumberOfProcessors: DWORD;
var
  LSystemInfo: TSystemInfo;
begin
  GetSystemInfo(LSystemInfo);
  // number of processor means number of threads
  // i.e. a processor with 4 cores can have 8 threads
  Result := LSystemInfo.dwNumberOfProcessors;
end;

function GetSystemPowerStateName(const ASystemPowerState: SYSTEM_POWER_STATE): string;
begin
  Result := SYSTEM_POWER_STATE_NAMES[ASystemPowerState];
end;

end.

How to use it:
a) drop a memo and a button on the form, rename the memo to "edInfo"
b) double-click the button and copy-paste the following code

procedure TForm1.Button1Click(Sender: TObject);

  procedure AddBool(const s: string; const Value: Boolean);
  begin
    edInfo.Lines.Add(Format('%s = %s', [s, BoolToStr(Value, True)]));
  end; // procedure AddBool(const s: string; const Value: Boolean);

  procedure AddString(const s, Value: string);
  begin
     edInfo.Lines.Add(Format('%s = %s', [s, Value]));
  end; // procedure AddString(const s, Value: string);

  procedure AddPercent(const s: string; const Value: Byte);
  begin
    edInfo.Lines.Add(Format('%s = %d%%', [s, Value]));
  end; // procedure AddPercent(const s: string; const Value: Byte);

  procedure AddSeconds(const s: string; const Value: DWORD);
  begin
    edInfo.Lines.Add(Format('%s = %d sec.', [s, Value]));
  end; // procedure AddSeconds(const s: string; const Value: DWORD);

  procedure AddDWord(const s: string; const Value: DWORD);
  begin
    edInfo.Lines.Add(Format('%s = %d', [s, Value]));
  end; // procedure AddDWord(const s: string; const Value: DWORD);

begin
  edInfo.Clear;
  AddBool('IsLidPresent', IsLidPresent);
  AddBool('IsRunningMobile', IsRunningMobile);
  AddBool('IsRunningOnBattery', IsRunningOnBattery);
  AddBool('IsPowerBtnPresent', IsPowerBtnPresent);
  AddBool('IsApmPresent', IsApmPresent);
  AddBool('IsUpsPresent', IsUpsPresent);
  AddBool('IsThermalControl', IsThermalControl);
  AddString('GetACLineStatus', GetACLineStatusName(GetACLineStatus));
  AddString('GetBatteryStatusStr', GetBatteryStatusStr(GetBatteryStatus));
  AddPercent('GetBatteryLifePercent', GetBatteryLifePercent);
  // if GetBatteryLifeTime = -1 it means that laptop is either plugged in OR
  // it is running on battery for a few seconds -- Windows did NOT detect
  // yet or it can't tell for certain how many seconds left
  // also the value might increase in a couple of seconds
  AddSeconds('GetBatteryLifeTime', GetBatteryLifeTime);
  // in my tests GetBatteryLifeTimeFull retrieves only -1 it might have something
  // to do with the fact that my laptop is only a couple of days old
  // or something fails -- I'm NOT 100% sure on this, please feel free to comment
  AddSeconds('GetBatteryLifeTimeFull', GetBatteryLifeTimeFull);
  AddDWord('GetNumberOfProcessors', GetNumberOfProcessors);
end;

c) and last but not least HAVE FUN!!

Fun with DWM

2011-01-26T09:16:00.001+02:00

Sooo... you like the "Peak preview" of Windows 7?! If so, then I bet you would want to play with it in your Delphi application, correct?! cool! here's how you do it in a few steps:

a) create a new VCL forms application;
b) add Dwmapi to uses clause;
c) copy and paste and paste from the following code;

unit Unit1;

interface

uses
  Windows,
  Messages,
  SysUtils,
  Variants,
  Classes,
  Graphics,
  Controls,
  Forms,
  Dialogs,
  Dwmapi,
  StdCtrls,
  ExtCtrls,
  Generics.Collections;

type
  TDGWindow = record
    StrCaption: string;
    StrClassName: string;
    Handle: HWND;
  end;

  TDGWindowList = class(TList);

type
  TfrmMain = class(TForm)
    Panel1: TPanel;
    lbWindows: TListBox;
    bnRefresh: TButton;
    bnPreview: TButton;
    procedure FormDestroy(Sender: TObject);
    procedure bnRefreshClick(Sender: TObject);
    procedure bnPreviewClick(Sender: TObject);
    procedure lbWindowsDblClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    FWindowList: TDGWindowList;
    FTumbnail: HTHUMBNAIL;
    FPreviewEnabled: Boolean;
  private
    procedure PreviewWindow(const ASource, ADest: HWND; const ARect: TRect);
    procedure PreviewDisable;
  public
    { Public declarations }
  end;

var
  frmMain: TfrmMain;

implementation

{$R *.dfm}

function FindWindowExtd(partialTitle: string): HWND;
var
  hWndTemp: hWnd;
  iLenText: Integer;
  cTitletemp: array [0..254] of Char;
  sTitleTemp: string;
begin
  hWndTemp := FindWindow(nil, nil);
  while hWndTemp <> 0 do begin
    iLenText := GetWindowText(hWndTemp, cTitletemp, 255);
    sTitleTemp := cTitletemp;
    sTitleTemp := UpperCase(copy( sTitleTemp, 1, iLenText));
    partialTitle := UpperCase(partialTitle);
    if pos( partialTitle, sTitleTemp ) <> 0 then
      Break;
    hWndTemp := GetWindow(hWndTemp, GW_HWNDNEXT);
  end;
  result := hWndTemp;
end;

procedure TfrmMain.bnPreviewClick(Sender: TObject);
var
  Index: Integer;
  LRect: TRect;
begin
  Index := lbWindows.ItemIndex;
  if Index < 0 then
    Exit;
  LRect := Rect(5, 5,
    Self.Width -Panel1.Width -20,
    Self.Height -10);
  PreviewWindow(
    FWindowList[Index].Handle,
    Self.Handle,
    LRect);
end;

procedure TfrmMain.bnRefreshClick(Sender: TObject);
var
  LHDesktop: HWND;
  LHWindow: HWND;
  LHParent: HWND;
  LExStyle: DWORD;
  LBuffer: array[0..255] of char;
  LWindow: TDGWindow;
begin
  lbWindows.Items.BeginUpdate;
  lbWindows.Items.Clear;
  FWindowList.Clear;
  LHDesktop := GetDeskTopWindow;
  LHWindow := GetWindow(LHDesktop, GW_CHILD);
  while LHWindow <> 0 do begin
    LWindow.Handle := LHWindow;
    GetWindowText(LHWindow, LBuffer, Length(LBuffer));
    LHParent := GetWindowLong(LHWindow, GWL_HWNDPARENT);
    LExStyle := GetWindowLong(LHWindow, GWL_EXSTYLE);
    if IsWindowVisible(LHWindow) and (LBuffer <> EmptyStr) and
        ((LHParent = 0) or (LHParent = LHDesktop)) and
        ((LExStyle and WS_EX_TOOLWINDOW = 0) or (LExStyle and WS_EX_APPWINDOW <> 0))
        then begin
      lbWindows.Items.Add(LBuffer);
      LWindow.StrCaption := LBuffer;
      GetClassName(LHWindow, LBuffer, Length(LBuffer));
      LWindow.StrClassName := LBuffer;
      FWindowList.Add(LWindow);
    end; // if IsWindowVisible(LHWindow) and (LBuffer <> EmptyStr) and ...
    LHWindow := GetWindow(LHWindow, GW_HWNDNEXT);
  end; // while LHWindow <> 0 do begin
  lbWindows.Items.EndUpdate;
  if lbWindows.Items.Count > 0 then
    lbWindows.ItemIndex := 0;
end;

procedure TfrmMain.FormCreate(Sender: TObject);
begin
  FPreviewEnabled := False;
  FWindowList := TDGWindowList.Create;
end;

procedure TfrmMain.FormDestroy(Sender: TObject);
begin
  FWindowList.Clear;
  FreeAndNil(FWindowList);
  PreviewDisable;
end;

procedure TfrmMain.lbWindowsDblClick(Sender: TObject);
begin
  bnPreview.Click;
end;

procedure TfrmMain.PreviewDisable;
begin
  if FPreviewEnabled then
    FPreviewEnabled := NOT Succeeded(DwmUnregisterThumbnail(FTumbnail));
end;

procedure TfrmMain.PreviewWindow(const ASource, ADest: HWND; const ARect: TRect);
var
  LResult: HRESULT;
  LThumpProp: DWM_THUMBNAIL_PROPERTIES;
begin
  if NOT DwmCompositionEnabled then begin
    MessageDlg('DWM composition is NOT enabled.', mtWarning, [mbOK], 0);
    Exit;
  end; // if NOT DwmCompositionEnabled then begin
  PreviewDisable;
  FPreviewEnabled := Succeeded(DwmRegisterThumbnail(ADest, ASource, @FTumbnail));
  if FPreviewEnabled then begin
    LThumpProp.dwFlags := DWM_TNP_SOURCECLIENTAREAONLY or DWM_TNP_VISIBLE or
      DWM_TNP_OPACITY or DWM_TNP_RECTDESTINATION;
    LThumpProp.fSourceClientAreaOnly := False;
    LThumpProp.fVisible := True;
    LThumpProp.opacity := 200;
    LThumpProp.rcDestination := ARect;
    LResult := DwmUpdateThumbnailProperties(FTumbnail, LThumpProp);
    FPreviewEnabled := (LResult = S_OK);
  end else
    MessageDlg('Cannot link to window  ' + IntToStr(ASource), mtError, [mbOK], 0);
end;

end.

or you simply download the demo application.
d) have fun!!

uDGVMUtils version 1.1 thanks to Chee Meng

2011-01-15T11:10:00.000+02:00

Thanks to Chee Meng I've added a detection scheme for Virtual Box.
Please let me know of any scenario in which a function fails to return properly so that I can modify the code.

unit uDGVMUtils;

interface

(*******************************************************************************

  uDGVMUtils -- is an attempt to create one of the best virtual machine
    detector methods, feel free to contribute in any way you wish.

  Version 1.1, 2010-01-15

  Copyright© you are free to use it for comercial, private or both purposes

  Contributors:
    Dorin Duminica
    Chee Meng

*******************************************************************************)

type
  TVMWareVersion = (
    vvExpress = 1,
    vvESX,
    vvGSX,
    vvWorkstation,
    vvUnknown,
    vvNative);

const
  VMWARE_VERSION_STRINGS: array [TVMWareVersion] of string = (
    'Express',
    'ESX',
    'GSX',
    'Workstation',
    'Unknown',
    'Native');

type
  TVirtualMachineType = (
    vmNative,
    vmVMWare,
    vmWine,
    vmVirtualPC,
    vmVirtualBox);

const
  VIRTUALMACHINE_STRINGS: array[TVirtualMachineType] of string = (
    'Native',
    'VMWare',
    'Wine',
    'Virtual PC',
    'Virtual Box');

function IsRunningVMWare(var AVMWareVersion: TVMWareVersion): Boolean; overload;
function IsRunningVMWare: Boolean; overload;
function IsRunningWine(var AWineVersion: string): Boolean; overload;
function IsRunningWine: Boolean; overload;
function IsRunningVirtualPC: Boolean;
function IsRunningVBox: Boolean;
function IsRunningVM(var AVMVersion: string): Boolean; overload;
function IsRunningVM: Boolean; overload;

implementation

uses
  SysUtils,
  Windows;

function IsRunningVMWare(var AVMWareVersion: TVMWareVersion): Boolean;
const
  CVMWARE_FLAG = $564D5868;
var
  LFlag: Cardinal;
  LVersion: Cardinal;
begin
  LFlag := 0;
  try
    asm
      push eax
      push ebx
      push ecx
      push edx

      mov eax, 'VMXh'
      mov ecx, 0Ah
      mov dx, 'VX'

      in eax, dx

      mov LFlag, ebx
      mov LVersion, ecx

      pop edx
      pop ecx
      pop ebx
      pop eax
    end;
  except
//  uncomment next two lines if you wish to see exception
//    on E: Exception do
//      ShowMessage(E.message);
  end; // trye
  if LFlag = CVMWARE_FLAG then begin
    Result := True;
    case LVersion of
      1: AVMWareVersion := vvExpress;
      2: AVMWareVersion := vvESX;
      3: AVMWareVersion := vvGSX;
      4: AVMWareVersion := vvWorkstation;
      else
        AVMWareVersion := vvUnknown;
    end
  end else begin
    Result := False;
    AVMWareVersion := vvNative;
  end; // if LFlag = CVMWARE_FLAG then begin
end;

function IsRunningVMWare: Boolean;
var
  LVMWareVersion: TVMWareVersion;
begin
  Result := IsRunningVMWare(LVMWareVersion);
end;

function IsRunningWine(var AWineVersion: string): Boolean;
type
  TWineGetVersion = function: PAnsiChar;{$IFDEF Win32}stdcall;{$ENDIF}
  TWineNTToUnixFileName = procedure (P1: Pointer; P2: Pointer);{$IFDEF Win32}stdcall;{$ENDIF}
var
  LHandle: THandle;
  LWineGetVersion: TWineGetVersion;
  LWineNTToUnixFileName: TWineNTToUnixFileName;
begin
  Result := False;
  AWineVersion := 'Unknown';
  LHandle := LoadLibrary('ntdll.dll');
  if LHandle > 32 then begin
    LWineGetVersion := GetProcAddress(LHandle, 'wine_get_version');
    LWineNTToUnixFileName := GetProcAddress(LHandle, 'wine_nt_to_unix_file_name');
    if Assigned(LWineGetVersion) or Assigned(LWineNTToUnixFileName) then begin
      Result := True;
      if Assigned(LWineGetVersion) then
        AWineVersion := StrPas(LWineGetVersion);
    end; // if Assigned(LWineGetVersion) or ...
    FreeLibrary(LHandle);
  end; // if LHandle > 32 then begin
end;

function IsRunningWine: Boolean;
var
  LWineVersion: string;
begin
  Result := IsRunningWine(LWineVersion);
end;

function IsRunningVirtualPC: Boolean;
asm
  push ebp;
  mov ebp, esp;

  mov ecx, offset @exception_handler;

  push ebx;
  push ecx;

  push dword ptr fs:[0];
  mov dword ptr fs:[0], esp;

  mov ebx, 0; // Flag
  mov eax, 1; // VPC function number

  // call VPC
  db $0F, $3F, $07, $0B

  mov eax, dword ptr ss:[esp];
  mov dword ptr fs:[0], eax;

  add esp, 8;

  test ebx, ebx;

  setz al;

  lea esp, dword ptr ss:[ebp-4];
  mov ebx, dword ptr ss:[esp];
  mov ebp, dword ptr ss:[esp+4];

  add esp, 8;

  jmp @ret1;

  @exception_handler:
  mov ecx, [esp+0Ch];
  mov dword ptr [ecx+0A4h], -1; // EBX = -1 ->; not running, ebx = 0 -> running
  add dword ptr [ecx+0B8h], 4; // ->; skip past the call to VPC
  xor eax, eax; // exception is handled

  @ret1:
end;

function IsRunningVBox: Boolean;

  function Test1: Boolean;
  var
    LHandle: Cardinal;
  begin
    Result := False;
    try
      LHandle := LoadLibrary('VBoxHook.dll');
      Result := (LHandle <> 0);
      if Result then
        FreeLibrary(LHandle);
    except
    end; // trye
  end; // function Test1: Boolean;

  function Test2: Boolean;
  var
    LHandle: Cardinal;
  begin
    Result := False;
    try
      LHandle := CreateFile(
        '\\\\.\\\VBoxMiniRdrDN',
        GENERIC_READ,
        FILE_SHARE_READ,
        NIL,
        OPEN_EXISTING,
        FILE_ATTRIBUTE_NORMAL,
        0);
      Result := (LHandle <> INVALID_HANDLE_VALUE);
      if Result then
        CloseHandle(LHandle);
    except
    end; // trye
  end; // function Test2: Boolean;

begin
  Result := Test1 or Test2;
end;

function IsRunningVM(var AVMVersion: string): Boolean;
begin
  AVMVersion := VIRTUALMACHINE_STRINGS[vmNative];
  Result := True;
  if IsRunningWine then
    AVMVersion := VIRTUALMACHINE_STRINGS[vmWine]
  else
    if IsRunningVMWare then
      AVMVersion := VIRTUALMACHINE_STRINGS[vmVMWare]
    else
      if IsRunningVirtualPC then
        AVMVersion := VIRTUALMACHINE_STRINGS[vmWine]
      else
        if IsRunningVBox then
          AVMVersion := VIRTUALMACHINE_STRINGS[vmVirtualBox]
        else begin
          AVMVersion := VIRTUALMACHINE_STRINGS[vmNative];
          Result := False;
        end;
end;

function IsRunningVM: Boolean;
var
  LVMVersion: string;
begin
  Result := IsRunningVM(LVMVersion);
end;

end.

HAVE FUN

Is your app running in a virtual machine?

2011-01-12T15:01:00.001+02:00

Here's an extremely simple unit that will check if your application is running under VMWare, Wine and or Virtual PC:

unit uDGVMUtils;

interface

type
  TVMWareVersion = (
    vvExpress = 1,
    vvESX,
    vvGSX,
    vvWorkstation,
    vvUnknown,
    vvNative);

const
  VMWARE_VERSION_STRINGS: array [TVMWareVersion] of string = (
    'Express',
    'ESX',
    'GSX',
    'Workstation',
    'Unknown',
    'Native');

type
  TVirtualMachineType = (
    vmNative,
    vmVMWare,
    vmWine,
    vmVirtualPC);

const
  VIRTUALMACHINE_STRINGS: array[TVirtualMachineType] of string = (
    'Native',
    'VMWare',
    'Wine',
    'Virtual PC');

function IsRunningVMWare(var AVMWareVersion: TVMWareVersion): Boolean; overload;
function IsRunningVMWare: Boolean; overload;
function IsRunningWine(var AWineVersion: string): Boolean; overload;
function IsRunningWine: Boolean; overload;
function IsRunningVirtualPC: Boolean;
function IsRunningVM(var AVMVersion: string): Boolean; overload;
function IsRunningVM: Boolean; overload;

implementation

uses
  SysUtils,
  Windows;

function IsRunningVMWare(var AVMWareVersion: TVMWareVersion): Boolean;
const
  CVMWARE_FLAG = $564D5868;
var
  LFlag: Cardinal;
  LVersion: Cardinal;
begin
  LFlag := 0;
  try
    asm
      push eax
      push ebx
      push ecx
      push edx

      mov eax, 'VMXh'
      mov ecx, 0Ah
      mov dx, 'VX'

      in eax, dx

      mov LFlag, ebx
      mov LVersion, ecx

      pop edx
      pop ecx
      pop ebx
      pop eax
    end;
  except
//  uncomment next two lines if you wish to see exception
//    on E: Exception do
//      ShowMessage(E.message);
  end; // trye
  if LFlag = CVMWARE_FLAG then begin
    Result := True;
    case LVersion of
      1: AVMWareVersion := vvExpress;
      2: AVMWareVersion := vvESX;
      3: AVMWareVersion := vvGSX;
      4: AVMWareVersion := vvWorkstation;
      else
        AVMWareVersion := vvUnknown;
    end
  end else begin
    Result := False;
    AVMWareVersion := vvNative;
  end; // if LFlag = CVMWARE_FLAG then begin
end;

function IsRunningVMWare: Boolean;
var
  LVMWareVersion: TVMWareVersion;
begin
  Result := IsRunningVMWare(LVMWareVersion);
end;

function IsRunningWine(var AWineVersion: string): Boolean;
type
  TWineGetVersion = function: PAnsiChar;{$IFDEF Win32}stdcall;{$ENDIF}
  TWineNTToUnixFileName = procedure (P1: Pointer; P2: Pointer);{$IFDEF Win32}stdcall;{$ENDIF}
var
  LHandle: THandle;
  LWineGetVersion: TWineGetVersion;
  LWineNTToUnixFileName: TWineNTToUnixFileName;
begin
  Result := False;
  AWineVersion := 'Unknown';
  LHandle := LoadLibrary('ntdll.dll');
  if LHandle > 32 then begin
    LWineGetVersion := GetProcAddress(LHandle, 'wine_get_version');
    LWineNTToUnixFileName := GetProcAddress(LHandle, 'wine_nt_to_unix_file_name');
    if Assigned(LWineGetVersion) or Assigned(LWineNTToUnixFileName) then begin
      Result := True;
      if Assigned(LWineGetVersion) then
        AWineVersion := StrPas(LWineGetVersion);
    end; // if Assigned(LWineGetVersion) or ...
    FreeLibrary(LHandle);
  end; // if LHandle > 32 then begin
end;

function IsRunningWine: Boolean;
var
  LWineVersion: string;
begin
  Result := IsRunningWine(LWineVersion);
end;

function IsRunningVirtualPC: Boolean;
asm
  push ebp;
  mov ebp, esp;

  mov ecx, offset @exception_handler;

  push ebx;
  push ecx;

  push dword ptr fs:[0];
  mov dword ptr fs:[0], esp;

  mov ebx, 0; // Flag
  mov eax, 1; // VPC function number

  // call VPC
  db $0F, $3F, $07, $0B

  mov eax, dword ptr ss:[esp];
  mov dword ptr fs:[0], eax;

  add esp, 8;

  test ebx, ebx;

  setz al;

  lea esp, dword ptr ss:[ebp-4];
  mov ebx, dword ptr ss:[esp];
  mov ebp, dword ptr ss:[esp+4];

  add esp, 8;

  jmp @ret1;

  @exception_handler:
  mov ecx, [esp+0Ch];
  mov dword ptr [ecx+0A4h], -1; // EBX = -1 ->; not running, ebx = 0 -> running
  add dword ptr [ecx+0B8h], 4; // ->; skip past the call to VPC
  xor eax, eax; // exception is handled

  @ret1:
end;

function IsRunningVM(var AVMVersion: string): Boolean;
begin
  AVMVersion := VIRTUALMACHINE_STRINGS[vmNative];
  Result := True;
  if IsRunningWine then
    AVMVersion := VIRTUALMACHINE_STRINGS[vmWine]
  else
    if IsRunningVMWare then
      AVMVersion := VIRTUALMACHINE_STRINGS[vmVMWare]
    else
      if IsRunningVirtualPC then
        AVMVersion := VIRTUALMACHINE_STRINGS[vmVirtualPC]
      else begin
        AVMVersion := VIRTUALMACHINE_STRINGS[vmNative];        
        Result := False;
      end;
end;

function IsRunningVM: Boolean;
var
  LVMVersion: string;
begin
  Result := IsRunningVM(LVMVersion);
end;

end.

usage:
add uDGVMUtils to uses clause and:
// check if running in a virtual machine
var
LVMVersion: string;
begin
ShowMessageFmt('%s, VM name: %s', [BoolToStr(IsRunningVM(LVMVersion), True), LVMVersion]);
end;

// check if running in wine
var
LWine: Boolean;
LWineVersion: string;
begin
ShowMessageFmt('Wine: %s, Wine ver.: %s', [BoolToStr(IsRunningWine(LWineVersion), True), LWineVersion]);
end;

you get the picture, have fun!!

Client activity information in PostgreSQL

2011-01-08T15:55:00.002+02:00

In most of my projects I use PostgreSQL as database, I'm sure that if you see what you get for free, most of you will turn to it, anyhu' this post is about getting information from database, such as:
- databases to which has connections to it;
- current queries ran on X database and the timestamp when the query was started;
- ID's of processes;
- user name of connected clients;
- port on which each client is connected;
- client IP address;
- based upon above information we can get more special info regarding active connections;

In order to see all of the above, run this query on the database:

SELECT * FROM PG_STAT_ACTIVITY;

The reason I was interested in this kind of information is that from time to time the database structure changes, therefore I need to run queries on previous database structures in order to fulfill latest needs, sooo... in order to upgrade the database I require that NO one else besides my "upgrade" application is connected to the database, therefore I run the following query in order to see to how many connections I have to X database, if the number of connections is greater than 1(if I'm connected to the database, I will be counted as well) then the application will wait until the number of connections to X database reaches 1 and then run the update queries, the query that I'm using is:

SELECT DATNAME AS "Database", COUNT(*) AS "ConnectionCount" FROM PG_STAT_ACTIVITY GROUP BY "Database";

and this will result in showing:

Database	ConnectionCount
X db	2
Y db	70
etc.

Well that's about all that I wanted to point out for now, do you have any special queries you run on a PostgreSQL database and want to share? comment bellow and I will put above this final thought like:
Name:
SQL QUERY

Happy new year!!

2011-01-01T00:38:00.000+02:00

I wish you all a happy new year!!
Saale Nao Mubbarak
Gelukkige nuwe jaar
Gezuar Vitin e Ri
Snorhavor Nor Tari
Kul 'am wa antum bikhair
Sheta Brikhta
Yeni Iliniz Mubarek!
Noki saal mubarrak bibi
Shuvo Nabo Barsho
Bloavezh Mat
×åñòèòà Íîâà Ãîäèíà
Soursdey Chhnam Tmei
FELIÇ ANY NOU
Nuo bazzor bekkunore
Xin Nian Kuai Le
Pace e Salute
Sretna Nova godina!
Blwyddyn Newydd Dda
Šťastný Nový rok
Godt Nytår
Ufaaveri Aa Aharakah Edhen
GELUKKIG NIEUWJAAR!
Kiortame pivdluaritlo
Felican Novan Jaron
Head uut aastat!
MELKAM ADDIS AMET YIHUNELIWO!
RUHUS HADUSH AMET
Onnellista Uutta Vuotta
Bonne Annee
Bliadhna mhath ur
Bo Nadal e Feliz Aninovo
Prosit Neujahr
GILOTSAVT AKHAL TSELS!
Kenourios Chronos
Nutan Varshbhinandan
Hauoli Makahiki Hou
L'Shannah Tovah
Naye Varsha Ki Shubhkamanyen
Sun Leen Fai Lok
Boldog Új Évet Kivánok
Selamat Tahun Baru
Sal -e- no mobarak
Sanah Jadidah
Bliain nua fe mhaise dhuit
Felice anno nuovo
Akimashite Omedetto Gozaimasu
Asegwas Amegaz
Hosa Varushadha Shubhashayagalu
SOMWAKA OMOYIA OMUYA
Snem Thymmai Basuk Iaphi
Sua Sdei tfnam tmei
Saehae Bock Mani ba deu sei yo!
NEWROZ PIROZBE
Laimīgo Jauno Gadu!
Laimingu Naujuju Metu
Sabai dee pee mai
Srekjna Nova Godina
Tratry ny taona
Selamat Tahun Baru
Nveen Varshachy Shubhechcha
Puthuvatsara Aashamsakal
Kum Thar Chibai
Is-Sena t-Tajba
Nawa Barsha ko Shuvakamana
Godt Nyttår
Nua Barshara Subhechha
Nupela yia i go long yu
Masaganang Bayung Banua
Nawai Kall Mo Mubarak Shah
Sal -e- no mobarak
Manigong Bagong Taon!
Szczesliwego Nowego Roku
Feliz Ano Novo
Nave sal di mubarak
AN NOU FERICIT
S Novim Godom
Manuia le Tausaga Fou
Sretna nova godina
Nayou Saal Mubbarak Hoje
Subha Aluth Awrudhak Vewa
Nawan Saal Shala Mubarak Theevay
Stastny Novy rok
sreèno novo leto
Iyo Sanad Cusub Oo Fiican!
Feliz Ano ~Nuevo
Heri Za Mwaka Mpyaº
GOTT NYTT ÅR!
Warsa Enggal
Eniya Puthandu Nalvazhthukkal
Losar Tashi Delek
Noothana samvatsara shubhakankshalu
Sawadee Pee Mai
Yeni Yiliniz Kutlu Olsun
Shchastlyvoho Novoho Roku
Naya Saal Mubbarak Ho
Yangi Yil Bilan
Chuc Mung Tan Nien
Blwyddyn Newydd Dda!

You gotta grow bigger ballz

2010-12-24T05:10:00.000+02:00

I had a few interesting conversations with a few very smart people the past few days and it came to me that I've never posted about an very interesting thing -- some people are afraid to ask some questions because they don't want to be categorized as stupid people or dumb as f**k, etc. -- now I'm pretty sure that some of you out there fall into this category, don't be shy we all been there.

Let's analyze a simple scenario: you are(or someone is) assigned to a new project(either in a company or as a independent contractor) there's a big chance that some parts of the project are harder to understand at first, however some people prefer not to ask 2, 3 or more times if they didn't get it the first time -- HUGE MISTAKE!! why is that a huge mistake?! well there is also a fat chance that you will waste time trying to figure some parts out and you might as well fail to deliver on time(happened to almost any person out there or will happen), however if you had ask the manager/client(s) for more details or simply say "I don't understand this and/or that" you could have win a lot of time and also gain trust(there are quite a few people that do appreciate when others admit that they've lost track of the conversation or something isn't clear -- why? because they can see on the spot that you are truly interested in doing a good job!) -- we all know that time is our biggest enemy(for example a day in my life should have at least 30 hours -- same for my clients, cheers!!).

The above example can be applied anywhere, from factory work to software development to rocket science, you name it...

Now I can see some managers going: some of my people always say "I got this", "I understand", "no need for more details", etc. but they actually don't... well yes, some people needs to be pushed from behind a bit, others can grow some balls over time and say "I haven't been concentrating enough to understand" or "sorry I've lost you at X point in the conversation, can you repeat the last part?" -- but these people are few, I won't make up bullshit percentage, I'm just talking from my past and present experience with people, however I can tell you that the number of people who are afraid to ask or simply don't give a damn is pretty big, maybe too big, but as one of my closest friend and client says

It is what it is, we just got to deal with it...

I would recommend spending some time with this people(coworkers, friends, family) and help them bypass their issues in order to get the best out of them, do NOT under any circumstances call them names just because he/she didn't get something the first, second or even third time, there are a lot of reasons why he/she lost focus:
- personal problems -- most often
- was concentrating on a personal project -- rarely
- something distracted the attention along the conversation -- very often, we are surrounded by a lot of gadgets and blinking LED's that it's pretty easy to lose focus
- etc. you get the point...

I believe the keywords are: "take responsibility" and "have the guts to ask" try to master these two, only good things can come to you.

I also want to cover in a few words the "my boss/manager is an idiot, asks only dumb questions, etc., I don't get why he/she is a boss/manager and I'm just a employee" -- well, I can tell you that they grew some balls over time and as a friend of mine says "they grew thicker skin", if you want to succeed, you really must take everything as it is and step by step get to the end goal.

If you're reading this before January 1st 2011 you really need to get a break, spend some time with your family!!

Merry Christmas and a happy new year to all you coders out there!!

Dynamic web pages with DWScript and IdHTTPServer

2010-12-22T18:22:00.000+02:00

I've finally found some time in my busy schedule to write a new post, this post is about generating dynamic web pages using DWScript(http://www.delphitools.info -- if you find DWScript useful please do not hesitate to donate to Eric, he is doing a wonderful job with DWScript) as script interpreter and IdHTTPServer as HTTP server.
But first let's understand the difference between static and dynamic web pages:
1. Static web pages:
- static web pages are just plain HTML files which will be manually updated by the developer or website owner whenever he wants;
Here's a drawing of the process that takes place in the case of static web pages

2. Dynamic web pages:
- dynamic web pages are similar to static HTML files, however this HTML files also contain script which is interpreted by a script interpreter which can be almost any script interpreter out there, i.e. perl, php, python, ruby, etc. for this example I've used DWScript;
Here's a drawing of the process that takes place in the case of dynamic web pages

as you can see the noticeable difference between static and dynamic web pages is the script interpreter which comes into play just before serving the HTML to the client.

In this post I won't cover the benefits of using dynamic web pages and the possible exploits.

For this post I've modified the HTTP server which I've created for a video tutorial, so here's the updated source of the uClientContext.pas file:

unit uClientContext;

interface

uses
  SysUtils,
  Classes,
  IdBaseComponent,
  IdComponent,
  IdCustomTCPServer,
  IdCustomHTTPServer,
  IdHTTPServer,
  IdContext,
  dwsComp,
  dwsCompiler,
  dwsExprs,
  dwsClassesLibModule,
  dwsMathFunctions,
  dwsStringFunctions,
  dwsStringResult,
  dwsTimeFunctions,
  dwsVariantFunctions,
  dwsHtmlFilter;

type
  TClientContext = class(TIdServerContext)
  private
    FLogStrings: TStrings;
    procedure Log(const s: string);
  public
    procedure HandleRequest(ARequestInfo: TIdHTTPRequestInfo;
      AResponseInfo: TIdHTTPResponseInfo);
    procedure ServeHTMLFile(const AFileName: string;
      ARequestInfo: TIdHTTPRequestInfo;
      AResponseInfo: TIdHTTPResponseInfo);
  public
    property LogStrings: TStrings read FLogStrings write FLogStrings;
  end;

implementation

var
  WebDir: string;

{ TClientContext }

procedure TClientContext.HandleRequest(ARequestInfo: TIdHTTPRequestInfo;
  AResponseInfo: TIdHTTPResponseInfo);
const
  SERROR_404 = 'Error 404 page not found "%s"';
var
  LLocation: string;
begin
  try
    LLocation := ARequestInfo.Document;
    if LLocation <> EmptyStr then begin
      if (LLocation = '/') or (LLocation = '/*') or SameText(LLocation, '/index.html') then
        ServeHTMLFile(WebDir + 'index.html', ARequestInfo, AResponseInfo)
      else begin
        LLocation := WebDir + Copy(LLocation, 2, MaxInt);
        if NOT SameText(ExtractFileExt(LLocation), '.html') then
          LLocation := LLocation + '.html';
        if FileExists(LLocation) then
          ServeHTMLFile(LLocation, ARequestInfo, AResponseInfo)
        else
          AResponseInfo.ContentText := Format(SERROR_404, [LLocation]);
      end;
    end else
      AResponseInfo.ContentText := Format(SERROR_404, [LLocation]);
  except
    on E: Exception do
      Log('Exception occured from IP ' + Connection.Socket.Binding.PeerIP +
        sLineBreak + E.Message);
  end; // trye
end;

procedure TClientContext.ServeHTMLFile(const AFileName: string;
  ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
var
  LHTMLFile: TStringList;
  LScript: TDelphiWebScript;
  LHTMLFilter: TdwsHtmlFilter;
  LClasses: TdwsClassesLib;
  LProgram: TdwsProgram;
begin
  LScript := TDelphiWebScript.Create(NIL);
  LScript.Config.ScriptPaths.Add(WebDir);
  LClasses := TdwsClassesLib.Create(NIL);
  LHTMLFilter := TdwsHtmlFilter.Create(NIL);
  LScript.Config.Filter := LHTMLFilter;
  LScript.AddUnit(TdwsHtmlUnit.Create(LScript));
  LScript.AddUnit(Tdws2StringsUnit.Create(LScript));
  LHTMLFile := TStringList.Create;
  try
    LClasses.Script := LScript;
    LHTMLFile.LoadFromFile(AFileName);
    LProgram := LScript.Compile(LHTMLFile.Text);
    try
      if NOT LProgram.Msgs.HasErrors then begin
        LProgram.Execute;
        AResponseInfo.ContentText := (LProgram.Result as TdwsDefaultResult).Text;
      end else
        AResponseInfo.ContentText := LProgram.Msgs.AsInfo
    finally
      FreeAndNil(LProgram);
    end; // tryf
  finally
    FreeAndNil(LHTMLFile);
    FreeAndNil(LClasses);
    FreeAndNil(LScript);
    FreeAndNil(LHTMLFilter);
  end; // tryf
end;

procedure TClientContext.Log(const s: string);
begin
  if Assigned(FLogStrings) then
    FLogStrings.Add(s);
end;

initialization
  WebDir := IncludeTrailingPathDelimiter(ExtractFilePath(ParamStr(0)) + 'www');

end.

as you can see the source code is pretty similar to the initial code, just that I've added a new method called ServeHTMLFile -- this method is called only if the requested HTML file is found in the www directory.
Technique: we don't create the interpreter instance unless the requested file is found in the www directory -- the reason is pretty obvious, we try to avoid memory allocation if it's not necessary, we could also improve the efficiency by caching the files in memory in order to serve them faster(RAM IO is faster than disk IO therefore this will give a significant speed improvement when server has thousands requests per second) however this will be covered in a future post hopefully.
In order to provide a proof of concept I've created a fairly simple "website" which has 3 buttons, each button redirects the client to a new web page:
index.html file

<HTML>
  <BODY>
    Hello world!!<BR>
    <BUTTON ONCLICK="window.location.href='/primes100.html'">show me primes up to 100</BUTTON> <BR>
    <BUTTON ONCLICK="window.location.href='/primes200.html'">show me primes up to 200</BUTTON> <BR>
    <BUTTON ONCLICK="window.location.href='/primes300.html'">show me primes up to 300</BUTTON> <BR>            
  </BODY>
</HTML>

very simple, right?
we also have a utils.inc file in which we have a method which checks if a number is prime, this file is also located in www directory

function IsPrime(Value: integer): boolean;
var
  Index: Integer;
begin
  Result := False;
  if Value <= 0 then
    Exit;
  for Index := 2 to Round(Sqrt(Value)) do
    if (Value mod Index) = 0 then
      Exit;
  Result := True;
end;

here are the other 3 HTML files primes100.html

<HTML>
  <BODY>
    <%
      {$I 'utils.inc'}
      var
        Index: Integer;
      for Index := 1 to 100 do
        if IsPrime(Index) then
          Send('<BR>' + IntToStr(Index)); 
    %>
  </BODY>  
</HTML>

primes200.html

<HTML>
  <BODY>
    <%
      {$I 'utils.inc'}
      var
        Index: Integer;
      for Index := 1 to 200 do
        if IsPrime(Index) then
          Send('<BR>' + IntToStr(Index)); 
    %>
  </BODY>  
</HTML>

primes300.html

<HTML>
  <BODY>
    <%
      {$I 'utils.inc'}
      var
        Index: Integer;
      for Index := 1 to 300 do
        if IsPrime(Index) then
          Send('<BR>' + IntToStr(Index)); 
    %>
  </BODY>  
</HTML>

Now, this is an extremely simple example, but as you can see it can be used as a template for a real hardcore web server. Unfortunately I don't have enough time these days for more in depth details, but you can download binary + source code or just the source code and enjoy the power and simplicity of DWScript.
The application is created in Delphi 2010.

Politics is anything but random

2010-12-13T12:45:00.000+02:00

I admit that I'm having trouble understanding politics, however I try my best to understand it and I'm really interested in how things go around the world because I live in it and to some extent it can/will affect me or my life style, having that said let's see what this post is all about:

In a previous post I've expressed my opinion regarding Wikileaks as being a hoax -- it is my opinion and even if I'm right or wrong I stand by it until someone can prove me wrong -- a reader commented "You're incoherent. Stick to writing about Delphi.", I agree to the second part however, the first part it might also be true.
The reason I'm against Wikileaks is very obvious... or at least I hope it is...
We all(or at least a pretty big number of us) know that the mainstream media is corrupted and it's anything but "for the people", they make money out of advertising(it's not a secret) however sometimes it comes down to one or more of the following situations:
- someone(or the government) does not want something to be published -- this leads into one or all of the following situations:
a) "someone" has power over the owner of the newspaper, news channel, etc.;
b) "someone" has enough money to make the newspaper, news channel, etc. turn the head in another direction;

- the media is paid(or forced by "someone") to spread disinformation;

- the media spreads disinformation in order to gain more audience -- this results in higher rate for advertising which leads to more cash;

- the journalist has a pretty good salary however if "someone" threatens his/her family the "subject" vanishes into thin air or if "someone" pays him/her a year(or more) worth of salary to shut up he/she will most likely do it, of course both situations can come as one(pay $ X and threaten family to shut up), most common is the pay;

The Internet is part of our lives these days and it helps us share information with outstanding speed -- this means that any information(especially if it's important) can reach millions of people in very short period of time -- he who controls the Internet has power over people's information(personal as well!!).
Take the social networks for instance, they hold so much personal information(which we give for free) that one can know almost anything about Mr./Mrs. X, WHAT IF "someone" would control the Internet or these companies?! yes... he/they would know where you are, where you live, what you've done the past X time, who you know, with who are you in a relationship, what you've talked to, who did you talked to, where ware you when you've wrote something, etc. -- can you see how much information we reveal about our selfs on the Internet?!
Deleting posts or images or changing information on the social networks won't do you any good, why?! because the data doesn't get deleted, there's a field that says "deleted" or "isdeleted" in tables so that information is not shown, however... it's there and can be accessed from server side or with some API's to which only few people have access.

OK, OK, enough BS, where do I want to get with all this?! well... the equation is simple, what if Wikileaks is just disinformation(from what I know until now, there's no real sensitive information released...) which will raise(I'm pretty sure already did) the question in a lot of governments around the world: "What if our sensitive information gets leaked?!" -- now we all know that a lot of dirty things happen(and happened and will still happen in the future) in politics since the beginning of it, do they want you(the guy who is working like a slave everyday in order to have a roof above your head and have something to eat, YOU pay his salary) to know what exactly is the government doing with the money it gets from you?! of course NOT...
Take China(and not only) as example, the government monitors the data that the people are accessing and spreading, WHY?! it's simple, they don't want anything to be leaked, riots or revolutions.
NOW, what IF the governments around the world starts controlling the data that floats on the Internet?! we get to the above situation in which we won't have privacy at all.
How can this happen?! simple, take Wikileaks as a "threat"(which until now isn't a threat at all...) and tell the people that we need to take actions so that we protect sensitive information from the hands of the "terrorists" -- it's a threat to national security, we must act immediately!! -- do you see a pattern?!

Let's take the word "terrorist", what does it mean?! according to Wikipedia:

Terrorism is the systematic use of terror especially as a means of coercion.[1] No universally agreed, legally binding, criminal law definition of terrorism currently exists. Common definitions of terrorism refer only to those violent acts which are intended to create fear (terror), are perpetrated for a religious, political or ideological goal, deliberately target or disregard the safety of non-combatants (civilians), and are committed by non-government agencies.

OK, OK... now do me a favor, think of yourself as a terrorist(it's hard, but please try), can you throw yourself sky high with a bomb because you don't agree with a government or something?!! I would not think so... I mean some of you have kids, family, friends, etc. can you leave them just to make a point?!
"But terrorists don't have friends, family, etc." -- possibly true, BUT still... just thinking that you will give your life should give you chills...

"You're paranoid, a total fu** up", "not another conspiracy crap", etc. -- I agree, it's possible that I'm wrong as hell, but still... what if I'm not?!
Take the time before 9/11 for example, would you allow the police to come into your house without a warrent?! NO!! could they vote this law?! NO!! why?! because it's illegal and immoral by all means!! still they wanted this, what happened?! well... the 9/11 incident in which a lot of people died and got injured -- now that's not right!!
How many towers got hit by a plane?! 1?! yea... sooo... why ware there 3(three) towers that collapsed?!! there are few people that know how many towers did actually collapsed on that day -- check that again, don't leave this "unfortunate incident" pass by because it was anything but an "incident".
Ohhh... yea... after that police got more aggressive, people can't really speak their mind if there's any injustice done to them, why?! because police can arrest you using BS's as excuses, can keep you locked up for as long as they please, etc.

By the way, I've saw a documentary on Discovery channel about "America's doomsday", it's a program started way back in the '50's by the president of USA, the program involved keeping the president and as many people from the government alive in case of a soviet nuclear attack. That's sweet and cool, EXCEPT that they've built a lot of bunkers which where absolute before it was finished because the soviets ware always improving their weapons, they knew that... YET they continued constructing bunkers using the people's money!!
Where do I want to get with this?! well.. what's the scope of a government?! in my opinion it is a group of people who leads the people and takes necessary actions to protect them against outside threats or against their own people, also the government must improve the life of each and every citizen as much as possible, YET the people are doing very bad, the people have NO defence against a war attack, YET the people is paying a lot of money for weapons, bunkers and all kind of BS's that "we need" in order to insure our safety, YET the people are struggling everyday to have a job or to have something to eat, while to governments around the world starts austerity programs because they "needed" to bailout banks(with the people's money of course) that got us in this situation(the economic crisis that is...) in the first place -- YET few people are revolting on this, WHY?! I'm not saying that we need to start revolutions around the world, NO!! that's not the solution, we need to change governments more often(1, 2 years max.!! if you can't keep our life style in that period, you can't improve it, so why do we need you?!), we need to put government people that took stupid actions with people's money in jail for a few years so that others will be more careful of how they spend money and what actions they take.

I want you to send this message to all your friends that work in the army, police or any type of armed force:

Don't forget that we're all people and you should protect the people NOT THE GOVERNMENT, any action taken against the people who try to express their problems or needs to the government(which has the job to improve the life of citizens) should be considered a THREAT TO THE PEOPLE, ANY THREAT TO THE PEOPLE SHOULD BE REMOVED IMMEDIATELY BY ALL MEANS NECESSARY!!

In the end I would like you to express your opinions about what I've wrote above(note that I might also be wrong) and also I would like you to verify everything that I wrote above, DO NOT TAKE ANYTHING FOR GRANTED, QUESTION MORE!!

Religion: who, what, where, why?!!!

2010-12-11T15:13:00.000+02:00

Skip this post if you're not open to impartial when it comes to religion.

NOTE: that I respect each person's belief regarding religion, we are entitled to our own opinions.

Today I received a e-mail from one of the readers regarding my previous post in which I've mentioned about Vatican's wealth, I will keep the person's name anonymous. the question was:
"what is your problem with the Vatican?"
Note: the person was polite and I have no issue whatsoever with his question, therefore I don't want to be misunderstood.

My "issues" with Vatican(and not only) are:
- why do they need a bank?
- why do they have their own laws?
- why do they ask for money(for tickets) in order to see the pope?!
- why can't ordinary people go in the Vatican library and see at least some(if not all) ancient documents?! -- as a believer you should be entitled to see(under surveillance or whatever, it doesn't matter) -- do they have something to hide?!?!
- the "why" list goes on...

I am what you call a "atheist" -- I wasn't raised like this, but in time I started to question a lot of things regarding religion(and not only) and I came to the conclusion that people tend to believe in "stuperstitial" stuff before science(NOTE: that NOT ONCE but a lot of times, religions have tried to ban early science because they hate questions to which they have to answer with proof -- why?! simply because you cannot explain religion...).

Let's NOT forget the deaths with the crusades "in the name of god" -- really now, do we have to kill people because they don't believe in our god or because they don't believe in anything?! my answer is NO(what's your answer?!), each individual has the right to own opinions.

I believe that the religions where started because people needs to believe in something in order to go over the hard life, however, from ancient times until now the religion was used as a control tool with each occasion, remember the history classes in which you've learned about how priests where selling "places in heaven"?! Ohhh... yea the same people who are preaching the "word of god" and the same people which added text in the "holly bible".

My main issue is with the influence of the pope(and priests), I mean we're teached in school about god and all that stuff in stead of being educated on how to behave in society and how to be hard worker and a honest person.

When I was young I've read a lot of holly books and the more I read the more I've found out how it contradicts itself and that is very, very hard on taking actions against non-belivers -- again, can you see a pattern?! YES, either you're with us or against us!!

The main issue with people is that a huge percent of them are like sheeps, they refuse to think or to have own opinions, the biggest problem is that they almost never question what's happening around them, they take for granted what others tell them(why should I bother to think?! I already have the answer... -- oh-ho-ho, but DO YOU?) -- this leads to mass manipulation.

I know most of the people don't like history, however, try to read a bit when you have time but don't forget that history is written by the victor -- never forget that!! -- you will see a lot of dirty things regarding religion and not only, manipulation schemes and other!

I'm pretty sure that a lot of you out there won't agree with what I've written above and very few will.., I'm waiting for your comments, however please be polite, we are humans(we're supposed to be polite with each other) after all...

Question more, don't stop at first answers, don't be afraid to ask "dumb" questions, silence is NOT the answer!

OK, I can't help myself regarding Wikileaks...

2010-12-10T22:39:00.000+02:00

My blood pressure is sky high each time I hear, read and/or see something regarding the Wikileaks so called "leaks", I'm f**kin' fed up with all this nonsense... I have yet to hear, read and/or see SENSITIVE INFORMATION released by Wikileaks, really now, can someone tell or point me to the right direction?! I only see the scandals on mainstream media regarding the so called "hacks" on Amazon, Visa, Mastercard and PayPal and regarding the illegal detention of J.A. with which I don't agree however law is law and is for everyone(well at least us..., the small people...).

Now regarding the "hackers" which "attacked" the Amazon(huge fail — LOL!! what the hell?! it's like trying to flood Google servers -- which are millions...), Visa(they don't really give a damn), Mastercard(they laughed their ass off on this...) and PayPal(I'm happy about this attack, they really have big fees!!) websites, c'mon people, that's NOT hacking... and I really hate the freakin' media which is trying to amplify this like it's a major attack on government server... blahhh... major attacks have happen in the past and we didn't hear about and still are happening and still will long after we're gone.

Wanna protect your server for this kind of "hacks"?! simply add another system(near the server) to which the server sends the logs via UDP or whatever... and then if the server is down because of this kind of attack(s), just follow the looong list of IP's which where making requests to the server and resulted in server crash, hello?! someone will have to pay huge amounts of money to da' court.

Bottom line, anyone can and SHOULD think if this is subject is really interesting, I mean, come on people, a lot of shit is happening in the world and no one is lifting a finger to do something, now all of the sudden someone(J.A.) came with some "leaks" which doesn't seem sensitive to me(again, I might be wrong, however please point to the "real" stuff) and we and the media are making a big case out of nothing, it seems to me like something else is happening behind the curtain, but it might be that I'm paranoid...
Take Vatican for instance, they got so much money that they could literally save tens(if NOT more) of millions of people around the whole freakin' World from starvation and diseases, but do they do it?! NO!! does the media care?! NO!! do WE care?! HUGE NO!! but still they say they are the voice of God and other BS'es...

STOP THE MEDIA FROM MANIPULATING YOU!!

Computing power: how much is enough?!

2010-11-30T13:36:00.000+02:00

I see almost every day someone showing off with their new hardcore computer with lots of Gigahertz and lots of RAM, etc. but is that system fast enough to find the first 100 mil. or 1 billion prime numbers in under 10 minutes?! well... it depends on the algorithms and the system configuration.
Time showed us that there's never enough computing power(I'm NOT talking about browsing the Internet or writing a text file here...), but what can we do in order to achieve our goals using computers as fast as possible?! there are a few options(off the top of my head):

1. buy better computers
2. use any computer you can get you're hands on

1. We always buy better computers in order to do stuff faster but there are a lot of limitations:
a. budget: we can buy STA(state of the art) computers with 4, 6, etc. cores that will make our life easier, but is this really a good idea?! the answer is NO, buying a i7 at 3 GHz with 4 cores it's about $ 3-400 depending in which country you live, now 3 Ghz with 4 cores is not the fastest you can get, Intel has way better CPU's than that -- extreme series, they also try to get as many cores as they can into a CPU but let's just stop at the extreme series which costs about $ 1.000/CPU(of course it worths the price, but it depends on your needs) -- now this is a lot just for a processor but depending on you're budget you can buy or skip.

b. operating system: some OS's are better than others -- depending on your needs of course -- let's take Windows for example, it is a very good OS for entertainment and office, but when you need to do some tasks that takes hours/days/weeks to complete is it good?! I honestly can't give a definitive answer on this because for tasks that needs a lot of time to complete I turn to my geek friend Linux -- it is very stable, it manages resources very well and if you don't need GUI(graphical user interface) it's pretty much rock-solid.

2. What do I mean by "use any computer you can get you're hands on"?!
It's not a secret that a lot of companies connect a bunch of computers together through a communication protocol and use each computer as a thread -- WAIT!! how does this work?!!
Basically it depends on the developers... you can have a system that is the Master on which you execute special programs and sends task execute request to 2 or more Slaves, when a slave completed it's task, it sends back the result to the master and waits for another request from the master -- pretty simple ey?! in essence yes, in practice NOT!!
Here is the basic idea:
step 1. Master => send request => slave(s)(1..N computers) -- usually at least 2!!
step 2. Master waits for all slaves to complete the tasks
step 3. when a slave completes the task it sends result back to the Master
step 4. Master processes result(s)
Fairly simplistic right?! but why do I say "at least 2 computers"?!
Over time we have been Witness hardware failure(I'm proud that I haven't had too many -- yet!!) let's say we got a highly intensive task that we believe that it will take "forever" to complete a matter of days, WHAT IF in this time one of the slaves has a hardware failure?! you've lost shit-load of time and we all know the equation:
time = money -> lose time => lose money another way to see this is: the less time you spend on doing something, the more money you earn.
Sooo... let's review what is one of the best approaches you can take when you need huge computing power:
1. get as many systems as you can -- no matter how powerful the CPU is or how much RAM the system has
2. implement the logic and the communication protocol(avoid using hard disks as much as possible <-- slowest part in the computer) 3. start using you're new hardcore computer network 4...N. always improve the idea!!

Now, let's try to throw some ideas of a possible implementation:
- create a flexible communication protocol(I prefer using TCP/IP because you can have GB's of data transfered in second(s)) maybe use XML?!
- choose the cleanest Linux distribution you can think of -- avoid using GUI for better performance(on slave side)
- implement integer(huge integers -- that can grow up to trillion digits long), string(huge strings that can be concated from 2 or more slaves), object(which has it's own methods which will be transfered along with it from master-slave, slave-master, slave-slave), etc.
- use some kind of ping mechanism so that the Master is automatically "knows" when a slave is dead and take appropriate actions(send task to another slave, e-mail tech department, etc.)
- Master CAN NOT execute task -- it needs only to assign tasks to slaves and communicate with them
- if you try hard enough you can also make the slaves "know" when the Master has a failure and another "free of task" slave can take it's place
- you will have to use a very fast interpreter

What do we get out of this?! well some of you know that you can buy good old Pentium 4 computers at 2.x-3 Ghz with 512 mb or 1 GB RAM for ~$ 100) -- WAIT!! so I can have 10 cores at $ 1.000?!?! yup...
You can also use implement this in such a away that you can use virtually any OS -- YES you can have 2 slaves on Windows 2000, 5 slaves on Windows XP, 20 slaves on Linux, 8 slaves on OSX, etc.
Sooo... the "hardcore" system can have a lot of slaves, running on multiple platforms AND you can always ADD more slaves on the network, OK but where's the drawback, I know there must be at least one -- yes there are plenty, but it basically depends on the developer(s):
- the system can take anywhere between a few seconds to a few minutes(depending on the initialization implementation -- needs to be ran at the beginning of the program execution) -- this can be tunned!!
- you will have to take care of the synchronization -- it's normal in a multithreaded environment
- if master dies the whole program progress can be lost -- this depends entirely on the implementation of the "main executor" or Mr. X ;-)
- you also need to take into consideration each system's configuration -- depending on this you can execute small tasks on Pentium 3 systems and others on P4 or i3/5/7's

As you can see the most important piece of the puzzle is the developer's skills.

But sometimes you need tens of thousands of computers -- WHAT can you do then?!
We all know that there are hundreds of millions of computers out there that are used only for Internet browsing, multimedia download, how can we use that to our advantage?! well a lot of hackers and companies uses/d zombie computers by uploading torrent clients and or multimedia programs for users to freely download and use, but while a lot of computers spend hours a day just downloading, the CPU and a lot of memory is available to be freely used legally or illegally depending on the EULA they provided with the software.
Take Skype for example, it uses your CPU and bandwidth in order to provide you with "free" service:

4.1 Permission to utilize Your computer. In order to receive the benefits provided by the Skype Software, You hereby grant permission for the Skype Software to utilize the processor and bandwidth of Your computer for the limited purpose of facilitating the communication between Skype Software users.

4.2 Protection of Your computer (resources). You understand that the Skype Software will use its commercially reasonable efforts to protect the privacy and integrity of Your computer resources and Your communication, however, You acknowledge and agree that Skype cannot give any warranties in this respect.

You hereby grant permission for the Skype Software to utilize the processor and bandwidth of Your computer for the limited purpose of facilitating the communication between Skype Software users.

This is a legal way of using your system, however others are JUST using your system because you got some illegal software from a torrent or warez website and you can't really complain about this in court, if you know what I mean -- it's your full responsibility.

As a Delphi/Pascal developer, what can you use in order to target as many platforms as you can and implement this? HELLO?!?! Freepascal and Lazarus is a good starting point and DO NOT forget that as a developer you should NOT be limited to a single programming language, you can also use C++ and/or Java as well if you implement your protocol flexible enough!!

Delphi XE Distiller

2010-11-18T10:11:00.002+02:00

Sooo... there's another Delphi Distiller available for those of you who wishes to download click this text(version 1.0.0.9).

DGTV: IdHTTPServer

2010-11-05T00:23:00.003+02:00

A new video tutorial is available, in this tutorial I'm explaining how to create a very basic HTTP server application, please watch it in HD for best experience, any comments are welcomed.
Part 1

Part 2

DGTV: VirtualStringTree

2010-11-03T01:14:00.002+02:00

I've created my first Delphi video tutorial which covers the basic use of VirtualStringTree component, please see it @ 720p for best experience.
Leave comments of what subject should I cover in a future video.

Delphi 2010 or XE?!

2010-11-02T15:44:00.001+02:00

OK, so we had a Delphi 2010 release and a couple of months later a Delphi XE(cool name huh?) release, your confused, what's the logic behind that? no cross platform, no 64 bit compiler nothing new actually besides the XE suffix, some IDE fixes and some light versions of third party tools.
All this still doesn't make sense... let's try a different approach: we know that the end goal of a company is to maximize their profits right?! if they have released Delphi 2010 without the IDE glitches it would have taken them a few months more to release Delphi 2010, that means that they would have "lost" money, what they(management) choose to do is release a Delphi 2010(I really hate this kind of names with suffix "year of release" sounds really gay!!) and after the IDE fixes a new version would be released(in this case XE) — sweet, the only problem is that people who have already purchased 2010 version have spent some money on a product which is NOT, I REPEAT NOT really good for big projects which involves thousands and thousands of lines of code — takes way too many freaking minutes or tens of minutes to build in order to test.
Does now make sense?! of course it does, but if your a customer, you're not "so" happy about this approach, Visual Studio has better releases as I've seen the last couple of years — this really bugs me!!
When I've tested XE(for a couple of minutes), I've seen faster IDE, less glitches, overall XE is a bit better than 2010, the only issue is that you have to spend more freaking money, what was my response to this?! invested $ 1.000 in a i7, memory and a good mother board — why?! well.. instead of giving them a couple of hundred Euros for something they should have giving in the 2010 release, I've upgraded my system which is a 2 years investment at least and give them s**t. Delphi 2010 runs smoothly now, I got a faster system, Intel, ASUS and Kingston got some money from me, problem solved!
---
Now I know what some of you might say: if you're a developer who makes money out of this, why NOT buy the latest releases since it's just a few hundred Euros/Dollars?! well the response is simple, while a company tries to maximize their profits, you as a developer(in this case customer) need to minimize your expenses — learn from your clients!!

Sooo you got your first milion, now what?!

2010-10-22T12:58:00.001+03:00

Let's just say that you just won € 1.7 mil. in lottery(tax free). What would you do with that much money in the current economy state?!
There are lots of things you can do with it, but the million euro question is: What's the best thing you can do with it, for you and MAYBE for others as well.
Let's just list a few possibilities:
- quit the job and waste the money;
- give the money to homeless people and help them start a fresh new life;
- give it to charity;
- start your own company(what kind of company, most of you that read this blog are developers, would you start a software company or do you think you can squeeze more money in other fields?!);
- buy the company in which you currently work(I'm sure it applies to many of you out there);
- buy a bigger house, bigger car, lots of bling-blings and biaches(I'm sure some of you want that -smile-);
- hold on to the money since there's no certain future coming;
- keep the money until pension, waste it then;
The above list is just off the top of my head — I disagree with at least half of the list — BUT I'm curious what other people would do with that much money.

No matter what you would do, consider this: money come and go, you're current job(if applies) is most likely pretty steady, you should take a deep breath before starting to think about how would you spend it and on what.
P.S. Don't forget, you also lose money(inflation which is a pretty big percent, let's say about 2%/year in Germany's or USA's case) by keeping it „safe¯ with each year.

Message dialogs: you're doing it wrong...

2010-10-14T21:44:00.000+03:00

No matter what you say or think, end-users are beasts, they will always find a way to make their life more complicated instead of reading messages or instructions...
I'm pretty sure AT least once in your life you pressed the wrong button on a message dialog, because you „thought¯ you know what it will ask you OR because you was in a hurry...
The main problem with the end-user is that (s)he will do this most of the times, let's suppose that you're asking the user if (s)he is sure to wipe a file or discard changes that are very important to him/her, even if the user should be blamed because (s)he didn't read the message, you're still the one that will be sweared.
So what can we do to overcome such a situation?! well not much without stressing the user BUT we can use a timed message dialog with which the user cannot interact for a amount of time — this will probably force the user to read the freaking message!
So here's my implementation of a timed message dialog:

unit uTimedMessageDlg;

interface

uses
  SysUtils,
  Windows,
  Classes,
  Forms,
  Dialogs,
  Controls,
  ExtCtrls;

const
  CDEFAULT_WAIT_SEC = 10;
  CSECOND = 1000;
  CTIMED_MESSAGE = '%s (%d seconds)';

type
  TTimedMessageDlg = class(TObject)
  private
    FTimer: TTimer;
    FSeconds: Cardinal;
    FMessageForm: TForm;
    FCountDown: Integer;
    FCaption: string;
    procedure OnTimer(Sender: TObject);
    procedure OnDialogShow(Sender: TObject);
  public
    constructor Create;
    destructor Destroy; override;
  public
    function DisplayDialog(const Msg: string; const Args: array of const;
      DlgType: TMsgDlgType; Buttons: TMsgDlgButtons;
      const SecondsToWait: Cardinal = 10): Integer;
  public
    property Seconds: Cardinal
      read FSeconds write FSeconds;
  end;
  
function TimedMessageDlg(const Msg: string; const Args: array of const ;
  DlgType: TMsgDlgType; Buttons: TMsgDlgButtons;
  const SecondsToWait: Cardinal): Integer;

implementation

{ TTimedMessageDlg }

constructor TTimedMessageDlg.Create;
begin
  FTimer := TTimer.Create(NIL);
  FTimer.Enabled := False;
  FTimer.Interval := 1000;
  FTimer.OnTimer := OnTimer;
  FSeconds := 10;
end;

function TTimedMessageDlg.DisplayDialog(const Msg: string;
  const Args: array of const;
  DlgType: TMsgDlgType; Buttons: TMsgDlgButtons;
  const SecondsToWait: Cardinal = 10): Integer;
begin
  FMessageForm := CreateMessageDialog(Format(Msg, Args), DlgType, Buttons);
  FMessageForm.OnShow := OnDialogShow;
  FCountDown := SecondsToWait -1;
  FCaption := FMessageForm.Caption;
  FMessageForm.Caption := Format(CTIMED_MESSAGE, [FCaption, FCountDown]);
  FTimer.Interval := 1000;
  FTimer.Enabled := True;
  Result := FMessageForm.ShowModal;
  FreeAndNil(FMessageForm);
end;

destructor TTimedMessageDlg.Destroy;
begin
  FreeAndNil(FTimer);
  inherited;
end;

procedure TTimedMessageDlg.OnTimer(Sender: TObject);
begin
  Dec(FCountDown);
  FMessageForm.Caption := Format(CTIMED_MESSAGE, [FCaption, FCountDown]);
  if FCountDown <= 0 then begin
    FMessageForm.Caption := FCaption;
    FTimer.Enabled := False;
    FMessageForm.Enabled := True;
  end; // if FCountDown <= 0 then begin
end;

procedure TTimedMessageDlg.OnDialogShow(Sender: TObject);
begin
  FMessageForm.Enabled := False;
end;

function TimedMessageDlg(const Msg: string; const Args: array of const ;
  DlgType: TMsgDlgType; Buttons: TMsgDlgButtons;
  const SecondsToWait: Cardinal): Integer;
var
  TimedMessage: TTimedMessageDlg;
begin
  TimedMessage := TTimedMessageDlg.Create;
  Result := TimedMessage.DisplayDialog(Msg, Args, DlgType, Buttons,
    SecondsToWait);
  FreeAndNil(TimedMessage);
end;

end.

Sooo... what's the difference between normal and this custom message dialog?! nothing much, just that it can also format your message if you wish to AND the user cannot close or press any button on the message for the specified amount of time — I suggest to keep the time-out value somewhere between 3 to 7 seconds max.

Fun with callbacks and progress form

2010-10-12T04:58:00.000+03:00

Some time ago I needed to display a progress form in order to give feedback to the user on current state of the task, therefore the „challenge¯ is pretty simple: a secondary form that will have a label — to display some info on current task — and two progress bars — for visual feedback — 1 progress bar for the „overall progress¯ and the other one for „current progress¯, this means that we have a task which is composed of few steps and each step has it's own progress.
Sooo... the MAIN idea is that the progress form needs to be displayed as modal while also calling a method(procedure) from another unit — this is where callbacks come into play.
What are callbacks?!

A callback is a reference to executable code, or a piece of executable code, that is passed as an argument to other code. This allows a lower-level software layer to call a subroutine (or function) defined in a higher-level layer.

For a better understanding of this article click this text to download the source code.
Let's achieve the same thing in a new project:
- add a button to this form
- add a new form to this application, remove it from auto-create forms(Project->Options->Forms)
- add two labels and two progress bars to the second form
- set the caption of one label to „Overall progress¯ and to the other label „Current progress¯
- name one progress bar „pbOverall¯ and the other „pbCurrent¯
Now let's write some code, first define the callback method as

type
  TProgressCallback = procedure (InProgressOverall, InProgressCurrent: TProgressBar) of Object;

we will pass „pbOverall¯ and „pbCurrent¯ as parameters in the callback method.
It's time to define a generic method that will create a new instance of our progress form in order to display a modal progress

procedure ShowProgress(InCallback: TProgressCallback);
var
  LWindowList: TTaskWindowList;
  LSaveFocusState: TFocusState;
  LProgressForm: TfrmProgressForm;
begin
  // create the instance
  LProgressForm := TfrmProgressForm.Create(NIL);
  try
    // save the focus state
    LSaveFocusState := SaveFocusState;
    // save the focused form
    Screen.SaveFocusedList.Insert(0, Screen.FocusedForm);
    // notify that a form will be displayed as modal
    Application.ModalStarted;
    // disable all other forms
    LWindowList := DisableTaskWindows(0);
    // set the progress form instance as the screen focused form 
    Screen.FocusedForm := LProgressForm;
    // send a active message
    SendMessage(LProgressForm.Handle, CM_ACTIVATE, 0, 0);
    // show the form
    LProgressForm.Show;
    // InCallback is our callback method to which we pass pbOverall and pbCurrent
    // as parameters so we can play with them later
    InCallback(LProgressForm.pbOverall, LProgressForm.pbCurrent);
    // after the callback is executed enable windows
    EnableTaskWindows(LWindowList);
    // restore focus state
    RestoreFocusState(LSaveFocusState);
  finally
    // notify that we're leaving a modal state
    Application.ModalFinished;
    // free and nil the progress form instance
    FreeAndNil(LProgressForm);
  end;
end;

all we have left to do now is to define a (private or public)method in main form with same parameters as the callback method like so:

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    // this is our callback method
    procedure ProgressCallback(InProgressOverall, InProgressCurrent: TProgressBar);
  public
    { Public declarations }
  end;

in the implementation section copy-paste this code

procedure TForm1.ProgressCallback(InProgressOverall,
  InProgressCurrent: TProgressBar);
var
  Index: Integer;
  kIndex: Integer;
begin
  MessageDlg('Press OK to start a long task...', mtInformation, [mbOK], 0);
  // 10 steps
  InProgressOverall.Max := 10;
  // 3000 updates per step
  InProgressCurrent.Max := 3000;
  for Index := 1 to InProgressOverall.Max do begin
    for kIndex := 1 to InProgressCurrent.Max do begin
      InProgressCurrent.Position := kIndex;
      // force application to process messages
      Application.ProcessMessages;
    end; // for kIndex := 1 to InProgressCurrent.Max do begin
    InProgressOverall.Position := Index;
    // force application to process messages
    Application.ProcessMessages;
  end; // for Index := 1 to InProgressOverall.Max do begin
  MessageDlg('Task completed!', mtInformation, [mbOK], 0);
end;

on the main form you have a button, in it's OnClick event add the following code:

ShowProgress(Self.ProgressCallback);

Any ideas on how to achieve the same effect in less code or more elegant?! please leave comment.

How to save a report as PDF to a stream with FastReport

2010-09-28T04:08:00.000+03:00

Recently I needed to save a report to a stream as PDF, I'm using FastReport for my reports.
I've searched a lot for a way to do this, but unfortunately I only found comments like „you can't export a report to a stream in PDF format with FastReport¯ and similar comments... so I started browsing the source code of the PDF exporter and 2 minutes later I saw that the exporter checks if property „Stream¯ is assigned, otherwise it will create a TFileStream instance using the report's „FileName¯ property — therefore assigning a TStream descendant to PDFExporter.Stream will make the exporter write the PDF data to THAT stream in stead of the file, without further chit-chat, let's see some code:
I took „PrintStringList¯ example from the Demo folder and modified it to show you how it's done, I've added a new button on the form and a save dialog, in the OnClick event of the button I've added the following code:

procedure TForm1.Button2Click(Sender: TObject);
var
  // we use a file stream for example, but you can replace this
  // with a memory stream or any type of stream which is a
  // descendant of abstract class TStream
  LFileStream: TFileStream;
begin
  // allow the user to choose a file name
  if SaveDialog1.Execute then begin
    // create the file stream object
    LFileStream := TFileStream.Create(SaveDialog1.FileName, fmCreate or fmShareDenyNone);
    try
      // set the range properties
      StringDS.RangeEnd := reCount;
      StringDS.RangeEndCount := sl.Count;
      // THIS IS THE MAGIC
      // assign the stream for the TfrxPDFExport component
      frxPDFExport1.Stream := LFileStream;
      // prepare the report
      frxReport1.PrepareReport(True);
      // export calls the PDFExport component in this case
      frxReport1.Export(frxPDFExport1);
    finally
      // free the file stream object
      FreeAndNil(LFileStream);
      // NIL reference to the stream
      frxPDFExport1.Stream := NIL;
    end; // tryf
  end; // if SaveDialog1.Execute then begin
end;

NOTE: you need FastReport installed!!
You can download the entire project source code by clicking on this text.

File/Stream compression/decompression class

2010-09-19T01:46:00.000+03:00

Tired of searching for zip libraries just to compress/decompress a file/stream?!
Why not use zlib shipped with Delphi?! it's lightweight, super fast, very good compression and above all it's very easy to use!!
( uDGCompressor.pas )

unit uDGCompressor;

interface

//  Author: Dorin Duminica
//
//  Scope: file/stream compression/decompression and encryption/decryption
//
//  License: free for commercial or private use

uses
  SysUtils,
  Windows,
  Classes,
  zlib;

const
  CKILO_BYTE = 1024;
  //  default buffer //
  CBUFFER_SIZE = 35 * CKILO_BYTE;

//  cipher base class //
//  the child classes will HAVE to implement the Encrypt/Decrypt  //
//  methods based on the parameters defined bellow  //
type
  TDGCipherBase = class(TObject)
  public
    procedure EncryptData(const InData: Pointer; const InSize: Integer;
      out OutData: Pointer; out OutSize: Integer); virtual; abstract;
    procedure DecryptData(const InData: Pointer; const InSize: Integer;
      out OutData: Pointer; out OutSize: Integer); virtual; abstract;
  end;

//  before each compressed block the following structure will be written  //
type
  TDGBlockDesc = record
    //  initial size of the block, before compresstion  //
    InitialSize: Integer;
    //  size of the compressed block in stream  //
    Size: Integer;
  end; // TDGBlockDesc = record

const
  szDGBlockDesc = SizeOf(TDGBlockDesc);

type
  //  each time a block of data is processed  //
  TDGProgressEvent = procedure (const Progress, ProgressMax: Integer) of Object;

  //  before/after compress/decompress events //
  TDGCompressorEvent = procedure (const InFileName, OutFileName: string;
    const InSize, OutSize: Int64) of Object;

  //  when a block's decompressed size is different than initial size //
  //  this type of event will be fired if assigned  //
  TDGDecompressFailEvent = procedure (const BlockDesc: TDGBlockDesc;
    const InBuffer, OutBuffer: Pointer; const InSize, OutSize: Integer) of Object;

//  the compress/decompress class //s
type
  TDGCompressor = class(TObject)
  private
    FInStreamSize: Int64;
    FOutStreamSize: Int64;
    FBufferSize: Integer;
    FCipher: TDGCipherBase;
    FOnProgress: TDGProgressEvent;
    FOnAfterCompress: TDGCompressorEvent;
    FOnBeforeCompress: TDGCompressorEvent;
    FOnAfterDecompress: TDGCompressorEvent;
    FOnBeforeDecompress: TDGCompressorEvent;
    FOnDecompressFail: TDGDecompressFailEvent;
  public
    constructor Create;
  public
    procedure CompressFile(const InFileName, OutFileName: string);
    procedure DecompressFile(const InFileName, OutFileName: string);
    procedure CompressStream(const InStream, OutStream: TStream);
    procedure DecompressStream(const InStream, OutStream: TStream);
  published
    //  properties  //
    property BufferSize: Integer read FBufferSize write FBufferSize;
    property Cipher: TDGCipherBase read FCipher write FCipher;
    property InStreamSize: Int64 read FInStreamSize;
    property OutStreamSize: Int64 read FOutStreamSize;
    //  events  //
    property OnAfterCompress: TDGCompressorEvent read FOnAfterCompress write FOnAfterCompress;
    property OnBeforeCompress: TDGCompressorEvent read FOnBeforeCompress write FOnBeforeCompress;
    property OnAfterDecompress: TDGCompressorEvent read FOnAfterDecompress write FOnAfterDecompress;
    property OnBeforeDecompresss: TDGCompressorEvent read FOnBeforeDecompress write FOnBeforeDecompress;
    property OnDecompressFail: TDGDecompressFailEvent read FOnDecompressFail write FOnDecompressFail;
    property OnProgress: TDGProgressEvent read FOnProgress write FOnProgress;
  end;

implementation

{ TDGCompressor }

procedure TDGCompressor.CompressFile(const InFileName, OutFileName: string);
var
  LInFileStream: TFileStream;
  LOutFileStream: TFileStream;
begin
  //  create TFileStream instances  //
  LInFileStream := TFileStream.Create(InFileName, fmOpenRead or fmShareDenyNone);
  LOutFileStream := TFileStream.Create(OutFileName, fmCreate or fmShareDenyNone);
  //  set the position of LInFileStream to the begining
  LInFileStream.Position := 0;
  //  call OnBeforeCompress event if assigned //
  if Assigned(FOnBeforeCompress) then
    FOnBeforeCompress(InFileName, OutFileName, LInFileStream.Size, LOutFileStream.Size);
  try
    //  attempt to compress stream  //
    CompressStream(LInFileStream, LOutFileStream);
  finally
    //  free objects  //
    FreeAndNil(LInFileStream);
    FreeAndNil(LOutFileStream);
  end; // tryf
  //  call OnAfterCompress event if assigned  //
  if Assigned(FOnAfterCompress) then
    FOnAfterCompress(InFileName, OutFileName, LInFileStream.Size, LOutFileStream.Size);
end;

procedure TDGCompressor.CompressStream(const InStream, OutStream: TStream);

    function ThereAreBytes: Boolean;
    begin
      Result := (InStream.Position < InStream.Size) and
        ((InStream.Size - InStream.Position) > 0);
    end; // function ThereAreBytes: Boolean;

var
  LInBuffer: Pointer;
  LOutBuffer: Pointer;
  LWriteBuffer: Pointer;
  LBlockDesc: TDGBlockDesc;
  LProgress: Integer;
  LWriteSize: Integer;
  LReadBytes: Integer;
  LProgressMax: Integer;
  LCompressedSize: Integer;
begin
  //  store the size of the InStream
  FInStreamSize := InStream.Size;
  //  allocate memory for the read buffer //
  LInBuffer := AllocMem(BufferSize);
  //  initalize progress  //
  LProgress := 0;
  //  set the max progress  //
  LProgressMax := InStream.Size;
  //  while we have bytes in InStream that are not compressed //
  while ThereAreBytes do begin
    //  attempt to read the BufferSize number of bytes from InStream  //
    LReadBytes := InStream.Read(LInBuffer^, BufferSize);
    //  compress the read bytes based on LReadBytes variable which holds
    //  the actual number of read bytes from InStream
    ZCompress(LInBuffer, LReadBytes, LOutBuffer, LCompressedSize);
    //  if we don't have a cipher assigned
    if NOT Assigned(FCipher) then begin
      //  set the reference to LOutBuffer
      LWriteBuffer := LOutBuffer;
      //  copy the size of the buffer
      LWriteSize := LCompressedSize;
    end else
      //  we have a cipher assigned, this means that we need to
      //  call the default EncryptData method which will encrypt our
      //  compressed data
      FCipher.EncryptData(LOutBuffer, LCompressedSize, LWriteBuffer, LWriteSize);
    //  set the inital size of the block, we check it on decompress
    LBlockDesc.InitialSize := LReadBytes;
    //  set the number of bytes that we have compressed and/or encrypted
    LBlockDesc.Size := LWriteSize;
    //  write the block descriptor
    OutStream.WriteBuffer(LBlockDesc, szDGBlockDesc);
    //  write the block data
    OutStream.WriteBuffer(LWriteBuffer^, LWriteSize);
    //  free memory from LOutBuffer
    FreeMem(LOutBuffer);
    //  free memory from LWriteBuffer only if a cipher is assigned
    if Assigned(FCipher) then
      FreeMem(LWriteBuffer);
    //  increment the progress by the number of read bytes
    Inc(LProgress, LReadBytes);
    // update the size of the OutStream
    FOutStreamSize := OutStream.Size;
    //  if the OnProgress event is assigned then call it by passing
    //  the current progress and the maximum progress
    if Assigned(FOnProgress) then
      FOnProgress(LProgress, LProgressMax);
  end; // while ThereAreBytes do begin
  //  free memory from LInBuffer
  FreeMem(LInBuffer, BufferSize);
end;

constructor TDGCompressor.Create;
begin
  //  initialize default values //
  FBufferSize := CBUFFER_SIZE;
  FInStreamSize := 0;
  FOutStreamSize := 0;
end;

procedure TDGCompressor.DecompressFile(const InFileName, OutFileName: string);
var
  LInFileStream: TFileStream;
  LOutFileStream: TFileStream;
begin
  //  create TFileStream instances  //
  LInFileStream := TFileStream.Create(InFileName, fmOpenRead or fmShareDenyNone);
  LOutFileStream := TFileStream.Create(OutFileName, fmCreate or fmShareDenyNone);
  //  call OnBeforeDecompress event if assigned //
  if Assigned(FOnBeforeDecompress) then
    FOnBeforeDecompress(InFileName, OutFileName, LInFileStream.Size, LOutFileStream.Size);
  //  attempt to decompress stream  //
  try
    DecompressStream(LInFileStream, LOutFileStream);
  finally
    //  free objects  //
    FreeAndNil(LInFileStream);
    FreeAndNil(LOutFileStream);
  end; // tryf
  //  call OnAfterDecompress event if assigned  //
  if Assigned(FOnAfterDecompress) then
    FOnAfterDecompress(InFileName, OutFileName, LInFileStream.Size, LOutFileStream.Size);
end;

procedure TDGCompressor.DecompressStream(const InStream, OutStream: TStream);

    function ThereAreBytes: Boolean;
    begin
      Result := (InStream.Position < InStream.Size) and
        ((InStream.Size - InStream.Position) > 0);
    end; // function ThereAreBytes: Boolean;

var
  LInBuffer: Pointer;
  LOutBuffer: Pointer;
  LWriteBuffer: Pointer;
  LBlockDesc: TDGBlockDesc;
  LProgress: Integer;
  LWriteSize: Integer;
  LReadBytes: Integer;
  LProgressMax: Integer;
  LDecompressedSize: Integer;
begin
  //  store the size of the InStream
  FInStreamSize := InStream.Size;
  //  allocate memory for the read buffer //
  LInBuffer := AllocMem(BufferSize);
  //  initalize progress  //
  LProgress := 0;
  //  set the max progress  //
  LProgressMax := InStream.Size;
  //  while we have bytes in InStream ... //
  while ThereAreBytes do begin
    //  read the block descriptor from stream
    InStream.ReadBuffer(LBlockDesc, szDGBlockDesc);
    //  attempt to read the number of bytes in the block descriptor
    LReadBytes := InStream.Read(LInBuffer^, LBlockDesc.Size);
    //  if we don't have a cipher assigned  ///
    if NOT Assigned(FCipher) then begin
      //  decompress the buffer //
      ZDecompress(LInBuffer, LReadBytes, LOutBuffer, LDecompressedSize);
      //  set reference to LOutBuffer //
      LWriteBuffer := LOutBuffer;
      //  copy the number of bytes  //
      LWriteSize := LDecompressedSize;
    end else begin
      //  we have a cipher assigned, we first decrypt data  //
      FCipher.DecryptData(LInBuffer, LReadBytes, LOutBuffer, LDecompressedSize);
      //  and then decompress it  //
      ZDecompress(LOutBuffer, LDecompressedSize, LWriteBuffer, LWriteSize);
    end; // if NOT Assigned(FCipher) then begin
    //  check if initial size is equal to current (decrypted and) decompressed size //
    if LBlockDesc.InitialSize <> LWriteSize then
      if Assigned(FOnDecompressFail) then
        FOnDecompressFail(LBlockDesc, LInBuffer, LWriteBuffer, LReadBytes, LWriteSize);
    OutStream.WriteBuffer(LWriteBuffer^, LWriteSize);
    FreeMem(LOutBuffer);
    if Assigned(FCipher) then
      FreeMem(LWriteBuffer);
    Inc(LProgress, LReadBytes + szDGBlockDesc);
    //  update the size of the OutStream
    FOutStreamSize := OutStream.Size;
    //  if the OnProgress event is assigned then call it by passing
    //  the current progress and the maximum progress
    if Assigned(FOnProgress) then
      FOnProgress(LProgress, LProgressMax);
  end; // while ThereAreBytes do begin
  //  free memory from LInBuffer
  FreeMem(LInBuffer, BufferSize);
end;

end.

You can download:
- only the source code
- source code + binary

As always any comments are welcomed.

Delphigeist group is available on Facebook

2010-09-09T07:39:00.000+03:00

I've been thinking of creating Delphigeist group on Facebook so here's the link http://www.facebook.com/group.php?gid=159341794080763

Target	Price
Independent Developers	$200,—/year
Students	$100,—/year
New companies	$100,—/developer first year and $150,—/year starting from 2nd year
Existing customers	$150,—/year
Schools	$50,—/year