program PIC_Serial_Programmer_on_LPT;

  uses
        Crt;

  type
        bin_t                     = record
                                      org   : array[0..$21ff] of Word;
                                      data  : array[0..$21ff] of Word;
                                      count : Word;
                                    end;

  const
        VER                       = '2.1 Beta';
        ROK                       = '14.09.2002';
        AUTOR                     = 'Adam Jurkiewicz';
        PROGRAM_NAME              = 'Picload';

        LPT                       : array[1..3] of word = ($378, $278, $3BC);

{        DATA                      : word = LPT + 0; {OUT}
        D0                        = $0001; {Pin  2}  {H:maska negacji, L:bit}
        D1                        = $0002; {Pin  3}
        D2                        = $0004; {Pin  4}
        D3                        = $0008; {Pin  5}
        D4                        = $0010; {Pin  6}
        D5                        = $0020; {Pin  7}
        D6                        = $0040; {Pin  8}
        D7                        = $0080; {Pin  9}

{        STATUS                    : word = LPT + 1; {IN}
        ERR                       = $0008; {Pin 15}
        ONOFF                     = $0010; {Pin 13}
        PAP                       = $0020; {Pin 12}
        ACK                       = $0040; {Pin 10}
        BUSY                      = $8080; {Pin 11}


{        CONTROL                   : word = LPT + 2; {OUT}
        STR                       = $0101; {Pin  1}
        ALF                       = $0202; {Pin 14}
        INI                       = $0004; {Pin 16}
        DSL                       = $0808; {Pin 17}

        C_DATA                    = D2;    {przypisanie sygnalom sterujacym}
        C_CLOCK                   = D5;    {wyprowadzen portu LPT}
        DATA_O                    = D0;
        DATA_I                    = ACK;
        CLOCK                     = D1;
        MCLR_K1                   = D4;
        MCLR_K2                   = D3;
        MCLR_LVP                  = D7;
        LVP                       = D6;
                                           {rozkazy sterujace programowaniem}
        Load_Configuration        = $00;   {procesorow PIC}
        Load_Data                 = $02;   {LSB(0): "0" - Code, "1" - Data}
        Read_Data                 = $04;   {LSB(0): "0" - Code, "1" - Data}
        Load_Data_for_Program_M   = $02;   {procesorow PIC}
        Load_Data_for_Data_M      = $03;
        Read_Data_from_Program_M  = $04;
        Read_Data_from_Data_M     = $05;
        Increment_Adress          = $06;
        Begin_Erase_Programming   = $08;
        Begin_Programming_Only    = $18;
        Bulk_Erase                = $09;   {LSB(1): "0" - Code, "1" - Data}
        Bulk_Erase_Program_M      = $09;
        Bulk_Erase_Data_M         = $0B;
        Erase_Code_Protection_1   = $01;
        Erase_Code_Protection_2   = $07;
        ChipErase                 = $1f;

        L                         = 0;
        H                         = 1;
        VPP                       = 2;

        NO_DATA                   : Word = $FFFF;
        BULK                      : Word = $7FFF;

        CODEMEM                   = 0;
        DATAMEM                   = 1;
        MAXCOL                    = 80;      {ilosc kolumn na ekranie}
        MEMCONFIG                 = $2000;   {adres pamieci konfiguracji}
        MAXCODE                   = $2000;
        MAXDATA                   = $FF;
        LENCONFIG                 = 7;       {dlugosc pamieci konfiguracji}
        MAXOPTIONS                = 9;

        No                        = 0;
        Yes                       = 1;
        LptPort                   = 2;
        ErrorCheck                = 3;
        WriteConfigWord           = 4;
        MaxCodeRead               = 5;
        MaxDataRead               = 6;
        QuietMode                 = 7;
        ReadAdres                 = 8;
        PicMode                   = 9;

        Switches                  = 1;
        Settings                  = 2;

        Texts                     : array[0..MAXOPTIONS] of string[20] =
                                    ('No',
                                     'Yes',
                                     'LptPort',
                                     'ErrorCheck',
                                     'WriteConfigWord',
                                     'MaxCodeRead',
                                     'MaxDataRead',
                                     'QuietMode',
                                     'ReadAdress',
                                     'PicModeA'
                                    );

        Group                     : array[1..2] of string[20] =
                                    ('Switches',
                                     'Settings'
                                    );
  var
        ready, dana, cm,
        r_error, lpt_nr, tryb_a,
        fileexist, overwrite      : Byte;
        i, j, k, count,
        LPT_PORT, LPT_OUT, LPT_IN : Word;
        cmdln, prog_name, param   : string;
        file_name, i_file_name,
        o_file_name, ini_file     : string[40];
        order                     : string[6];
        plik                      : Text;
        Options                   : array[0..MAXOPTIONS] of word;
        Dane                      : bin_t;

  {  --------------------------------------------------------------------  }

  function cut_path (linia : string) : string;
  begin
    while pos ('\', linia) <> 0 do
      delete (linia, 1, pos ('\', linia));
    cut_path := linia;
  end;

  {  --------------------------------------------------------------------  }

  function downstr (tekst : string) : string;
  var      i, j : byte;
  begin
    for i := 1 to length (tekst) do
      if tekst[i] in['A'..'Z'] then tekst[i] := chr (ord (tekst[i]) or $20);
    downstr := tekst;
  end;

  {  --------------------------------------------------------------------  }

  function wykasuj_znaki (linia : string; delchar : char) : string;
  begin
    while pos (delchar, linia) <> 0 do
      delete (linia, pos (delchar, linia), 1);
    wykasuj_znaki := linia;
  end;

  {  --------------------------------------------------------------------  }

  function bin2hex (x : Longint; tryb : Byte) : string;
  var      hex      : string[4];
           i, len   : Byte;
  begin                                  { funkcja konwertujaca liczbe     }
    hex := '';                           { z postaci binarnej do           }
    for i := 1 to tryb do                { szesnastkowej, z wstepnym       }
      hex := hex + '0';                  { ustawieniem ilosci pozycji      }
    len := length (hex);
    for i := 0 to len - 1 do
    begin
      hex[i + 1] := chr (((x shr ((len - i - 1) * 4)) and $000F) + ord ('0'));
      if hex[i + 1] > '9' then hex[i + 1] := chr (ord (hex[i + 1]) + 7);
    end;
    bin2hex := hex;
  end;

  {  --------------------------------------------------------------------  }


  procedure help (tryb : Byte);
  const     active = ' (default)';
  var       l      : array[1..3] of string[10];
  begin
    WriteLn;
    WriteLn (PROGRAM_NAME,' - PIC 16FXXX Series Freeware Programmer V', VER, ' (', ROK, ')');
    WriteLn ('Based on Microchip AN589 Circuit');
    WriteLn;
    WriteLn ('Programmed by ', AUTOR,', Poland');
    WriteLn ('Source: http://ajpic.zonk.pl/picload/');
    WriteLn ('E-mail: sword@ajpic.zonk.pl');
    WriteLn;
    if tryb = 1 then
    begin
      WriteLn;
      WriteLn (' usage:   ',prog_name,' <command> [switch] [file[.hex | .bin]]');
      WriteLn;
      WriteLn (' command:');
      WriteLn ('          -wp      - write to program memory');
      WriteLn ('          -wd      - write to data memory');
      WriteLn ('          -rp[n]   - read n words from program memory [n = ', Options[MaxCodeRead], ']');
      WriteLn ('          -rd[n]   - read n bytes from data memory [n = ', Options[MaxDataRead], ']');
      WriteLn ('          -ep      - erase program memory');
      WriteLn ('          -ed      - erase data memory');
      WriteLn ('          -ec      - erase code protect and all memory');
      WriteLn ('          -go      - reset chip and run program');
      WriteLn ('          -sc      - save configuration file');
      WriteLn ('          -dc      - delete configuration file');
      WriteLn (' switch:');

      fillchar (l, SizeOf (l), #0);
      for i := 1 to 3 do
        if Options[PicMode] = i - 1 then l[i] := active;
      WriteLn ('          -a[n]    - write mode A [n = 1]');
      WriteLn ('                       0 - standard protocol', l[1]);
      WriteLn ('                       1 - PIC A protocol', l[2]);
      WriteLn ('                       2 - PIC 12 protocol', l[3]);

      fillchar (l, SizeOf (l), #0);
      for i := 1 to 3 do
        if Options[LptPort] = LPT[i] then l[i] := active;
      WriteLn ('          -l<n>    - use LPT<n>');
      WriteLn ('                       1 - 0x', bin2hex (LPT[1], 3), l[1]);
      WriteLn ('                       2 - 0x', bin2hex (LPT[2], 3), l[2]);
      WriteLn ('                       3 - 0x', bin2hex (LPT[3], 3), l[3]);

      fillchar (l, SizeOf (l), #0);
      if Options[WriteConfigWord] = Options[Yes] then l[2] := active;
      if Options[WriteConfigWord] = Options[No]  then l[1] := active;
      WriteLn ('          -wc[n]   - configuration word [n = 1]');
      WriteLn ('                       0 - is not written', l[1]);
      WriteLn ('                       1 - is written', l[2]);

      fillchar (l, SizeOf (l), #0);
      if Options[ErrorCheck] = Options[Yes] then l[2] := active;
      if Options[ErrorCheck] = Options[No]  then l[1] := active;
      WriteLn ('          -ce[n]   - checking for errors [n = 1]');
      WriteLn ('                       0 - no errors are checked', l[1]);
      WriteLn ('                       1 - all errors are checked', l[2]);

      fillchar (l, SizeOf (l), #0);
      if Options[QuietMode] = Options[Yes] then l[2] := active;
      if Options[QuietMode] = Options[No]  then l[1] := active;
      WriteLn ('          -q[n]    - quiet mode [n = 0]');
      WriteLn ('                       0 - all messages are displayed', l[1]);
      WriteLn ('                       1 - no messages are displayed', l[2]);
      WriteLn;
      Halt;
    end;
  end;

  {  --------------------------------------------------------------------  }

  function check_file (nazwa : string) : byte;
  var       plik : text;
            kod  : byte;
  begin
    Assign (plik, nazwa);
{$I-}
    Reset (plik);
{$I+}
    kod := IOResult;
    if kod = 0 then close (plik);
    check_file := kod;
  end;

  {  --------------------------------------------------------------------  }

  procedure get_hex (filename : string; var bin : bin_t);  { czytnik plikow Intel HEX }
  var
            linia                 : string;
            ild, lp, j            : Byte;
            poz, lpoz, i, ll, l   : Word;
            plik                  : Text;
            c                     : Char;

  function cyfra (linia : string; pos : Byte) : Byte;
  begin
   if linia[pos] in ['A'..'F'] then cyfra := Ord (linia [pos]) - 55
                               else cyfra := Ord (linia [pos]) - 48;
  end;

  begin
    if check_file (filename) <> 0 then
    begin
      Writeln;
      WriteLn ('File: "', filename,'" is missing!');
      Halt;
    end;

    Assign (plik, filename);
    Reset (plik);
    Read (plik, c);
    if c <> ':' then
    begin
      WriteLn;
      WriteLn ('File "', filename,'" doesn'#39't look like Intel HEX!!!');
      Close (plik);
      Halt;
    end;
    Close (plik);

    Reset (plik);
    poz := 0;
    bin.count := 0;
    lpoz := 0;
    ll := 0;
    while not Eof (plik) do
    begin
      ReadLn (plik, linia);

      ild := 0;
      for i := 1 to 2 do
        ild := ild + (Word (1) shl ((2 - i) * 4)) * cyfra (linia, i + 1);
      if ild = 0 then Break;

      bin.count := bin.count + ild;
      for i := 1 to 4 do
        bin.org[poz] := bin.org[poz] + (Word (1) shl ((4 - i) * 4)) * cyfra (linia, i + 3);
      lpoz := bin.org[poz];
      i := 1;
      while i <= ild * 2 do
      begin
        l := 0;
        for j := 1 to 2 do
          l := l + (Word (1) shl ((2 - j) * 4)) * cyfra (linia, i + j + 8);

        for j := 3 to 4 do
          l := l + (Word (1) shl (((4 - j) * 4) + 8)) * cyfra (linia, i + j + 8);

        bin.data[poz] := l;
        inc (i, 4);
        bin.org[poz] := lpoz div 2;
        Inc (poz);
        Inc (lpoz, 2);
      end;
      Inc (ll);
    end;
    bin.count := bin.count div 2;
    Close (plik);
  end;

  {  --------------------------------------------------------------------  }

  procedure get_bin (filename : string; var bin : bin_t);  { czytnik plikow Intel BIN }
  var
            plik             : Text;
            c                : Char;
            ll               : Word;
            x                : Byte;
  begin
    if check_file (filename) <> 0 then
    begin
      Writeln;
      WriteLn ('File: "', filename,'" is missing!');
      halt;
    end;

    assign (plik, filename);
    reset (plik);
    ll := 0;
    while (not eof (plik)) and (ll < $1FFF) do
    begin
      read (plik, c);
      bin.org[ll] := ll;
      bin.data[ll] := Byte (c);
      Inc (bin.count);
      Inc (ll);
    end;
    close (plik);
  end;

  {  --------------------------------------------------------------------  }

  procedure bargraf (len, max : longint);
  var       i, wlen   : word;
  begin
      Write (#13);
      if max < 2 then max := 2;
      if len = 0 then len := 1;
      wlen := ((MAXCOL - 1) * longint (len)) div (max - 1);
      for i := 1 to MAXCOL - 1 do
        if i <= wlen then Write ('Û')
                     else Write ('°');
  end;

  {  --------------------------------------------------------------------  }

  procedure set_signal (signal : word; level : byte);
  begin
    Port[LPT_OUT] := (Port[LPT_OUT] and (not byte (signal and $00FF)))
      xor ((byte (signal and $00FF) * level) xor byte ((signal and $FF00) shr 8));
  end;

  {  --------------------------------------------------------------------  }

  function get_signal (signal : word) : byte;
  begin
    get_signal := byte (((Port[LPT_IN] and byte (signal and $00FF))
      xor byte ((signal and $FF00) shr 8)) <> 0);
  end;

  {  --------------------------------------------------------------------  }

  procedure set_data_control (level : byte);
  begin
    set_signal (C_DATA, level);
  end;

  {  --------------------------------------------------------------------  }

  procedure set_clock_control (level : byte);
  begin
    set_signal (C_CLOCK, level);
  end;

  {  --------------------------------------------------------------------  }

  procedure set_clock (level : byte);
  begin
    set_signal (CLOCK, level);
  end;

  {  --------------------------------------------------------------------  }

  procedure set_data (level : byte);
  begin
    set_signal (DATA_O, level);
  end;

  {  --------------------------------------------------------------------  }

  procedure set_lvp (level : byte);
  begin
    set_signal (LVP, level);
  end;

  {  --------------------------------------------------------------------  }

  procedure set_mclr (level : byte);
  begin
    case level of
      L : begin
            set_signal (MCLR_K1, H);
            set_signal (MCLR_K2, L);
            set_signal (MCLR_LVP, L);
          end;
      H : begin
            set_signal (MCLR_K1, L);
            set_signal (MCLR_K2, L);
            set_signal (MCLR_LVP, L);
          end;
    VPP : begin
            set_signal (MCLR_K1, L);
            set_signal (MCLR_K2, H);
            set_signal (MCLR_LVP, H);
          end;
    end;
    delay(5);
  end;

  {  --------------------------------------------------------------------  }

  procedure set_programming_mode;        { procedura ustawiajaca sygnaly   }
  begin                                  { do wprowadzenia ukladu w stan   }
    set_mclr (L);                        { programowania }
    set_lvp (L);
    set_clock_control (L);
    set_data_control (L);
    set_clock (L);
    set_data (L);
    set_mclr (VPP);
    set_lvp (H);
  end;

  {  --------------------------------------------------------------------  }

  procedure set_run_mode;                { procedura ustawiajaca sygnaly   }
  begin                                  { w stan powodujacy uruchomienie  }
    set_clock (L);                       { programu                        }
    set_data (L);
    set_lvp (H);
    set_clock_control (H);
    set_data_control (H);
    set_mclr (L);                        { programowania }
    set_mclr (H);
  end;

  {  --------------------------------------------------------------------  }

  procedure set_reset_mode;              { procedura ustawiajaca sygnaly   }
  begin                                  { w stan powodujacy zresetowanie  }
    set_clock_control (L);               { procesora                       }
    set_mclr (L);
    delay (100);
    set_mclr (H);
    set_clock_control (H);
  end;

  {  --------------------------------------------------------------------  }

  procedure send_command (Command : word; var dane : Word);
  var       i : Byte;                    { procedura wysylajaca rozkaz do  }
            c : Word;                    { ukladu i w zaleznosci od kierun-}
  begin                                  { ku wysyla lub odbiera dana      }
    for i := 0 to 5 do                   { wyslanie rozkazu 6 bitow        }
    begin
      set_clock (H);
      set_data ((Command shr i) and $01);
      set_clock (L);
      delay(0);
    end;

    if (Command = Read_Data_from_Program_M) or
       (Command = Read_Data_from_Data_M) then
    begin
      set_data_control (H);
      dane := 0;
      for i := 0 to 15 do
      begin
        set_clock (H);
        delay(0);
        set_clock (L);
        delay(0);
        dane := dane or (get_signal (DATA_I) shl i);
      end;
      dane := (dane shr 1) and $3fff;
      if Command = Read_Data_from_Data_M then dane := dane and $00FF;
      set_data_control (L);
      exit;
    end;

    if dane = $FFFF then Exit;

    dane := dane shl 1;
    for i := 0 to 15 do
    begin
      set_clock (H);
      set_data ((dane shr i) and $01);
      delay(0);
      set_clock (L);
    end;
    dane := dane shr 1;
   end;

  {  --------------------------------------------------------------------  }

  procedure write_pic (memory : Byte);  { procedura wysyla zawartosc pliku}
  var                                    { .hex lub .bin do ukladu sprawda-}
            i, j, read_in, max : Word;   { jac czy dana zostala poprawnie  }
            k, maxbar          : Word;   { zapisana. Obslugiwana jest pam- }
  begin                                  { miec programu i danych          }
    set_programming_mode;
    max := Dane.org[Dane.count - 1];

    for i := 0 to max do
    begin
      if Dane.org[i] < $2000 then maxbar := Dane.org[i]
                             else break;
    end;

    if (memory = 1) and (max > MAXDATA) then max := MAXDATA;
    j := 0;
    r_error := 0;
    for i := 0 to max do
    begin
      if i = $2000 then
        send_command (Load_Configuration, Dane.data[j]);

      if Dane.org[j] = i then
      begin
        send_command (Read_Data or memory, read_in);
        if read_in <> Dane.data[j] then
        begin
          send_command (Load_Data or memory, Dane.data[j]);
          send_command (Begin_Erase_Programming, NO_DATA);
          Delay (10);
          send_command (Read_Data or memory, read_in);
        end;

        if (read_in <> Dane.data[j]) and (Options[ErrorCheck] = Options[Yes]) then
        begin
          WriteLn;
          WriteLn ('Error programming at ADRESS: ', bin2hex (i, 4),
                   ', SEND: ', bin2hex (Dane.data[j], 4 - 2 * memory),
                   ', READ: ', bin2hex (read_in, 4 - 2 * memory));
          r_error := 1;
        end
        else bargraf (i, maxbar);

        send_command (Increment_Adress, NO_DATA);
        inc (j);
      end
      else
        send_command (Increment_Adress, NO_DATA);
    end;

    Writeln;

    set_run_mode;
    set_reset_mode;
  end;

  {  --------------------------------------------------------------------  }

  procedure read_pic (memory : Byte);   { procedura zczytuje zawartosc    }
  var                                    { pamieci programu lub danych     }
            j, read_in, max1 : Word;     { i otrzymane Dane wysyla na sta- }
            k, i, max        : LongInt;  { ndardowe wyjscie lub do pliku   }
  begin
    rewrite (plik);
    set_programming_mode;

    case memory of
      0 : begin
            max := MEMCONFIG + LENCONFIG;
            max1 := Options[MaxCodeRead];
          end;

      1 : begin
            max := Options[MaxDataRead];
            max1 := Options[MaxDataRead];
          end;
    end;

    for i := 0 to max do
    begin
      if (i = max1) and (memory = CODEMEM) then
      begin
        for i := 1 to MAXCOL div 2 - 3 do Write (plik, '-');
        WriteLn (plik);
        i := MEMCONFIG;
        j := 0;
        send_command (Load_Configuration, j);
      end;

      send_command (Read_Data or memory, read_in);

      send_command (Increment_Adress, NO_DATA);
      write (plik, 'Data read at ADRESS: ', bin2hex (i, 4), ', DATA: ', bin2hex (read_in, 4 - 2 * memory),
      ', ASCII: ', char ((read_in and $ff00) shr 8), char ((read_in and $00ff)));

      case memory of
        0 : WriteLn (plik);
        1 : WriteLn (plik, ' : ', chr (read_in));
      end;

      if (o_file_name <> '') and (i < MEMCONFIG) then bargraf (i, max1);
    end;
    set_run_mode;
    set_reset_mode;
    close (plik);
  end;

  {  --------------------------------------------------------------------  }

  procedure erase_memory (memory : Byte);  { Procedura wysyla sygnal kasujacy }
  begin                                    { pamiec programu lub danych       }
    set_programming_mode;
    send_command (Load_Data or memory, BULK);
    send_command (Bulk_Erase or (memory shl 1), NO_DATA);
    send_command (Begin_Erase_Programming, NO_DATA);
    Delay (10);
    set_run_mode;
    set_reset_mode;
  end;

  {  --------------------------------------------------------------------  }

  procedure erase_cp;
  var       i : byte;
  begin

    set_programming_mode;
    send_command (Load_Configuration, BULK);
    for i := 0 to 6 do
      send_command (Increment_Adress, NO_DATA);

    case Options[PicMode] of

      0 : begin
            send_command (Erase_Code_Protection_1, NO_DATA);
            send_command (Erase_Code_Protection_2, NO_DATA);

            send_command (Begin_Erase_Programming, NO_DATA);
            Delay (40);

            send_command (Erase_Code_Protection_1, NO_DATA);
            send_command (Erase_Code_Protection_2, NO_DATA);
          end;

      1 : begin
            send_command (ChipErase, NO_DATA);
            Delay (40);
          end;

      2 : begin
            send_command (Bulk_Erase, NO_DATA);
            send_command (Begin_Erase_Programming, NO_DATA);
            Delay (40);
          end;
    end;
    set_run_mode;
    set_reset_mode;
  end;

  {  --------------------------------------------------------------------  }

  procedure init_lpt (BASE : word);
  begin
    LPT_PORT := BASE;
    LPT_OUT := LPT_PORT;
    LPT_IN := LPT_PORT + 1;
  end;

  {  --------------------------------------------------------------------  }

  procedure check_param (cmdln : string);
  var       kod   : integer;
            value : word;
  begin
    case cmdln[2] of

      'q' : if length (cmdln) > 2 then
            begin
              value := ord (cmdln[3]) - ord ('0');
              if value < 2 then Options[QuietMode] := value
            end
            else Options[QuietMode] := Options[Yes];

      'l' : if length (cmdln) > 2 then
            begin
              value := ord (cmdln[3]) - ord ('0');
              if value < 4 then Options[LptPort] := LPT[value];
              init_lpt (Options[LptPort]);
            end;

      'a' : if length (cmdln) > 2 then
            begin
              value := ord (cmdln[3]) - ord ('0');
              if value < 3 then Options[PicMode] := value;
            end;

      'w' : case cmdln[3] of
              'c' : if length (cmdln) > 3 then
                      begin
                        value := ord (cmdln[4]) - ord ('0');
                        if value < 2 then Options[WriteConfigWord] := value;
                      end
                      else Options[WriteConfigWord] := Options[Yes];
            end;

      'c' : case cmdln[3] of
              'e' : if length (cmdln) > 3 then
                    begin
                      value := ord (cmdln[4]) - ord ('0');
                      if value < 2 then Options[ErrorCheck] := value;
                    end
                    else Options[ErrorCheck] := Options[Yes];
            end;

      'r' : case cmdln[3] of
              'p' : begin
                      val (copy (cmdln, 4, 4), count, kod);
                      if kod = 0 then Options[MaxCodeRead] := count;
                      delete (cmdln, 4, 255);
                    end;

              'd' : begin
                      val (copy (cmdln, 4, 3), count, kod);
                      if kod = 0 then Options[MaxDataRead] := count;
                      delete (cmdln, 4, 255);
                    end;
            end;
    end;
  end;

  {  --------------------------------------------------------------------  }

  function get_value (opcja, grupa, nazwa_pliku : string) : word;
  var
           plik     : Text;
           linia    : string;
           found, i : word;
           kod      : integer;
  begin
    get_value := NO_DATA;

    assign (plik, nazwa_pliku);
    reset (plik);

    found := 0;
    opcja := downstr (opcja);
    grupa := downstr (grupa);
    while (not (eof (plik))) do
    begin
      readln (plik, linia);
      if pos ('[', linia) <> 0 then
      begin
        linia := downstr (wykasuj_znaki (linia, ' '));
        if pos ('[' + grupa + ']', linia) = 1 then
        begin
          found := 1;  {grupa znaleziona }
          break;
        end;
      end;
    end;

    while (not (eof (plik))) and (found = 1) do
    begin
      readln (plik, linia);
      if pos ('[', linia) <> 0 then break;
      linia := downstr (linia);
      if (pos (opcja, linia) <> 0) then
      begin
        if pos ('=', linia) = 0 then break;
        delete (linia, 1, pos ('=', linia));
        val (linia, i, kod);
        if kod = 0 then get_value := abs (i);
        if linia[1] = downstr (Texts[No ][1]) then get_value := Options[No];
        if linia[1] = downstr (Texts[Yes][1]) then get_value := Options[Yes];
        break;
      end;
    end;
    close (plik);
  end;

  {  --------------------------------------------------------------------  }

  procedure read_ini_file;
  var       i    : byte;
            data : word;
  begin
    data := get_value (Texts[LptPort], Group[Switches], ini_file);
    if (data <> NO_DATA) and (data < 4) then Options[LptPort] := LPT[data];

    data := get_value (Texts[ErrorCheck], Group[Switches], ini_file);
    if (data <> NO_DATA) and (data < 2) then Options[ErrorCheck] := data;

    data := get_value (Texts[WriteConfigWord], Group[Switches], ini_file);
    if (data <> NO_DATA) and (data < 2) then Options[WriteConfigWord] := data;

    data := get_value (Texts[QuietMode], Group[Switches], ini_file);
    if (data <> NO_DATA) and (data < 2) then Options[QuietMode] := data;

    data := get_value (Texts[PicMode], Group[Switches], ini_file);
    if (data <> NO_DATA) and (data < 2) then Options[PicMode] := data;


    data := get_value (Texts[MaxCodeRead], Group[Settings], ini_file);
    if (data <> NO_DATA) and (data < MAXCODE) then Options[MaxCodeRead] := data;

    data := get_value (Texts[MaxDataRead], Group[Settings], ini_file);
    if (data <> NO_DATA) and (data < MAXDATA) then Options[MaxDataRead] := data;
  end;

  {  --------------------------------------------------------------------  }

  procedure set_default;
  begin
    Options[No] := 0;
    Options[Yes] := 1;
    Options[LptPort] := LPT[2];
    Options[ErrorCheck] := Options[Yes];
    Options[WriteConfigWord] := Options[Yes];
    Options[MaxCodeRead] := 1024;
    Options[MaxDataRead] := 64;
    Options[QuietMode] := Options[No];
    Options[PicMode] := Options[No];
  end;

  {  --------------------------------------------------------------------  }
  {  --------------------------------------------------------------------  }
  {  --------------------------------------------------------------------  }

  begin

    set_default;

    prog_name := downstr (ParamStr (0)); { zczytanie nazwy programu    }
    for i := length (prog_name) downto 1 do
      if prog_name[i] = '\' then
      begin
        Delete (prog_name, 1, i);
        Break;
      end;

    ini_file := '.\' + copy (prog_name, 1, pos ('.', prog_name) - 1) + '.ini';

    if check_file (ini_file) = 0 then read_ini_file;
    init_lpt (Options[LptPort]);


    for cm := 1 to ParamCount do
    begin
      cmdln := downstr (ParamStr (cm));
      if cm = 1 then order := copy (cmdln,1,3);
      if cmdln[1] = '-' then check_param (cmdln)
                        else file_name := cmdln;
    end;


    {
    repeat
      set_mclr (L);
      set_mclr (VPP);
    until false;

    }

    if ParamCount = 0 then
    begin
      help (1);
      halt;
    end;

    if order = '-wp' then      { write to program memory }
    begin
      i_file_name := file_name;
      if Pos ('.', i_file_name) = 0 then i_file_name := i_file_name + '.hex';
      get_hex (i_file_name, Dane);
      help (0);
      WriteLn;
      WriteLn ('Writing program memory...');
      WriteLn;
      write_pic (CODEMEM);
      WriteLn;
      WriteLn ('Done!');
      if (Options[ErrorCheck] = Options[Yes]) then
      begin
        WriteLn;
        if r_error = 0 then WriteLn ('All locations OK!')
                       else WriteLn ('Errors detected!!!');
        if (Options[ErrorCheck] = Options[No]) then
        begin
          WriteLn ('Warning!');
          WriteLn ('No Errors was checked!!!');
        end;
      end;
      Halt;
    end;

    if order = '-wd' then      { write to data memory }
    begin
      i_file_name := file_name;
      if Pos ('.', i_file_name) = 0 then i_file_name := i_file_name + '.bin';
      get_bin (i_file_name, Dane);
      Options[WriteConfigWord] := Options[No];
      help (0);
      WriteLn;
      WriteLn ('Writing data memory...');
      WriteLn;
      write_pic (DATAMEM);
      WriteLn;
      WriteLn ('Done!');
      if (Options[ErrorCheck] = Options[Yes]) then
      begin
        WriteLn;
        if r_error = 0 then WriteLn ('All locations OK!')
                       else WriteLn ('Errors detected!!!');
        if (Options[ErrorCheck] = Options[No]) then
        begin
          WriteLn ('Warning!');
          WriteLn ('No Errors was checked!!!');
        end;
      end;
      Halt;
    end;

    if order = '-rp' then      { read from program memory }
    begin
      o_file_name := file_name;
      assign (plik, o_file_name);
      help (0);
      WriteLn;
      WriteLn ('Reading program memory...');
      WriteLn;
      read_pic (CODEMEM);
      WriteLn;
      WriteLn ('Done!');
      Halt;
    end;

    if order = '-rd' then      { read from data memory }
    begin
      o_file_name := file_name;
      assign (plik, o_file_name);
      help (0);
      WriteLn;
      WriteLn ('Reading data memory...');
      WriteLn;
      read_pic (DATAMEM);
      WriteLn;
      WriteLn ('Done!');
      Halt;
    end;

    if order = '-ep' then      { erase program memory }
    begin
      help (0);
      WriteLn;
      WriteLn ('Erasing program memory...');
      WriteLn;
      erase_memory (0);
      WriteLn;
      WriteLn ('Done!');
      Halt;
    end;

    if order = '-ed' then      { erase data memory }
    begin
      help (0);
      WriteLn;
      WriteLn ('Erasing data memory...');
      WriteLn;
      erase_memory (1);
      WriteLn;
      WriteLn ('Done!');
      Halt;
    end;

    if order = '-ec' then      { erase all memory }
    begin
      help (0);
      WriteLn;
      WriteLn ('Erasing code protection, program and data memory...');
      WriteLn;
      erase_cp;
      WriteLn;
      WriteLn ('Done!');
      Halt;
    end;

    if order = '-go' then      { reset chip and run pogram }
    begin
      help (0);
      WriteLn;
      WriteLn ('Reseting the chip...');
      set_reset_mode;
      WriteLn;
      WriteLn ('Done!');
      Halt;
    end;

    if order = '-sc' then      { write configuration file }
    begin
      for i := 1 to 3 do
        if Options[LptPort] = LPT[i] then lpt_nr := i;
      help (0);
      WriteLn;
      WriteLn ('Saving configuration file...');
      assign (plik, ini_file);
      rewrite (plik);
      writeln (plik, ';Configuration file of ', PROGRAM_NAME,' Programmer V', VER);
      writeln (plik);
      writeln (plik, '[', Group[Switches], ']');
      writeln (plik, Texts[LptPort], '=', lpt_nr);
      writeln (plik, Texts[ErrorCheck], '=', Texts[Options[ErrorCheck]]);
      writeln (plik, Texts[WriteConfigWord], '=', Texts[Options[WriteConfigWord]]);
      writeln (plik, Texts[PicMode], '=', Texts[Options[PicMode]]);
      writeln (plik, Texts[QuietMode], '=', Texts[Options[QuietMode]]);
      writeln (plik);
      writeln (plik, '[', Group[Settings], ']');
      writeln (plik, Texts[MaxCodeRead], '=', Options[MaxCodeRead]);
      writeln (plik, Texts[MaxDataRead], '=', Options[MaxDataRead]);
      close (plik);
      WriteLn;
      WriteLn ('Done!');
      Halt;
    end;

    if order = '-dc' then      { delete configuration file }
    begin
      help (0);
      WriteLn;
      WriteLn ('Deleting configuration file...');
      if check_file (ini_file) = 0 then
      begin
        assign (plik, ini_file);
        erase (plik);
      end;
      WriteLn;
      WriteLn ('Done!');
      Halt;
    end;

    help (1);
  end.