algorytm.org

Implementacja w Delphi/Pascal

Baza Wiedzy
wersja offline serwisu przeznaczona na urządzenia z systemem Android
Darowizny
darowiznaWspomóż rozwój serwisu
Nagłówki RSS
Artykuły
Implementacje
Komentarze
Forum
Bookmarki






Sonda
Implementacji w jakim języku programowania poszukujesz?

EAN-13 - Implementacja w Delphi/Pascal
Ocena użytkownikóww: *****  / 3
SłabyŚwietny
Nadesłany przez Tomasz Lubiński, 27 października 2005 01:00
Kod przedstawiony poniżej przedstawia główną część rozwiązania problemu.
Pobierz pełne rozwiązanie.

Jeżeli nie odpowiada Ci sposób formatowania kodu przez autora skorzystaj z pretty printer'a i dostosuj go automatycznie do siebie.

ean13_d/ean13_d.dpr:
program ean13_d;

//www.algorytm.org
//EAN13
//(c) 2005 Tomasz Lubinski

{$APPTYPE CONSOLE}
uses
  SysUtils;

var
  EAN13 : array [0..12] of Integer;
  valid : boolean = false;
  EAN13str : string;

Numbers : array [0 .. 126] of Integer = (
	0, 10, 11, 12, 13, 2, 30, 31, 32, 33, 34, 35, 36, 37, 380, 383, 385, 387, 40,
	41, 42, 43, 44, 45, 46, 470, 471, 474, 475, 476, 477, 478, 479, 480, 481,
	482, 484, 485, 486, 487, 489, 49, 50, 520, 528, 529, 531, 535, 539, 54, 560,
	569, 57, 590, 594, 599, 600, 601, 608, 609, 611, 613, 619, 621, 622, 624,
	625, 626, 627, 628, 629, 64, 690, 691, 692, 70, 729, 73, 740, 741, 742, 743,
	744, 745, 746, 750, 759, 760, 770, 773, 775, 777, 779, 780, 784, 786, 789,
	790, 80, 81, 82, 83, 84, 850, 858, 859, 860, 867, 869, 87, 880, 885, 888, 890,
	893, 899, 90, 91, 93, 94, 950, 955, 977, 978, 979, 98, 99 );

Countries : array [0 .. 126] of String = (
        'USA i Kanada', 'USA i Kanada', 'USA i Kanada', 'USA i Kanada', 'USA i Kanada',
	'Do użytku wewnętrznego', 'Francja', 'Francja', 'Francja', 'Francja',
	'Francja', 'Francja', 'Francja', 'Francja', 'Bułgaria', 'Słowenia',
	'Chorwacja', 'Bośnia-Hercegowina', 'Niemcy', 'Niemcy', 'Niemcy', 'Niemcy',
	'Niemcy', 'Japonia', 'Rosja', 'Kirgistan', 'Tajwan', 'Estonia', 'Łotwa',
	'Azerbejdżan', 'Litwa', 'Uzbekistan', 'Sri Lanka', 'Filipiny', 'Białoruś',
	'Ukraina', 'Mołdawia', 'Armenia', 'Gruzja', 'Kazachstan', 'Hong Kong',
	'Japonia', 'Wielka Brytania', 'Grecja', 'Liban', 'Cypr', 'Macedonia', 'Malta',
	'Irlandia', '540-Belgia i Luksemburg', 'Portugalia', 'Islandia', 'Dania',
	'Polska', 'Rumunia', 'Węgry', 'RPA', 'RPA', 'Bahrain', 'Mauritius', 'Maroko',
	'Algeria', 'Tunezja', 'Syria', 'Egipt', 'Libia', 'Jordania', 'Iran', 'Kuwejt',
	'Arabia Saudyjska', 'Emiraty Arabskie', 'Finlandia', 'Chiny', 'Chiny',
	'Chiny', 'Norwegia', 'Izrael', '730-Szwecja', 'Gwatemala', 'Salwador',
	'Honduras', 'Nikaragua', 'Kostaryka', 'Panama', 'Dominikana', 'Meksyk',
	'Wenezuela', 'Szwajcaria', 'Kolumbia', 'Urugwaj', 'Peru', 'Boliwia',
	'Argentyna', 'Chile', 'Paragwaj', 'Ekwador', 'Brazylia', 'Brazylia', 'Włochy',
	'Włochy', 'Włochy', 'Włochy', 'Hiszpania', 'Kuba', 'Słowacja', 'Czechy',
	'Jugosławia', 'Korea Północna', 'Turcja', '870-Holandia', 'Korea Południowa',
	'Tajlandia', 'Singapur', 'Indie', 'Wietnam', 'Indonezja', 'Austria',
	'Austria', 'Australia', 'Nowa Zelandia', 'EAN - IDA', 'Malezja', 'ISSN',
	'ISBN', 'ISMN', 'Kupony', 'Kupony' );


function checkSum(): boolean;
var
        sum: Integer;
begin

        sum := 1 * EAN13[0] +
               3 * EAN13[1] +
	       1 * EAN13[2] +
	       3 * EAN13[3] +
	       1 * EAN13[4] +
	       3 * EAN13[5] +
	       1 * EAN13[6] +
	       3 * EAN13[7] +
	       1 * EAN13[8] +
	       3 * EAN13[9] +
	       1 * EAN13[10] +
	       3 * EAN13[11];
		
        sum := sum mod 10;
        sum := 10 - sum;
        sum := sum mod 10;

        if sum = EAN13[12] then
		result := true
	else
		result := false;

end;

function getCountry(): String;
var
        code, i, j : Integer;
begin
	result := 'unknown';
        code := 0;

	for i := 0 to 2 do
            begin
		code := code * 10;
		code := code + EAN13[i];

		for j := 0 to 126 do
        		if Numbers[j] = code then
                             begin
				result := Countries[j];
				break;
                             end;

		if result <> 'unknown' then
        		break;
            end;
end;

procedure EAN13Validator(EAN13Number: String);
var
        i : integer;
begin

	if (length(EAN13Number) <> 13) then
		valid := false
	else
            begin
		for i := 0 to 12 do
			EAN13[i] := strToInt(EAN13Number[i+1]);

		if checkSum() then
			valid := true
		else
			valid := false;
  	    end;
end;


begin
        writeln('Podaj numer EAN13 (bez spacji i myslinikow)');
        readln(EAN13str);

        EAN13Validator(EAN13str);


        if valid then
           begin
        	writeln('Numer EAN13 jest prawidłowy');
        	writeln('Kraj pochodzenia ' + getCountry());

           end
        else
           begin
        	writeln('Numer EAN13 jest nieprawidłowy');
           end;

end.
Dodaj komentarz