The Spirit of Delphi

SynMiniMap updated to v. 1.1

2012-05-08T04:28:00.002+03:00

SynMiniMap has been updated, update or get it by clicking here.

The new version carries a few fixes and enhancements:
added:

editor scroll using MiniMap(normal|reversed)
ability to override tab width, by default it will grab the editor's tab width, now you can override it and set it to 4 for example, very useful if editing html and suffering from div-itism
a few new properties inherited from TCustomControl

fixed:

flickering when scrolling "too many" lines at once
line calculation on click, Sublime Text doesn't have the option(or at least I'm not aware) to click on a line and automatically move the caret on it, SynMiniMap passes the line and char in the event data of the OnClick event

known issues: <

if you've assigned the OnClick event, the "char" value passed in the event data is not always correct, needs fix, but it's not wrong by far, so, you can set the CaretX or not, but at least you can go to the correct line on click (:

There are no other notable changes, however, if you find it useful, and make fixes, enhancements, please consider sending it back so that others can benefit from it.

License:

I want to be clear on this, the license is Apache 2.0 because I think it's the most flexible one available on Google Code, however, whatever restrictions you may find in it, please don't take it into consideration, if you wish to contribute to the project then excellent, if not, there's no biggie, you can use the source as you wish, commercial, private, etc.

If you find bugs or want to request enhancements, please use the google code Issue Tab or e-mail me directly at duminicadorin at google's mail dot com (:

Enjoy!

SynMiniMap or Sublime Text minimap ripoff

2012-05-05T17:05:00.002+03:00

Some time ago, I've heard about Sublime Text, outstanding tool!

One of the things I like most about it, is the minimap, which is a scaled down version of the file which will help you have a bird's eye view of the file, this means that you can see somewhere between 100 and 200 lines in the minimap, while the text editor can only display about half of what the minimap can at best.

I've started thinking, wouldn't it be cool if there was something like that for SynEdit? googled-googled-googled, nada... okay, that kinda' sux... synedit is around for many years... oh well, started coding and here's the result(this is a screenshot of the included demo)

You can find the code at http://code.google.com/p/delphigeist-delphi-stuff It also includes a simple tabbed demo. Suggestions and bug fixes are welcomed!
The code is under apache license 2.0, whatever that means... if anyone can suggest the most "freely" license possible, I'm willing to change it.

Delphi-like MessageDlg in Javascript with jQuery

2012-05-01T06:08:00.000+03:00

As you may already know, the good old MessageDlg function in Delphi is not available for web applications, so you're done to a few options:

use some third party "plugin"
use jQuery-UI dialog
create your own

I've created my own MessageDlg function that is very close to the Delphi function, however, the dependencies are jQuery and jQuery UI

function MessageDlg( text, type, buttons, callback ) {
  /* code */
}

where

text: text to be displayed
type: dialog type, i.e. Information, Confirmation, Warning, Error
buttons: array of button types to be added on the dialog, ala delphi, i.e. [mbOK, mbYes, mbNo]
callback: function to be called when the user clicks a button, the function gets a integer parameter passed which is equal to the button type, i.e. mbOK = mrOK

Here's the code: filename.js

// MessageDlg types
var mtInformation = 0;
var mtConfirmation = 1;
var mtWarning = 2;
var mtError = 3;

// MessageDlg type classes, used for icons
var MessageDlgTypes = [
 { type: mtInformation, iconClass: "icon-information" },
 { type: mtConfirmation, iconClass: "icon-confirmation" },
 { type: mtWarning, iconClass: "icon-warning" },
 { type: mtError, iconClass: "icon-error" }
];

function getMsgDlgIcon( type ) {
 var index;
 var result;
 for ( index = 0; index < MessageDlgTypes.length; index++ ) {
  if ( MessageDlgTypes[ index ].type == type ) {
   result = MessageDlgTypes[ index ].iconClass;
   break;
  }
 }
 return result;
}

// string, holds all icon classes for removal before applying a new icon
var MessageDlgIconClasses = "";

function buildMsgDlgIconClasses() {
 var index;
 for ( index = 0; index < MessageDlgTypes.length; index++ ) {
  MessageDlgIconClasses += " " + MessageDlgTypes[ index ].iconClass;
 }
}

buildMsgDlgIconClasses();

// helper function to itrate all message dialog types
function forEachMsgDlgType( callback ) {
 var index;
 for ( index = 0; index < MessageDlgTypes.length; index++ ) {
  callback( MessageDlgTypes[ index ] );
 }
}

// MessageDlg button types
var mbOK = 0
var mbYes = 1;
var mbNo = 2;
var mbCancel = 3;
var mbAbort = 4;
var mbIgnore = 5;

// MessageDlg return types, passed in callback function if provided
var mrOK = mbOK;
var mrYes = mbYes;
var mrNo = mbNo;
var mrCancel = mbCancel;
var mrAbort = mbAbort;
var mrIgnore = mbIgnore;

/*
 MessageDlg button type localization
 @type: direct relationship with button types
 @caption: button caption(text)
 @accessKey: accelerator, ALT+KEY in stead of using mouse, i.e. ALT+Y for [&Yes]
*/
var MessageDlgBtnExtInfo = [
 { type: mbOK, caption: "OK", accessKey: "O" },
 { type: mbYes, caption: "Yes", accessKey: "Y" },
 { type: mbNo, caption: "No", accessKey: "N" },
 { type: mbCancel, caption: "Cancel", accessKey: "C" },
 { type: mbAbort, caption: "Abort", accessKey: "A" },
 { type: mbIgnore, caption: "Ignore", accessKey: "I" }
];

/*
 each time you call MessageDlg,
 callback parameter will be assigned to this variable
*/
var MessageDlgTempCallback;

// called each time a button is clicked
function MessageDlgOnClick( button ) {
 // hide dialog
 $( "#messagedlg .outter-wrapper" ).hide( "slide", { direction: "up" }, function() {
  $( "#messagedlg" ).hide();
  // check if we can call back
  if ( typeof MessageDlgTempCallback != "undefined" ) {
   MessageDlgTempCallback( button );
  }
 });
}

function getMsgDlgBtnInfo( type ) {
 var index;
 var result;
 for ( index = 0; index < MessageDlgBtnExtInfo.length; index++ ) {
  if ( MessageDlgBtnExtInfo[ index ].type == type ) {
   result = MessageDlgBtnExtInfo[ index ];
   break;
  }
 }
 return result;
}

/*
 @text: string -> text or html
 @type: integer -> mtInformation..mtError
 @buttons: array of integer -> mbYes...mbIgnore
 @callback: function( integer ) -> called when user clicks a button passing the message result as first param
*/
function MessageDlg( text, type, buttons, callback ) {
 // append elements to body if it doesn't exist yet
 if ( ! $( "#messagedlg" )[ 0 ] ) {
  $( "body" ).prepend(
   "<div id=\"messagedlg\" class=\"messagedlg\">\
    <div class=\"outter-wrapper\">\
     <div class=\"message-wrapper\">\
      <div class=\"message-icon\"></div>\
      <div class=\"message-text\"></div>\
     </div>\
     <div class=\"buttons \"></div>\
    </div>\
   </div>"
  );
 }
 // check parameters
 if ( typeof type == "undefined" || typeof buttons == "undefined" ) {
  throw "MessageDlg: type and buttons must be defined!";
 }
 // we want only array instance to be passed in buttons parameter
 if ( ! buttons instanceof Array ) {
  throw "MessageDlg: buttons parameter must be array!";
 }
 // save callback
 MessageDlgTempCallback = callback;
 // create buttons
 var index;
 var button;
 var temp = "";
 var btnInfo;
 for ( index = 0; index< buttons.length; index++ ) {
  button = buttons[ index ];
  btnInfo = getMsgDlgBtnInfo( button );
  temp += "<button onclick=\"MessageDlgOnClick( " + button + ");\" accesskey=\"" + btnInfo.accessKey + "\">" + btnInfo.caption + "</button>";
 }
 $( "#messagedlg .message-icon" )
  .removeClass( MessageDlgIconClasses )
  .addClass( getMsgDlgIcon( type ) );
 // we're overriding the existing buttons
 $( "#messagedlg .buttons" ).html( temp );
 $( "#messagedlg .message-text" ).html( text );
 $( "#messagedlg" ).show(0, function() {
  $( "#messagedlg .outter-wrapper" ).show( "slide", {direction: "up" }, function() {
   $( "#messagedlg button:first-child" ).focus();
  });
 });
}

// variations of "MessageDlg" since javascript is case sensitive
function messageDlg( text, type, buttons, callback ) {
 MessageDlg( text, type, buttons, callback );
}

function messagedlg( text, type, buttons, callback ) {
 MessageDlg( text, type, buttons, callback );
}

function msgdlg( text, type, buttons, callback ) {
 MessageDlg( text, type, buttons, callback );
}

function msgInfo( text, callback ) {
 MessageDlg( text, mtInformation, [mbOK], callback );
}

function msgAsk( text, callback ) {
 MessageDlg( text, mtConfirmation, [mbYes, mbNo], callback );
}

function msgWarn( text, callback ) {
 MessageDlg( text, mtWarning, [mbOK], callback );
}

function msgError( text, callback ) {
 MessageDlg( text, mtError, [mbOK], callback );
}

function msg( text, callback ) {
 MessageDlg( text, mtInformation, [mbOK], callback );
}

as you can see, the core of the function doesn't require that much code, however, I've added a few effects here and there to make it more eye pleasing and to be flexible, now the css part: filename.css

.messagedlg {
 position: fixed;
 left: 0;
 top: 0;
 right: 0;
 bottom: 0;
 z-index: 10000;
 display: none;
 background-image: url(/images/256x256msgdlgbg.png);
}

.messagedlg .outter-wrapper {
 background-color: #fcfcfc;
 border: 2px solid #bababa;
 border-top: 2px solid transparent;
 border-bottom-left-radius: 10px;
 border-bottom-right-radius: 10px;
 display: none;
 font-size: 1.5em;
 height: 200px;
 left: 10%;
 position: fixed;
 padding: 1em;
 padding-top: 0;
 width: 80%;
}

.messagedlg .outter-wrapper .buttons {
 border-top: 1px solid #e5e5e5;
 height: 40px;
 text-align: center;
}

.messagedlg .outter-wrapper .buttons button {
 background-color: #fafafa;
 border: 1px solid #d5d5d5;
 border-right: 2px solid #d5d5d5;
 border-bottom: 2px solid #d5d5d5;
 border-radius: 4px;
 font-size: 14px;
 height: 30px;
 margin: 0.5em;
 width: 75px;
}

.messagedlg .outter-wrapper .buttons button:focus {
 border: 1px solid #f80000;
 border-right: 2px solid #f80000;
 border-bottom: 2px solid #f80000;
 font-weight: bold;
}

.messagedlg .outter-wrapper .message-wrapper {
 height: 160px;
}

.messagedlg .outter-wrapper .message-wrapper .message-icon {
 float: left;
 height: 160px;
 width: 128px;
 background-repeat: no-repeat;
 background-position: center center;
}

.icon-information {
 background-image: url(/images/128x128msgdlginfo.png);
}

.icon-confirmation {
 background-image: url(/images/128x128msgdlgconf.png);
}

.icon-warning {
 background-image: url(/images/128x128msgdlgwarn.png);
}

.icon-error {
 background-image: url(/images/128x128msgdlgerror.png);
}

.messagedlg .outter-wrapper .message-wrapper .message-text {
 height: 140px;
 overflow-x: hidden;
 overflow-y: auto;
 padding-top: 1em;
 padding-left: 1em;
}

that's quite a bit of css for something so simple that could have been achieved using a table element, but hey, it works, also, it allows you to tweak things the way your heart dictates. Checkout http://code.google.com/p/delphigeist-javascript-stuff/ for code and other future stuff.

Multiple event handlers and more

2012-03-23T17:24:00.001+02:00

If you want the sample app and skip reading, click here.
Yesterday I finished translating a C# application to Delphi, this application is part of an SDK.
While translating — even tho' my C# knowledge is limited — I couldn't help not noticing how easy it is to translate C# code to Delphi, well it shouldn't be a surprise since the chief architect behind Delphi and C# is the same person Anders Hejlsberg.
Since this was my first ever C# to Delphi translation, my initial thought was a "one-to-one" translation, however, while analyzing how the application works, I've realized that a "one-to-one" wouldn't be a good idea, normally, but in this case it was the fastest and easiest way in order to replicate original functionality and also be able to go back to the original code and see what was "missed" or "how it was done" down to the each method and variable definition.
Like with almost every programming task, you learn something new — or better ways of accomplishing something —, I've learned how C# handles events and how simple a lot of things can be defined, for example you can have multiple "event listeners or subscribers if you will" — like in Java and others — assigned, and when you call this event, all assigned handlers or subscribers will be called by forwarding the parameters.
Sadly, in Delphi we can't assign multiple event handlers by default, but that doesn't mean we can't simulate it, however it will involve more coding...
NOTE: this application was created using Delphi 2010, should work in any Delphi version that supports generics and even earlier versions if you rewrite specialized versions of TList.
While writing this demo application, I was thinking that it would be a good time to add extra magic that I think it could be useful for novice programmers, so, here's the uMagic.pas unit:

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

  Original author: Dorin Duminica

  License:
    This code is provided as is, free for both commercial and personal use,
    the author(s) takes no responsability whatsoever of any damage(harder, pets,
    monkeys on fire, etc.) as a result of direct or indirect use of this code

  In this demo:
  ~~~~~~~~
  - simple example of using generics(specializing a generic type to fit your needs)
  - proves the importance of NOT assuming array Low and High bound
  - how to create object instances by knowing the class type
  - how to use "class var/method" a.k.a. "static var/method"
  - how to define and use events and callbacks
  - how to retrieve address of object in memory
  - using RandomRange, Randomize, RandSeed, Format
  - the importance of logging information
  - define class decendants
  - how to use "initialization" section of a unit
  - how NOT to create a user interface, this interface is for "development"
    test ONLY, it is anything but something you would present to a customer


*******************************************************************************)
unit uMagic;

interface

uses
  //
  //  required for Format function
  //
  SysUtils
  //
  //  required in order to specialize TList for our types
  //
  ,Generics.Collections
  ;

type
  //
  //  simple event, customize it as you please
  //
  TSimpleEvent = procedure (Sender: TObject; AMessage: string) of Object;
  //
  //  forward declaration
  //
  TSimpleObjectBase = class;
  //
  //  specialize a generic TList to hold TSimpleEvent's
  //  list of events
  //
  TSimpleEventList = class(TList<TSimpleEvent>)
  public
    //
    //  invoke this to call event on all TSimpleObjectBase decendants
    //  instances held in list
    //
    procedure Call(Sender: TObject; AMessage: string);
  end;
  //
  //  specialize a generic TList to hold TSimpleObjectBase decendants
  //  simple object list, will hold instances of TSimpleObjectBase
  //
  TSimpleObjectList = class(TList<TSimpleObjectBase>);
  //
  //  simple worthless class
  //
  TSimpleObjectBase = class(TObject)
  private
    FSimpleEvent: TSimpleEvent;
  private
    //
    //  static variable, will keep track of the number of TSimpleObjectBase
    //  decendant instances
    //
    class var FInstanceCount: Integer;
  public
    //
    //  constructor & destructor
    //
    constructor Create(ASimpleEvent: TSimpleEvent);
    destructor Destroy; override;
  public
    //
    //  returns the value stored in FInstanceCount
    //
    class function InstanceCount: Integer;
  public
    procedure CallMe(Sender: TObject; AMessage: string);
  end;
  //
  //  helps us create an instance of TSimpleObjectBase decendant
  //
  TSimpleObjectBaseClass = class of TSimpleObjectBase;
  //
  //  dummy classes, we're only interested in their class names
  //  returned by calling <ObjectInstance.ClassName>
  //
  TSimpleObject_A = class(TSimpleObjectBase);
  TSimpleObject_B = class(TSimpleObjectBase);
  TSimpleObject_C = class(TSimpleObjectBase);
  TSimpleObject_D = class(TSimpleObjectBase);
  TSimpleObject_E = class(TSimpleObjectBase);
  TSimpleObject_F = class(TSimpleObjectBase);
  TSimpleObject_G = class(TSimpleObjectBase);
  TSimpleObject_H = class(TSimpleObjectBase);
  TSimpleObject_I = class(TSimpleObjectBase);
  TSimpleObject_J = class(TSimpleObjectBase);
  TSimpleObject_K = class(TSimpleObjectBase);

const
  CSIMPLEOBJECTS_COUNT = 11;
  //
  //  define CSIMPLEOBJECTS's Low bound
  //
  CSIMPLEOBJECTS_LOW = 100;
  //
  //  holds a list of class types, will be created dynamically
  //  ~~~~~~~~~~
  //  IMPORTANT:
  //  ~~~~~~~~~~
  //  just so we can understand WHY it's imporant to use
  //  Low( array ) and High( array ) in order to grab an array's
  //  Low and High bound, we're going to define the bounds differently
  //  than we're "used" to i.e. array[0..count -1]
  //
  CSIMPLEOBJECTS: array[CSIMPLEOBJECTS_LOW..CSIMPLEOBJECTS_LOW +
      CSIMPLEOBJECTS_COUNT -1] of TSimpleObjectBaseClass = (
    //
    //  add more class types to this list, just remember that you need to
    //  define it/them before this constant list
    //
    TSimpleObject_A,
    TSimpleObject_B,
    TSimpleObject_C,
    TSimpleObject_D,
    TSimpleObject_E,
    TSimpleObject_F,
    TSimpleObject_G,
    TSimpleObject_H,
    TSimpleObject_I,
    TSimpleObject_J,
    TSimpleObject_K
  );

implementation

uses
  //
  //  not really required, you can also raise an Exception in stead
  //  of showing a message, your call
  //
  Dialogs
  ;

{ TSimpleEventList }

procedure TSimpleEventList.Call(Sender: TObject; AMessage: string);
var
  Index: Integer;
begin
  //
  //  call all methods by passing sender and message
  //  we're calling them in the order added
  //
  for Index := 0 to Self.Count -1 do
    Items[ Index ] ( Sender, AMessage );
end;

{ TSimpleObjectBase }

procedure TSimpleObjectBase.CallMe(Sender: TObject; AMessage: string);
begin
  //
  //  check if FSimpleEvent is assigned
  //  if NOT, then show a message, or raise an exception
  //
  if NOT Assigned(FSimpleEvent) then
    ShowMessageFmt(
      'Hey! what''s the big idea? FSimpleEvent is NOT assigned for %s', [
      Self.ClassName
    ])
  else
    FSimpleEvent(Sender, Format(
      '%s called by a %s with message: "%s"', [
      Self.ClassName,
      Sender.ClassName,
      AMessage
    ]));
end;

constructor TSimpleObjectBase.Create(ASimpleEvent: TSimpleEvent);
begin
  //
  //  set reference to the method we're going to call
  //  in order to display information on main form
  //
  FSimpleEvent := ASimpleEvent;
  //
  //  increment the number of instances
  //
  Inc(FInstanceCount);
end;

destructor TSimpleObjectBase.Destroy;
begin
  //
  //  decrement the number of instances
  //
  Dec(FInstanceCount);
  inherited Destroy;
end;

class function TSimpleObjectBase.InstanceCount: Integer;
begin
  //
  //  return FInstanceCount
  //  we don't want FInstanceCount to be modified at will
  //
  Result := FInstanceCount;
end;

initialization
  //
  //  initialization TSimpleObjectBase.FInstanceCount to zero
  //
  TSimpleObjectBase.FInstanceCount := 0;

end.

and of course Unit1.pas unit:

unit Unit1;

interface

uses
   Windows
  ,Messages
  ,SysUtils
  ,Variants
  ,Classes
  ,Graphics
  ,Controls
  ,Forms
  ,Dialogs
  ,StdCtrls
  ,CheckLst
  ,ExtCtrls
  ,ComCtrls
  //
  //  unit in which we've defined our custom types and constants
  //  basically where most of the "magic" happens
  //
  ,uMagic
  ;

type
  TObjTypeSelect = (
    otsAll,
    otsInvert,
    otsNone
  );

type
  TForm1 = class(TForm)
    Splitter1: TSplitter;
    pcObjs: TPageControl;
    tsObjectTypes: TTabSheet;
    tsObjsInstances: TTabSheet;
    lbObjTypes: TCheckListBox;
    gbOptions: TGroupBox;
    Panel1: TPanel;
    Button2: TButton;
    bnCreateObjects: TButton;
    bnObjsFree: TButton;
    Splitter2: TSplitter;
    lvObjsCreated: TListView;
    pcLog: TPageControl;
    tsMessages: TTabSheet;
    edMsgObjs: TMemo;
    tsActivityLog: TTabSheet;
    edLog: TMemo;
    sbMain: TStatusBar;
    bnFreeObjInstance: TButton;
    bnObjInstanceNotrack: TButton;
    Bevel1: TBevel;
    Panel2: TPanel;
    edReportMemoryLeaks: TCheckBox;
    Panel3: TPanel;
    bnObjTypeSelectAll: TButton;
    bnObjTypeSelectInvert: TButton;
    bnObjTypeSelectNone: TButton;
    gbReadMe: TGroupBox;
    Panel4: TPanel;
    edMsgForm1: TEdit;
    Label1: TLabel;
    edReadMe: TMemo;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure bnCreateObjectsClick(Sender: TObject);
    procedure bnObjsFreeClick(Sender: TObject);
    procedure tsActivityLogShow(Sender: TObject);
    procedure bnFreeObjInstanceClick(Sender: TObject);
    procedure bnObjInstanceNotrackClick(Sender: TObject);
    procedure edReportMemoryLeaksClick(Sender: TObject);
    procedure bnObjTypeSelectAllClick(Sender: TObject);
    procedure bnObjTypeSelectInvertClick(Sender: TObject);
    procedure bnObjTypeSelectNoneClick(Sender: TObject);
  private
    FSimpleObjectList: TSimpleObjectList;
    FSimpleEventList: TSimpleEventList;
    FUnreadLogs: Integer;
  private
    function GetAddrHex(AAddress: Pointer): string;
    procedure OnObjectMessage(Sender: TObject; AMessage: string);
    procedure FreeObjects(const AtIndex: Integer = -1);
    procedure Log(const s: string); overload;
    procedure Log(const fmt: string; const args: array of const); overload;
    procedure UpdateStatusbar;
    procedure SelectObjTypes(ASelect: TObjTypeSelect);
  public
    procedure CallAllObjects;
  public
    property SimpleEventList: TSimpleEventList read FSimpleEventList write FSimpleEventList;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

uses
   DateUtils
  ,Math // RandomRange
  ;

procedure TForm1.bnCreateObjectsClick(Sender: TObject);
var
  //
  //  loop variable
  //
  Index: Integer;
  //
  //  helper variable, will hold index of TSimpleObjectBase decendant
  //  type class  from CSIMPLEOBJECTS
  //
  LObjIndex: Integer;
  //
  //  temporary pointer to a TSimpleObjectBase decendant
  //
  LSimpleObject: TSimpleObjectBase;
  //
  //  temporary TListItem, used for displaying object(s) information
  //  i.e. class type, object address in memory, object event address
  //
  LItem: TListItem;
  //
  //  object address as hex
  //
  LObjAddress: string;
begin
  lvObjsCreated.Items.BeginUpdate;
  edLog.Lines.BeginUpdate;
  try
    //
    //  create instances of selected types
    //
    for Index := 0 to lbObjTypes.Count -1 do
      if lbObjTypes.Checked[Index] then begin
        //
        //  create a new instance of type X
        //
        LObjIndex := Integer( lbObjTypes.Items.Objects[ Index ] );
        LSimpleObject := TSimpleObjectBase( CSIMPLEOBJECTS[ LObjIndex ].NewInstance );
        //
        //  invoke constructor
        //
        LSimpleObject.Create(Self.OnObjectMessage);
        //
        //  add simple object's event to list of events
        //
        //
        SimpleEventList.Add(LSimpleObject.CallMe);
        //
        //  grab object address
        //
        LObjAddress := GetAddrHex(LSimpleObject);
        //
        //  log
        //
        Log('Created instance of type %s @ 0x%s', [
          LSimpleObject.ClassName,
          LObjAddress
        ]);
        //
        //  keep track of created instances
        //
        FSimpleObjectList.Add( LSimpleObject );
        //
        //  add a new item in created list view
        //
        LItem := lvObjsCreated.Items.Add;
        LItem.Caption := LSimpleObject.ClassName;
        LItem.SubItems.Add(Format('0x%s', [LObjAddress]));
      end; // if lbObjTypes.Checked[Index] then begin
  finally
    lvObjsCreated.Items.EndUpdate;
    edLog.Lines.EndUpdate;
  end; // tryf
end;

procedure TForm1.bnFreeObjInstanceClick(Sender: TObject);
var
  LItem: TListItem;
begin
  LItem := lvObjsCreated.Selected;
  if LItem <> NIL then
    FreeObjects(LItem.Index);
end;

procedure TForm1.bnObjInstanceNotrackClick(Sender: TObject);
var
  Index: Integer;
  LSimpleObject: TSimpleObjectBase;
begin
  //
  //  pick a random class type from list
  //  create an instance, but don't keep track of it
  //  for testing TSimpleObjectBase.InstanceCount
  //  ~~~~~~~~
  //  WARNING:
  //  ~~~~~~~~
  //  This will generate memory leaks, don't use this approach
  //  in "real" development, this is for educational purpose
  //
  //  ~~~
  //  generate a random Index, use High(CSIMPLEOBJECTS) + 1
  //  because RandomRange will not include the ATo value
  //
  Index := RandomRange(Low(CSIMPLEOBJECTS), High(CSIMPLEOBJECTS) +1);
  //
  //  create a random TSimpleObjectBase decendant instance
  //
  LSimpleObject := TSimpleObjectBase( CSIMPLEOBJECTS[ Index ].NewInstance );
  //
  //  this instance will NOT communicate with main form
  //  therefore we pass NIL for callback
  //
  LSimpleObject.Create(NIL);
  //
  //  log
  //
  Log('[NO TRACK] Created instance of type %s @ 0x%s.', [
    LSimpleObject.ClassName,
    IntToHex(Integer(LSimpleObject), 8)
  ]);
end;

procedure TForm1.bnObjsFreeClick(Sender: TObject);
begin
  if MessageDlg('Are you sure you want to free all object instances?',
      mtConfirmation, [mbYes, mbNo], 0, mbNo) = mrYes then
    FreeObjects;
end;

procedure TForm1.bnObjTypeSelectAllClick(Sender: TObject);
begin
  SelectObjTypes(TObjTypeSelect.otsAll);
end;

procedure TForm1.bnObjTypeSelectInvertClick(Sender: TObject);
begin
  SelectObjTypes(TObjTypeSelect.otsInvert);
end;

procedure TForm1.bnObjTypeSelectNoneClick(Sender: TObject);
begin
  SelectObjTypes(TObjTypeSelect.otsNone);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  CallAllObjects;
end;

procedure TForm1.CallAllObjects;
begin
  if SimpleEventList.Count < 1 then
    Log('FYI there are no objects created.')
  else begin
    Log('Calling all objects with message "%s"', [edMsgForm1.Text]);
    SimpleEventList.Call(Self, edMsgForm1.Text);
  end;
end;

procedure TForm1.edReportMemoryLeaksClick(Sender: TObject);
begin
  ReportMemoryLeaksOnShutdown := edReportMemoryLeaks.Checked;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  //
  //  loop variable
  //
  Index: Integer;
begin
  lbObjTypes.Items.BeginUpdate;
  try
    //
    //  create instance of TSimpleEventList;
    //
    FSimpleEventList := TSimpleEventList.Create;
    //
    //  this list will hold all instance, we don't want memory leaks!
    //
    FSimpleObjectList := TSimpleObjectList.Create;
    //
    //  populate object list
    //
    for Index := Low(CSIMPLEOBJECTS) to High(CSIMPLEOBJECTS) do
      lbObjTypes.Items.AddObject(
        //
        //  add class name for visual
        //
        CSIMPLEOBJECTS[Index].ClassName,
        //
        //  hack to store the "index" of object type from CSIMPLEOBJECTS
        //  WE DON'T ASSUME the Low and High bound!!!
        //
        TObject(Index)
      );
    //
    //  initialize variable to zero
    //
    FUnreadLogs := 0;
  finally
    lbObjTypes.Items.EndUpdate;
  end; // tryf
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  //
  //  free objects
  //
  FreeObjects;
  //
  //  destroy instance of TSimpleEventList;
  //
  FSimpleEventList.Free;
  //
  //  free objects holder
  //
  FSimpleObjectList.Free;
end;

procedure TForm1.FreeObjects(const AtIndex: Integer);

  procedure RemoveObject(const ObjIndex: Integer);
  var
    LSimpleObject: TSimpleObjectBase;
    LClassName: string;
    LAddress: string;
  begin
    LSimpleObject := FSimpleObjectList[ ObjIndex ];
    LClassName := LSimpleObject.ClassName;
    LAddress := GetAddrHex(LSimpleObject);
    //
    //  remove event from event list
    //
    SimpleEventList.Delete(ObjIndex);
    //
    //  log
    //
    Log('Removed event for instance of type %s @ 0x%s', [
      LClassName,
      LAddress
    ]);
    //
    //  remove from list view
    //
    lvObjsCreated.Items.Delete(ObjIndex);
    //
    //  free object
    //
    LSimpleObject.Free;
    //
    //  log
    //
    Log('Instance of type %s @ 0x%s was freed', [
      LClassName,
      LAddress
    ]);
    //
    //  remove object from list
    //
    FSimpleObjectList.Delete( ObjIndex );
  end; // procedure RemoveObject(const ObjIndex: Integer);

var
  Index: Integer;
begin
  lvObjsCreated.Items.BeginUpdate;
  edLog.Lines.BeginUpdate;
  try
    if AtIndex >= 0 then
      RemoveObject(AtIndex)
    else
      for Index := FSimpleObjectList.Count -1 downto 0 do
        RemoveObject(Index);
  finally
    lvObjsCreated.Items.EndUpdate;
    edLog.Lines.EndUpdate;
  end; // tryf
end;

function TForm1.GetAddrHex(AAddress: Pointer): string;
begin
  Result := IntToHex(Integer(AAddress), 8);
end;

procedure TForm1.Log(const s: string);
begin
  edLog.Lines.Add(Format('[%s] %s', [DateTimeToStr(Now), s]));
  if pcLog.ActivePageIndex <> tsActivityLog.PageIndex then
    Inc(FUnreadLogs)
  else
    FUnreadLogs := 0;
  UpdateStatusbar;
end;

procedure TForm1.Log(const fmt: string; const args: array of const);
begin
  Log(Format(fmt, args));
end;

procedure TForm1.OnObjectMessage(Sender: TObject; AMessage: string);
begin
  edMsgObjs.Lines.Add(Format('[%s] %s called by %s', [
    DateTimeToStr(Now),
    Sender.ClassName,
    AMessage
  ]));
end;

procedure TForm1.SelectObjTypes(ASelect: TObjTypeSelect);
var
  Index: Integer;
begin
  for Index := 0 to lbObjTypes.Count -1 do
    case ASelect of
      TObjTypeSelect.otsAll:
        lbObjTypes.Checked[ Index ] := True;
      TObjTypeSelect.otsInvert:
        lbObjTypes.Checked[ Index ] := NOT lbObjTypes.Checked[ Index ];
      TObjTypeSelect.otsNone:
        lbObjTypes.Checked[ Index ] := False;
    end; // case ASelect of
end;

procedure TForm1.tsActivityLogShow(Sender: TObject);
begin
  FUnreadLogs := 0;
  UpdateStatusbar;
end;

procedure TForm1.UpdateStatusbar;
begin
  sbMain.Panels[1].Text := IntToStr(SimpleEventList.Count);
  sbMain.Panels[3].Text := IntToStr(FUnreadLogs);
  sbMain.Panels[5].Text := IntToStr(TSimpleObjectBase.InstanceCount);
end;

initialization
  //
  //  set RandSeed
  //
  RandSeed := Ceil(Tomorrow / Today * Now);
  //
  //  call Randomize
  //
  Randomize;

end.

Click here to download the source code.

Well, that's about it for now, I hope you enjoy this demo!

tDCS -- say what?

2012-02-18T13:45:00.000+02:00

WARNING:
You should NOT experiment with tDCS WITHOUT MEDICAL SUPERVISION, experiments with tDCS were and are made on perfectly healthy people, therefore if you have any health issues whatsoever(even allergies), please consider only informing yourself about this subject and NEVER, under any circumstances, try to experiment.

Yesterday I've found out about tDCS -- no, it's not a Delphi class, but there should be one! -- while reading this article on gizmodo.com

Short Q&A:
Q: what does the name mean?
A: the longer version of the name is Transcranial Direct Current Stimulation

Q: is it dangerous?
A: let's put it this way: if you don't read enough about it(both pros and cons) and you're not ready to take the risk of going loco, then, maybe you shouldn't hook a battery to your head.

Q: applications?
A: some can be read here, here, here, here and of course google

In case you haven't checked the article on gizmodo, here's an image illustrating the idea behind it(courtasy of gizmodo.com)

The trouble with us currently, is that we don't have enough time these days to learn something new, tDCS could be a cheat that we can activate whenever we need, but we can't run around with a battery in our pocket or remember to charge it every day, because it can take some time to get used to and it can get pretty odd, so how can we cheat(yet again)?
It turns out that for quite a few years, there's a little device in our pocket or near us every day that we take special care of being charged, that's right! your mobile phone/tablet/laptop! but what do this three types of devices have in common? well, most of them have a mini usb, so with two wires hooked to your brain and plugged into your favorite device's usb port, tadam! you got yourself a tDCS on the go.

For the purpose of this article, I will choose an Android phone as a good device for experimenting, why? because it is very flexible, you can do a lot of weird stuff with it, after all, it is using a linux kernel...

The Cocktail:
- one rooted(it may be possible to play with it without rooting, not sure) Android phone
- an app that let's you fiddle with the usb
- a mini usb cable
now that you have everything you need, I assume that the app is capable of managing the amount of current the usb port will serve and that you have thought about this long enough, you can start experimenting!

Here are a couple of ideas:
- X second(s) on, X second(s) off
- X second(s) on, Y second(s) off
- take the rhythm of your favorite song, translate it into electrical impulses
- test your skills on something that puts your brain to work, first without tDCS and then with, but on different games/tests/etc.
- test all or part of the above using an EEG(i.e. http://emotiv.com/, too expensive? then take a look at this) device
once you've started, I'm sure you can take experiments to a whole new level, next level, next level! (:

Since Free Pascal is capable of creating Android apps, maybe you should start there?

I would love to read your ideas regarding this project.

Was Ray Kurzweil right about singularity being near? I believe so, what do you think?

Sometime within the next couple of days, I'll post something that is partially related to this, but much more significant in terms of applications and lower health risk.

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.

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