Source file: /~heha/basteln/PC/SF-Interface/dm166.zip/dm166wr.pas

{$A-,B-,D+,E+,F-,G-,I+,L+,N-,O-,P-,Q+,R-,S-,T-,V+,X+}
{$M 16384,0,0}
uses dos;
var
 com:word;
 c: char;
 b,cs:byte;
 f:text;
 i,ii,cc:integer;
 s:PathStr;
 ct:word;
const
 DateinameOK: boolean=false;
var FName:PathStr;
var ComAddr:array[1..4] of word absolute $40:0;

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;

procedure PutByte(b:byte);
{ var i:word;}
 begin
  repeat
   if KeyIn<>0 then error(' Anwender-Abbruch');
   if port[com+5] and $60 =$60 then begin	{Beide Register leer}
{    for i:=0 to maxint do;	Wie sollte denn das funktionieren?}
    port[com+0]:=b;
    break;
   end;
   asm int 28h end;	{Prozessor abgeben}
  until false;
 end;

begin
 com:=ComAddr[2]; if com=0 then com:=ComAddr[1];
 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
    'P': begin
          val('$'+copy(s,3,255),ii,cc);
          if cc<>0 then error('Fehlerhafte Portadresse!');
          com:=ii;
         end;
    'C': begin
          val(copy(s,3,255),ii,cc);
          if (cc<>0) or (ii<1) or (ii>4) then
           error('Fehlerhafte COM-Port-Nummer!');
          ii:=ComAddr[ii];
          if ii=0 then error('COM-Port existiert nicht!');
          com:=ii;
         end;
    else error('Unbekannte Option!');
   end;
  end else begin
   if DateinameOK then error('Überschüssiger Parameter!');
   assign(f,AppendExt(s,'.roy'));
   DateinameOK:=true;
  end;
 end;
 if DateinameOK=false then error('Dateiname angeben!');
 {$i-}Reset(f);{$i+}
 case ioresult of
  2,3: error('Datei nicht gefunden!');
  0:;
  else error('Fehler beim Öffnen!');
 end;
 port[com+3]:=$80;
 port[com+0]:=$80;
 port[com+1]:=$01; {Baudrate 300Bd}
 port[com+3]:=$03; {8 Datenbits}
 while port[com+5] and 1 <>0 do
  asm mov dx,[com]; in al,dx; end;
	{Dummy-Auslesen verhindert vielleicht Startverklemmung?}
 port[com+4]:=$02; {RTS auf High und DTR auf Low für OPV}
 PutByte($80);
 cs:=0; ct:=0;
 while not eof(f) do begin
  Read(f,c);
  c:=Upcase(c);
  case c of
   '.': c:=')';
   '-': c:='(';
   '/': c:='$';
   '$': c:='''';
   '£': c:='&';
   '¥': c:='%';
   ',': c:='#';
   '''': c:='"';
   ':': c:='!';
   '\': c:='';
   #13: begin read(f,c); c:=#255; end;
   '■': begin read(f,c,c); c:='■'; end;
  end;
  b:=Byte(c);
  Inc(cs,b);
  PutByte(b);
  Inc(ct); write('Bytes: ',ct,^M);
 end;
 writeln;
 Close(f);

 PutByte($f8);
 Inc(cs,$f8);
 PutByte(-cs);
 PutByte($1a);
 writeln('Übertragung erfolgreich(?)');
end.