function GetDirSize (dir: string; subdir: boolean): longint;
var
rec : TSearchRec;
found : integer;
begin
result := 0;
if dir[length(dir)] <> '\' then dir := dir+'\';
found := findfirst(dir+'*.*', faAnyFile, rec);
while found=0 do
begin
inc(result, rec.size);
if (rec.Attr and faDirectory > 0) and (rec.Name[1] <> '.') and (subdir = true) then inc(result, getdirsize(dir+rec.Name, true));
found := findnext(rec);
end;
findclose(rec);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
ShowMessage(IntToStr(GetDirSize('c:\windows', false)) + ' B'+#13+IntToStr(GetDirSize('c:\windows', true)) + ' B');
end;
Příklad vypíše velikost adresáře Windows a to jak samotného, tak včetně podadresářů.

Celková velikost souborů v adresáři a podadresářích

Ukážeme si další funkci, která patří do okruhu práce se soubory a složkami. Naučíme se, jak zjistit velikost souborů nejen v daném adresáři, ale též celkový součet i včetně všech podadresářů. Poslouží nám k tomu velmi jednoduchá funkce, která vrací velikost adresáře (či adresářů) v bytech. Parametrem je pochopitelně adresář, jehož velikost nás zajímá a také logická proměnná, určující zda se mají do výpočtu zahrnout též podadresáře.

A jak to vlastně celé funguje ?

Po stisknutí příslušného tlačítka se nejprve vložený soubor "rozbalí" do složky pro dočasné soubory, poté se spustí a naše aplikace zároveň čeká na jeho ukončení (viz procedura ShellExecute_AndWait, kterou můžete velmi dobře použít i v jiných případech). Po ukončení "vnořené" aplikace se zobrazí informační dialog a nakonec je tato aplikace z dočasné složky opět vymazána.
Po dobu, co jsou spuštěny hlavní i "vnořená" aplikace, se obě chovají zcela nezávisle jako běžné současně spuštěné programy. Nelze však ukončit hlavní aplikaci do té doby, dokud nebude ukončena i aplikace vložená (to je právě práce procedury ShellExecute_AndWait).
A poznámka na úplný závěr. Nepokoušejte se vnořenou aplikaci spouštět vícekrát (vícenásobným stiskem příslušného tlačítka), protože dokud nebude ukončena, stále je rozbalena v pracovní složce a pokusem o další spuštění se vlastně snažíte vytvořit stejný soubor znovu. To pochopitelně vede k chybě, takže to buď nedělejte vůbec, nebo musíte vždy zajistit vytvoření unikátního názvu pro každou instanci vnořené aplikace. Připomínám, že název je vytvořen v události OnCreate hlavního formuláře naší aplikace.

Zbytek najdete v následujícím kódu:

.
.
.
var
Form1: TForm1;
SOUBOR_KALKULACKA : string;

implementation

{$R *.DFM}
{$R KALKULACKA.RES}
.
.
.

function GetTempDir : string;
var
Buffer: array[0..MAX_PATH] OF Char;
begin
GetTempPath(Sizeof(Buffer)-1,Buffer);
result := StrPas(Buffer);
end;

procedure ExtractRes(ResType, ResName, ResNewName : String);
var
Res : TResourceStream;
begin
Res := TResourceStream.Create(Hinstance, Resname, Pchar(ResType));
try
Res.SavetoFile(ResNewName);
finally
Res.Free;
end;
end;

Procedure ShellExecute_AndWait(FileName : String);
var
exInfo : TShellExecuteInfo;
Ph : DWORD;
begin
FillChar( exInfo, Sizeof(exInfo), 0 );
with exInfo do
begin
cbSize:= Sizeof( exInfo );
fMask := SEE_MASK_NOCLOSEPROCESS or SEE_MASK_FLAG_DDEWAIT;
Wnd := GetActiveWindow();
ExInfo.lpVerb := 'open';
lpFile:= PChar(FileName);
nShow := SW_SHOWNORMAL;
end;
if ShellExecuteEx(@exInfo) then
begin
Ph := exInfo.HProcess;
end
else
begin
ShowMessage(SysErrorMessage(GetLastError));
exit;
end;
while WaitForSingleObject(ExInfo.hProcess, 50) <> WAIT_OBJECT_0 do
Application.ProcessMessages;
CloseHandle(Ph);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
SOUBOR_KALKULACKA := GetTempDir + 'kalkulacka.EXE';
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
ExtractRes('EXEFILE','TESTFILE',SOUBOR_KALKULACKA);
If FileExists(SOUBOR_KALKULACKA) then
begin
ShellExecute_AndWait(SOUBOR_KALKULACKA);
ShowMessage('Kalkulačka byla ukončena...');
DeleteFile(SOUBOR_KALKULACKA);
end;
end;

resources

Nejprve je tedy potřeba vytvořit zdrojový kód resources. Jedná se o běžný textový soubor (vytvořený například v Poznámkovém bloku), obsahující pouze následující řádek:
TESTFILE EXEFILE C:\Windows\Calc.exe
Ti bystřejší z vás již jistě pochopili, že program, který budeme vkládat do naší aplikace, je Kalkulačka z Windows. Pokud máte systémový adresář jinde, nebo chcete využít jiný program než Kalkulačku, je pochopitelně potřeba udat cestu. Takto vytvořený soubor uložte například pod názvem "kalkulacka.rc".
Dalším krokem je kompilace s využitím Resource Compileru z Delphi. Naleznete jej v adresáři {Delphi}/Bin pod názvem "brcc32.exe" a kompilaci provedete snadno tak, že spustíte compiler a jako parametr uvedete název našeho zdrojového souboru. Kvůli ulehčení práce si můžete oba soubory zkopírovat do stejného adresáře a samotnou kompilaci spustíte například tímto "příkazem":
c:\Pomocnyadresar\brcc32.exe kalkulacka.rc
Výsledkem by měl být soubor "kalkulacka.res", který zkopírujeme do adresáře s naší hlavní aplikací. A nyní již zbývá jen zahrnout zdrojový soubor do naší aplikace a pomocí několika dalších důležitých funkcí se postarat o její načtení a spuštění. Pravidelným čtenářům našeho seriálu se omlouvám, že jsem opět zopakoval tento postup vytváření resource souboru, který je stejný, jaký jsme použili při vytváření resources pro Windows XP, ale každý pochopitelně není pravidelným čtenářem a trocha opakování neuškodí. :)

Vložení dalšího spustitelného souboru do aplikace

To, co si teď ukážeme, asi v praxi příliš nevyužijete, ale přesto je to zajímavý tip. Naučíme se, jak přímo do naší aplikace vložit další program a ten poté spustit. Dalo by se s jistou nadsázkou říci, se jedná o určitou formu trojského koně, a praktické využití tohoto tipu ponechám čistě na vaší fantazii. Postup je vlastně velmi jednoduchý. Externí program, který chceme do aplikace vložit, si přidáme do resources naší aplikace. V těle naší aplikace pak podobným způsobem, jako se z resources například přehrávají zvuky, spustíme onen externí program.

procedure FileReplaceString(const FileName, searchstring, replacestring: string);
var
fs: TFileStream;
S, N: string;
begin
fs := TFileStream.Create(FileName, fmOpenread or fmShareDenyNone);
try
SetLength(S, fs.Size);
fs.ReadBuffer(S[1], fs.Size);
finally
fs.Free;
end;
N := StringReplace(S, SearchString, replaceString, [rfReplaceAll, rfIgnoreCase]);
fs := TFileStream.Create(FileName, fmCreate);
try
fs.WriteBuffer(N[1], Length(N));
finally
fs.Free;
end;
end;

Náhrada textu v textovém souboru

Náhrada nějakého textu v souboru (textovém) patří mezi velmi časté a běžné úkony, takže si ukážeme jeden z jednoduchých způsobů. Netvrdím, že je to ten nejideálnější způsob, avšak pro jednoduché použití postačí. Parametrem funkce je pouze soubor, ve kterém bude hledání a nahrazování probíhat, a dále dva textové řetězce – hledaný text a jeho náhrada. Pohledem na zdrojový kód snadno zjistíte, že hlavní díl práce vykonává funkce StringReplace, která se stará o vlastní hledání a náhradu. Pomocí jejích parametrů můžete též nastavit, zda se mají nahradit všechny výskyty daného textu nebo jen ten první (rfReplaceAll), a zda se mají nebo nemají brát v úvahu velká písmena (rfIgnoreCase). Kvůli zjednodušení příkladu není testována úspěšnost výměny (zda byl vůbec nalezen soubor atd..), ale to již myslím nebude pro čtenáře problém doplnit podle vlastních požadavků.

zdroj

.
.
.
private
{ Private declarations }
function GetMasterVolumeControl(Mixer: hMixerObj; var Control: TMixerControl): MMResult;
procedure SetMasterVolume(Mixer: hMixerObj; Value: Word);
.
.
.

procedure TForm1.SetMasterVolume(Mixer: hMixerObj; Value: Word);
var
MasterVolume : TMixerControl;
Details : TMixercontrolDetails;
UnsignedDetails: TMixercontrolDetailsUnsigned;
Code: MMResult;
begin
code := GetMasterVolumecontrol(Mixer, MasterVolume);
if code = MMSYSERR_NOERROR then
begin
with Details do begin
cbStruct := SizeOf(Details);
dwControlId := MasterVolume.dwControlId;
cChannels := 1;
cMultipleItems := 0;
cbDetails := SizeOf(UnsignedDetails);
paDetails := @UnsignedDetails;
end;
UnsignedDetails.dwValue := Value;
code := mixerSetControlDetails(Mixer, @Details, Mixer_SetControlDetailsf_value);
end;
if Code <> MMSYSERR_NOERROR then ShowMessage('Došlo k chybě při pokusu o změnu hlasitosti.');
end;

function TForm1.GetMasterVolumeControl(Mixer: hMixerObj; var Control: TMixerControl): MMResult;
var
Line: TMixerLine;
Controls: TMixerLineControls;
begin
ZeroMemory(@line, SizeOf(line));
Line.cbStruct := SizeOf(Line);
Line.dwComponentType := MIXERLINE_COMPONENTTYPE_DST_SPEAKERS;
result := mixerGetLineInfo(Mixer, @Line, MIXER_GETLINEINFOF_COMPONENTTYPE);
if Result = MMSYSERR_NOERROR then
begin
ZeroMemory(@Controls, SizeOf(Controls));
Controls.cbStruct := sizeOf(Controls);
Controls.dwLineID := Line.dwLineID;
Controls.cControls := 1;
Controls.dwControlType := MIXERCONTROL_CONTROLTYPE_VOLUME;
Controls.cbmxctrl := SizeOf(Control);
Controls.pamxctrl := @Control;
Result := MixerGetLineControls(Mixer, @Controls, Mixer_GETLINECONTROLSF_ONEBYTYPE);
end;
end;

procedure TForm1.TrackBar1Change(Sender: TObject);
begin
SetMasterVolume(0,TrackBar1.Position);
end;

Nastavení hlasitosti

Ukážeme si, jak se dá nastavit globální hlasitost v systému (Master Volume). V dnešní době multimediálních aplikací, kdy zkouší kde kdo naprogramovat nějaký vlastní video nebo mp3 přehrávač, vlastní hru a nebo prostě jakoukoliv aplikaci pracující se zvukem, je to jistě užitečný tip. Budeme potřebovat knihovnu MMSystem a praktické použití si budeme demonstrovat na jednoduchém příkladu, kdy bude hlasitost ovládána pomocí posuvníku (TrackBar). Na formulář tedy umístěte TrackBar, do zdrojového kódu vložte níže uvedené funkce a příslušně upravte událost OnChange u TrackBaru. Ve vlastnostech posuvníku též musíte upravit rozsah povolených hodnot. Jako minimum zvolíme pochopitelně nulu, horní hranice je maximem číselného typu Word (čili 65535 či chcete-li MaxWord).

Pochopitelně

by bylo vhodné náš informační dialog o chybě, který se uživateli zobrazí, trošku více propracovat. Popsat pokud možno druh chyby (avšak netechnicky, spíše volně pro běžného uživatele), připojit název souboru se záznamy (aby uživatel věděl, kde ho má hledat) a pochopitelně adresu, kam může uživatel soubor poslat, pokud vám bude chtít pomoci s vývojem aplikace a odstraňováním chyb. Obzvláště ve fázi betaverzí je tento kontakt s uživatelem důležitý a čím nedodělanější verze aplikace, tím propracovanější soubor se záznamy chyb je potřeba. Jistě by tedy bylo vhodné zahrnout do souboru též informaci o verzi operačního systému, některé hardwarové informace a podobně (vše, co lze detekovat bez zásahu uživatele, abychom jej tím příliš neotravovali).
Málem bych zapomněl na jednu důležitou věc. Když se vrátíme k našemu příkladu, možná vás napadne, jak jej vlastně otestovat v praxi, zda vůbec funguje ? Asi by nemělo smysl čekat na nějakou nenadálou chybu, takže si ji prostě budeme muset vyrobit sami. Fantazii se meze nekladou a jistě budete schopni nějakou "umělou" chybu sami spáchat. Pro ty, kterým se nechce přemýšlet, dám tutový tip. Co třeba zkusit dělení nulou ? :)

Ale dost zbytečných řečí,

pojďme na náš příklad. Jak bylo řečeno, při vzniku chyby, která není ošetřena jiným způsobem, zobrazí dialogové okno s upozorněním pro uživatele a zapíše popis do souboru error.log do adresáře s aplikací. Zdrojový kód tedy obsahuje vlastně jen přesměrování výjimek na naši proceduru (to zařídíme v události OnCreate hlavního formuláře) a samotná procedura již jen zobrazí jednoduchý dialog a zapíše data na disk.
.
.
.
public
{ Public declarations }
procedure AppOnException(Sender: TObject; E: Exception);
.
.
.

procedure TForm1.FormCreate(Sender: TObject);
begin
Application.OnException := AppOnException;
end;

procedure TForm1.AppOnException(Sender: TObject; E: Exception);
var
ErrFileHandle: THandle;
ErrFileName : String;
ErrMsg, s : String;
T : TComponent;
begin
s := ' -> ';
t := Sender As TComponent;
while (t <> nil) and (t.Owner <> nil) do begin
s := s + ' ' + t.Name;
t := t.Owner;
end;

ErrFileName := ExtractFilePath(Application.ExeName) + 'error.log';
ErrFileHandle := CreateFile(PChar(ErrFileName), GENERIC_WRITE, FILE_SHARE_READ, NIL, OPEN_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0);
if ErrFileHandle <> INVALID_HANDLE_VALUE then
begin
ErrMsg := Format('%s : %s - %s'#13#10, [DateTimeToStr(Now), E.ClassName, E.Message]);
SetFilePointer(ErrFileHandle, 0, nil, soFromEnd);
FileWrite(ErrFileHandle, Pointer(ErrMsg)^, Length(ErrMsg));
CloseHandle(ErrFileHandle);
end;
ShowMessage('Pozor, v programu došlo k nečekané chybě. Doporučujeme uložit všechna data a ukončit aplikaci.');
end;

příklad

Vlastně by stačilo celý příklad zjednodušit a napsat si pouze vlastní obsluhu výjimky na jeden řádek, která by zobrazila například jednoduché upozornění prostřednictvím ShowMessage a v podstatě to vlastně i náš příklad dělá, ale ještě navíc jako "bonus" zapisuje vzniklé chyby do textového souboru - logu. Zde se nabízí například srovnání s tím, co možná někteří již znáte z Windows XP, kde se při nějaké neočekávané chybě systému či aplikací zobrazí informační dialog, který vám nabízí odeslání informací o chybě rovnou "domů" do Microsoftu. Samozřejmě že náš příklad se nemůže "error reportu" z XPček rovnat, protože v něm jsou obsaženy výpisy paměti a mnoho dalších informací. My se spokojíme pouze s tím, že se nám zapíše pouze typ výjimky, oblast paměti a modul, který ji způsobil. Jedná se vlastně přesně o ty informace, které by se bývaly zobrazily v dialogu, pokud bychom si výjimku neošetřili sami. Avšak uživatel - laik bude jistě méně zmaten, pokud se mu zobrazí náš vlastní dialog s vysvětlením, co se stalo. A můžeme též připojit žádost na uživatele, aby nás jako autora na vzniklou chybu upozornil a případně zaslal vytvořený soubor s popisem chyby, který se vytvořil. Na něco podobného, tedy bez té fáze odesílání či vytváření záznamu o chybě, můžete narazit například v oblíbeném Windows Commanderu.