
=============================================================================           
READER  - HOW_CHIPS_WORK.TXT
PROGRAM - PHRACK48(10) (For Slovak telecard preedited by noMaX & mbTroNiX)
=============================================================================           
           Reader :
           ~~~~~~~~

     The following schematics is a very simple one, which will enable you to
read all kind of telecards with a chip, and also other memory cards.


                         | +5V
                         |
 Centronic                 /
   Port                  ,/           C 100nF
             Presence of *---------------||--------------------,
              the card   |     ,-------------+-------------,   |
 Pin10 (Ack)  --<--------*-----|   1         |         5   |---*--,
               R/W | RST       +-------\     |     /-------+      |
 Pin4 (d2)    -->--------------|   2    +----+    +    6   |      |
               Clock           +--------|         |--------+      |
 Pin3 (d1)    -->--------------|   3    +----+----+    7   |---,  |
               RAZ | RFU       +-------/     |     \-------+   |  |
Pin2 (d0)     -->--------------|   4         |         8   |   |  |
                               '-------------+-------------'   |  |
               I/O                                             |  |
Pin 11 (Busy) --<----------------------------------------------'  |
               Gnd                                                |
Pin 25        ----------------------------------------------------'


=============================================================================           
   Program:
   ------------------cut here-----------------

{***************************************************************************}
{                         T E L E C A R D . PAS    (TurboPascal 7.0)        }
{***************************************************************************}
{   This program enable you to dumb the memory of electronics phonecard     }
{   from all over the world, so that you will be able to see which country  }
{   the card is from how many units are left and so on ...                  }
{888888888888888888888888888888888888888888888888888888888888888888888888888}
{8                                                                         8}
{8      Not working version of telecard.pas from phrack48 was preeditted   8}
{8      to 9tcmax.pas for SLOVAK CARD in @1997 by                          8}
{8      n o M a X    and    m b T r o N i X                                8}
{8                                                                         8}
{8      Comments you can email to:                                         8}
{8                                noMaX@hotmail.com                        8}
{8              or                mbTroNiX@hotmail.com                     8}
{8                                                                         8}
{888888888888888888888888888888888888888888888888888888888888888888888888888}
USES  crt,dos;
CONST port_address=$378;    { lpr1 chosen }
TYPE string8=string[8];
     string2=string[2];
VAR reg          : registers;
    i,j,old_unit : integer;
    max_unit,max,serial,da,db,dc     : longint;
    Data         : array[1..32] of byte;
    car,ch_seria : char;
    byte_number  : integer;
    displaying   : char;
{***************************************************************************}
PROCEDURE Send(b:byte);
  BEGIN port[port_address]:=b;
  END;
{***************************************************************************}
FUNCTION Get:byte;
  BEGIN get:=port[port_address+1];
  END;
{***************************************************************************}
{ FUNCTION dec2hexa_one(decimal_value):hexa_character_representation;       }
{                                                                           }
{          - convert a 4 bit long decimal number to hexadecimal.            }
{---------------------------------------------------------------------------}
FUNCTION dec2hexa_one(value:byte):char;
  BEGIN case value of
         0..9    : dec2hexa_one:=chr(value+$30);
         10..15  : dec2hexa_one:=chr(value+$37);
       END;
  END;
{---------------------------------------------------------------------------}
{ FUNCTION d2h(decimal_byte):string2;                                       }
{                                                                           }
{        -convert a decimal byte to its hexdecimal representation.          }
FUNCTION d2h(value:byte):string2;
  VAR msbb,lsbb:byte;
  BEGIN msbb:=0;
        if ( value >= $80 ) then
        BEGIN msbb:=msbb+8;
              value:=value-$80;
        END;
        if ( value >= $40 ) then
        BEGIN msbb:=msbb+4;
              value:=value-$40;
        END;
        if ( value >= $20 ) then
        BEGIN msbb:=msbb+2;
              value:=value-$20;
        END;
        if ( value >= $10 ) then
        BEGIN msbb:=msbb+1;
              value:=value-$10;
        END;
        lsbb:=0;
        if ( value >= $08 ) then
        BEGIN lsbb:=lsbb+8;
              value:=value-$08;
        END;
        if ( value >= $04 ) then
        BEGIN lsbb:=lsbb+4;
              value:=value-$04;
        END;
        if ( value >= $02 ) then
        BEGIN lsbb:=lsbb+2;
              value:=value-$02;
        END;
        if ( value >= $01 ) then
        BEGIN lsbb:=lsbb+1;
              value:=value-$01;
        END;
        d2h := dec2hexa_one(msbb) + dec2hexa_one(lsbb);
END;
{---------------------------------------------------------------------------}
Function Binary(b : byte):string8;
  var weight : byte;
      s      : string8;
      BEGIN weight:=$80;
            s:='';
            while (weight > 0 ) do
            BEGIN if ((b and weight) = weight) then s:=s+'1'
            else s:=s+'0';
            weight:=weight div $02;
            END;
            Binary:=s;
      END;
{---------------------------------------------------------------------------}

{---------------------------------------------------------------------------}
FUNCTION Octal_Unit_Count:LongInt;

  FUNCTION BitCount( Data : integer ):LongInt;
    VAR    i : integer;
    BEGIN i:=0;
          while ((Data and $01)=$01) do
          BEGIN Data:=Data div 2;
                inc(i);
          END;
          BitCount:=i;
    END;

  BEGIN Octal_Unit_Count:= 4096*BitCount(Data[9])+512*BitCount(Data[10])
                           +64*BitCount(Data[11])+8*BitCount(Data[12])
                           +BitCount(Data[13]);
  END;

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

PROCEDURE Card_Type;
  BEGIN case Data[1] and Data[2] and Data[3] of

    $10 and $2B and $12: BEGIN write('Telecard - Slovakia - ');   END;
    $98 and $25 and $FF: BEGIN write('Telecard - Slovakia - ');   END;
    $92 and $3B and $FF: BEGIN write('Telecard - Slovakia - ');   END;
    END;
ch_seria:='X';
old_unit:=0;
  {seria A,B,C max. unit 50,75,100}
     if Data[5]=$00 then
       begin
         ch_seria:='C';
         old_unit:=50;
       end;

     if Data[5]=$01 then
       begin
         ch_seria:='C';
         old_unit:=75;
       end;

     if Data[5]=$02 then
       begin
         ch_seria:='C';
         old_unit:=100;
       end;

     if Data[5]=$10 then
       begin
         ch_seria:='A';
         old_unit:=50;
       end;

     if Data[5]=$11 then
       begin
         ch_seria:='A';
         old_unit:=75;
       end;

     if Data[5]=$12 then
       begin
         ch_seria:='A';
         old_unit:=100;
       end;

     if Data[5]=$20 then
       begin
         ch_seria:='B';
         old_unit:=50;
       end;

     if Data[5]=$21 then
       begin
         ch_seria:='B';
         old_unit:=75;
       end;

     if Data[5]=$22 then
       begin
         ch_seria:='B';
         old_unit:=100;
       end;


da:=Data[6];
db:=Data[7];
dc:=Data[8];
serial:=((da*$10000) + (db*$100) + (dc)) ;
writeln('SERIAL NO  ',ch_seria,' ',serial);
write ('### ',Octal_Unit_Count,' UNITS LEFT from max. ',old_unit,' units ###');
writeln (' of 5 octal counter of ',(4096*8 + 512*8 + 64*8 + 8*8 + 8),' UNITS');
END;



{---------------------------------------------------------------------------}
PROCEDURE waiting;
  BEGIN send($00);
        write('Enter a card in the reader and press a key ...');
        repeat until KeyPressed;
        gotoxy(1, wherey);
        clreol;
    END;
{---------------------------------------------------------------------------}
PROCEDURE Full_Displaying;
 BEGIN writeln('Memory dump:');
       for i:=1 to 80 do write('-');
       for i:=1 to (byte_number div 6+1) do
       BEGIN for j:=1 to 6 do
             BEGIN if j+6*(i-1) <= byte_number then write(binary(Data[j+6*(i-1)]):9);
             END;
             gotoxy(60,wherey);
             for j:=1 to 6 do
             if j+6*(i-1)  <= byte_number then write(d2h(Data[j+6*(i-1)]),' ');
             writeln;
       END;
       for i:=1 to 80 do write('-');
       Card_Type;
       writeln;
 END;
{---------------------------------------------------------------------------}
PROCEDURE Short_Displaying;
 VAR j : integer;
 BEGIN for j:=1 to byte_number do
       BEGIN write(d2h(Data[j]),' ');
       END;
       writeln;
 END;
{---------------------------------------------------------------------------}
{ V PROCEDURE Reading treba nastavit send-y podla casoveho diagramu}
PROCEDURE Reading;
  VAR i, j : integer;
     Value : byte;
  BEGIN send($FE);
        send($F8);
        for i:=1 to byte_number do
        BEGIN Value:=0;
              for j:=1 to 8 do
              BEGIN Value:=Value*$02 + (1 xor ((get and $080) div $080));
                    send($FB);
                    delay(1);
                    send($F8);
              END;
              Data[i]:=Value;
        END;
        case displaying of
          'F':full_displaying;
          'S':short_displaying;
        END;
  END;

{---------------------------------------------------------------------------}
{ V PROCEDURE writing treba nastavit send-y podla casoveho diagramu}

PROCEDURE writing;
  VAR i,n:integer;
      car:char;

  BEGIN write('Which bit do you want to set to "1" : ');
        readln(n);

        waiting;
        car:=readkey;

        send($FA);
        send($F8);
        for i:=1 to n do
        BEGIN send($F9);
              if i=n then
              BEGIN send($FD);
                    delay(20);
                    send($FF);
              END;
              send($FB);
        END;
        reading;
  END;
{---------------------------------------------------------------------------}
PROCEDURE Saving;

  VAR filename : string;
      f,g        : text;
      i        : word;

  BEGIN write('Enter the filename (max. 7+3 characters): ');
        readln(filename);
        assign(f, filename);
        assign(g, 'd'+filename);
        rewrite(f);
        rewrite(g);
        for i:=1 to byte_number do write(f,d2h(Data[i]),' ');
        for i:=1 to byte_number do write(g,(Data[i]),' ');
        close(f);
        close(g);
  END;
{---------------------------------------------------------------------------}
PROCEDURE load_from_file;
  VAR filename : string;
      f        : text;
      i        : word;
  BEGIN write('Enter the filename: ');
        readln(filename);
        assign(f, 'D'+filename);
  Reset(f);
  i:=0;
  while not Eof(f) do
  begin
    i:=i+1;
    Read(f, Data[i]);
  end;
 Full_Displaying;
 END;


{---------------------------------------------------------------------------}
PROCEDURE initialize;

  VAR i : integer;

  BEGIN byte_number:=32;
        displaying:='F';
        clrscr;
        writeln(' 1 - to dump a 256 bit card');
        writeln(' 2 - to dump a 128 bit card');
        writeln(' F - to display in full format');
        writeln(' W - to write bit to 1');
        window(41,1,80,25);
        writeln(' S  - to display in short format');
        writeln(' F2 - to save in a file');
        writeln(' 0  - to load from a file');
        writeln(' Q  - to exit the program');
        window(1,5,80,25);
        writeln('');
        writeln('      Telecard Readrer preedited by noMaX & mbTroNiX @hotmail.com ');
        writeln('');
        window(1,8,80,25);
  END;
{===========================================================================}
 BEGIN
 clrscr;
 writeln('                               W e L C o m E');
 writeln;
 writeln('                 T e l e c a r d   R e A d e R   b y   ');
 writeln;
 writeln('                 n o M a X     and    m b T r o N i X');
 writeln;
 writeln('       noMaX@hotmail.com           or             mbTroNiX@hotmail.com');
 delay(2000);

 initialize;
       repeat waiting;
              car:=upcase(readkey);
              case car of
               'W':writing;
               'Q':;
               '1':byte_number:=32;
               '2':byte_number:=16;
               'F','S':displaying:=car;
               '0':load_from_file;
               #00: BEGIN car:=readkey;
                         if car=#60 then saving;
                    END;
               else reading;
               END;
       until car='Q';
 writeln('88888888888888888888888888888888888888888888888888888888888888888888888888888888');
 writeln('               T e l e c a r d   R e A d e R   b y  ');
 writeln;
 writeln('                 n o M a X     and    m b T r o N i X');
 writeln;
 writeln;
 writeln('       noMaX@hotmail.com           or             mbTroNiX@hotmail.com');
 writeln;
 writeln('88888888888888888888888888888888888888888888888888888888888888888888888888888888');
 delay(500);

 END.

   ------------------cut here-----------------

=============================================================================           
   data pre 9tcmax (pre load zo suboru)
   d1,d2,d3 (pri loade daj meno iba 1,2,3)

d1:
   ------------------cut here-----------------
146 59 255 7 2 8 147 118 0 0 0 7 7 255 255 255 146 59 255 7 2 8 147 118 0 0 0 0 0 255 255 255 
   ------------------cut here-----------------

d2:
   ------------------cut here-----------------
152 37 255 0 16 12 6 77 0 0 0 15 3 255 255 255 152 37 255 0 16 12 6 77 0 0 0 15 3 255 255 255 
   ------------------cut here-----------------

d3:
   ------------------cut here-----------------
16 43 18 0 32 6 23 89 0 0 0 15 7 255 255 255 16 43 18 0 32 6 23 89 0 0 0 0 0 255 255 255 
   ------------------cut here-----------------

=============================================================================           
                            EnD of SVKCARD.TXT
=============================================================================           



