NAZWA (2).TXT

program Nadajnik;

uses
Dos;

const
nr_Portu = 0;

SOH=$01;
STX=$02;
ETX=$03;
EOT=$04;
ENQ=$05;
ACK=$06;
DLE=$10;
NAK=$15;
SYN=$16;
ETB=$17;

BlockLen = 125;

var
Bufor: array [0..127] of Byte;
BufLen: integer;
LastH: Byte;

procedure InitData;
begin
BufLen:=-1;
end;

procedure InitRS;
Var
r : Registers;
Begin
r.ah:=0;
r.dx:=nr_portu;
r.al:=3+128+64+32;
Intr($14,r);
End;

procedure SendB(zn : Byte);
Var
r : Registers;
Begin
r.ah:=1;
r.dx:=nr_portu;
r.al:=zn;
Intr($14,r);
{ Wyslij:=(r.ah And 128 = 0);}
End;

function GetB(Var zn : Byte) : Boolean;
Var
r : Registers;
Begin
r.ah:=2;
r.dx:=nr_portu;
Intr($14,r);
zn:=r.al;
GetB:=(r.ah And 128 = 0);
End;


procedure Koduj(s : Byte;var res1,res2:Byte);
begin
res1:=(((s And $F0) SHR 4) +32);
res2:=((s And $0F) +32);
end;

{Dopisac}
function OdbierzPotw:Boolean;
var
ret: Boolean;
B: Byte;
begin
ret:=GetB(B);
ret:=ret and (B=ACK);
OdbierzPotw:=ret;
end;

procedure Zakoncz(Err: String);
begin
writeln(Err);
halt;
end;

procedure Rozlacz(Err: String);
begin
SendB(DLE);
SendB(EOT);
Zakoncz(Err);
end;

procedure SendBlock(EndOfData: Boolean);
var
LRC: Byte;

i, ile: integer;
OK: Boolean;
begin
ile:=0; {Ile prob}
repeat

LRC:=0;
for i:=0 to BufLen do begin
LRC:=LRC xor Bufor[i];
SendB(Bufor[i]);
end;

{Koniec Danych}
if EndOfData then begin
LRC:=LRC xor ETX;
SendB(ETX);
end else begin
LRC:=LRC xor ETB;
SendB(ETB);
end;

i:=i+1;
OK := OdbierzPotw;
until (OK) or (i=3);
if i=3 then Rozlacz('Blad podczas transmisji');

BufLen:=0;
Bufor[0]:=LastH;
end;

procedure PutB(B: Byte);
begin
if B=SOH then LastH:=SOH else
if B=STX then LastH:=STX;
BufLen:=BufLen+1;
Bufor[BufLen]:=B;
if BufLen=BlockLen then SendBlock(false);
end;

procedure PackB(B: Byte);
var
b1, b2: Byte;
begin
Koduj(B, b1, b2);
PutB(b1);
PutB(b2);
end;

function WyslijPoczatek:Boolean;
begin
SendB(EOT);
SendB(0);
SendB(0);
SendB(ENQ);
WyslijPoczatek:=OdbierzPotw;
end;

procedure Polacz;
var
naw: Boolean;
i: integer;
begin
i:=0;
repeat
naw:=WyslijPoczatek;
i:=i+1;
until (i=3) or (naw);
if naw=false then Zakoncz('Polaczenie nie zostalo nawiazane');
end;

procedure WyslijPlik(path, name: string);
var
f: File;
i, j: integer;
b: Byte;
begin
PutB(SOH);
for i:=1 to Length(name) do
PackB(ord(name[i]));
PutB(STX);

assign(f, path+name);
reset(f, 1);
while not(eof(f)) do begin
BlockRead(f, b, 1, i);
PackB(b);
end;
close(f);
SendBlock(true);
end;


procedure przeslanie;
begin
InitData;
Polacz;
WyslijPlik('','nazwa.txt');
Rozlacz('Plik przeslany');
end;

begin
InitRS;
przeslanie;
end.

zanotowane.pl

doc.pisz.pl

pdf.pisz.pl

qualintaka.pev.pl