Showing posts with label delphi. Show all posts
Showing posts with label delphi. Show all posts

Thursday, May 21, 2009

How Detect If an Application Has Stopped Responding

In many situations you might like to detect if an application is blocked. For example while automating Internet Explorer, you'd like to know if Internet Explorer has stopped responding. There is no clear definition of an application hanging. Typically the application is "busy" with some processing. However from a user's perspective, the application has stopped responding. The idea is to periodically detect if the application is still responding in a timer and depending on application logic, the target application can be killed or other necessary action can be taken. Next example describes how to detect if an automated instance of Internet Explorer is hung or not.
unit Unit1;

interface

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

type
TForm1 = class(TForm)
btnLaunch: TButton;
btnCheck: TButton;
btnKill: TButton;
procedure btnLaunchClick(Sender: TObject);
procedure btnCheckClick(Sender: TObject);
procedure btnKillClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
modObjIE : OLEVariant;
modlngWndIE : THandle;
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.btnLaunchClick(Sender: TObject);
begin
modObjIE := CreateOleObject('InternetExplorer.Application');
modObjIE.Visible := true;
modObjIE.Navigate2('http://www.borland.com');
modlngWndIE := modObjIE.hwnd;
end;

procedure TForm1.btnCheckClick(Sender: TObject);
var
dwResult : DWORD;
lngReturnValue : longint;
begin
lngReturnValue := SendMessageTimeout(modlngWndIE, WM_NULL, 0,
0, SMTO_ABORTIFHUNG OR SMTO_BLOCK, 1000, dwResult);
If lngReturnValue > 0 then
ShowMessage('Responding')
Else
ShowMessage('Not Responding');
end;



procedure TForm1.btnKillClick(Sender: TObject);
var
ProcessID : DWORD;
Process : THandle;
begin
GetWindowThreadProcessId(modlngWndIE, @ProcessID);
Process := OpenProcess(PROCESS_ALL_ACCESS, false, ProcessID);
TerminateProcess(Process, 0);
end;

end.

Although the code is written for Internet Explorer, the idea can be used for other applications as well.
unit Unit1;

interface

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

type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
var
H : THandle;
lngReturnValue : longint;
DWResult : DWORD;
begin
H := FindWindow('Notepad', nil);
if H > 0 then
begin
lngReturnValue := SendMessageTimeout(H, WM_NULL, 0,
0, SMTO_ABORTIFHUNG And SMTO_BLOCK, 1000, DWResult);
if lngReturnValue > 0 then
ShowMessage('Responding')
else
ShowMessage('Not responding');
end
else
ShowMessage('Application not found');
end;

end.

Tuesday, August 14, 2007

How to convert from HTML color to delphi color

Here is a sample of code how to convert from HTML color representation to Delphi colors:

function HtmlToColor(Color: string): TColor;
begin
Result := StringToColor('$' + Copy(Color, 6, 2) + Copy(Color, 4, 2) + Copy(Color, 2, 2));
end;


I write a small example program:

unit Unit1;

interface

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

type
TForm1 = class(TForm)
Edit1: TEdit;
Button1: TButton;
Shape1: TShape;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}
function HtmlToColor(Color: string): TColor;
begin
Result := StringToColor('$' + Copy(Color, 6, 2) + Copy(Color, 4, 2) + Copy(Color, 2, 2));
end;


procedure TForm1.Button1Click(Sender: TObject);
begin
Shape1.Brush.Color:=HtmlToColor(Edit1.Text);
Shape1.Invalidate;
end;

end.

Friday, July 13, 2007

Variants and COM

Empty and Null


Variants can handle several datatypes and some special states as EMPTY and NULL. Before you
assign a value to a variant, it has the state EMPTY. There are a lot of functions to check the
state or type of a variant and there are predefined variants you can use.


uses Variants;

procedure VariantDemo;
var
vDemo: Variant;
bTest: Boolean;
begin
// EMPTY
vDemo := Unassigned; // assign EMPTY to variant
bTest := VarIsEmpty(vDemo); // check if variant is EMPTY
// NULL
vDemo := NULL; // assign NULL to variant
bTest := VarIsNull(vDemo); // check if variant is NULL
// numeric
vDemo := 8.8; // assign a float to variant
bTest := VarIsNumeric(vDemo); // check if variant is numeric
// text
vDemo := 'demo'; // assign a string to variant
bTest := VarIsStr(vDemo); // check if variant contains text
// COM methods can define obtional parameters. if you are
// working with typelibraries you have to pass a parameter
// nevertheless, then you can pass "EmptyParam"
vDemo := EmptyParam;
bTest := VarIsEmptyParam(vDemo);
end;

How to register a COM server


Before you can use and test your new created COM server, you have to register it. You can do
this with the Delphi menu Start\Register ActiveX-Server or you can register it by
yourself. It depends on the kind of server you have (in-process *.dll or out-of-process *.exe)
how to register the server.





















  Register Unregister
in-process (MyServer.dll) regsvr32 MyServer.dll regsvr32 /u MyServer.dll
out-of-process (MyServer.exe) MyServer.exe /regserver MyServer.exe /unregserver

If you often have to do with COM servers, it is very useful to be able to (un)register them
in the explorer. It's not difficult to extend the explorer's context menu, you can use this
small reg file to add a "Register" and an "UnRegister" entry.








Download regfile StoComRegister.zip

User actions while (un)registering a COM server


With an in-process server (DLL), you have the possiblility to run additional code at the
time of (un)registering. Creating a COM library, the delphi IDE will produce a projectfile like
this:


library Project1;

uses
ComServ;

exports
DllGetClassObject,
DllCanUnloadNow,
DllRegisterServer,
DllUnregisterServer;

{$R *.RES}

begin
end.

The functions "DllRegisterServer" and "DllUnregisterServer" are exported, and will be called
when the user or the setup registers the server. You can detour this call to take your own
actions, but make sure no errors can occur in this place.


library Project1;

uses
ComServ;

function CustomDllRegisterServer: HResult; stdcall;
begin
// call the standard function
Result := DllRegisterServer;
// execute your own code
// ...
end;

function CustomDllUnregisterServer: HResult; stdcall;
begin
// call the standard function
Result := DllUnregisterServer;
// execute your own code
// ...
end;

exports
DllGetClassObject,
DllCanUnloadNow,
CustomDllRegisterServer name 'DllRegisterServer',
CustomDllUnregisterServer name 'DllUnregisterServer';

{$R *.RES}

begin
end.


Modal forms in COM


When you are using modal forms in a COM server, you will miss the support of the menu
shortcuts and the automatic navigation between the controls with the TAB key. this is because
the "Application" object doesn't handle the windows messages, it is the window of the client
application.


// if you display a form from inside a COM server, you will miss the
// automatic navigation between the controls with the "TAB" key.
// the "KeyPreview" property of the form has to be set to "True".
procedure TForm1.FormKeyPress(Sender: TObject; var Key: Char);
var
bShift: Boolean;
begin
// check for tab key and switch focus to next or previous control.
// handle this in the KeyPress event, to avoid a messagebeep.
if (Ord(Key) = VK_TAB) then
begin
bShift := Hi(GetKeyState(VK_SHIFT)) <> 0;
SelectNext(ActiveControl, not(bShift), True);
Key := #0; // mark as handled
end;
end;

// if you display a form from inside a COM server, you will miss the
// support of the menu- and action- shortcuts like "<Ctrl><S>".
// the "KeyPreview" property of the form has to be set to "True".
procedure TForm1.FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
const
AltMask = $20000000;
var
myMessage: TWMKey;
begin
// recreate the original "KeyUp" message
FillChar(myMessage, SizeOf(TWMKey), 0);
myMessage.Msg := WM_KEYUP;
myMessage.CharCode := Key;
if (ssAlt in Shift) then
myMessage.KeyData := AltMask;
// find and execute matching shortcut
if IsShortCut(myMessage) then
Key := 0; // mark as handled
end;

Using interfaces without COM


Normally you will use interfaces in combination with COM objects. In contrast to
conventional objects, a COM object supports reference counting and will free itself when the
last reference is released.



You can use interfaces for your conventional objects too, without supporting reference
counting and automatically freeing. Doing this, you have to pay attention to some special
facts.


ITest = interface(IInterface)
// press <ctrl><shift><g> to create your own GUID for each interface.
// this is necessary to implement the "QueryInterface" method.
['{CA51B752-0DF5-40D2-945C-A5CF2EAA3B31}']
procedure ShowText;
end;

TTest = class(TObject, ITest)
protected
FText: String;
// IInterface
function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
function _AddRef: Integer; stdcall;
function _Release: Integer; stdcall;
// ITest
procedure ShowText;
end;

Because every interface inherites from the parent interface "IInterface" (same as windows
specific "IUnknown"), you have to support at least the three methods of "IInterface". This
example shows a standard implementation.


function TTest._AddRef: Integer;
begin
Result := -1; // no reference counting supported
end;

function TTest._Release: Integer;
begin
Result := -1; // no reference counting supported
end;

function TTest.QueryInterface(const IID: TGUID; out Obj): HResult;
begin
if GetInterface(IID, Obj) then
Result := S_OK
else
Result := E_NOINTERFACE;
end;

procedure TTest.ShowText;
begin
ShowMessage(FText);
end;

When you later use the object, you have to be careful, that at the moment of destruction, no
reference to the interface remains.



procedure WellUsed;
var
myTestObject: TTest;
pTestInterface: ITest;
begin
// creating the object
myTestObject := TTest.Create;
// get a reference to the interface of the object, this will implicitly call "_AddRef"
pTestInterface := myTestObject;
// ...
// release the reference to the interface, this will implicitly call "_Release"
pTestInterface := nil;
// freeing the object itself
myTestObject.Free;
end;

If you free the object, before the last reference to the interface is released, then the
implicitly call to "_Release" will call to a not existing object (Delphi will release the
interface automatically, if you don't do it yourself).


procedure WrongUsed;
var
myTestObject: TTest;
pTestInterface: ITest;
begin
myTestObject := TTest.Create;
pTestInterface := myTestObject;
// ...
// freeing the object with an existing reference
myTestObject.Free;
// this releasing of the interface will implicitly call "_Release", but there
// is no living object anymore.
pTestInterface := nil;
end;

Normally, calling a method of a not existing object will cause a runtime error, not in our
example. That's because no member of the object is used inside "_Release", as soon as you
access a member, you will get the expected error. So, first make sure you don't call a
"_Release" on a not existing object, then don't access members inside of "_Release".


function TTest._Release: Integer;
begin
// this will cause an error, if the reference is released after the object was freed.
FText := '';
Result := -1; // no reference counting supported
end;

Saturday, June 16, 2007

Global mouse hook

Here is a global mouse hook on Delphi which will intercept middle (scroll) button click (WM_NCMBUTTONDOWN and WM_MBUTTONDOWN messages), check if any top level window is under the cursor and if yes then minimize that window.

The code is pretty simple.

We need two projects: one - which runs the hook and then kills it; the other - the hook itself (it is supposed to be a DLL because it is a global hook). Nothing difficult (at least if you what is DLL and how to use them)!

Here is the mouse hook (WH_MOUSE) implementation:

library MiddleButton;

uses
Windows,
Messages;

const
MemMapFile = 'temp_thief';
type
PDLLGlobal = ^TDLLGlobal;
TDLLGlobal = packed record
HookHandle: HHOOK;
end;

var
GlobalData: PDLLGlobal;
MMF: THandle;

{$R *.res}

function HookProc(Code: integer; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
var
CurrWND: THandle;
begin
if Code < wparam =" WM_NCMBUTTONDOWN)" wparam =" WM_MBUTTONDOWN)" mmf =" 0" globaldata =" nil">nil then
UnmapViewOfFile(GlobalData);

if MMF<> INVALID_HANDLE_VALUE then
CloseHandle(MMF);
end;

procedure RunHook; stdcall;
begin
GlobalData^.HookHandle:= SetWindowsHookEx(WH_MOUSE, @HookProc, HInstance, 0);
if GlobalData^.HookHandle = INVALID_HANDLE_VALUE then
begin
MessageBox(0, 'Error :)' , '' , MB_OK);
Exit;
end;
end;

procedure KillHook; stdcall;
begin
if (GlobalData<>nil) and (GlobalData^.HookHandle<>INVALID_HANDLE_VALUE) then
UnhookWindowsHookEx(GlobalData^.HookHandle);
end;

procedure DLLEntry(dwReason: DWORD);
begin
case dwReason of
DLL_PROCESS_ATTACH: CreateGlobalHeap;
DLL_PROCESS_DETACH: DeleteGlobalHeap;
end;
end;

exports
KillHook,
RunHook;

begin
DLLProc:= @DLLEntry;
DLLEntry(DLL_PROCESS_ATTACH);
end.And here is an implementation of the hook launcher:
unit RunMiddleButton;

interface

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

type
TfrmMain = class(TForm)
btnRunHook: TButton;
btnKillHook: TButton;
procedure btnRunHookClick(Sender: TObject);
procedure btnKillHookClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

procedure RunHook; stdcall; external 'MiddleButton.dll' name 'RunHook';
procedure KillHook; stdcall; external 'MiddleButton.dll' name 'KillHook';

var
frmMain: TfrmMain;

implementation

{$R *.dfm}

procedure TfrmMain.btnRunHookClick(Sender: TObject);
begin
RunHook;
end;

procedure TfrmMain.btnKillHookClick(Sender: TObject);
begin
KillHook;
end;

end.

Friday, June 15, 2007

Rounded buttons with bitmaps for the up/down state

unit Bibutton;

interface

uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
Forms, ExtCtrls;

type
TBiButton = class(TCustomControl)
private
FTPicture : TPicture;
FPPicture : TPicture;
FOnPaint : TNotifyEvent;
FRegion : THandle;
FBRegion : THandle;
FBorder : Boolean;
FOffset : Integer;
FCaption : String;

FXRad,
FYRad : Integer;

Down,
Pressed : Boolean;

procedure SetTPicture (Value : TPicture);
procedure SetPPicture (Value : TPicture);
procedure SetXRadius (Value : Integer);
procedure SetYRadius (Value : Integer);
procedure SetBorder (Value : Boolean);
procedure PictureChanged(Sender : TObject);
procedure WM_LButtonDown (var Msg : TWMLButtonDown); message wm_LButtonDown;
procedure WM_LButtonUp (var Msg : TWMLButtonUp); message wm_LButtonUp;
procedure WM_MouseMove (var Msg : TWMMouseMove); message wm_MouseMove;
procedure WM_Size (var Msg : TWMSize); message wm_Size;
procedure SetRegion;
procedure SetOffest(const Value: Integer);
procedure SetCaption(const Value: String);

public
constructor Create (AOwner : TComponent); override;
destructor Destroy; override;
property Canvas;

protected
function GetPalette : HPalette; override;
procedure Paint; override;

published
// The "not-pressed-picture"
property TopPicture : TPicture read FTPicture write SetTPicture;
// The "pressed-picture" - if none, TopPicture will be used
property PressedPicture : TPicture read FPPicture write SetPPicture;
// for round buttons
property XRadius : Integer read FXRad write SetXRadius;
property YRadius : Integer read FYRad write SetYRadius;
// showing a border or not
property Border : Boolean read FBorder write SetBorder;
// offset of the "pressed-picture"
property Offset : Integer read FOffset write SetOffest;
property Caption : String read FCaption write SetCaption;

property Color;
property Font;
property Align;
property Visible;
property ShowHint;
property Enabled;
property ParentColor;
property ParentFont;
property ParentShowHint;
property TabOrder;
property OnClick;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnEnter;
property OnExit;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
end;

procedure Register;

implementation

procedure Register;
begin
RegisterComponents('GBit', [TBiButton]);
end;


constructor TBiButton.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FRegion := 0;
FBRegion := 0;
ControlStyle := [csCaptureMouse, csClickEvents];
FTPicture := TPicture.Create;
FTPicture.OnChange := PictureChanged;
FPPicture := TPicture.Create;
FPPicture.OnChange := PictureChanged;
FBorder := True;
Height := 100;
Width := 100;
XRadius := Width;
YRadius := Height;
Offset := 2;
Pressed := False;
end;


destructor TBiButton.Destroy;
begin
FTPicture.Free;
FPPicture.Free;
DeleteObject (FRegion);
DeleteObject (FBRegion);
inherited Destroy;
end;


function TBiButton.GetPalette: HPalette;
begin
Result := 0;
if FTPicture.Graphic is TBitmap then
Result := TBitmap(FTPicture.Graphic).Palette;
end;


procedure TBiButton.SetTPicture(Value: TPicture);
begin
FTPicture.Assign(Value);
end;


procedure TBiButton.SetPPicture(Value: TPicture);
begin
FPPicture.Assign(Value);
end;


procedure TBiButton.Paint;
var
Rect : TRect;
Ha : HDC;
ps : TPaintStruct;
x, y : Integer;
R, rx,
G, gx,
B, bx : Word;
AColor,
LightC,
DarkC : TColor;
begin
Rect := GetClientRect;
InvalidateRgn (Handle, FRegion, False);
try
SetWindowRgn (Self.Handle, FBRegion, True);
except
end;

if Color < width =" Width)" height =" Height)" width =" Width)" height =" Height)"> Down then begin
Down := D;
Invalidate;
end;
end;
inherited;
end;


procedure TBiButton.SetYRadius (Value : Integer);
begin
if Value > Height then
Value := Height;
if Value <> YRadius then begin
FYRad := Value;
SetRegion;
Invalidate;
end;
end;


procedure TBiButton.SetXRadius (Value : Integer);
begin
if Value > Width then
Value := Width;
if Value <> XRadius then begin
FXRad := Value;
SetRegion;
Invalidate;
end;
end;


procedure TBiButton.SetRegion;
begin
DeleteObject (FRegion);
DeleteObject (FBRegion);
if XRadius > Width then
FXRad := Width;
if YRadius > Height then
FYRad := Height;
FRegion := CreateRoundRectRgn (0, 0, Width+1, Height+1, XRadius, YRadius);
FBRegion := CreateRoundRectRgn (0, 0, Width+1, Height+1, XRadius, YRadius);
end;


procedure TBiButton.WM_Size (var Msg : TWMSize);
begin
SetRegion;
Invalidate;
end;


procedure TBiButton.SetBorder (Value : Boolean);
begin
if Value <> FBorder then begin
FBorder := Value;
Invalidate;
end;
end;

procedure TBiButton.SetOffest(const Value: Integer);
begin
FOffset := Value;
Invalidate;
end;

procedure TBiButton.SetCaption(const Value: String);
begin
FCaption := Value;
Invalidate;
end;

end.

Thursday, July 13, 2006

How to create a non-rectangular form

And how to do this? Here you will find a simple example that just gives some text and sets the region like it. Expand it by your mind!

unit uMainForm;

interface

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

type
TfrmMainForm = class(TForm)
btnDoAction: TButton;
pmnPopup: TPopupMenu;
miDrawText: TMenuItem;
miExit: TMenuItem;
procedure btnDoActionClick(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure miExitClick(Sender: TObject);
private
{ Private declarations }
HRgn: THandle;
public
{ Public declarations }
end;

var
frmMainForm: TfrmMainForm;

implementation

{$R *.DFM}

procedure TfrmMainForm.btnDoActionClick(Sender: TObject);
var
s: String;
begin
DeleteObject(HRgn);
s := InputBox('Region Text', 'Please enter some text to set to the region', 'CoolRgn');

BeginPath(Canvas.Handle);
with Canvas do
begin
Font.Name := 'Comic Sans MS'; Font.Size := 64; Font.Style := [fsBold];
TextOut(0, 0, s);
end;

EndPath(Canvas.Handle);
HRgn := PathToRegion(Canvas.Handle);
SetWindowRgn(Handle, HRgn, True);

btnDoAction.Visible := False;
Color := clRed;
end;

procedure TfrmMainForm.FormClose(Sender: TObject;
var Action: TCloseAction);
begin
DeleteObject(HRgn);
end;

procedure TfrmMainForm.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button = mbLeft then
begin
ReleaseCapture;
SendMessage(Handle, WM_NCLBUTTONDOWN, HTCAPTION, 0);
end;
end;

procedure TfrmMainForm.miExitClick(Sender: TObject);
begin
Application.MainForm.Close;
end;

end.

Saturday, June 24, 2006

Using Google Translate from Delphi

This is how to translate a text unsing Google Translate from Delphi:
For sending data to Google will use http GET method.


function translate(ss,lng:string):string;
var s:widestring;
a,b:integer;
http:tidhttp;
begin
http:=tidhttp.Create;
s:=http.Get('http://translate.google.com/translate_t?text='
+httpencode(ss)+'&langpair='+lng);
a:=posex('›',s,pos('‹textarea',s));
b:=posex('‹/textarea›',s,a);
result:=copy(s,a+1,b-a-1);
http.Free;
end;


where ss is the text to be translated and lng is the string that tell
Google from and to what language to translate.
Here is some definiton of lng:


lng:array[0..17]of string=('zh-CN%7Cen',
'en%7Czh-CN',
'en%7Cfr',
'en%7Cde',
'en%7Cit',
'en%7Cja',
'en%7Cko',
'en%7Cpt',
'en%7Ces',
'fr%7Cen',
'fr%7Cde',
'de%7Cen',
'de%7Cfr',
'it%7Cen',
'ja%7Cen',
'ko%7Cen',
'pt%7Cen',
'es%7Cen');

Friday, February 17, 2006

Making life easier with Indy

Let's take a look at the networking in Delphi.
One of the best library for writing network applications in Delphi is with no doubt Indy. It has almost everything someone wished for internt programming.

In the begining because today Google makes the net goes round ;) , let see how can use pop3 for retrieving mails from your Gmail account.

Drop on your form: a button, a listbox, one TIdPOP3, one TIdSSLIOHandlerSocketOpenSSL and one TIdMessage. Make the set the components that .dfm look like this:

object Form1: TForm1
Left = 0
Top = 0
Width = 420
Height = 378
Caption = 'Form1'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
OldCreateOrder = False
PixelsPerInch = 96
TextHeight = 13
object Button1: TButton
Left = 16
Top = 16
Width = 75
Height = 25
Caption = 'Button1'
TabOrder = 0
OnClick = Button1Click
end
object ListBox1: TListBox
Left = 32
Top = 72
Width = 345
Height = 265
ItemHeight = 13
TabOrder = 1
end
object pop: TIdPOP3
IOHandler = IdSSLIOHandlerSocketOpenSSL1
AutoLogin = True
Host = 'pop.gmail.com'
Username = 'youruser@gmail.com'
UseTLS = utUseImplicitTLS
Password = 'yourpassword'
Port = 995
SASLMechanisms = <>
Left = 208
Top = 16
end
object msg: TIdMessage
AttachmentEncoding = 'MIME'
BccList = <>
CCList = <>
Encoding = meDefault
FromList = <>
Recipients = <>
ReplyTo = <>
ConvertPreamble = True
Left = 304
Top = 24
end
object IdSSLIOHandlerSocketOpenSSL1: TIdSSLIOHandlerSocketOpenSSL
Destination = 'pop.gmail.com:995'
Host = 'pop.gmail.com'
MaxLineAction = maException
Port = 995
DefaultPort = 0
SSLOptions.Method = sslvSSLv2
SSLOptions.Mode = sslmUnassigned
SSLOptions.VerifyMode = []
SSLOptions.VerifyDepth = 0
Left = 160
Top = 32
end
end

This is a simple application and i only show here how to retrieve the number of messages from the inbox and the subject. For everything eles use your imagination :D

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, IdIOHandler, IdIOHandlerSocket, IdIOHandlerStack, IdSSL,
IdSSLOpenSSL, IdMessage, IdBaseComponent, IdComponent, IdTCPConnection,
IdTCPClient, IdExplicitTLSClientServerBase, IdMessageClient, IdPOP3;

type
TForm1 = class(TForm)
Button1: TButton;
pop: TIdPOP3;
msg: TIdMessage;
IdSSLIOHandlerSocketOpenSSL1: TIdSSLIOHandlerSocketOpenSSL;
ListBox1: TListBox;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var n,i:integer;
begin
pop.Connect;
n:=pop.CheckMessages;
listbox1.Items.Add(format('There are %d messages',[n]));
for i:=0 to n-1 do
begin
pop.Retrieve(i,msg);
listbox1.Items.Add(format('%d - %s',[i,msg.Subject]));
application.ProcessMessages;
end;
pop.Disconnect;
end;

end.

I hope this helps you and if you got any questions feel free to ask.
Good luck !