Зарядка телефонных карточек

Не хватает денег на
сотку? Даже на таксофоны, которые стоят на каждом
углу? Ну, тогда это тяжелый случай... Хотя погоди, у
меня специально для таких как ты завалялась
схемка, как звонить из новых (карточных
таксофонов на халяву !!! Единственное, что тебе для
этого понадобится - телефонная карта (ну, достать
ее, я думаю, не проблема), LPT-порт (на митинском
радиорынке можно найти рублей ендак за 20-25 с
корпусом), провода к нему, ессесно, компутер в
живом состоянии с Паскалем, ну и, самое главное:
ПРЯМЫЕ РУКИ И ГОЛОВА НА ПЛЕЧАХ (а не так, как
обычно). В общем, делаешь все вот по этой схеме:

Только на этой схеме
есть одно "но"! У нас есть 2 типа карточек и у них
немного различаются местами контакты, но с
вольтметром недолго выяснить отличия (благо,
они там не сильно большие)

(n.c. : not connected)

LPT: Phone Card
CN
2 <-------------------> 3
3 <-------------------> 2
13 <------------------> 7

А вот и сама программа
на Паскале для перезарядки карточек.

program PhoneCard;
uses Crt;
const
LPT=$378; {Base addres of LPT}
del=1; {Delay }
(*
LPT:
CN
Clk - data 0 2
Reset - data 1 3
I/O - SLCTD 13
*)
procedure Clk(v:byte);
(*
Clk(1) - Set CLK to High (1)
Clk(0) - Set CLK to Low (0)
*)
var
tmp:byte;
begin
tmp:=Port[LPT];
if v=0 then tmp:=tmp and $FE else tmp:=tmp or 1;
Port[LPT]:=tmp;
end;
procedure Reset(v:byte);
(*
Reset(1) - Set Reset to High (1)
Reset(0) - Set Reset to Low (0)
*)
var
tmp:byte;
begin
tmp:=Port[LPT];
if v=0 then tmp:=tmp and $FD else tmp:=tmp or 2;
Port[LPT]:=tmp;
end;
function GetData:Byte;
var
tmp:Byte;
begin
tmp:=Port[LPT+1];
if tmp=120 then GetData:=1 else GetData:=0;
end;
procedure SetData(v:byte);
var
tmp:byte;
begin
tmp:=Port[LPT];
if v=0 then tmp:=tmp and $FB else tmp:=tmp or 4;
Port[LPT]:=tmp;
end;
var
arr:array[0..1024] of byte;
idx:word;
f:text;
begin
assign(f,'con');
rewrite(f);
idx:=0;
textmode(Font8x8 or CO80);
clrscr;
Clk(0);Reset(0);delay(del);
Reset(1);delay(del);
Clk(1);delay(del);Clk(0);delay(del);Reset(0);delay(del);
repeat
begin
if (idx mod 8)=0 then write(f,#13#10+'Byte ',(idx div 8):2,' :') else
if (idx mod 4)=0 then write(f,' ');
Clk(1);
delay(del);
arr[idx]:=GetData;
Clk(0);
delay(del);
write(f,arr[idx]);
inc(idx);
end;
until idx=1024;
while keypressed do readkey;
writeln(#13#10'Press any key to exit ...');readkey;
close(f);
end.