telecard.pas

ic电话卡读写器程序

{*****************************************************************************}
{                             T E L E C A R D . PAS                           }
{*****************************************************************************}
{   This program enable you to dumb the memory of electronics phonecards      }
{   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 ....                   }
{*****************************************************************************}
{                                                                             }
{                        Written by Stephane BAUSSON (1993)                   }
{                                                                             }
{                         Email: [e-mail]                    }
{                                                                             }
{                       Snail Mail Address: 4, Rue de Grand                   }
{                                           F-88630 CHERMISEY                 }
{                                           France                            }
{                                                                             }
{*****************************************************************************}
{* Thanks to: Tomi Engdahl ([e-mail])                             *}
{*****************************************************************************}

USES crt,dos;

CONST port_address=$378;     { lpr1 chosen }

TYPE string8=string[8];
     string2=string[2];

VAR reg         : registers;
    i,j         : integer;
    Data        : array[1..32] of byte;
    car         : 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 hexadecimal 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 weigth : byte;
      s      : string8;

  BEGIN weigth:=$80;
        s:='';
        while (weigth > 0) do
        BEGIN if ((b and weigth) = weigth) then s:=s+'1'
              else s:=s+'0';
              weigth:=weigth div $02;
        END;
        Binary:=s;
  END;

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

FUNCTION Units:byte;

  VAR  u, i : integer;
       s    : string8;

  BEGIN u:=0;
        i:=13;
        while (Data[i] = $FF) do
        BEGIN u:=u+8;
              i:=i+1;
        END;
        s:=Binary(Data[i]);
        while(s[1]='1') do
              BEGIN inc(u);
              s:=copy(s,2,length(s));
        END;
        units:=u;
  END;

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

function Units_2:LongInt;

  BEGIN Units_2:=4096*Data[9]+512*Data[10]+64*Data[11]+8*Data[12]+Data[13];
  END;

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

PROCEDURE Card_Type;

  BEGIN case Data[2] of
         $03: BEGIN write('Telecard - France - ');
                    case Data[12] of
                     $13: write('120 Units - ',units-130,' Units left');
                     $06: write('50 Units - ',units-60,' Units left');
                     $15: write('40 Units - ',units-40,' Units left');
                    END;
              END;
         $2F:BEGIN write('Telecard - Germany - ', Units_2, ' Units left');
             END;
         $3B:BEGIN write('Telecard - Greece - ', Units_2, ' Units left');
             END;
         $83:BEGIN write('Telecard');
                   case Data[12] of
                     $1E: write(' - Sweden');
                     $30: write(' - Norway');
                     $33: write(' - Andorra');
                     $3C: write(' - Ireland');
                     $47: write(' - Portugal');
                     $55: write(' - Czech Republic');
                     $5F: write(' - Gabon');
                     $65: write(' - Finland');
                   END;
                   if (Data[12] in [$30,$33,$3C,$47,$55,$65]) then
                   BEGIN case ((Data[3] and $0F)*$100+Data[4]) of
                          $012: write (' - 10 Units - ',units-12,' Units left');
                          $024: write (' - 22 Units - ',units-24,' Units left');
                          $027: write (' - 25 Units - ',units-27,' Units left');
                          $032: write (' - 30 Units - ',units-32,' Units left');
                          $052: write (' - 50 Units - ',units-52,' Units left');
                          $067: write (' - 65 Units - ',units-62,' Units left');
                          $070: write (' - 70 Units - ',units-70,' Units left');
                          $102: write (' - 100 Units - ',units-102,' Units left');
                          $152: write (' - 150 Units -  ',units-152,' Units left');
                         END;
                    END;
{                    write(' - N