Pokud budete chtít pouze otestovat,

zda je dané rozlišení v systému dostupné (bez samotné změny), nastavte jako druhý parametr funkce ChangeDisplaySettings hodnotu CDS_TEST (v naší ukázce je parametrem 0, která právě zajistí rovnou změnu rozlišení). Další možností je parametr CDS_UPDATEREGISTRY, který zajistí též uložení nastavení do registru, takže bude platné i po restartu.
function ZmenaRozliseni(Width, Height, Bit: integer): integer;
var
DvMode : TDeviceMode;
begin
DvMode.dmSize := SizeOf(TDeviceMode);
DvMode.dmPelsWidth := Width;
DvMode.dmPelsHeight := Height;
DvMode.dmBitsPerPel := Bit;
DvMode.dmFields := DM_PELSWIDTH + DM_PELSHEIGHT + DM_BITSPERPEL;
case ChangeDisplaySettings(DvMode, 0) of
DISP_CHANGE_SUCCESSFUL: Result := 1;
DISP_CHANGE_RESTART: Result := 2;
else Result := 3;
end;
end;

Správnější postupe

by patrně byl: nejprve zjistit, která rozlišení jsou dostupná (což ovšem také není problém), a poté jedno z nich vybrat. Vzhledem k tomu, že budete ale pravděpodobně tuto funkci využívat k nastavení konkrétního rozlišení potřebného pro nějaký daný účel, není to myslím třeba. Když dané rozlišení nebude na systému nějakého uživatele dostupné, vrátí nám funkce chybu a vy můžete uživatele informovat. V případě, že bychom vytvářeli cosi jako utilitu na změny rozlišení (podobnou té, která je v systému již obsažena), bylo by zcela jistě na místě použít první způsob, kde budou nabídnuta pouze dostupná nastavení.

Změna rozlišení obrazovky

A dostáváme se ke změně rozlišení obrazovky. Předkládám vám velmi zjednodušené řešení – funkci, jejíž parametry jsou pouze požadované rozlišení a barevná hloubka v bitech. Jako návratová hodnota se nám vrátí 1, pokud vše proběhlo v pořádku a došlo ke změně rozlišení, hodnota 2 se vrátí v případě, že je nutno počítač nejprve restartovat, a hodnota 3 znamená, že došlo k nějaké chybě a rozlišení nelze změnit. Změna nebude pevná, protože se neuloží do registrů a po restartu systému se vrátí k původnímu stavu.

Změna rozlišení obrazovky

A dostáváme se ke změně rozlišení obrazovky. Předkládám vám velmi zjednodušené řešení – funkci, jejíž parametry jsou pouze požadované rozlišení a barevná hloubka v bitech. Jako návratová hodnota se nám vrátí 1, pokud vše proběhlo v pořádku a došlo ke změně rozlišení, hodnota 2 se vrátí v případě, že je nutno počítač nejprve restartovat, a hodnota 3 znamená, že došlo k nějaké chybě a rozlišení nelze změnit. Změna nebude pevná, protože se neuloží do registrů a po restartu systému se vrátí k původnímu stavu.

Změna rozlišení obrazovky

A dostáváme se ke změně rozlišení obrazovky. Předkládám vám velmi zjednodušené řešení – funkci, jejíž parametry jsou pouze požadované rozlišení a barevná hloubka v bitech. Jako návratová hodnota se nám vrátí 1, pokud vše proběhlo v pořádku a došlo ke změně rozlišení, hodnota 2 se vrátí v případě, že je nutno počítač nejprve restartovat, a hodnota 3 znamená, že došlo k nějaké chybě a rozlišení nelze změnit. Změna nebude pevná, protože se neuloží do registrů a po restartu systému se vrátí k původnímu stavu.

Změna rozlišení obrazovky

A dostáváme se ke změně rozlišení obrazovky. Předkládám vám velmi zjednodušené řešení – funkci, jejíž parametry jsou pouze požadované rozlišení a barevná hloubka v bitech. Jako návratová hodnota se nám vrátí 1, pokud vše proběhlo v pořádku a došlo ke změně rozlišení, hodnota 2 se vrátí v případě, že je nutno počítač nejprve restartovat, a hodnota 3 znamená, že došlo k nějaké chybě a rozlišení nelze změnit. Změna nebude pevná, protože se neuloží do registrů a po restartu systému se vrátí k původnímu stavu.

Změna rozlišení obrazovky

A dostáváme se ke změně rozlišení obrazovky. Předkládám vám velmi zjednodušené řešení – funkci, jejíž parametry jsou pouze požadované rozlišení a barevná hloubka v bitech. Jako návratová hodnota se nám vrátí 1, pokud vše proběhlo v pořádku a došlo ke změně rozlišení, hodnota 2 se vrátí v případě, že je nutno počítač nejprve restartovat, a hodnota 3 znamená, že došlo k nějaké chybě a rozlišení nelze změnit. Změna nebude pevná, protože se neuloží do registrů a po restartu systému se vrátí k původnímu stavu.

Změna rozlišení obrazovky

A dostáváme se ke změně rozlišení obrazovky. Předkládám vám velmi zjednodušené řešení – funkci, jejíž parametry jsou pouze požadované rozlišení a barevná hloubka v bitech. Jako návratová hodnota se nám vrátí 1, pokud vše proběhlo v pořádku a došlo ke změně rozlišení, hodnota 2 se vrátí v případě, že je nutno počítač nejprve restartovat, a hodnota 3 znamená, že došlo k nějaké chybě a rozlišení nelze změnit. Změna nebude pevná, protože se neuloží do registrů a po restartu systému se vrátí k původnímu stavu.

Změna rozlišení obrazovky

A dostáváme se ke změně rozlišení obrazovky. Předkládám vám velmi zjednodušené řešení – funkci, jejíž parametry jsou pouze požadované rozlišení a barevná hloubka v bitech. Jako návratová hodnota se nám vrátí 1, pokud vše proběhlo v pořádku a došlo ke změně rozlišení, hodnota 2 se vrátí v případě, že je nutno počítač nejprve restartovat, a hodnota 3 znamená, že došlo k nějaké chybě a rozlišení nelze změnit. Změna nebude pevná, protože se neuloží do registrů a po restartu systému se vrátí k původnímu stavu.

Změna rozlišení obrazovky

A dostáváme se ke změně rozlišení obrazovky. Předkládám vám velmi zjednodušené řešení – funkci, jejíž parametry jsou pouze požadované rozlišení a barevná hloubka v bitech. Jako návratová hodnota se nám vrátí 1, pokud vše proběhlo v pořádku a došlo ke změně rozlišení, hodnota 2 se vrátí v případě, že je nutno počítač nejprve restartovat, a hodnota 3 znamená, že došlo k nějaké chybě a rozlišení nelze změnit. Změna nebude pevná, protože se neuloží do registrů a po restartu systému se vrátí k původnímu stavu.

Lepší je samozřejmě

tomuto stavu předcházet a nadpisy volit s rozumem, ale někdy to prostě nelze. Proto zde mám pro vás funkci, která zjistí, které z písem (zda velké či malé) je v systému právě nastaveno, a podle toho můžete případně zareagovat (změnou nastavení formuláře nebo písem a podobně).
function VelikostFontu : integer;
var DC : HDC;
begin
DC := GETDC(0);
Result := 0;
case GetDeviceCaps(DC, LOGPIXELSX) of
96: Result := 1;
102: Result := 2;
end;
ReleaseDC(0, DC);
end;
Pokud funkce vrátí hodnotu 1, jedná se o malý font (96 dpi), číslo 2 znamená velký font (102 dpi). Samozřejmě není problém tuto funkci drobně upravit, aby vracela přímo číslo velikosti, protože jak víte, stále je zde možnost vlastního nastavení, takže teoreticky ani jedna z těchto možností nemusí platit.

Zjištění velikosti systémového fontu

Tento tip se týká "grafiky" jako takové spíše nepřímo, ale přesto je poměrně důležitý. Zkuste si jeden malý test – nastavte v systému velikost fontu na "Velké písmo". Nyní spusťte svoji aplikaci. Možná, že se nestane nic mimořádného, ale pokud je vaše aplikace plná různých nadpisů, jejichž délka je přesně stavěna na velikost malých fontů (které jsou v systému implicitně nastaveny a těsně navazují jeden na druhý či těsně sousedí s ostatními vizuálními prvky formuláře), může se stát, že se při zvětšeném fontu některé nadpisy ořežou.

Pro úplnost (kdyby to snad nebylo z příkladu jasné) dodávám, že náš příklad vypíše daný text zelenou barvou na souřadnice (200, 200). Souřadnice samozřejmě musíte volit s ohledem na momentální rozlišení obrazovky a při změnách rozlišení (viz dále) je třeba postarat se o překreslení na vhodné místo, protože pokud má být váš text například umístěn v pravém dolním rohu, jeho poloha je pochopitelně závislá na aktuálním rozlišení obrazovky.

Ale nyní již k našemu příkladu. Jedná se opět o jednoduchý příklad použitý v události stisku tlačítka. Parametry, které nás budou hlavně zajímat, jsou jednak samotný vypisovaný text, dále jeho souřadnice a barva. Jako font bude použit aktuální systémový font. Text bude vykreslen transparentně a barvu budeme volit opět pomocí trojkombinace RGB.
procedure TForm1.Button1Click(Sender: TObject);
var dc: hdc;
ocolor: COLORREF;
oBKM : integer;
nastext: string;
begin
nastext := 'Náš zobrazovaný text'
dc := GetWindowDC(GetDesktopWindow);
try
ocolor := SetTextColor(DC, RGB(0, 255, 0));
oBKM := SetBkMode(DC, TRANSPARENT);
TextOut(DC, 200, 200, nastext, Length(nastext));
SetBkMode(DC, oBKM);
SetTextColor(DC, ocolor);
finally
ReleaseDC(GetDesktopWindow, DC);
end;
end;

Ovšem pozor, je nutné upozornit na to, že o překreslování vypisovaného textu se musíte postarat sami, protože při dočasném překrytí textu například oknem jiné aplikace text zmizí (tedy přesněji řečeno nebude automaticky opětovně překreslen). Taktéž pokud dojde k "obnovení pracovní plochy" (například výběrem položky Obnovit v kontextovém menu pracovní plochy), text opět zmizí. Proto musíte jeho překreslování hlídat a obnovovat sami.

Psaní po pracovní ploše

Pokud toužíte popsat přímo pracovní plochu Windows, ukážeme si jednoduchý postup. Využití této funkce ponechám na vás. Můžete ji využít například v některých specifických případech, kdy potřebujete zobrazovat určitou informaci i tehdy, když uživatel minimalizuje vaši aplikaci. V tom případě můžete vypisovat dané informace například někam do rohu pracovní plochy. A nebo jej využijete k naprosto neseriózním zábavným účelům.

To můžeme provést

právě v okamžiku nějaké činnosti, kdy se bude zobrazovat její průběh, a po skončení necháme ProgressBar "zmizet" a opět se objeví "pod ním skrytý" StatusBar. Jelikož se v naší ukázce nastavují rozměry ProgressBaru jen jednou jako událost stisku tlačítka (kvůli zjednodušení; ve vašem kódu pochopitelně budete přepínat mezi ProgressBarem a StatusBarem ve vhodnou chvíli programově), při změně rozměru okna se dostane ProgressBar jaksi mimo svou původní polohu (nebude přesně překrývat StatusBar). Proto musíte buď sami zajistit, aby se jeho rozměr aktualizoval při změně rozměru okna, nebo zajistit to, aby se rozměry okna měnit nemohly. To záleží na typu vaší aplikace a na vašem uvážení.
procedure TForm1.Button1Click(Sender: TObject);
begin
with ProgressBar1 do
begin
Parent := StatusBar1;
Left := 0;
Top := 0;
Height := StatusBar1.Height;
Width := StatusBar1.Width;
end;
end;
A to bude pro dnešek všechno. Příště se podíváme trošku na grafiku.

Jak umístit ProgressBar na StatusBar

Standardní komponenta StatusBar není příliš přívětivá při pokusu umístit na ni jiné komponenty. Dalo by se říct, že se na ni běžným způsobem nedá umístit v podstatě nic (hovořím o komponentě, která je součástí Delphi 5; nevím, jak to vypadá v nové verzi). Ukážeme si, jak na ni "umístit" komponentu ProgressBar. No, vlastně se nejedná tak docela o umístění v pravém slova smyslu, spíše překryjeme StatusBar komponentou ProgressBar.

const Info = 100;
TrayIko = 101;

.
.
.
public
{ Public declarations }
hSysMenu: hmenu;
procedure WMSysCommand(var Message: TMessage); message WM_SYSCOMMAND;
.
.
.

procedure TForm1.WMSysCommand(var Message : TMessage);
begin
if Message.WParam = Info then ShowMessage('Kliknuto na položku Info');
if Message.WParam = TrayIko then ShowMessage('Kliknuto na položku Minimalizace do tray...');
inherited;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
hSysMenu := GetSystemMenu(Form1.Handle, False);
AppendMenu(hSysMenu, MF_SEPARATOR, 0, '');
AppendMenu(hSysMenu, MF_STRING, Info, '&Info');
AppendMenu(hSysMenu, MF_STRING, TrayIko, 'Minimalizuj do &hlavního panelu');
end;

Nejprve si utvoříme seznam konstant, které nám budou identifikovat jednotlivé přidané položky. V události OnCreate hlavního formuláře nejprve přidáme naše položky do menu (a oddělíme je od ostatních oddělovačem). Poté budeme pomocí odchytávání zprávy WMSysCommand zjišťovat, zda došlo k vybrání právě některé z našich položek, a adekvátně na to reagovat. V naší ukázce se pro jednoduchost a ilustraci zobrazí pouze informační okno.

Přidání vlastních položek do systémového menu

Systémové menu, které se zobrazí po kliknutí na ikonku aplikace v jejím titulkovém pruhu (a nebo kliknutím pravého tlačítka na libovolné místo titulkového pruhu), lze velmi snadno obohatit o své vlastní položky. Využití ponechám čistě na vaší fantazii, namátkou mě třeba napadá položka minimalizace do Tray (ikonky vedle hodin) nebo informace o programu. V naší ukázce si právě o tyto dvě položky menu obohatíme, aby byl jasný princip.

Náš příklad předpokládá,

že máte na svém formuláři komponentu MainMenu a jedna z jejích položek má jméno Help1 (její titulek - Caption - může být pochopitelně libovolný). Celý kód přidejte do události OnCreate hlavního formuláře.
procedure TForm1.FormCreate(Sender: TObject);
var
Itm: TMenuItemInfo;
Buf: Array[0..79] of Char;
begin
ZeroMemory(@Itm, SizeOf(Itm));
with Itm do
begin
cbSize := 44;
fMask := MIIM_TYPE;
dwTypeData := Buf;
cch := SizeOf(Buf);
end;
if GetMenuItemInfo(MainMenu1.Handle, Help1.MenuIndex, True, Itm) then
begin
Itm.fType := Itm.fType or MFT_RIGHTJUSTIFY;
if SetMenuItemInfo(MainMenu1.Handle, Help1.MenuIndex, True, Itm) then DrawMenuBar(MainMenu1.WindowHandle);
end;
end;

Položka menu zcela vpravo

Další lahůdka se bude týkat rozložení prvků hlavního menu. Některé aplikace (například oblíbený Windows Commander) mají své hlavní menu upraveno tak, že jedna z položek – obvykle nápověda – je vytěsněna zcela k pravému okraji menu. Mně osobně se tento způsob líbí, připadá mi logický, a nápověda se tak neztratí mezi ostatními položkami (pokud ji ovšem právě kvůli odsunutí na pravou stranu nepřehlédnete, ale to by se stát snad nemělo). Pokud se budete snažit dosáhnout tohoto efektu "přemlouváním" standardní komponenty MainMenu a nastavováním různých parametrů, příliš úspěšní nebudete (to jste možná při pokusech zjistili). Ukážeme si teď spolehlivý způsob, jak na to.

Zvolte zkrátka takovou kombinaci, která bude vhodně doplňovat grafický ráz vaší aplikace. Ukažme si tedy vlastní kód:
.
.
.

private
{ Private declarations }
procedure WMNCPaint(var Msg: TWMNCPaint); message WM_NCPAINT;

.
.
.


procedure TForm1.WMNCPaint(var Msg:TWMNCPaint);
var
dc: hDc;
Pen: hPen;
OldPen: hPen;
OldBrush: hBrush;

begin
inherited;
dc := GetWindowDC(handle);
Msg.Result := 1;
Pen := CreatePen(PS_SOLID, 3, RGB (0,0,0));
OldPen := SelectObject(dc, Pen);
OldBrush := SelectObject(dc, GetStockObject(NULL_BRUSH));
Rectangle(dc, 0, 0, Form1.Width, Form1.Height);
SelectObject(dc, OldBrush);
SelectObject(dc, OldPen);
DeleteObject(Pen);
ReleaseDC(Handle, Canvas.Handle);
end;
Důležitá je pro nás funkce CreatePen. První parametr určuje typ výplně čáry (zde nastavena plná výplň, jiná se asi pro rámeček moc nehodí). Druhý parametr (v našem příkladu je to číslo 3) udává tloušťku rámečku a třetím parametrem je barva v klasické RGB trojkombinaci, tj. hodnoty 0–255 (v naší ukázce je to konkrétně černá). Vrhněte se tedy do experimentování.

Rámeček kolem okna aplikace

Prvním grafickým vylepšením, které si teď ukážeme, bude orámování okna aplikace rámečkem dané tloušťky a barvy. Pokud zvolíme přiměřenou tloušťku a vhodnou (například černou) barvu, dosáhneme celkem pozoruhodného zvýraznění daného okna. Parametry volte s rozvahou a vkusem. Přílišná tloušťka rámečku nevypadá dobře (mírně řečeno) a červená barva asi také nebude úplně to pravé (tedy jak se to vezme, pro chybové hlášení by to nemuselo být špatné).

Pro buffer

je použita maximální velikost paměti, alokovatelná na "heapu", což má přispět k maximální rychlosti výpočtu. V případě, že by vám tato velikost z nějakého důvodu nefungovala (člověk nikdy neví), můžete jej zmenšit podle potřeby. I v případě velikosti 4 kB byl rozdíl ve výpočtu u 40 MB souboru téměř neměřitelný.
A ještě jedna poznámka na závěr. U delších souborů může výpočet opravdu nějakou dobu trvat, takže pokud nebudete chtít, aby se vám aplikace během výpočtu "kousla", přidejte obvyklé Application.ProcessMessages dovnitř cyklu. Tím se sice výpočet může poněkud zpomalit, ale je to lepší než zatuhnutí aplikace (i když jen na chvíli).

Rovnou se přiznávám, že samozřejmě nejsem autorem této konkrétní implementace. Bohužel, autora se mi nepodařilo zjistit. I když na různých webových stránkách kolují všelijaké verze od různých autorů, nejsou vždycky právě funkční a autor jednoznačně identifikovatelný. Verzi, kterou vám předkládám, používám již dlouho a neměla by vám dělat sebemenší problémy.

procedure CalcCRC32(FileName: String; var CRC32: dword);
var F: file;
BytesRead: dword;
Buffer: Array[1..65521] of byte;
i: Word;
begin
FileMode := 0;
CRC32 := $ffffffff;
{$I-}
AssignFile(F, FileName); Reset(F, 1);
if IOResult = 0 then begin
repeat
BlockRead(F, Buffer, SizeOf(Buffer), BytesRead);
for i := 1 to BytesRead do CRC32 := (CRC32 shr 8) xor Table[Buffer[i] xor (CRC32 and $000000FF)];
until BytesRead = 0;
end;
CloseFile(F);
{$I+}
CRC32 := not CRC32;
end;


procedure TForm1.Button1Click(Sender: TObject);
var
crc :dword;
begin
CalcCRC32('c:\VasSoubor.exe', crc);
if crc<>0 then ShowMessage(IntToHex(crc,6));
end;

Samotný kód

je víceméně optimalizován a vlastní funkce výpočtu je poměrně krátká. Celý zdrojový kód je ovšem dlouhý kvůli tabulce konstant používaných při výpočtu, která celé funkci předchází.
Nyní již tedy samotný kód (který je pravděpodobně nejdelší, jaký se zatím v tomto seriálu objevil):
const Table: Array[0..255] of DWord =
($00000000, $77073096, $EE0E612C, $990951BA,
$076DC419, $706AF48F, $E963A535, $9E6495A3,
$0EDB8832, $79DCB8A4, $E0D5E91E, $97D2D988,
$09B64C2B, $7EB17CBD, $E7B82D07, $90BF1D91,
$1DB71064, $6AB020F2, $F3B97148, $84BE41DE,
$1ADAD47D, $6DDDE4EB, $F4D4B551, $83D385C7,
$136C9856, $646BA8C0, $FD62F97A, $8A65C9EC,
$14015C4F, $63066CD9, $FA0F3D63, $8D080DF5,
$3B6E20C8, $4C69105E, $D56041E4, $A2677172,
$3C03E4D1, $4B04D447, $D20D85FD, $A50AB56B,
$35B5A8FA, $42B2986C, $DBBBC9D6, $ACBCF940,
$32D86CE3, $45DF5C75, $DCD60DCF, $ABD13D59,
$26D930AC, $51DE003A, $C8D75180, $BFD06116,
$21B4F4B5, $56B3C423, $CFBA9599, $B8BDA50F,
$2802B89E, $5F058808, $C60CD9B2, $B10BE924,
$2F6F7C87, $58684C11, $C1611DAB, $B6662D3D,
$76DC4190, $01DB7106, $98D220BC, $EFD5102A,
$71B18589, $06B6B51F, $9FBFE4A5, $E8B8D433,
$7807C9A2, $0F00F934, $9609A88E, $E10E9818,
$7F6A0DBB, $086D3D2D, $91646C97, $E6635C01,
$6B6B51F4, $1C6C6162, $856530D8, $F262004E,
$6C0695ED, $1B01A57B, $8208F4C1, $F50FC457,
$65B0D9C6, $12B7E950, $8BBEB8EA, $FCB9887C,
$62DD1DDF, $15DA2D49, $8CD37CF3, $FBD44C65,
$4DB26158, $3AB551CE, $A3BC0074, $D4BB30E2,
$4ADFA541, $3DD895D7, $A4D1C46D, $D3D6F4FB,
$4369E96A, $346ED9FC, $AD678846, $DA60B8D0,
$44042D73, $33031DE5, $AA0A4C5F, $DD0D7CC9,
$5005713C, $270241AA, $BE0B1010, $C90C2086,
$5768B525, $206F85B3, $B966D409, $CE61E49F,
$5EDEF90E, $29D9C998, $B0D09822, $C7D7A8B4,
$59B33D17, $2EB40D81, $B7BD5C3B, $C0BA6CAD,
$EDB88320, $9ABFB3B6, $03B6E20C, $74B1D29A,
$EAD54739, $9DD277AF, $04DB2615, $73DC1683,
$E3630B12, $94643B84, $0D6D6A3E, $7A6A5AA8,
$E40ECF0B, $9309FF9D, $0A00AE27, $7D079EB1,
$F00F9344, $8708A3D2, $1E01F268, $6906C2FE,
$F762575D, $806567CB, $196C3671, $6E6B06E7,
$FED41B76, $89D32BE0, $10DA7A5A, $67DD4ACC,
$F9B9DF6F, $8EBEEFF9, $17B7BE43, $60B08ED5,
$D6D6A3E8, $A1D1937E, $38D8C2C4, $4FDFF252,
$D1BB67F1, $A6BC5767, $3FB506DD, $48B2364B,
$D80D2BDA, $AF0A1B4C, $36034AF6, $41047A60,
$DF60EFC3, $A867DF55, $316E8EEF, $4669BE79,
$CB61B38C, $BC66831A, $256FD2A0, $5268E236,
$CC0C7795, $BB0B4703, $220216B9, $5505262F,
$C5BA3BBE, $B2BD0B28, $2BB45A92, $5CB36A04,
$C2D7FFA7, $B5D0CF31, $2CD99E8B, $5BDEAE1D,
$9B64C2B0, $EC63F226, $756AA39C, $026D930A,
$9C0906A9, $EB0E363F, $72076785, $05005713,
$95BF4A82, $E2B87A14, $7BB12BAE, $0CB61B38,
$92D28E9B, $E5D5BE0D, $7CDCEFB7, $0BDBDF21,
$86D3D2D4, $F1D4E242, $68DDB3F8, $1FDA836E,
$81BE16CD, $F6B9265B, $6FB077E1, $18B74777,
$88085AE6, $FF0F6A70, $66063BCA, $11010B5C,
$8F659EFF, $F862AE69, $616BFFD3, $166CCF45,
$A00AE278, $D70DD2EE, $4E048354, $3903B3C2,
$A7672661, $D06016F7, $4969474D, $3E6E77DB,
$AED16A4A, $D9D65ADC, $40DF0B66, $37D83BF0,
$A9BCAE53, $DEBB9EC5, $47B2CF7F, $30B5FFE9,
$BDBDF21C, $CABAC28A, $53B39330, $24B4A3A6,
$BAD03605, $CDD70693, $54DE5729, $23D967BF,
$B3667A2E, $C4614AB8, $5D681B02, $2A6F2B94,
$B40BBE37, $C30C8EA1, $5A05DF1B, $2D02EF8D);

Kontrolní součet podruhé

– počítáme CRC 32
Pokud to ovšem s výpočtem kontrolních součtů myslíme opravdu vážně, měli bychom používat standardní, všeobecně používané a profesionální řešení. Tím může být například výpočet CRC32 (CRC = Cyclic Redundency Check). Ten je sice poněkud náročnější na výpočet (čas) a délku kódu, ale je jedním z nejpoužívanějších a tuším (a teď mě, prosím, omluvte, pokud se pletu), že jej používá i jeden z dnes již klasických komprimačních programů PKZip. Teorií samotných výpočtů kontrolních součtů se zde nebudeme zabývat, protože by čtenáře asi příliš nezaujala a zájemci nechť se obrátí na příslušnou odbornou literaturu.

function GetCheckSum(FileName : string) : DWORD;
var
F : File of DWORD;
P : Pointer;
Fsize : DWORD;
Buffer : Array [0..500] of DWORD;
begin
FileMode := 0;
AssignFile(F,FileName);
Reset(F);
Seek(F,FileSize(F) div 2);
Fsize := FileSize(F) -1 -FilePos(F);
if Fsize > 500 then Fsize := 500;
BlockRead(F, Buffer, Fsize);
Close (F);
P := @Buffer;
asm
xor eax, eax
xor ecx, ecx
mov edi , p
@again:
add eax, [edi + 4*ecx]
inc ecx
cmp ecx, fsize
jl @again
mov @result, eax
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
ShowMessage(IntToStr(GetCheckSum('c:\VasSoubor.exe')));
end;

Kontrolní součet - první způsob

Další věcí, kterou si teď ukážeme, bude výpočet kontrolního součtu daného souboru. Všichni asi vědí, o co se jedná, takže myslím netřeba žádného většího vysvětlování. Používá se k identifikaci daného souboru, při porovnávání souborů, jako kontrola při komprimaci a v dalších podobných případech. Ukážeme si opět dva (z mnoha jiných) způsobů, jak na to. První způsob je poněkud kratší a velmi jednoduchý, spíše orientační; může nám spíše napovědět před použitím mocnějších nástrojů (viz další kapitola). Pokud například chcete spočítat kontrolní součty dvou souborů a poté je porovnat (a teď ponechme stranou, jestli je to zrovna efektivní způsob), při velmi velkých souborech v řádu stovek MB může tento výpočet trvat relativně dlouho. Tento zjednodušený způsob je naopak velmi rychlý a alespoň pro orientaci postačí.