Tipy a triky v Delphi, díl 8.

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.

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;

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).

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ů

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.

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;

Vyhledávání souborů

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í.

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.

Ale teď již k vlastnímu příkladu. Nejprve umístěte na formulář dva Editboxy (jeden pro adresář a druhý pro masku), jedno tlačítko a jeden ListBox. Vlastní zdrojový kód se bude skládat ze dvou procedur:

procedure Najdi(mask:string);
var
  search:TSearchRec;
  verz:string;
  such:string;
begin
  such:=ExtractFileName(mask);
  verz:=ExtractFilePath(mask);
  if verz[length(verz)]<>`\` then verz:=verz+`\`;
  if FindFirst(mask,$23,search)=0 then
  begin
    repeat
      form1.ListBox1.Items.Add(verz+search.Name);
      Application.ProcessMessages;   
    until FindNext(search)<>0;
  end;
  if FindFirst(verz+`*.*`,fadirectory,search)=0 then
  begin
    repeat
      if ((search.Attr and fadirectory)=fadirectory) and (search.name[1]<>`.`) then
      begin
        Najdi(verz+search.name+`\`+such);
      end;
    until FindNext(search) <>0;
    FindClose(search);
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  adresar:string;
  maska:string;
begin
  screen.Cursor:=crHourGlass;
  listbox1.Items.Clear;
  adresar:=edit1.Text;
  maska:=edit2.Text;
  if adresar[length(adresar)]<>`\` then adresar:=adresar+`\`;
  Najdi(adresar+maska);
  screen.Cursor:=crDefault;
end;

A to je pro dnešek vše. Příště se mimo jiné znovu trochu podíváme na práci s internetem v našich aplikacích.

Diskuze (18) Další článek: Tým iPaqu k pronajmutí

Témata článku: Software, Programování, Search, Složitá záležitost, DEL, TRI, Trik, Následující aplikace, Díl


Určitě si přečtěte

Archivovat data do cloudu, na HDD, SSD, DVD, nebo Blu-ray? Co je nejvýhodnější?

Archivovat data do cloudu, na HDD, SSD, DVD, nebo Blu-ray? Co je nejvýhodnější?

** Kam doma natrvalo uložit data? Vyplatí se ještě optická média? ** Jaké kapacity disků a médií má smysl koupit? ** Cenovou výhodnost si ukážeme na příkladech s 2TB úložištěm

Lukáš Václavík | 118

Lukáš Václavík
ZálohováníÚložištěPevné disky
Testy procesorů Ryzen 5000: AMD překonalo Intel ve všech směrech

Testy procesorů Ryzen 5000: AMD překonalo Intel ve všech směrech

** AMD začalo prodávat nové procesory Ryzen 5000 s architekturou Zen 3 ** K dispozici jsou nezávislé testy z celého světa ** AMD překonává Intel ve všech směrech

Karel Javůrek | 69

Karel Javůrek
ProcesoryTestyAMD
Uživatelé hlásí problémy s jednou z listopadových záplat pro Windows 10
Karel Kilián
Windows UpdateAktualizaceWindows 10
Nejlepší herní notebooky a pracovní stroje: Když máte více než 20 tisíc

Nejlepší herní notebooky a pracovní stroje: Když máte více než 20 tisíc

** Když máte na notebook více než 20 tisíc korun, odpadají kompromisy ** Notebooky na práci dostávají tenká kovová těla a styl ** Herní notebooky zvládnou i nejmodernější hry v plné kvalitě

David Polesný | 43

David Polesný
Notebooky
Fedora 33 prostě funguje. Linux si zaslouží dobýt laptop, je to ale asi opět marné

Fedora 33 prostě funguje. Linux si zaslouží dobýt laptop, je to ale asi opět marné

** Desktopový Linux funguje a vypadá stále lépe ** Fedora 33 není výjimkou ** Ve stínu Windows a macOS tu vyrostly skvělé alternativy

Jakub Čížek | 156

Jakub Čížek
FedoraOperační systémyLinux
Vybrali jsme 12 programovatelných hraček a stavebnic pro děti a jejich rodiče

Vybrali jsme 12 programovatelných hraček a stavebnic pro děti a jejich rodiče

** Získejte děti pro matematiku a základy techniky ** Kupte jim hračku nebo stavebnici, které vdechnou vlastní život ** Vybrali jsme stavebnice pro malé caparty i budoucí experty

Jakub Čížek | 10

Jakub Čížek
Stavebnice
Air Bank, Fio banka a MONETA zakládají alianci pro bankovní identitu
Jakub Čížek
BankaČeskoeGovernment

Aktuální číslo časopisu Computer

Jak prodloužit výdrž notebooku

Velké testy: gamepady a inkoustové tiskárny

Důkladný test Sony Playstation 5