GT Delphi Components – Freeware Components

Archive for the ‘Delphi Code Snippets’ Category

Here is to enable / disable the proxy server for a windows pc.

unit main;

interface

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

type
  TForm1 = class(TForm)
    CheckBox1: TCheckBox;
    btnApply: TButton;
    procedure btnApplyClick(Sender: TObject);
  private
    { Private declarations }
    R            : TRegistry;
    ProxySetting : Integer;
  public
    { Public declarations }
    constructor Create(AOwner : TComponent);override;
  end;

var
  Form1: TForm1;

const
  //The registry key where the setting is stored.
  PROXY_KEY = 'Software\Microsoft\Windows\CurrentVersion\Internet Settings';
implementation

{$R *.dfm}
{------------------------------------------------------------------------------}
constructor TForm1.Create(AOwner: TComponent);
begin
  inherited;
   R := TRegistry.Create;
  try
    R.RootKey := HKEY_CURRENT_USER;
    if R.OpenKey(PROXY_KEY,False) then
    begin
      //Reading the state of the setting.
      ProxySetting := R.ReadInteger('ProxyEnable');
      case ProxySetting of
        0: CheckBox1.Checked := False;
        1: CheckBox1.Checked := True;
      end;
    end;
  finally
    R.CloseKey;
    FreeAndNil(R);
  end;
end;
{------------------------------------------------------------------------------}
procedure TForm1.btnApplyClick(Sender: TObject);
begin
 { TODO -oUser -cConsole Main : Insert code here }
  R := TRegistry.Create;
  try
    R.RootKey := HKEY_CURRENT_USER;
    if R.OpenKey(PROXY_KEY,False) then
    begin
      //Setting Proxy enable / disable.
      ProxySetting := R.ReadInteger('ProxyEnable');
      if CheckBox1.Checked then
        R.WriteInteger('ProxyEnable',1)
      else
        R.WriteInteger('ProxyEnable',0);
    end;
  finally
    R.CloseKey;
    FreeAndNil(R);
  end;
end;
{------------------------------------------------------------------------------}
end.

This demo will demonstrate how to use the TgtExplorerSysObjs class.

This uses the TShellListView and TShellTreeView components.

Here is the source code :

{*******************************************************}
{                                                       }
{       GT Delphi Components                            }
{       TgtExplorerSysObjs  Demo                        }
{                                                       }
{       Copyright (c) GT Delphi Components              }
{       http://www.gtdelphicomponents.gr                }
{                                                       }
{                                                       }
{*******************************************************}

unit f_main;

interface

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

type
  TForm1 = class(TForm)
    ShellTreeView1: TShellTreeView;
    ShellListView1: TShellListView;
  private
    { Private declarations }
    FGTSysObjs : TgtExplorerSysObjs;
  public
    { Public declarations }
    constructor  Create(AOwner : TComponent);override;
    destructor   Destroy;override;
  end;

var
  Form1: TForm1;

implementation
uses
  Registry
  ;

{$R *.dfm}
{------------------------------------------------------------------------------}
constructor TForm1.Create(AOwner: TComponent);
begin
  inherited;
  FGTSysObjs := TgtExplorerSysObjs.Create(Self);
//Show system objects without
//having the user to go Folder->Options
//and set it there.
  FGTSysObjs.ShowSystemObjects := True;
end;
{------------------------------------------------------------------------------}
destructor TForm1.Destroy;
begin
  inherited;
end;
{------------------------------------------------------------------------------}

end.

Upon a request here is the code on how to enable / disable the visibility of system objects,files,folders,e.t.c. in the Windows Explorer

TgtExplorerSysObjs is a TComponent descentant which implements this logic.

Here is the source code :

{*******************************************************}
{                                                       }
{       GT Delphi Components                            }
{       TgtExplorerSysObjs                              }
{                                                       }
{       Copyright (c) GT Delphi Components              }
{       http://www.gtdelphicomponents.gr                }
{                                                       }
{                                                       }
{*******************************************************}
unit o_GTExplorerSysObjects;

interface
uses
   Classes
  ;

type
  TgtExplorerSysObjs  = class(TComponent)
  private
    FShowSystemObjects: Boolean;
    procedure SetShowSystemObjects(const Value: Boolean);
    { Private declarations }
  protected
    { Protected declarations }
    FDefaultHiddenStatus : Integer;
    procedure  UpdateExplorer;
    procedure  ApplySysObjsVisible(Visible : Boolean);
  public
    { Public declarations }
    constructor Create(AOwner:TComponent);override;
    destructor  Destroy;override;
  published
    { Published declarations}
    property ShowSystemObjects : Boolean read FShowSystemObjects write SetShowSystemObjects;
  end;

implementation

uses
   Windows
  ,Messages
  ,Registry
  ;

const
  EXPLORER_KEY   = '\Software\Microsoft\Windows\CurrentVersion\Explorer\Advanced';
  EXPLORER_VALUE = 'ShowSuperHidden';
  EXPLORER_CLASS = 'ExploreWClass';

{ TgtExplorerSysObjs }
{------------------------------------------------------------------------------}
constructor TgtExplorerSysObjs.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FDefaultHiddenStatus := 0;
end;
{------------------------------------------------------------------------------}
destructor TgtExplorerSysObjs.Destroy;
begin
  ApplySysObjsVisible(False);
  inherited;
end;
{------------------------------------------------------------------------------}
procedure TgtExplorerSysObjs.ApplySysObjsVisible(Visible: Boolean);
var
  R : TRegistry;
begin
  //ShowSuperHidden is a flag for system objects
  //files,folders,e.t.c
  //0=Hide Files 1= ShowFiles
  R := TRegistry.Create;
  try
    R.RootKey := HKEY_CURRENT_USER;
    if R.OpenKey(EXPLORER_KEY,False) then
    begin
      case Visible of
        True :
          begin
            if not R.ValueExists(EXPLORER_VALUE) then
              R.WriteInteger(EXPLORER_VALUE,1)
            else
            begin
              FDefaultHiddenStatus := R.ReadInteger(EXPLORER_VALUE);
              R.WriteInteger(EXPLORER_VALUE,1)
            end;
          end;
        False :
          begin
            if not R.ValueExists(EXPLORER_VALUE) then
              R.WriteInteger(EXPLORER_VALUE,FDefaultHiddenStatus)
            else
              R.WriteInteger(EXPLORER_VALUE,FDefaultHiddenStatus)
          end;
      end;
    end;
  finally
    R.CloseKey;
    R.Free;
  end;
  UpdateExplorer;
end;
{------------------------------------------------------------------------------}
procedure TgtExplorerSysObjs.UpdateExplorer;
var
  H : LongInt;
begin
 //Refresh the explorer.
 //This applies to Windows XP with SP2
 //Not tested with any other version of Windows.
 H := FindWindow(EXPLORER_CLASS,nil);
 if H <> 0 then
  SendMessage(H,WM_COMMAND,28931,0);
end;
{------------------------------------------------------------------------------}

//Getters - Setters\\
{------------------------------------------------------------------------------}
procedure TgtExplorerSysObjs.SetShowSystemObjects(const Value: Boolean);
begin
  if FShowSystemObjects <> Value then
  begin
    FShowSystemObjects := Value;
    ApplySysObjsVisible(FShowSystemObjects);
  end;
end;
{------------------------------------------------------------------------------}

end.

This demo will demonstrate how to use the TgtFormEvents.

Here is the source code of the project

procedure TForm1.Button1Click(Sender: TObject);
var
  AFrm : TForm;
begin
  //Creating a Form
  AFrm                     := TForm.Create(Self);
  AFrm.Position            := poScreenCenter;
  //Creating the FormEvents component
  FFormEvents              := TgtFormEvents.Create(Self);
  //Attaching the FormEvents component to the form
  FFormEvents.Form         := AFrm;

  //Assiging the events
  FFormEvents.OnBeforeShow := OnBeforeShow;
  FFormEvents.OnAfterShow  := OnAfterShow;
  FFormEvents.OnMinimize   := OnMinimize;
  FFormEvents.OnRestore    := OnRestore;

  try
    //Showing the form
    if CheckBox1.Checked then
      AFrm.ShowModal
    else
      AFrm.Show;
  finally
    //Destroying the form
    if CheckBox1.Checked  then
    begin
      FreeAndNil(AFrm);
      FreeAndNil(FFormEvents);
    end;
  end;
end;

(No Ratings Yet)
 Loading ...

This demo will demonstrate the usage of the GT Setting Controls Suite.
This demo requires that the GT Setting Controls Suite is installed into Delphi IDE

procedure TForm1.btnSaveClick(Sender: TObject);
begin
  gtSettingsManager1.SaveSettings;
end;

procedure TForm1.btnLoadClick(Sender: TObject);
begin
  gtSettingsManager1.LoadSettings;
end;

procedure TForm1.btnClearClick(Sender: TObject);
begin
  gtSettingsManager1.ClearControlValues;
end;

Download the source code

This demo will demonstrate the usage of the TgtRegisteredClasses component on how to list all registered classes in a delphi application.

This is the actual code of the demo

procedure TForm1.btnGetClassesClick(Sender: TObject);
begin
  ListBox1.Items.Clear;
  ListBox1.Items.AddStrings(RegisteredClasses.ClassList);
end;

procedure TForm1.btnRegisterClassesClick(Sender: TObject);
begin
  RegisterClass(TWinControl);
  RegisterClass(TButton);
end;

The btnGetClasses lists all registered classes in the listbox and the btnRegisterClasses
registers some new classes.
Press first the btnGetClasses then the btnRegisterClasses to see the diference.

Download the soure code of the Class Finder Demo

This demo is using the TgtRegisteredClasses component

This post will demonstrate how to get a list of running processes in a windows pc and many extra details for each process.
This demo will be a good start if anybody want’s to write a windows task manager alternative.

At the end of the post you will find a demo with source code to download

The demo consists of one basic class TgtProcessManager.
It will do all the work here is the declaration part of the class(because it is pretty big to post the whole unit) :

{------------------------------------------------------------------------------}
  TgtProcessManager = class(TComponent)
  private
    FHostApp              : string;
    FHostAppLoadedModules : TStrings;
    FFileInfo             : TgtFileInfo;
    FRunningProcessList: TObjectList;
    FOnAfterLaunch: TNotifyEvent;
    procedure SetHostApp(const Value: string);
    function GetRunningProcess(Index: Integer): TgtRunningProcess;
    { Private declarations }
  protected
    { Protected declarations }
    function  GetProcessId(ProcessName : string):Cardinal;
    function  GetModuleLoaded(ModuleName : string):Boolean;
    function  InternalTerminateProcess(ExeName : string):Integer;
    procedure InternalLaunch(ExeFileName: string;WaitTimeOut:Integer=5000;
      ExeParams:string='';Wait: Boolean = False);
    procedure GetHostAppLoadedModules;
    function  GetMemUsageForProcess(ProcId:Cardinal):Cardinal;
    procedure GetCpuUsage(AProcess : TgtRunningProcess);
  public
    { Public declarations }
    constructor Create(AOwner : TComponent);override;
    destructor  Destroy;override;
    procedure  UpdateRunningProcessList;
    function  IsModuleLoaded(ModuleName:string;LookInCache : Boolean = False):Boolean;
    function  TerminateProcess(ExeName : string):Integer;overload;
    function  TerminateProcess(RunningProcess : TgtRunningProcess):Integer;overload;
    function  TerminateProcess(RunningProcessIndex : Integer):Integer;overload;
    procedure Launch(ExeFileName: string;WaitTimeOut:Integer=5000;ExeParams:string='');
    procedure LaunchAndWait(ExeFileName: string;WaitTimeOut:Integer=5000;ExeParams:string='');
  public
    property  RunningProcesses[Index : Integer] : TgtRunningProcess read GetRunningProcess;
  published
    { Published declarations}
    property HostApp              : string          read FHostApp         write SetHostApp;
    property HostAppLoadedModules : TStrings        read FHostAppLoadedModules;
    property ModuleInfo           : TgtFileInfo     read FFileInfo;
    property RunningProcessList   : TObjectList     read FRunningProcessList;
  published
    property OnAfterLaunch : TNotifyEvent read FOnAfterLaunch write FOnAfterLaunch;
  end;

There is also a list view(TgtProcessListView) that has embedded a TgtProcessManager and does all the work by it self below a screenshot with TgtProcessListView in usage

This the declaration part of the TgtProcessListView class

type
{------------------------------------------------------------------------------}
  TgtProcessListView = class;
{------------------------------------------------------------------------------}
  TgtProcessInfoThread = class(TThread)
  private
    { Private declarations }
    FProcessListView : TgtProcessListView;
  protected
    { Protected declarations }
    FProcessManager : TgtProcessManager;
    procedure UpdateUI;
  public
    { Public declarations }
    procedure Execute;override;
  public
    constructor Create(AProcessListView:TgtProcessListView);
    destructor  Destroy;override;
  published
    { Published declarations}
  end;
{------------------------------------------------------------------------------}
  TgtProcessListView = class(TCustomListView)
  private
    FRefreshInterval: Cardinal;
    { Private declarations }
  protected
    { Protected declarations }
    FProcessInfoThread : TgtProcessInfoThread;
    procedure CreateColumns;
    procedure Initialize;
  protected
    procedure SetParent(AParent: TWinControl);override;
  public
    { Public declarations }
    constructor Create(AOwner:TComponent);override;
    destructor  Destroy;override;
  published
    { Published declarations}
    property RefreshInterval : Cardinal read FRefreshInterval write FRefreshInterval;
  end;
{------------------------------------------------------------------------------}

The execute part of the TgtProcessInfoThread does update the listview with the running processes

{------------------------------------------------------------------------------}
procedure TgtProcessInfoThread.Execute;
begin
  while not Terminated do
  begin
    WaitForSingleObject(Handle,FProcessListView.RefreshInterval);
    FProcessManager := TgtProcessManager.Create(nil);
    try
      FProcessManager.UpdateRunningProcessList;
      Synchronize(UPdateUI);
    finally
      FreeAndNil(FProcessManager);
    end;
  end;
end;
{------------------------------------------------------------------------------}

Download the source code

Upon request here is a demo for using the TgtTimer component.
Download the GTTimer Demo

GTTimer Demo Main Screen

{*******************************************************}
{                                                       }
{       GT Delphi Components                            }
{       GT Threaded Timer Demo                          }
{                                                       }
{       Copyright (c) GT Delphi Components              }
{       http://www.gtdelphicomponents.gr                }
{                                                       }
{                                                       }
{*******************************************************}
unit f_main;

interface

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

type
  TForm1 = class(TForm)
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    Label1: TLabel;
    edtTimerInterval: TEdit;
    UpDown1: TUpDown;
    chkBoxTimerEnabled: TCheckBox;
    btnClose: TButton;
    ProgressBar1: TProgressBar;
    Timer1: TTimer;
    ProgressBar2: TProgressBar;
    Label2: TLabel;
    Edit1: TEdit;
    UpDown2: TUpDown;
    CheckBox1: TCheckBox;
    procedure btnCloseClick(Sender: TObject);
    procedure chkBoxTimerEnabledClick(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure CheckBox1Click(Sender: TObject);
  private
    { Private declarations }
    FTimer : TgtTimer;
    procedure InternalOnTimer(Sender : TObject);
  public
    { Public declarations }
    constructor Create(AOwner : TComponent);override;
    destructor  Destroy;override;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

{GTTimer Usage}

{
 Of course TgtTimer can be installed into the IDE but for the purpose
 of this demo it is created and used in runtime and does not
 require installation into the IDE for the Demo to work
}
{------------------------------------------------------------------------------}
constructor TForm1.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  //Creating the GTTimer
  FTimer         := TgtTimer.Create(Self);
  //Assigning the event
  FTimer.OnTimer := InternalOnTimer;
  FTimer.Enabled := False;
end;
{------------------------------------------------------------------------------}
destructor TForm1.Destroy;
begin
  if Assigned(FTimer) then
    FTimer.Enabled := False;//Setting to false will destroy the thread
  inherited;
end;
{------------------------------------------------------------------------------}
procedure TForm1.btnCloseClick(Sender: TObject);
begin
  Close;
end;
{------------------------------------------------------------------------------}
procedure TForm1.InternalOnTimer(Sender: TObject);
begin
  //Just playing with the progress bar
  if (ProgressBar1.Position + 1) < = ProgressBar1.Max then
    ProgressBar1.Position := ProgressBar1.Position + 1
  else
    ProgressBar1.Position := 0;
end;
{------------------------------------------------------------------------------}
procedure TForm1.chkBoxTimerEnabledClick(Sender: TObject);
begin
  //Setting the interval and enable state
  if UpDown1.Position >=0 then
    FTimer.Interval := UpDown1.Position;
  FTimer.Enabled := TCheckBox(Sender).Checked;
end;
{------------------------------------------------------------------------------}

{TTimer Usage}
{------------------------------------------------------------------------------}
procedure TForm1.Timer1Timer(Sender: TObject);
begin
  //Just playing with the progress bar
  if (ProgressBar2.Position + 1) < = ProgressBar2.Max then
    ProgressBar2.Position := ProgressBar2.Position + 1
  else
    ProgressBar2.Position := 0;
end;
{------------------------------------------------------------------------------}
procedure TForm1.CheckBox1Click(Sender: TObject);
begin
    //Setting the interval and enable state
  if UpDown2.Position >=0 then
    Timer1.Interval := UpDown2.Position;
  Timer1.Enabled := TCheckBox(Sender).Checked;
end;
{------------------------------------------------------------------------------}

end.

GTTimer is a Timer Component which delivers the same result as a classic TTimer component but it uses a TThread descentant to implement the logic of the Timer Interval.
This timer is not based on the window messaging system as the classic TTimer component which makes it more reliable and less resource consuming(supposing you have many timers in your application).
For any comments suggestions or anything else please leave a comment on the specific post.
So enough said here is the code

{*******************************************************}
{                                                       }
{       GT Delphi Components                            }
{       GT Threaded Timer                               }
{                                                       }
{       Copyright (c) GT Delphi Components              }
{       http://www.gtdelphicomponents.gr                }
{                                                       }
{                                                       }
{*******************************************************}
unit o_GTTimer;

interface

uses
  Classes
  ;

type
{------------------------------------------------------------------------------}
  TgtTimer = class;
{------------------------------------------------------------------------------}
 TgtTimerThread = class(TThread)
 private
   { Private declarations }
   FTimer : TgtTimer;
 protected
   { Protected declarations }
   procedure DoTimer;
 public
   { Public declarations }
   constructor Create(ATimer : TgtTimer);
   destructor  Destroy;override;
   procedure Execute;override;
 published
   { Published declarations}
 end;
{------------------------------------------------------------------------------}
  TgtTimer = class(TComponent)
  private
    FEnabled: Boolean;
    FInterval: Cardinal;
    FOnTimer: TNotifyEvent;
    procedure SetEnabled(const Value: Boolean);
    procedure SetInterval(const Value: Cardinal);
    { Private declarations }
  protected
    { Protected declarations }
    FTimerThread : TgtTimerThread;
    procedure UpdateTimer;
  public
    { Public declarations }
    constructor Create(AOwner:TComponent);override;
    destructor  Destroy;override;
  published
    { Published declarations}
    property Enabled : Boolean  read FEnabled  write SetEnabled;
    property Interval: Cardinal read FInterval write SetInterval;
  published
    property OnTimer : TNotifyEvent read FOnTimer write FOnTimer;
  end;
{------------------------------------------------------------------------------}

implementation
uses
   Windows
  ,SysUtils
  ;

{ TgtTimerThread }
{------------------------------------------------------------------------------}
constructor TgtTimerThread.Create(ATimer: TgtTimer);
begin
  inherited Create(True);
  FreeOnTerminate := True;
  FTimer          := ATimer;
end;
{------------------------------------------------------------------------------}
destructor TgtTimerThread.Destroy;
begin
  inherited;
end;
{------------------------------------------------------------------------------}
procedure TgtTimerThread.DoTimer;
begin
  if Assigned(FTimer.OnTimer) then
    FTimer.OnTimer(FTimer);
end;
{------------------------------------------------------------------------------}
procedure TgtTimerThread.Execute;
begin
  while (not Self.Terminated) and (FTimer.Enabled) do
  begin
    WaitForSingleObject(Self.Handle,FTimer.Interval);
    Synchronize(DoTimer);
  end;
end;
{------------------------------------------------------------------------------}

{ TgtTimer }
{------------------------------------------------------------------------------}
constructor TgtTimer.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FEnabled  := True;
  FInterval := 1000;
end;
{------------------------------------------------------------------------------}
destructor TgtTimer.Destroy;
begin
  inherited;
end;
{------------------------------------------------------------------------------}
procedure TgtTimer.UpdateTimer;
begin
  if Assigned(FTimerThread) then
  begin
    FTimerThread.Terminate;
    FTimerThread := nil;
  end;
  if Enabled then
  begin
    if FInterval > 0 then
    begin
      FTimerThread := TgtTimerThread.Create(Self);
      FTimerThread.Resume;
    end
    else
      Enabled := False;
  end;
end;
{------------------------------------------------------------------------------}

//Getters - Setters\\
{------------------------------------------------------------------------------}
procedure TgtTimer.SetEnabled(const Value: Boolean);
begin
  FEnabled := Value;
  UpdateTimer;
end;
{------------------------------------------------------------------------------}
procedure TgtTimer.SetInterval(const Value: Cardinal);
begin
  if Value <> FInterval then
  begin
    FInterval := Value;
    UpdateTimer;
  end;
end;
{------------------------------------------------------------------------------}

end.

This post will demonstrate how to connect and retrieve mail from a POP3 account.

For the purpose of this demonstration we will need
a TIdPOP3 component and a TIdMessage component.

Step 1 :
Go to the Indy Clients tab and drop an TIdPOP3 component and a Memo component on the form

Ok let’see whats under the connect and get button

procedure TForm1.Button2Click(Sender: TObject);
var
  MsgCount : Integer;
  i        : Integer;
  FMailMessage :  TIdMessage;
begin
  Memo1.Lines.Clear;
  IdPOP31.Host      := 'mypop3.example.com'; //Setting the HostName;
  IdPOP31.Username  := 'myusername';//Setting UserName;
  IdPOP31.Password  := 'mypassword';//Setting Password;
  IdPOP31.Port      := 110;//Setting Port;

  try
    IdPOP31.Connect();
   //Getting the number of the messages that server has.
    MsgCount := IdPOP31.CheckMessages;
    for i:= 0 to Pred(MsgCount) do
    begin
      try
        FMailMessage := TIdMessage.Create(nil);
        IdPOP31.Retrieve(i,FMailMessage);
        Memo1.Lines.Add('======================================================');
        Memo1.Lines.Add(FMailMessage.From.Address);
        Memo1.Lines.Add(FMailMessage.Recipients.EMailAddresses);
        Memo1.Lines.Add(FMailMessage.Subject);
        Memo1.Lines.Add(FMailMessage.Sender.Address);
        Memo1.Lines.Add(FMailMessage.Body.Text);
        Memo1.Lines.Add('======================================================');
      finally
        FMailMessage.Free;
      end;
    end;
  finally
    IdPOP31.Disconnect;
  end;
end;