08
Jul 09

Delphi: Utils :: AppRunningCount

:: articles :: by Gilberto Saraiva

Folks,

For everybody thats need to limit the instance number of your application:

 Delphi |  copy code |? 
01
uses SysUtils, TLHelp32;
02
 
03
function AppRunningCount(const AExeName: string): integer;
04
var
05
  hSnap: THandle;
06
  p32: TProcessEntry32;
07
begin
08
  Result := 0;
09
  hSnap := CreateToolHelp32SnapShot(TH32CS_SNAPPROCESS, 0);
10
  p32.dwSize := Sizeof(TProcessEntry32);
11
  Process32First(hSnap, p32);
12
  repeat
13
    if SameText(AExeName, ExtractFileName(p32.szExeFile)) then
14
      inc(Result);
15
  until not Process32Next(hSnap, p32);
16
  CloseHandle(hSnap);
17
end;

Use:

 Delphi |  copy code |? 
1
// On DPR
2
// Limit to 1 instance
3
begin 
4
  if AppRunningCount(ExtractFileName(ParamStr(0))) = 1 then
5
  begin
6
  // Application codes
7
  end;
8
end.
9

Explaining more about this approach:
In a situation of multiples logons at the same machine the Mutex cannot provide a correctly singleton structure because the mutex handle still only under the local scope of the user. So the way to control the instance number is counting the number of times the process appear on the process list of the machine.



19
Jun 09

Delphi: Chained List

:: articles :: by Gilberto Saraiva

Folks,

Some times when we need to hold stripped informations, like socket or audio buffers, we need to create a chained list that control all the information sequentially and provide a navigation on the holded data only by stepping forward(next) or stepping back(prior).

A structure of a Chained List is divided on 2 main variables: Data and Next(or Prior, as needed), for every Item on the Chain you have the Data(Pointer, value or someting you have to hold) and a reference for the next or prior item on the list. Chained list don’t provide a direct access for items, so you can’t access a item without navigate on others. Chained Lists can be improved, but the main goal is provide a near infinite list that have the best performance of all others techniques.

As you know now, Chained lists don’t hold indexs for items (don’t have a direct access) and that avoid re-index procedures that consume a big time when you’ve a large list. When you need to remove a item in a Chained list that have a predecessor and a antecessor, you’ll have to make the first improvement on the chain structure to hold the Prior and the Next item for each Item you have, and thats provide you a confortable way to manipulate items without writing a lot of code and variables.

A basic structure of a Chained List on Delphi

 Delphi |  copy code |? 
01
uses ChainedListCtrl;
02
 
03
type
04
  TfrmMain = class(TForm)
05
    edtWord: TEdit;
06
    btnAdd: TButton;
07
    lblPhrase: TLabel;
08
    btnClean: TButton;
09
    procedure FormCreate(Sender: TObject);
10
    procedure FormDestroy(Sender: TObject);
11
    procedure btnAddClick(Sender: TObject);
12
    procedure btnCleanClick(Sender: TObject);
13
  private
14
    { Private declarations }
15
  public
16
    Phrase: TChainedList;
17
    procedure UpdateList;
18
  end;
19
 
20
var
21
  frmMain: TfrmMain;
22
 
23
implementation
24
 
25
{$R *.dfm}
26
 
27
{ Note: Create the Chain List Control Object
28
}
29
procedure TfrmMain.FormCreate(Sender: TObject);
30
begin
31
  Phrase := TChainedList.Create;
32
end;
33
 
34
{ Note: Destroy the Chain Object
35
}
36
procedure TfrmMain.FormDestroy(Sender: TObject);
37
begin
38
  Phrase.Free;
39
end;
40
 
41
{ Note: Update the Label to hold all the words
42
        included on the Chained list
43
}
44
procedure TfrmMain.UpdateList;
45
var
46
  sPhrase: string;
47
begin
48
  sPhrase := '';
49
  Phrase.First;
50
  while Phrase.Current <> nil do
51
  begin
52
    if sPhrase <> '' then
53
      sPhrase := sPhrase + ' ';
54
 
55
    sPhrase := sPhrase + PChar(Phrase.Current^);
56
    Phrase.Next;
57
  end;
58
  lblPhrase.Caption := sPhrase;
59
end;
60
 
61
{ Note: Add the text on the Chain
62
   p.s: StrNew create a copy of the string that will be managed
63
        out of the garbage collector(str refcount structure)
64
}
65
procedure TfrmMain.btnAddClick(Sender: TObject);
66
begin
67
  Phrase.Add.Current^ := StrNew(PChar(edtWord.Text));
68
  UpdateList;
69
end;
70
 
71
{ Note: Clean the Chain list
72
   p.s: StrDispose release the memory of the create string
73
        to avoid memory leaks
74
}
75
procedure TfrmMain.btnCleanClick(Sender: TObject);
76
begin
77
  Phrase.Last;
78
  while Phrase.Current <> nil do
79
    Phrase.Remove(@StrDispose);
80
  UpdateList;
81
end;

I wrote some comments on the code to refers the goals of each method, but some things have to be said:
1st. Many improviments can be done on a Chained List, but some times a improvement can be bad to the performance result so keep it on the mind when you change some thing.
2nd. Chained List as the name says, chained, so don’t try to put a index control on it because can be a big mistake.
3rd. Use it when you need a great performance, not when you only need to hold some common data. A Indexed List control will be better and easy to manipulate then a Chained List.

Feel free to use and ask some thing.

Hugs for all



19
Jun 09

Delphi: Utils :: TChainedList

:: articles :: by Gilberto Saraiva

Folks,

For everybody thats use a lot Chained lists on your projects:

 Delphi |  copy code |? 
001
uses SysUtils;
002
 
003
type
004
  PPointer = ^Pointer;
005
 
006
  TChainedList = class
007
  private
008
    FFirst   : Pointer;
009
    FLast    : Pointer;
010
    FCurrent : Pointer;
011
    FCount   : Integer;
012
    function GetCurrent: PPointer;
013
  public
014
    constructor Create;
015
    destructor Destroy; override;
016
 
017
    function First : TChainedList;
018
    function Last  : TChainedList;
019
    function Prior : TChainedList;
020
    function Next  : TChainedList;
021
 
022
    function Add: TChainedList;
023
    function Remove: TChainedList; overload;
024
    function Remove(AChainedReleaser: Pointer): TChainedList; overload;
025
 
026
    property Current: PPointer read GetCurrent;
027
    property Count: Integer read FCount;
028
  end;
029
 
030
implementation
031
 
032
type
033
  PChainedItem = ^TChainedItem;
034
  TChainedItem = record
035
    Prior, Next: PChainedItem;
036
    Data: Pointer;
037
  end;
038
 
039
{ TChainedList }
040
 
041
constructor TChainedList.Create;
042
begin
043
  FCount := 0;
044
  FFirst := nil;
045
  FLast := nil;
046
  FCurrent := nil;
047
end;
048
 
049
destructor TChainedList.Destroy;
050
begin
051
  First;
052
  while Current <> nil do
053
    Remove;
054
 
055
  inherited;
056
end;
057
 
058
function TChainedList.GetCurrent: PPointer;
059
begin
060
  if FCurrent <> nil then
061
    Result := @PChainedItem(FCurrent).Data
062
  else
063
    Result := nil;
064
end;
065
 
066
function TChainedList.First: TChainedList;
067
begin
068
  FCurrent := FFirst;
069
  Result := Self;
070
end;
071
 
072
function TChainedList.Last: TChainedList;
073
begin
074
  FCurrent := FLast;
075
  Result := Self;
076
end;
077
 
078
function TChainedList.Prior: TChainedList;
079
begin
080
  if FCurrent <> nil then
081
    FCurrent := PChainedItem(FCurrent)^.Prior
082
  else
083
    FCurrent := nil;
084
  Result := Self;
085
end;
086
 
087
function TChainedList.Next: TChainedList;
088
begin
089
  if FCurrent <> nil then
090
    FCurrent := PChainedItem(FCurrent)^.Next
091
  else
092
    FCurrent := nil;
093
  Result := Self;
094
end;
095
 
096
function TChainedList.Add: TChainedList;
097
var
098
  pNew: PChainedItem;
099
begin
100
  New(pNew);
101
  pNew^.Prior := nil;
102
  pNew^.Next := nil;
103
  pNew^.Data := nil;
104
 
105
  if FFirst = nil then
106
  begin
107
    FFirst := pNew;
108
    FLast := pNew;
109
  end else
110
  begin
111
    pNew^.Prior := PChainedItem(FLast);
112
    PChainedItem(FLast)^.Next := pNew;
113
    FLast := pNew;
114
  end;
115
 
116
  FCurrent := FLast;
117
  Result := Self;
118
  Inc(FCount);
119
end;
120
 
121
function TChainedList.Remove: TChainedList;
122
var
123
  pCur: PChainedItem;
124
begin
125
  pCur := FCurrent;
126
  if pCur^.Data <> nil then
127
    raise Exception.Create('Current item memory leak detected.');
128
 
129
  if pCur^.Next <> nil then
130
    pCur^.Next^.Prior := pCur^.Prior;
131
 
132
  if pCur^.Prior <> nil then
133
    pCur^.Prior^.Next := pCur^.Next;
134
 
135
  if pCur = FFirst then
136
  begin
137
    FFirst := pCur^.Next;
138
    FCurrent := FFirst;
139
  end else if pCur = FLast then
140
  begin
141
    FLast := pCur^.Prior;
142
    FCurrent := FLast;
143
  end else
144
    FCurrent := pCur^.Next;
145
 
146
  Result := Self;
147
  Dispose(pCur);
148
  Dec(FCount);
149
end;
150
 
151
function TChainedList.Remove(AChainedReleaser: Pointer): TChainedList;
152
type
153
  TRelease = procedure(APointer: Pointer);
154
var
155
  PdrRelease: TRelease;
156
begin
157
  @PdrRelease := AChainedReleaser;
158
  PdrRelease(PChainedItem(FCurrent)^.Data);
159
  PChainedItem(FCurrent)^.Data := nil;
160
  Result := Remove;
161
end;

See how to use it here: Delphi: Chained List

Hugs!



01
Sep 08

Delphi: Utils :: ToolButtonScreenPos

:: articles :: by Gilberto Saraiva

Folks,

For everybody that needs the ToolButton position:

 Delphi |  copy code |? 
1
type
2
  TToolButtonAccess = class(TToolButton);
3
 
4
function ToolButtonScreenPos(AToolButton: TToolButton): TPoint;
5
begin
6
  GetDCOrgEx(TToolButtonAccess(AToolButton).Canvas.Handle, Result);
7
  Inc(Result.X, AToolButton.Left);
8
  Inc(Result.Y, AToolButton.Top);
9
end;

Hugs!



01
Sep 08

Delphi: Utils :: SpeedButtonScreenPos

:: articles :: by Gilberto Saraiva

Folks,

For everybody that needs the Speedbutton position:

 Delphi |  copy code |? 
1
type
2
  TSpeedButtonAccess = class(TSpeedButton);
3
 
4
function SpeedButtonScreenPos(ASpeedButton: TSpeedButton): TPoint;
5
begin
6
  GetDCOrgEx(TSpeedButtonAccess(ASpeedButton).Canvas.Handle, Result);
7
  Inc(Result.X, ASpeedButton.Left);
8
  Inc(Result.Y, ASpeedButton.Top);
9
end;

Hugs!



01
Sep 08

Delphi: Utils :: DesktopArea

:: articles :: by Gilberto Saraiva

Folks,

For everybody that need to show something only on the useful area of the desktop I wrote this function:

 Delphi |  copy code |? 
1
function DesktopClientArea: TRect;
2
var
3
  rDesktop, rWinBar: TRect;
4
begin
5
  Windows.GetWindowRect(GetDesktopWindow, rDesktop);
6
  Windows.GetWindowRect(FindWindow('Shell_TrayWnd', nil), rWinBar);
7
  SubtractRect(Result, rDesktop, rWinBar);
8
end;

Hugs!



07
Aug 08

Delphi: Utils :: PNG for Delphi

:: articles :: by Gilberto Saraiva

Folks,

Let me provide this good library of PNG for Delphi, as I see that is hard to get a copy searching on the web I’ll provide it here.

Component: PNG Delphi
Component Author: Gustavo Huffenbacher Daud
Lastest version: 2002
Download it here: pngimagelib (354.42 KB) - 314 hits

Its very easy to use, and came with a help ( PngDelphi.chm under the .zip )

Hugs



28
Jul 08

Delphi: Utils :: ChangeDropShadow

:: articles :: by Gilberto Saraiva

Folks,

With this procedure you can change the Drop Shadow effect provided by windows XP/Vista on all windows without need to reset the computer.

 Delphi |  copy code |? 
01
procedure ChangeDropShadow(AActive: boolean);
02
var
03
  Buff: Cardinal;
04
  Param: Pointer;
05
  DevMode: TDeviceMode;
06
begin
07
  with TRegistry.Create do
08
  begin
09
    RootKey := HKEY_CURRENT_USER;
10
    if OpenKey('\Control Panel\Desktop\', false) then
11
    begin
12
      ReadBinaryData('UserPreferencesMask', Buff, 4);
13
      if AActive then
14
        Buff := Buff or (1 shl 18)
15
      else
16
        Buff := Buff xor (Buff and (1 shl 18));
17
      WriteBinaryData('UserPreferencesMask', Buff, 4);
18
      Param := nil;
19
      if AActive then
20
        Param := @AActive;
21
 
22
      SystemParametersInfo(SPI_SETDROPSHADOW, 0,
23
        Param, SPIF_SENDWININICHANGE);
24
    end;
25
    Free;
26
  end;
27
end;

Hugs!



26
Jul 08

Benchmark: Como utilizar?

:: articles :: by Gilberto Saraiva

Camaradas,

Vou falar um pouco sobre o projeto Benchmark que está disponível no fórum da DevPartners.

Para que serve o projeto Benchmark?

O projeto começou de uma brincadeira entre amigos para desenvolver o algoritmo mais rápido de criação de arranjos, então surgiu a necessidade de termos um sistema de quantificação de tempo utilizado, um benchmark, foi ai que eu comecei a escrever o projeto Benchamark.

Um Benchmark serve para medir uma grandeza matemática que servirá para comparação ou avaliação.
Exemplo:
Frames por segundo em um jogo de computador, a grande maioria dos benchmarks são feitos para comparar o desempenho entre duas ou mais placas de vídeo.

O projeto Benchmark servirá no meu aplicativo?

Claro, o projeto Benchmark foi feito para não ser dependente de nada, é só colocar no seu projeto e utilizar quando necessário.

Como faço para fazer um Benchmark de uma processo dentro do meu aplicativo?

Primeiro você deve baixar o código-fonte do projeto Benchmark para sua máquina, acessando o fórum do projeto, http://devpartners.projects.pro.br/forum/?board=4.

Uma pequena ajuda foi escrita para você que não conhece bem o Subversion:
Como baixar um projeto pelo Subversion.

Logo que tiver o código do Benchmark na sua máquina, acesse a pasta do Benchmark e copie o arquivo pasBenchmark.pas ( Benchmark\source\ ) para o diretorio de Lib do seu Delphi ( essa dica é para facilitar a implementação em outros projetos também, se você entende um pouco mais do esquema de diretórios do Delphi você poderá adicionar a Unit como uma biblioteca ), o diretório Lib do Delphi 7 é o:
C:\Arquivos de programas\Borland\Delphi7\Lib

Feito isso, você deve editar seu projeto em apenas 2 partes:

  • Adicionar o Benchmark no Uses da Unit do processo:
    Exemplo:
     Delphi |  copy code |? 
    01
    02
    unit Unit1;
    03
    { ... }
    04
     
    05
    var
    06
      Form1: TForm1;
    07
     
    08
    implementation
    09
     
    10
    uses pasBenchmark;
    11
  • Antes de iniciar o processo que deseja fazer o Benchmark:
     Delphi |  copy code |? 
    01
    procedure TForm1.ConnectToServer;
    02
    begin
    03
      { ... processo que conecta em um servidor de dados ... }
    04
    end;
    05
     
    06
    procedure TForm1.btnRunClick(Sender: TObject);
    07
    begin
    08
      Benchmark.StartBenchmarking('Benchmark de conexão com o servidor');
    09
      try
    10
        ConnectToServer;
    11
      except
    12
      end;
    13
      Benchmark.EndBenchmarking;
    14
    end;
  • Ao executar o aplicativo e executar o processo, você verá que uma janela abrirá, exibindo as informações do Benchmark, com um resultado semelhante ao exemplificado abaixo:
    1º Benchmark de conexão com o servidor
    Benchmark start at : 26/07/2008 11:54:26
    \___ runned under 550.587,964276 ms

    O que nos informa que a conexão com o servidor de dados demorou 550.587 milisegundos, algo en torno de 0,5 segundos.

    Aonde posso obter mais exemplos de como usar?

    Logo que você copiar os arquivos do projeto para sua máquina atravez do Subversion, você poderá acessar as demonstrações que acompanham o projeto na pasta Benchmark\demos

    Espero que o projeto ajude mais gente como já me ajudou algumas vezes.

    Abraço a todos



    23
    Jul 08

    MySQL: Database Dump tricks

    :: articles :: by Gilberto Saraiva

    Folks,

    Let me relate this:

    Sometimes when you are dumping a database to another host your connection can down, and you will lost all your job and start again? No, no, no, you can make some tricks to continue where you stopped.

    So let me enumarate the tricks:

    MySQLDump commands:

  • Use –add-drop-table
    For don’t lose what you already done, you can config dump to don’t drop the table you are transfering.
    Command:
     DOS |  copy code |? 
    1
    --add-drop-table=FALSE
  • Use –no-create-info
    To avoid the creation of the table, you need to set this option as true.
    Command:
     DOS |  copy code |? 
    1
    --no-create-info=TRUE
  • Use –where option
    the –where option will work as a SQL filter for you, so if you have a indexed table you can
    Command:
     DOS |  copy code |? 
    1
    --where="ID > 300"
  • MySQL commands:

  • Use –force
    To avoid a break on the processing if the dump post a SQL that can cause a error, you need to Force to MySQL continue even with a SQL error and it will keep the rest of the process working.
    Command:
     DOS |  copy code |? 
    1
    --force
  • So, now you know what the commands do and can create a full command line like this one:

     DOS |  copy code |? 
    1
    2
    C:\MySQL\Bin>mysqldump -h 10.0.0.1 -u root -p123456 --add-drop-table=FALSE --no-create-info=TRUE --where="ID > 300" MyDatabase MyTable | mysql -h www.mysite.com -u MyWebUser -p123456 --force MyWebDatabase
    3

    Piece of cake, uhm?