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.

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

18 komentářů

Nejnovější komentáře

  • Štěpa 6. 11. 2003 23:31:46
    Jestli si tohle někdo přečte, tak bych se chtěl zeptat, jak se to dělá v...
  • J.V 28. 7. 2003 22:23:05

    Myslím, že i při odesílání emailu je požadováno heslo.

  • Fous 15. 7. 2003 8:45:42

    A co vlastnost LocalIP komponenty PowerSock (záložka fastNet) ?

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

CCleaner obsahuje softwarovou havěť! Tvůrcům se do kódu dostali hackeři

CCleaner obsahuje softwarovou havěť! Tvůrcům se do kódu dostali hackeři

** Masově oblíbený program pro softwarovou očistu Windows ovládli hackeři ** Narušení se podařilo zavčas odhalit, unikla jen data o počítačích uživatelů ** Je paradoxní, že CCleaner byl slabě zabezpečen, když jej letos koupil Avast

18.  9.  2017 | David Polesný | 45

Země se jenom o vlásek vyhnula věčnému zmrznutí

Země se jenom o vlásek vyhnula věčnému zmrznutí

** Země po většinu doby své existence zmrzlá rozhodně nebyla ** Podle nového výzkumu tomu však unikla jen o vlásek ** Kdyby totiž byla jenom o 15 procent dále od Slunce, tak by prý kompletně celá zamrzla

Včera | Stanislav Mihulka | 9

Noční strana Venuše vydala další tajemství

Noční strana Venuše vydala další tajemství

18.  9.  2017 | Jiří Černý

Jak tankují bombardéry: Z létající benzinky šest kilometrů nad Českem

Jak tankují bombardéry: Z létající benzinky šest kilometrů nad Českem

** Bombardéry tankují z létající benzinky Boeing KC-135 Stratotanker ** Tu americké letectvo pro doplňování paliva jiných letounů ve vzduchu využívá už více jak půlstoletí ** Tankování probíhá přes speciální výsuvné čerpací rameno na zádi

17.  9.  2017 | Natoaktual.cz


Aktuální číslo časopisu Computer

Vyplatí se ještě těžit kryptoměny?

Velký test studentských notebooků

Test pěti levných soundbarů

Nejlepší chytré hodinky