uses dos;
var
com:word; {COM-Port-Basisadresse}
irqno:byte; {IRQ-Nummer}
intno:byte;
OldPICMask: byte; {Zum korrekten Zurücksetzen}
c: char;
b,cs:byte;
f:text;
i,ii,cc:integer;
s:PathStr;
ct:word;
const
DateinameOK: boolean=false;
NoWarn:boolean=false;
var FName:PathStr;
sr:SearchRec;
var ComAddr:array[1..4] of word absolute $40:0;
var Ringpuffer: array[0..255]of byte;
const GetIdx:word=0;
const PutIdx:word=0;
var OldInt: procedure;
procedure NewInt; interrupt;
begin
while Port[com+5] and 1 <>0 do {Solange Daten vorhanden}
if (PutIdx+1) mod sizeof(Ringpuffer)<>GetIdx then begin
Ringpuffer[PutIdx]:=Port[com+0];
PutIdx:=(PutIdx+1) mod sizeof(Ringpuffer);
end;
if irqno>=8 then port[$A0]:=$20; {Slave EOI}
port[$20]:=$20; {Master End Of Interrupt}
end;
function AppendExt(s:PathStr;Ext:ExtStr):PathStr;
var
p:DirStr; n:NameStr; e:ExtStr;
begin
FSplit(s,p,n,e);
if e='' then e:=Ext;
AppendExt:=p+n+e;
end;
procedure error(s:String);
begin writeln(s); halt; end;
function KeyIn:Word; assembler;
asm
mov ah,1
int 16h
mov ax,0
jz @@e
int 16h
@@e:
end;
function GetByte:byte;
begin
repeat
if KeyIn<>0 then error(' Anwender-Abbruch');
if GetIdx<>PutIdx then begin
GetByte:=Ringpuffer[GetIdx];
GetIdx:=(GetIdx+1)mod sizeof(Ringpuffer);
break;
end;
asm int $28 end; {DOS Idle interrupt gehört zum guten Ton}
until false;
end;
function Irq2Intno(irq:byte):byte;
begin
if irq<8 then Irq2Intno:=irq+8 {"niedriger" IRQ}
else Irq2Intno:=irq-8+$70; {"hoher" IRQ}
end;
begin
com:=ComAddr[2]; irqno:=3; {Standardwerte für COM2}
if com=0 then begin {wenn kein COM2 existiert...}
com:=ComAddr[1]; irqno:=4; {Standardwerte für COM1}
end;
for i:=1 to ParamCount do begin
s:=ParamStr(i);
if (s[0]>=#2) and ((s[1]='-') or (s[1]='/')) then begin{Option}
case upcase(s[2]) of
'O': nowarn:=true;
'P': begin {Portadresse-Direktangabe}
val('$'+copy(s,3,255),ii,cc);
if cc<>0 then error('Fehlerhafte Portadresse!');
com:=ii;
end;
'I': begin {IRQ-Line}
val(copy(s,3,255),ii,cc);
if (cc<>0) or (ii>15) then error('Fehlerhafte IRQ-Nummer!');
irqno:=ii;
end;
'C': begin {COM-Nummer}
val(copy(s,3,255),ii,cc);
if (cc<>0) or (ii<1) or (ii>4) then
error('Fehlerhafte COM-Port-Nummer!');
if ii=1 then irqno:=4;
if ii=2 then irqno:=3;
ii:=ComAddr[ii];
if ii=0 then error('COM-Port existiert nicht!');
com:=ii;
end;
'H','?': begin
writeln('Anwendung: aread [optionen] Dateiname');
writeln('Optionen:');
writeln('/O Keine Warnung wenn Datei vorhanden');
writeln('/P COM-Portadresse (hex, direkt)');
writeln('/C COM-Portnummer (z.B. /C1 oder /C2)');
writeln('/I IRQ-Nummer (wenn anderes COM-Port als COM1 oder COM2)');
writeln('Standard ist COM2; wenn nicht vorhanden COM1.');
halt(0);
end;
else error('Unbekannte Option "'+s[2]+'"!');
end;
end else begin
if DateinameOK then error('Überschüssiger Parameter!');
fname:=AppendExt(s,'.roy');
assign(f,fname);
DateinameOK:=true;
end;
end;
if DateinameOK=false then error('Dateiname angeben!');
FindFirst(fname,$17,sr);
if DosError=0 then begin
if sr.Attr and $10 <>0 then
error(fname+' ist ein Verzeichnis!');
if sr.Attr and 1 <>0 then
error(fname+' ist schreibgeschützt!');
if not nowarn then begin
write('Datei existiert bereits, überschreiben (J)? ');
readln(s);
if not (s[1] in ['J','j','Y','y']) then
error('Dann eben nicht.');
end;
end;
Rewrite(f);
intno:=Irq2Intno(irqno);
GetIntVec(Intno,@OldInt);
SetIntVec(Intno,@NewInt);
while port[com+5] and 1 <>0 do
OldPICMask:=port[com+0]; {Dummy-Auslesen verhindert Startverklemmung}
port[com+3]:=$80;
port[com+0]:=$c0;
port[com+1]:=$00; {Baudrate 600Bd}
port[com+3]:=$03; {8 Datenbits}
port[com+4]:=$02; {RTS auf High und DTR auf Low für OPV}
if irqno<8 then begin
OldPICMask:=port[$21];
port[$21]:=OldPICMask and not (1 shl irqno); {PIC freigeben}
end else begin
OldPICMask:=port[$A1];
port[$A1]:=OldPICMask and not (1 shl (irqno-8)); {PIC freigeben}
end;
if irqno>=8 then port[$A0]:=$20; {Slave EOI}
port[$20]:=$20; {Master End Of Interrupt}
port[com+1]:=1; {Int bei RxB (0x01..0x0F)}
port[com+4]:=$0A; {Modemkontrollreg. Int. enable}
write('Erwarte Startcode...');
c:=#0;
repeat
b:=GetByte;
Write(b);
until b=$80; {Das ist der Startcode}
writeln(' OK.');
cs:=0; ct:=0;
repeat
b:=GetByte;
Inc(cs,b);
if b=$f8 then break;
Inc(ct); write('Bytes: ',ct,^M);
c:=char(b);
case c of
')': c:='.';
'(': c:='-';
'$': c:='/';
'''': c:='$';
'&': c:='£';
'%': c:='¥';
'#': c:=',';
'"': c:='''';
'!': c:=':';
'': c:='\';
#255: begin write(f,#13); c:=#10; end;
'■': begin write(f,'■'#13); c:=#10; end;
end;
write(f,c);
until false;
writeln;
Close(f);
Inc(cs,GetByte);
if cs<>0 then error('Prüfsumme fehlerhaft!');
if GetByte<>$1a then error('Dateiendemarke falsch');
port[com+4]:=2; {Modemkontrollreg. Int. disable}
port[com+1]:=0; {Int bei RxB (0x01..0x0F)}
if irqno<8 then begin
port[$21]:=OldPICMask; {PIC1 sperren}
end else begin
port[$A1]:=OldPICMask; {PIC2 sperren}
end;
SetIntVec(Intno,@OldInt);
writeln('Übertragung erfolgreich.');
end.
| Detected encoding: OEM (CP437) | 1
|
|
|