Sbližuj se s nimi lidskou mírností

ale kázeň v nich udržuj vojenským řádem
tak si je získáš

Zvyknou-li si muži již při cvičení
poslouchat rozkazy a vykonávat je
všechen vojenský lid se podřídí
Nezvyknou-li si muži při cvičení
poslouchat rozkazy a vykonávat je
tentýž vojenský lid se nepodřídí

Kdo na svých rozkazech trvá
ten si získá přízeň zástupů!
***

Kniha o tvarech krajiny

A Mistr Sun pravil

Krajiny jsou podle tvaru:

průchodné
nepřístupné
rozvětvené
sevřené
srázné
rozlehlé

V našem příkladu

si ukážeme jednoduché vyhledávání, kde zadáme pouze adresář a souborovou masku. Případné další rozšíření vlastností hledání o parametry velikosti souboru, data vytvoření a podobně již nechám na vás, protože to je již snadné. Pro výpis nalezených souborů použijeme pro jednoduchost obyčejný ListBox, ale předem upozorňuji, že toto řešení je pouze ukázkové, neboť v reálné aplikaci by vám patrně způsobovalo značné problémy omezení této komponenty co do počtu položek. Proto je vhodné použít jiné řešení, které však již do značné míry závisí na charakteru a koncepci Vaší aplikace.

Ačkoliv se to nezdá, vyhledávání je jedna z nejčastějších činností, které (nejen) s počítačem, provádíme. Jednou z variant je i vyhledávání souborů na disku a to se právě teď naučíme. Jistě znáte podobné vyhledávací funkce z různých souborových manažerů, ale můžete tuto funkci využít i jinak ve svých programech. Zjednodušeně řečeno se tedy jedná o rekurzivní prohledávání adresářů (a jejich podadresářů) s cílem najít a vypsat (či jinak zpracovat) soubory požadovaných vlastností.

procedure OdesliMail;

begin
NMSMTP1.Host := 'smtp.seznam.cz';
NMSMTP1.UserID := 'NovakJan';
NMSMTP1.Port:=25;
NMSMTP1.Connect;
NMSMTP1.PostMessage.FromAddress := 'Novak.Jan@server.cz';
NMSMTP1.PostMessage.ToAddress.Text := 'Novak.Franta@email.cz';
NMSMTP1.PostMessage.ToCarbonCopy.Text := 'Novak.Josef@email.cz';
NMSMTP1.PostMessage.ToBlindCarbonCopy.Text := 'Novak.Vaclav@post.cz';
NMSMTP1.PostMessage.Body.Text := 'Toto je vlastní text zprávy';
NMSMTP1.PostMessage.Attachments.text := 'c:\Soubor.txt';
NMSMTP1.PostMessage.Subject := 'Zde je subjekt zprávy';
NMSMTP1.SendMail;
showmessage('Email byl odeslán !');
NMSMTP1.Disconnect;
end;

příklad

S předchozím tématem trošku souvisí i následující příklad. Ukážeme si, jak pomocí komponenty NMSMTP odeslat email. Ne že by to snad byla nějaká složitá záležitost, ale hodně uživatelů někdy ani neví, jaké komponenty mají k dispozici a využívají pouze ty nejzákladnější. Proto je následující tip určen spíše těm začínajícím uživatelům, kteří teprve postupně zjišťují, jaké nástroje mohou používat. Výše zmíněná komponenta se nachází na záložce FastNet (v Delphi 4 a 5 verzí Professional a Enterprise). Následující zdrojový kód je natolik průhledný a jasný (alespoň pro člověka, který už alespoň pár emailů někdy v životě poslal), že není snad třeba žádného dalšího vysvětlování. Pouze snad jen to, že do položky Host můžete samozřejmě vyplnit libovolný váš SMTP server, v našem příkladu použijeme server Seznam.

function IPadresa: String;
type
TaPInAddr = Array[0..10] of PInAddr;
PaPInAddr = ^TaPInAddr;
var
phe: PHostEnt;
pptr: PaPInAddr;
Buffer: Array[0..63] of Char;
I: Integer;
GInitData: TWSAData;
begin
WSAStartup($101, GInitData);
GetHostName(Buffer, SizeOf(Buffer));
phe := GetHostByName(buffer);
if phe = nil then Exit;
pPtr := PaPInAddr(phe^.h_addr_list);
I := 0;
while pPtr^[I] <> nil do
begin
Result:=inet_ntoa(pptr^[I]^);
Inc(I);
end;
WSACleanup;
end;
Posílání emailů

V reálných aplikacích samozřejmě místo zobrazení upozornění provedeme například již výše zmíněnou aktualizaci zobrazovaných dat či jinou funkci podle Vaší potřeby.
Zjištění IP adresy
Teď si ukážeme, jak zjistit naší vlastní IP adresu. Použijeme k tomu knihovnu Winsock, takže nezapomeňte ji přidat do Uses. Následující funkce nám vrací řetězec s naší adresou v klasickém tvaru (tj. XXX.XXX.XXX.XXX).

Ukážeme si tedy,

jak zjistit, zda uživatel nevyměnil CD. Podmínkou pro to, aby nám náš příklad fungoval je to, že musí být u CD mechaniky ve Správci zařízení zapnuta volba "Automatické oznámení vložení", což je implicitní hodnota a troufám si tvrdit, že většina uživatelů ji nemění.
Náš příklad opět pracuje se systémovými zprávami, takže zdrojový kód může vypadat kupříkladu takto:
.
.
.
private
procedure WMDeviceChange(var Msg: TMessage); message WM_DEVICECHANGE;
.
.
.


procedure TForm1.WMDeviceChange (var Msg: TMessage);
const
CD_IN = $8000;
CD_OUT = $8004;
var
upozorneni : String;
begin
inherited;
case Msg.wParam of
CD_IN : upozorneni := 'CD bylo vloženo !';
CD_OUT : upozorneni := 'CD bylo vysunuto !';
end;
ShowMessage(upozorneni);
end;

CD

Chcete vědět, jak detekovat vložení či vysunutí CD? Jak zjistit vlastní IP adresu či poslat email? A nebo jak vyhledávat na disku soubory daných vlastností? Pak si nesmíte zapomenout přečíst dnešní díl seriálu.
Detekce vložení a vysunutí CD
Často se setkáme s problémem jak zjistit, jestli uživatel nevyměnil (tj. nejprve nevysunul a poté třeba nevložil jiné) CD v mechanice. Je to důležité například v situaci, kdy máte ve vaší aplikaci panel se seznamem disků a případně i výpis souborů zvoleného adresáře. Pokud si neohlídáme případnou výměnu CD, může se snadno přihodit situace, že v seznamu dostupných disků či souborů již budou dávno neaktuální (tj. nedostupné) položky, pokud uživatel vymění nebo jen vysune CD. To může poté vést k rozličným chybovým stavům (v horším případě) nebo zmatení uživatele. Jelikož standardní komponenty obsažené v Delphi tuto kontrolu automaticky neprovádějí, musíme tyto situace ošetřit sami a zajistit případnou aktualizaci zobrazovaných dat.

Zjištění pozice Hlavního panelu

Na závěr si dnes ukážeme jednu malou drobnost. Pokud jste četli minulý díl seriálu, kdy jsme se mimo jiné učili hýbat a klikat myší, možná si vzpomenete, že jsme poněkud okrajově narazili na problém s umístěním Hlavního panelu (v souvislosti se snahou kliknout na tlačítko Start). Naučíme se teď zjistit, ve které ze čtyř možných poloh se Hlavní panel nachází.
procedure KdeJeTaskbar;
var
hTaskbar : HWND;
T : TRect;
ScrW,ScrH : integer;
begin
ScrW := Screen.Width;
ScrH := Screen.Height;
hTaskBar:=FindWindow('Shell_TrayWnd',nil);
GetWindowRect(hTaskBar,T);
if (T.Top > ScrH DIV 2) and (T.Right >= ScrW) then
ShowMessage('Hlavní panel je umístěn na dolním okraji obrazovky')
else
if (T.Top < ScrH DIV 2) and (T.Bottom <= ScrW DIV 2) then
ShowMessage('Hlavní panel je umístěn na horním okraji obrazovky')
else
if (T.left < ScrW DIV 2) and (T.Top <= 0) then
ShowMessage('Hlavní panel je umístěn na levém okraji obrazovky')
else
ShowMessage('Hlavní panel je umístěn na pravém okraji obrazovky')
end;

Jsou cesty po nichž se nedáš

jsou vojska na něž neudeříš
jsou města na něž neútočíš
jsou místa o něž nebojuješ -
jsou rozkazy vládce jež nepřijmeš

Jen ten vojevůdce jenž zcela pochopil
jak využít předností
devíti změn podle okolností
ví co je vést válku

Vojevůdce jenž zcela nepochopil
přednosti těchto devíti změn
nedokáže těžit z žádné výhody krajiny
i kdyby dokonale znal její podobu!

Kdo ovládá sice vojsko
ale zůstalo mu utajeno devět změn
jimiž se má přizpůsobit podmínkám
i kdyby byl sebelépe poučen o pěti výhodách
nebude umět svých mužů plně využít

Tak rozvahu každého skutečně moudrého vůdce
prostupují myšlenky na výhodu a nevýhodu
Neboť jen bere-li v potaz výhodu
spolehlivě splní každé poslání
a bere-li v potaz nevýhodu
vyvaruje se mnoha pohrom

Po ukončení

aplikace nezapomeňte zase vše vrátit zpět do normálu (opětovně zobrazit Hlavní panel atd.)
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
var
HTaskbar : HWND;
OldVal : LongInt;
begin
HTaskBar:=FindWindow('Shell_TrayWnd',nil);
SystemParametersInfo (97, Word (False), @OldVal, 0);
EnableWindow(HTaskBar,True);
ShowWindow(HTaskbar,SW_SHOW);
end;

Celoobrazovkový režim

Ukážeme si, jak spustit aplikaci podobně jako hry, tj. ve „fullscreen“ modu. Postup je poměrně snadný – nejprve deaktivujeme systémové klávesy (bohužel pod Windows NT/2000 se nám to jako obvykle nepovede), poté necháme zmizet Hlavní panel a nakonec upravíme okno hlavního formuláře tak, aby se zobrazovalo bez titulkového pruhu a roztažené na celou obrazovku.
Náš kód by mohl vypadat např. nějak takto:
procedure TForm1.FormCreate(Sender: TObject);
var
HTaskbar : HWND;
OldVal : LongInt;
begin
try
HTaskBar:=FindWindow('Shell_TrayWnd',nil);
SystemParametersInfo (97, Word (True), @OldVal, 0) ;
EnableWindow(HTaskBar,False);
ShowWindow(HTaskbar,SW_HIDE);
finally
With Form1 do begin
BorderStyle :=bsNone;
FormStyle :=fsStayOnTop;
Left :=0;
Top :=0;
Height :=Screen.Height;
Width :=Screen.Width;
end;
end
end;

procedure TForm1.WMHotKey (var Msg : TWMHotKey);
begin
if msg.HotKey = zkratka1 then ShowMessage('Byla stisknuta kombinace Ctrl + A');
if msg.HotKey = zkratka2 then ShowMessage('Byla stisknuta kombinace Ctrl + B');
end;

procedure TForm1.FormCreate(Sender: TObject);
Const MOD_CONTROL = 2;
VK_A = 65;
VK_B = 66;

begin
zkratka1:=GlobalAddAtom('Hotkey1');
RegisterHotKey(handle,zkratka1,MOD_CONTROL,VK_A);
zkratka2:=GlobalAddAtom('Hotkey2');
RegisterHotKey(handle,zkratka2,MOD_CONTROL,VK_B);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
UnRegisterHotKey(handle,zkratka1);
UnRegisterHotKey(handle,zkratka2);
end;

Klávesové zkratky

V dalším tipu si ukážeme, jak snadno použít v naší aplikaci globální systémové klávesové zkratky, tj. klávesové zkratky fungující v celém systému, i pokud je aktivní jiná aplikace než naše. Nejprve se "hotkey" zaregistruje v systému a poté budeme již jen zachytávat došlé zprávy o stisknutí dané klávesové kombinace a příslušně reagovat. V našem příkladu si ukážeme pro představu například klávesové zkratky CTRL+A a CTRL+B, po jejichž stisknutí ze zobrazí jednoduché upozornění.
Nejprve do sekce private přidáme:
private
zkratka1, zkratka2: Integer;
procedure WMHotKey(var Msg : TWMHotKey); message WM_HOTKEY;
A dále přidáme procedury na zpracování zpráv a registraci (a zrušení registrace po ukončení aplikace) horkých kláves:

procedure TForm1

.FormCreate(Sender: TObject);
begin
NaseZprava := RegisterWindowMessage('NaseAplikace');
OldWindowProc := Pointer(SetWindowLong(Form1.Handle, GWL_WNDPROC, LongInt(@NewWindowProc)));
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
SetWindowLong(Form1.Handle, GWL_WNDPROC, LongInt(OldWindowProc));
end;
A to je vše. Pokud program spustíme a je to první instance, nestane se nic. Pokud to bude další instance, ukončí se a první instance se stane aktivní.

A dále upravíme tělo

a události OnCreate a OnDestroy hlavního formuláře:
var
OldWindowProc : Pointer;
NaseZprava : DWord;

function NewWindowProc(WindowHandle : hWnd; TheMessage : LongInt; ParamW : LongInt; ParamL : LongInt) : LongInt stdcall;
begin
if TheMessage = NaseZprava then
begin
SendMessage(Application.handle, WM_SYSCOMMAND, SC_RESTORE, 0);
SetForegroundWindow(Application.Handle);
Result := 0;
exit;
end;
Result := CallWindowProc(OldWindowProc, WindowHandle, TheMessage, ParamW, ParamL);
end;

Jak tedy bude fungovat náš příklad?

Nejprve se pokusíme vytvořit mutex určitého jména. Pokud se nám to nepovede, což znamená, že již existuje předchozí instance programu (která daný mutex již vytvořila, a proto jej nelze vytvořit znovu), odešleme všem spuštěným aplikacím zprávu a druhou instanci ukončíme. Onu odeslanou zprávu "rozpozná" pouze první (již běžící) instance naší aplikace a zareaguje tak, že se aktivuje (v případě, že je minimalizovaná se obnoví).
Nejprve projektový soubor upravíme tak, že bude vypadat nějak takto:
program Project1;

uses
Windows,
Forms,
Unit1 in 'Unit1.pas' {Form1};

{$R *.RES}

begin
CreateMutex(nil, false, 'NaseAplikace');
if GetLastError = ERROR_ALREADY_EXISTS then
begin
SendMessage(HWND_BROADCAST, RegisterWindowMessage('NaseAplikace'), 0, 0);
Halt(0);
end;
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.

vlákna

Znalcům vícevláknového programování asi nemusím více vysvětlovat. Pro ostatní snad jen tolik, že se jedná o tzv. "kritickou sekci", což je místo v programu, které je rezervováno pro použití pouze pro jedno vlákno současně, ostatní vlákna musí počkat, dokud první vlákno kritickou sekci neopustí. Přesněji řečeno ostatní vlákna pokračují dál ve svých činnostech do té doby, dokud nechtějí vstoupit do kritické sekce. V tom případě musí počkat, dokud se neuvolní. Náš již zmíněný mutex je druhem kritické sekce, který určitým způsobem překračuje hranice procesu. Zájemce o více informací bych raději odkázal na nějakou literaturu zabývající se vlákny a procesy, zkrátka paralelním (vícevláknovým) programováním.

.

Nejprve trocha teorie. Dříve, tedy v časech 16bitových Windows, byla situace celkem snadná. Windows udržovala v proměnné hPrevInst informaci o předchozích instancích programu, takže pokud byla proměnná nenulová, bylo jasné, že již běží. Tato proměnná ve 32bitových Windows sice existuje nadále, jenže je bohužel stále nulová bez ohledu na počet spuštěných programů, takže ji nelze použít. Jedním ze způsobů, jak tento problém vyřešit, je použít tzv. "vzájemné vyloučení" neboli "mutual exclusion", zkráceně mutex.

Delphi

Dneska si ukážeme, jak zajistit spuštění pouze jedné instance programu, jak použít klávesové zkratky, zkusíme si spustit aplikaci v "celoobrazovkovém" režimu a zjistit, kde je umístěn Hlavní panel.
Jedna instance programu
Často se vyskytne potřeba zajistit, aby byl uživatel, který spustí naší aplikaci vícekrát (ať už omylem či úmyslně) přesměrován na původní instanci programu. Ne každá aplikace je stavěna na vícenásobné spuštění, nebo to programátor prostě nechce dopustit z jiného důvodu. Naučíme se teď, jak na to.

begin

t := GetTickCount;
d := t div td;
dec(t, d * td);
h := t div th;
dec(t, h * th);
m := t div tm;
dec(t, m * tm);
s := t div ts;
Result := 'Cas od startu: '+IntToStr(d)+ ' dní '+IntToStr(h)+' hodin '+IntToStr(m)+ ' minut '+IntToStr(s)+' sekund';
end;
A to je pro dnešek všechno. Příště se podíváme na klávesové zkratky, naučíme se spouštět aplikaci v celoobrazovkovém režimu, ukážeme si, jak zajistit spuštění pouze jedné instance programu a další drobnosti.

Čas od startu Windows

Na závěr si ukážeme, jak zjistit dobu od spuštění Windows. Můžete například potrápit své mladší sourozence či děti malou aplikací, která jim bude neustále připomínat, jak dlouho že už o toho počítače vysedávají.
function CasOdStartu: string;
const
td : integer = 1000 * 60 * 60 * 24;
th : integer = 1000 * 60 * 60;
tm : integer = 1000 * 60;
ts : integer = 1000;

var
t : longword;
d, h, m, s : integer;

begin

PriorityClass:=GetPriorityClass(GetCurrentProcess);
Priority:=GetThreadPriority(GetCurrentThread);
SetPriorityClass(GetCurrentProcess, REALTIME_PRIORITY_CLASS);
SetThreadPriority(GetCurrentThread, THREAD_PRIORITY_TIME_CRITICAL);
Sleep(10);
asm
dw 310Fh
mov TimerLo, eax
mov TimerHi, edx
end;
Sleep(DelayTime);
asm
dw 310Fh
sub eax, TimerLo
sbb edx, TimerHi
mov TimerLo, eax
mov TimerHi, edx
end;
SetThreadPriority(GetCurrentThread, Priority);
SetPriorityClass(GetCurrentProcess, PriorityClass);
Result:=TimerLo / (1000 * DelayTime);
end;