Nyní můžeme začít vytvářet naší ukázkovou aplikaci. Na prázdný formulář tedy nejprve umístíme tři komponenty, které se nám postarají o procházení adresáři a disky. Kvůli zjednodušení můžeme použít například komponenty FileListBox, DirectoryListBox a DriveComboBox ze záložky Win 3.1 na paletě komponent. Komponenty pak navzájem "propojíme" běžným způsobem nastavením vlastností v Object Inspectoru tak, aby se změna disku či složky automaticky projevila i na výpis souborů a souborovou masku omezíme na soubory WAV.
Pro výpis informací, získaných ze souborů, můžeme použít například Label, respektive jejich větší množství (podle toho kolik a jaké informace budeme vypisovat), ale použít můžete pochopitelně cokoliv, to již nechám na vás. Samotné načtení a zobrazení informací pak umístíme do události OnChange komponenty FileListBox.
A to už se tedy postupně dostáváme k samotnému výpisu informací. Nejdříve si ještě nadefinujeme globální proměnnou, do které budou data načítána a poté již následuje vlastní funkce pro čtení dat ze souboru:
.
.
var
soubor: WAVrecord;
.
.


function ReadWAV(const FileName: string; var WAVData: WAVrecord): Boolean;
var
SourceFile: file;
begin
try
Result := true;
AssignFile(SourceFile, FileName);
FileMode := 0;
Reset(SourceFile, 1);
BlockRead(SourceFile, WAVData, 40);
if WAVData.DataHeader <> 'data' then
begin
Seek(SourceFile, WAVData.FormatSize + 28);
BlockRead(SourceFile, WAVData.SampleNumber, 4);
end;
CloseFile(SourceFile);

Tipy a triky v Delphi

Tipy a triky v Delphi

Tématem dnešního dílu budou soubory WAVE. Nebudeme je sice přehrávat, to není až zas tak velký problém, ale naučíme se zjišťovat o nich různé užitečné informace jako je typ, délka, frekvence a mnoho dalších.
Soubory WAVE jsou alespoň na platformě Windows oblíbeným a celkem dlouhá léta standardním formátem pro ukládání zvukových dat. Hudbu máte sice pravděpodobně uloženu v jiném formátu kvůli úspoře místa, ale například pro nahrávání zvuků (hudby) z nějakého externího zdroje a následnou editaci je to celkem použitelný formát, který zvládá snad každý zvukový editor a můžete tak bez ztráty kvality zvuky upravovat. Až poté je teprve převedete do nějakého úspornějšího formátu (MP3, WMA a podobně). Rovněž rozličné systémové zvuky či zvuky v aplikacích jsou uloženy v tomto formátu. Proto jistě nebude na škodu, když si teď ukážeme, jak získat z hlavičky souboru některé zajímavé údaje a vlastnosti souboru.
Nejprve si vytvoříme datovou strukturu, do které tyto informace z hlavičky načteme. Můžeme k tomu využít například záznam (record) a ten bude vypadat takto:
.
.
type
WAVrecord = record
RIFFHeader: array [1..4] of Char;
FileSize: Integer;
WAVEHeader: array [1..4] of Char;
FormatHeader: array [1..4] of Char;
FormatSize: Integer;
FormatID: Word;
ChannelNumber: Word;
SampleRate: Integer;
BytesPerSecond: Integer;
BlockAlign: Word;
BitsPerSample: Word;
DataHeader: array [1..4] of Char;
SampleNumber: Integer;
end;
.

if Pos(uppercase('soname'),exestring) > 0 then
begin
Extract('soname','eoname',ExeString,Temp);
SpeedButton1.Caption := 'Program je registrován na: '+Temp;
end;
end;

procedure TForm1.SpeedButton1Click(Sender: TObject);
var
MyStream: TMemoryStream;
MyFile,newname: string;
A,B: Integer;
begin
If Speedbutton1.Caption <> 'Napište vaše jméno a klikněte sem pro registraci' then exit;
if edit1.text = '' then
begin
showmessage('Vložte prosím vaše jméno !');
exit;
end;
MyStream := TMemoryStream.Create;
try
ExeString := ExeString + uppercase('soname') + Edit1.Text + uppercase('eoname');
MyStream.Clear;
MyStream.WriteBuffer(Pointer(ExeString)^, Length(ExeString));
newname := application.exename;
Insert('_clone',newname,length(application.exename)-3);
MyStream.savetofile(newname);
finally
MyStream.Free;
end;
ShellExecute(Handle, 'open', pchar(newname), nil, nil, SW_SHOWNORMAL);
application.terminate;
end;

end.
Zdrojový program aplikace si ukazujeme celý, pěkně od začátku až do konce, aby nedošlo k nějakým nejasnostem. Zdrojový kód jsem nechal tentokrát téměř beze změn, tak jak se mi dostal do rukou.
Možná jste si všimli, že je opět použita jedna z variant procedury Delay. Je použita proto, aby v kritické fázi mazání jednoho souboru a spouštění jiného nedošlo ke vzájemné kolizi, ke které může dojít. Proto je vložena půlsekundová pauza.
Místo ve zdrojovém kódu, které je výrazně orámováno lomítky, obsahuje ten kód, který bude proveden v tom případě, že již došlo k úspěšné registraci (a v této fázi již by měl být tedy na disku pouze výsledný modifikovaný soubor). Sem tedy vložte ten kód, který má reagovat na tuto situaci. V naší ukázce dojde jednak k zneviditelnění komponenty Edit, protože ta již není potřeba, a pak je ještě změněna barva formuláře.
Co říci na úplný závěr? Vzhledem ke způsobu manipulace se soubory, jejich kopírování a mazání nebude zřejmě příliš vhodné tento postup použít pro velmi velké soubory. A i při použití pro menší soubory nelze vyloučit za určitých extrémních podmínek možné selhání, ale to je riziko každého podobného krkolomného postupu. Pokud však nemáte jinou možnost, račte vyzkoušet...

procedure TForm1.FormCreate(Sender: TObject);
Var
MyStream: TMemoryStream;
name,C,Temp: String;
D,E: integer;
begin
exe2String(ExeString);
if pos(uppercase('soname'),exestring) > 0 then
begin
delay(500);
if pos('_clone',application.exename) = 0 then
begin
name := application.exename;
Insert('_clone',name,(length(name)-3));
deletefile(name);
end;
////////////////////////////////////////////////////////////////////////////////
edit1.visible := false;
form1.color := $00c6aa84;
////////////////////////////////////////////////////////////////////////////////
end;

if pos('_CLONE',uppercase(application.exename)) <> 0 then
begin
delay(500);
name := application.exename;
Delete(name,length(name)-9,6);
if deletefile(name) then
begin
MyStream := TMemoryStream.Create;
try
MyStream.WriteBuffer(Pointer(ExeString)^, Length(ExeString));
MyStream.savetofile(name);
finally
MyStream.Free;
ShellExecute(Handle, 'open', pchar(name), nil, nil, SW_SHOWNORMAL);
application.terminate
end;
end
else showmessage(name+' nenalezen');
end;

• pokud se již nejedná o dočasný klon, program smaže v daném adresáři všechny soubory, které mají v názvu _CLONE (tím vlastně provede závěrečný úklid) a postup je u konce
• jestliže se jedná o klon, je nejprve smazán z disku originální program, poté uložen na disk modifikovaný soubor pod původním názvem, ten je spuštěn a klon se sám ukončí
• spuštěný finální soubor se postará o smazání klonu (viz. o dva body výše)
Doufám, že je teď již postup zcela jasný a můžeme si tedy ukázat zdrojový kód. Příklad předpokládá, že na formuláři budete mít jeden Edit pro zadávání jména a dále pak SpeedButton, po jehož stisku dojde k registraci - spustí se modifikace souboru:
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Buttons, StdCtrls,ShellAPI, ExtCtrls, Mask;

type
TForm1 = class(TForm)
SpeedButton1: TSpeedButton;
Edit1: TEdit;
procedure FormCreate(Sender: TObject);
procedure SpeedButton1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
ExeString: String;

implementation

{$R *.DFM}

procedure Extract(A,B: String;Var C,D: String);
Var
E,F: Integer;
begin
if Pos(uppercase(A),C) > 0 then
begin
E := Pos(uppercase(A),C)+length(A);
F := Pos(uppercase(B),C);
D := Copy(C,E,F-E);
end;
end;

procedure Exe2String(var A:String);
Var
ExeStream: TFileStream;
MyStream: TMemoryStream;
begin
ExeStream:=TFileStream.Create(Application.ExeName,fmOpenRead or fmShareDenyNone);
Try
SetLength(A, ExeStream.Size);
ExeStream.ReadBuffer(Pointer(A)^, ExeStream.Size);
Finally
ExeStream.Free;
end;
end;

procedure Delay(ms : longint);
var
TheTime : LongInt;
begin
TheTime := GetTickCount + ms;
while GetTickCount < TheTime do Application.ProcessMessages;
end;

Tipy a triky v Delphi

Tipy a triky v Delphi, díl 53.
14. 8. 2002, Jan Šindelář formát pro tisk
Tématem dnešního dílu bude poněkud kontroverzní záležitost, protože se pokusíme modifikovat soubor aplikace přímo za jejího běhu.
Jistě vás napadlo, že běžným způsobem to nepůjde, protože běžící program by vám neměl operační systém v žádném případě dovolit jakkoliv pozměňovat či mazat z disku a také vám to nedovolí. Způsobů, jak toto omezení obejít, lze určitě vymyslet několik, ale vždy se bude jednat o ne příliš obvyklý způsob a proto berte i čistotu dnešního zdrojového kódů poněkud tolerantněji.
Ale zpět k našemu příkladu. Jistou možností je vytvořit za běhu aplikace její upravenou kopii a původního souboru se poté zbavit například tím, že do registru systému vložíme příkaz k jeho vymazání po dalším restartu Windows. Jistě víte, že podobný způsob využívají například instalační programy, které se tak zbavují těch částí programu, které nemohly být z určitého důvodu ukončeny (a smazány) v době odinstalace aplikace. Způsob je to jistě korektní a čistý, ale má tu nevýhodu, že tento efekt změny není okamžitý a je závislý právě na restartu systému. Proto si ukážeme jiný postup, který bude mít okamžitý efekt, ale nebude tak způsobný, jako postup předchozí.
Než si ukážeme zdrojový kód, je třeba si slovně popsat celý princip. Věc není komplikovaná, ale je potřeba si ujasnit jisté situace, které mohou nastat a které jsou pro příklad klíčové. Velmi zkráceně řečeno je postup takový, že se vytvoří kopie běžící aplikace, která bude poté uložena na disk v již pozměněné podobě a pochopitelně pod jiným názvem. Tato nová aplikace bude poté spuštěna, původní aplikace se ukončí a bude novou aplikací z disku smazána. Nyní již zbývá jen poslední věc a tou je název nově vzniklé aplikace. Ten je totiž jiný, než byl u aplikace původní, protože jsme pochopitelně nemohli uložit na disk dva soubory téhož názvu. A proto si postup ještě jednou zopakujeme. Opět uložíme kopii souboru na disk, ale tentokrát již pod původním názvem, tato další nová aplikace bude opět spuštěna a postará se o smazání "dočasné" aplikace. Tím je celý postup u konce a na disku (a běžící v paměti) je teď již pouze modifikovaná aplikace s původním názvem. Celé to trošku připomíná jeden ze základních programátorských postupů výměny hodnot dvou proměnných, která se udělá pomocí proměnné třetí (tedy, jak možná víte, ono to jde udělat i bez pomocné proměnné, ale to teď nechme stranou).
Celá věc má ještě několik drobných fint, které by nemusely být ze zdrojového kódu hned jasné a tak si je teď ještě musíme vysvětlit. Příklad, který naleznete v závěru článku, řeší s využitím výše popsaného postupu jednoduchou registraci uživatele. Při prvním spuštění bude uživatel požádán o vložení jeho jména. Toto jméno bude poté uloženo přímo do aplikace modifikací jejího souboru a nemusí tak být uloženo v registrech nebo INI souboru. Když bude poté taková aplikace spuštěna, "pozná" že již byla registrována a tato úvodní procedura bude přeskočena. Toto uživatelské jméno bude uloženo na samém konci souboru mezi "klíčová" slova SONAME a EONAME. Tato slova jsou tam právě proto, aby aplikace při svém znovuspuštění poznala, zda již došlo k registraci a můžete si je dle potřeby změnit.
Znovu si tedy popišme celý postup, tentokrát již jen heslovitě:
• aplikace je spuštěna a podle toho, zda najde na svém konci jméno uživatele mezi speciálními klíčovými slovy pozná, zda má spustit registrační proceduru nebo ne
• pokud k registraci ještě nedošlo, uživatel je požádán o vložení jména
• poté dojde k převedení celého souboru aplikace na string, na jehož konec bude přidáno jméno uživatele spolu s klíčovými slovy
• tento soubor je uložen pod dočasným názvem (k originálnímu názvu je přidáno _CLONE), tato nová aplikace je spuštěna a původní se sama ukončí
• takto vzniklý modifikovaný klon nejprve zjistí, jestli již došlo k registraci a pokud ano, snaží se zjistit, zda je klon a nebo finální program (to pozná ze svého jména)

Stav modemu

Stav modemu
I druhý dnešní tip souvisí s modemem. Tentokrát si ukážeme, jak zjistit některé jeho stavové informace. Opět je třeba specifikovat COM port a celá struktura procedury je dost podobná předchozímu příkladu. Výsledný stav je poté vypsán v jednoduchém dialogu.
procedure TForm1.Button1Click(Sender: TObject);
var
CommPort : string;
hCommFile : THandle;
ModemStat : DWord;
begin
CommPort := 'COM3';
hCommFile := CreateFile(PChar(CommPort), GENERIC_READ, 0, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
if hCommFile = INVALID_HANDLE_VALUE then
begin
ShowMessage('Nelze otevřít '+ CommPort);
exit;
end;

if GetCommModemStatus(hCommFile, ModemStat) then
begin
if ModemStat and MS_CTS_ON <> 0 then ShowMessage('The CTS (clear-to-send) is on.');
if ModemStat and MS_DSR_ON <> 0 then ShowMessage('The DSR (data-set-ready) is on.');
if ModemStat and MS_RING_ON <> 0 then ShowMessage('The ring indicator is on.');
if ModemStat and MS_RLSD_ON <> 0 then ShowMessage('The RLSD (receive-line-signal-detect) is on.');
end;

CloseHandle(hCommFile);
end;
Zjištění stavu modemu nějaký čas zabere (u mě okolo dvou sekund), takže nepanikařte, pokud se výsledek nezobrazí ihned. Text (tedy stav), který se zobrazí jako výsledek, jsem tentokrát nepřekládal, protože by to mohlo být spíše kontraproduktivní a věřím že ti, kteří tento tip budou zkoušet, ví o co jde a dají přednost původním termínům.