{$A+,D-,R-,P-,C-,T-}
PROGRAM MIDInet;

{ Netzwerkprogramm fuer alle ATART ST
         (C) 1987 by Guenter Nowinski
                 and Axel Buttchereit
                     Moosholzweg 10
                     3392 Clausthal-Zellerfeld 3 }

      {$I midinet.i}
      {$Igemconst.pas}
     midi=3;
     key = 2;

TYPE
   aes_ptr = ^char;
   int_in_parms = ARRAY[0..15] OF integer;
   int_out_parms = ARRAY[0..45] OF integer;
   addr_in_parms = ARRAY[0..1] OF aes_ptr;
   addr_out_parms = ARRAY[0..0] OF aes_ptr;
   pfad_puffer = PACKED ARRAY[1..80] OF char;
   pfad_zeiger_typ = ^pfad_puffer;


   p128 = PACKED ARRAY[0..127] OF byte;
   pack80 = PACKED ARRAY[1..80] OF char;

   janus = RECORD
             CASE boolean OF
               true : (adr : long_integer); { Pufferadresse}
               false: (point:^daten)      { Dies ist der Puffer }
             END;

   daten = RECORD
             nummer     : integer;
             sendreq    : boolean;
             receivereq : boolean;
             busy       : boolean;
             auto_ack   : boolean;
             ok_flag    : boolean;
             ack        : ARRAY[1..15] OF boolean;
             online     : ARRAY[1..15] OF boolean;
             in_puffer  : p128;
             out_puffer : p128;
           END;

   int_puffer = RECORD
                  CASE boolean OF
                    true  : (adr : long_integer);
                    false : (ptr : ^p128)
                  END;

      {$I gemtype.pas}

VAR puffer : janus;
    hpuffer : int_puffer;
    in_puf_adr : long_integer;
    p_midi1,p_datin,p_mesout,p_mesin,p_start,p_fehler,p_getquit : dialog_ptr;
    p_infile,p_outfile,p_sendint,p_empfint,p_notonlin,
    p_dateianf : dialog_ptr;
    ap_id,menu_id:integer;
    accname:str255;
    dummy,event:integer;
    an_set : SET OF 1..15;
    msg:message_buffer;
    midipfad : string;


      {$Igemsubs.pas}

PROCEDURE aes_call(op : integer;
                   VAR int_in   : int_in_parms;
                   VAR int_out  : int_out_parms;
                   VAR addr_in  : addr_in_parms;
                   VAR addr_out : addr_out_parms);
  EXTERNAL;


PROCEDURE objc_draw(objekt : aes_ptr;
                    index,tiefe : integer;
                    x,y,b,h : integer);
VAR
  int_in   : int_in_parms;
  int_out  : int_out_parms;
  addr_in  : addr_in_parms;
  addr_out : addr_out_parms;

BEGIN
int_in[0] := index;
int_in[1] := tiefe;
int_in[2] := x;
int_in[3] := y;
int_in[4] := b;
int_in[5] := h;
addr_in[0] := objekt;
aes_call(42,int_in,int_out,addr_in,addr_out)
END;

FUNCTION bconstat(dev : integer):boolean; BIOS(1);   {MIDI: dev=3}

PROCEDURE dummy_bconin(dev : integer);    BIOS(2);   {MIDI: dev=3}

PROCEDURE bconout(dev : integer;C : char);BIOS(3);   {MIDI: dev=3}

PROCEDURE io_check(b:boolean); EXTERNAL;

FUNCTION io_result:integer; EXTERNAL;

PROCEDURE let_redraw;
VAR dumdidum : integer;
BEGIN
event:=get_event(e_timer,0,0,0,1000,
                 false,0,0,0,0,false,0,0,0,0,
                  msg,dumdidum,dumdidum,dumdidum,dumdidum,dumdidum,dumdidum)
END;

PROCEDURE clear_midi_buffer;
BEGIN
WHILE bconstat(midi) DO dummy_bconin(midi)
END;

PROCEDURE clear_key_buffer;
BEGIN
WHILE bconstat(key) DO dummy_bconin(key)
END;

PROCEDURE tastendruck;
BEGIN
clear_key_buffer;
dummy_bconin(key)
END;

PROCEDURE send_ack(von,an : integer);
BEGIN
bconout(midi,chr(von*16 + an));  {Ackn. von an}
bconout(midi,chr(0));            {ist Datenblock der L„nge 0}
bconout(midi,chr(1))             {Checksum war OK}
END;

PROCEDURE frei;
BEGIN
bconout(midi,chr(0))
END;

PROCEDURE int_in_string(i : integer;VAR s : string);
BEGIN
s := chr(48 + i DIV 10);
s := concat(s,chr(48 + i MOD 10))
END;

PROCEDURE string_in_int( s : string; VAR i : integer);
VAR j : integer;
BEGIN
i := 0;
FOR j := length(s) DOWNTO 1 DO
  i := i*10 + ord(s[j]) - 48
END;

PROCEDURE dgetpath(ptr : pfad_zeiger_typ;drv : integer);
  GEMDOS($47);

FUNCTION dgetdrv : integer;
  GEMDOS($19);

PROCEDURE get_path(VAR path : string);
VAR
  l : integer;
  pfad_pointer : pfad_zeiger_typ;
BEGIN
  new(pfad_pointer);
  dgetpath(pfad_pointer,0);
  l := 0;
  WHILE pfad_pointer^[l+1] <> chr(0) DO
  BEGIN
    l := succ(l);
    path[l] := pfad_pointer^[l]
  END;
  path[0] := chr(l);
  path := concat(chr(dgetdrv+65),':',path,'\')
END;

PROCEDURE standard_send(an : integer; VAR raus : boolean);
VAR state,dummy : integer;
    z : str255;
BEGIN
WITH puffer.point^ DO
REPEAT
  ack[an]:=false;
  online[an] := true;
  sendreq:=true;
  WHILE sendreq DO;
  busy:=false;
  WHILE NOT busy DO;
  IF NOT ack[an] THEN
    IF online[an] THEN
      BEGIN
        state := obj_state(p_fehler,fabbruch);
        obj_setstate(p_fehler,fabbruch,state & $fe,false);
        state := obj_state(p_fehler,fweiter);
        obj_setstate(p_fehler,fweiter,state & $fe,false);
        int_in_string(an,z);
        z := concat('(',z,')');
        set_dtext(p_fehler,fehleran,z,system_font,te_left);
        center_dialog(p_fehler);
        raus := (do_dialog(p_fehler,0) = fabbruch);
        end_dialog(p_fehler);
        let_redraw;
      END
    ELSE BEGIN
         state := obj_state(p_notonlin,noknopf);
         obj_setstate(p_notonlin,noknopf,state & $fe,false);
         int_in_string(an,z);
         z := concat('(',z,')');
         set_dtext(p_notonlin,notonan,z,system_font,te_left);
         center_dialog(p_notonlin);
         dummy := do_dialog(p_notonlin,0);
         raus := true;
         end_dialog(p_notonlin);
         let_redraw
         END
UNTIL (ack[an] AND ok_flag) OR raus;
END;

FUNCTION fopen(VAR name : pack80; mode : integer):integer;
  GEMDOS($3d);

FUNCTION fread(h_nummer : integer; count,buf : long_integer):integer;
  GEMDOS($3f);

PROCEDURE fwrite(h_nummer : integer; count,buf : long_integer);
  GEMDOS($40);

PROCEDURE fclose(h_nummer : integer);
  GEMDOS($3e);

FUNCTION my_reset(fn : str255):integer;
{ liefert im Fehlerfall negativen Wert }
VAR name : pack80;
    i,l : integer;
BEGIN
l := length(fn);
FOR i := 1 TO l DO
  name[i] := fn[i];
name[l+1] := chr(0);
my_reset := fopen(name,0)
END;

PROCEDURE res_laden;
VAR vonwo:string;
  FUNCTION getrez:integer;
  XBIOS(4);

BEGIN
  IF getrez=2 {hohe Aufloesung}
  THEN vonwo:=concat(midipfad,'midimono.rsc')
    ELSE vonwo:=concat(midipfad,'midicol.rsc');
  IF NOT load_resource(vonwo) THEN
    BEGIN
      dummy:=do_alert('[3][Es fehlt die Resource-Datei][Abbruch]',1);
      exit_gem;
      halt
    END;
  find_dialog(midi1,p_midi1);
  find_dialog(datin,p_datin);
  find_dialog(mesout,p_mesout);
  find_dialog(mesin,p_mesin);
  find_dialog(start,p_start);
  find_dialog(fehler,p_fehler);
  find_dialog(getquit,p_getquit);
  find_dialog(infile,p_infile);
  find_dialog(outfile,p_outfile);
  find_dialog(sendint,p_sendint);
  find_dialog(empfint,p_empfint);
  find_dialog(notonlin,p_notonlin);
  find_dialog(dateianf,p_dateianf)
END;


PROCEDURE installieren(adresse:long_integer);
{ Diese Routine stellt den Pfad fest,
  installiert die VBI-Routine fuer den
  MIDInet Server und uebergibt ihr die Adresse des Puffers. }
TYPE name=PACKED ARRAY[1..80] OF char;

VAR pfad:name;
    pfadstr,cmdline,env:string;
    wahl,i:integer;

  PROCEDURE pexec(mode:integer; VAR path:name;
                  VAR cmdline:string;VAR env:string);
  GEMDOS($4b);

BEGIN
  center_dialog(p_start);
  begin_update;
  wahl := do_dialog(p_start,0);
  end_update;
  end_dialog(p_start);
  WITH puffer.point^ DO
  BEGIN
    CASE wahl OF
      sm1 : nummer := 1;
      sm2 : nummer := 2;
      sm3 : nummer := 3;
      sm4 : nummer := 4;
      sm5 : nummer := 5;
      sm6 : nummer := 6;
      sm7 : nummer := 7;
      sm8 : nummer := 8;
      sm9 : nummer := 9;
      sm10: nummer := 10;
      sm11: nummer := 11;
      sm12: nummer := 12;
      sm13: nummer := 13;
      sm14: nummer := 14;
      sm15: nummer := 15
    END;
    sendreq:=false;
    receivereq:=false;
    busy:=false;
    auto_ack := true
  END;
  pfadstr:=concat(midipfad,'MIDINET.PRG');
  FOR i:=1 TO length(pfadstr) DO pfad[i]:=pfadstr[i];
  pfad[length(pfadstr)+1]:=chr(0);
         { cmdline darf keine $00 enthalten, sonst vorzeitiges Ende! }
  FOR i:=0 TO 5 DO
  BEGIN
    cmdline[i]:=chr((adresse MOD 16)+64);
    adresse:=adresse DIV 16;
  END;
  cmdline[6]:=chr(0);
  env[0]:=chr(0);
  pexec(0,pfad,cmdline,env)   { Jetzt starten }
END;


PROCEDURE nachrichtsend;
VAR adr,wort1,wort2,z,z1,z2:str255;
    i,j,dummy,state:integer;
    raus : boolean;
BEGIN
center_dialog(p_mesout);
z := 'An';
FOR i := 1 TO 15 DO
  IF i IN an_set THEN
    BEGIN
    int_in_string(i,adr);
    z := concat(z,' ',adr)
    END;
set_dtext(p_mesout,meldan,z,system_font,te_left);
REPEAT
  z1:='__________________________________________________';
  z2:='XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX';
  set_dedit(p_mesout,meld2,z1,z2,'',system_font,te_left);
  z1:=concat('Meldung   ',z1);
  set_dedit(p_mesout,meld1,z1,z2,'',system_font,te_left);
  state := obj_state(p_mesout,clear);
  obj_setstate(p_mesout,clear,state & $fe,false);
  state := obj_state(p_mesout,textok);
  obj_setstate(p_mesout,textok,state & $fe,false);
  state := obj_state(p_mesout,outstop);
  obj_setstate(p_mesout,outstop,state & $fe,false);
  dummy:=do_dialog(p_mesout,0)
UNTIL dummy<>clear;
end_dialog(p_mesout);
let_redraw;
IF dummy<>outstop THEN
  BEGIN
    get_dedit(p_mesout,meld1,wort1);
    get_dedit(p_mesout,meld2,wort2);
    WITH puffer.point^ DO
      BEGIN
        j:=2;
        FOR i:=1 TO length(wort1) DO
          BEGIN
            out_puffer[j]:=ord(wort1[i]);
            j:=succ(j)
          END;
        out_puffer[j]:=255; {Trennzeichen}
        j:=succ(j);
        FOR i:=1 TO length(wort2) DO
          BEGIN
            out_puffer[j]:=ord(wort2[i]);
            j:=succ(j)
          END;
        out_puffer[j]:=0;  { Endezeichen }
        out_puffer[1]:=j-1; {Zeichenanzahl incl. Endezeichen}
      END;
    FOR i := 1 TO 15 DO
      IF i IN an_set THEN
        WITH puffer.point^ DO
          BEGIN
            out_puffer[0]:=i+16*nummer;
            standard_send(i,raus)
          END
  END
END;


PROCEDURE nachrempfang;
VAR i,dummy,absend:integer;
    z:str255;
BEGIN
  write(chr(7));
  WITH puffer.point^ DO
  BEGIN
    absend:=in_puffer[0] DIV 16;
    int_in_string(absend,z);
    z := concat('Meldung von ',z);
    set_dtext(p_mesin,meldvon,z,system_font,te_left);
    z:='';
    i:=1;
    WHILE (i<ord(in_puffer[1])) AND (in_puffer[i+1]<>255) DO
    BEGIN
      z:=concat(z,chr(in_puffer[i+1]));
      i:=succ(i)
    END;
    set_dtext(p_mesin,intext1,z,system_font,te_left);
    z:='';
    i:=succ(i);
    WHILE i<ord(in_puffer[1]) DO
    BEGIN
      z:=concat(z,chr(in_puffer[i+1]));
      i:=succ(i)
    END;
    set_dtext(p_mesin,intext2,z,system_font,te_left);
    center_dialog(p_mesin);
    objc_draw(p_mesin,0,1,0,0,639,399);
    tastendruck;
    receivereq:=false;
    end_dialog(p_mesin);
    let_redraw;
  END
END;

PROCEDURE bereit(VAR anz:integer;h_nummer,ani:integer);
BEGIN
anz := fread(h_nummer,124,hpuffer.adr+2);
hpuffer.ptr^[0] := puffer.point^.nummer * 16 + ani;
hpuffer.ptr^[1] := anz + 1;
IF anz < 124
  THEN hpuffer.ptr^[anz+2] := 0
  ELSE hpuffer.ptr^[anz+2] := 255
END;


PROCEDURE warten(ani:integer);
VAR quittiert : boolean;
    z:str255;
BEGIN
quittiert := false;
int_in_string(ani,z);
z := concat('(',z,')');
set_dtext(p_getquit,quitan,z,system_font,te_left);
center_dialog(p_getquit);
objc_draw(p_getquit,0,1,0,0,639,399);
WITH puffer.point^ DO
  BEGIN
    REPEAT
      WHILE NOT receivereq DO;
      IF (in_puffer[0] DIV 16 = ani) AND
         (in_puffer[1] = 3) AND
         (in_puffer[2] = 0) AND
         (in_puffer[3] = ord('Q'))
        THEN quittiert := true
        ELSE nachrempfang
    UNTIL quittiert;
    receivereq := false;
    end_dialog(p_getquit);
    let_redraw;
  END
END;

PROCEDURE meldung(empf:integer;meldtext:string);
VAR i:integer;
     raus:boolean;
BEGIN
  WITH puffer.point^ DO
  BEGIN
    WHILE sendreq DO;
    FOR i:=1 TO length(meldtext) DO
      out_puffer[i+1]:=ord(meldtext[i]);
    i:=length(meldtext);
    out_puffer[0]:=empf+16*puffer.point^.nummer;
    out_puffer[1]:=i+1;
    out_puffer[i+2]:=0;
    raus := false;
    REPEAT
      standard_send(empf,raus)
    UNTIL NOT raus
  END
END;

PROCEDURE transfer(auswahl:path_name;ani:integer);
VAR i,j,l,state,h_nummer,anz:integer;
    z:str255;
    raus,schluss:boolean;
BEGIN
  h_nummer:=my_reset(auswahl);
  fclose(h_nummer);
  IF h_nummer<0 THEN
    meldung(ani,'Die angeforderte Datei existiert nicht.')
  ELSE
  WITH puffer.point^ DO
  BEGIN
    let_redraw;
    i := length(auswahl);
    WHILE auswahl[i]<>'\' DO i:=pred(i);
    i := succ(i);
    l := 0;
    j := 3;
    WHILE (i<=length(auswahl)) DO
      BEGIN
        l := succ(l);
        out_puffer[j]:=ord(auswahl[i]);
        i:=succ(i);
        j:=succ(j)
      END;
    out_puffer[0]:=ani+16*nummer;
    out_puffer[1]:=l+2;
    out_puffer[2]:=0;
    out_puffer[j]:=0;
    raus := false;
    standard_send(ani,raus);
    IF NOT raus THEN
      BEGIN
        warten(ani);
        z := concat('Lesen von: ',auswahl);
        set_dtext(p_outfile,outfin,z,system_font,te_left);
        int_in_string(ani,z);
        z := concat('Senden an: ',z);
        set_dtext(p_outfile,outfnr,z,system_font,te_left);
        center_dialog(p_outfile);
        objc_draw(p_outfile,0,1,0,0,639,399);
        schluss := false;
        h_nummer := my_reset(auswahl);
        IF h_nummer>=0 THEN
        BEGIN
          bereit(anz,h_nummer,ani);
          REPEAT
            out_puffer := hpuffer.ptr^;
            ack[ani] := false;
            sendreq := true;
            schluss := (anz < 124);
            IF NOT schluss THEN bereit(anz,h_nummer,ani);
            REPEAT
              WHILE sendreq DO;
              busy := false;
              WHILE NOT busy DO;
              IF NOT ack[ani] THEN
                BEGIN
                state := obj_state(p_sendint,siknopf);
                obj_setstate(p_sendint,siknopf,state & $fe,false);
                int_in_string(ani,z);
                z := concat('(',z,')');
                set_dtext(p_sendint,sendan,z,system_font,te_left);
                center_dialog(p_sendint);
                dummy := do_dialog(p_sendint,0);
                end_dialog(p_sendint);
                let_redraw
                END
              ELSE IF NOT ok_flag THEN
                     BEGIN
                       sendreq := true;
                       ack[ani] := false;
                       write(chr(7))
                     END
            UNTIL ack[ani] AND ok_flag
          UNTIL schluss
        END;
        fclose(h_nummer);
        end_dialog(p_outfile);
        let_redraw;
      END
  END
END;

PROCEDURE dateisend;
VAR vorgabe,auswahl:path_name;
    z : str255;
    i,j,l,h_nummer,anz,state,ani:integer;
    raus,schluss : boolean;

BEGIN
auswahl:='';
get_path(vorgabe);
vorgabe:=concat(vorgabe,'*.*');
IF get_in_file(vorgabe,auswahl) THEN
  FOR ani := 1 TO 15 DO
    IF ani IN an_set THEN
      transfer(auswahl,ani)
END;

PROCEDURE holedatei;
VAR i,state,von:integer;
    z,z1,z2,pfad:str255;
    raus:boolean;
BEGIN
  state := obj_state(p_dateianf,anfanf);
  obj_setstate(p_dateianf,anfanf,state & $fe,false);
  state := obj_state(p_dateianf,anfaus);
  obj_setstate(p_dateianf,anfaus,state & $fe,false);
  z1:='Pfad  __________________________________________________';
  z2:='XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX';
  set_dedit(p_dateianf,anfpfad,z1,z2,'',system_font,te_left);
  i:=1;
  WHILE NOT (i IN an_set) DO i:=succ(i);
  von:=i;
  int_in_string(i,z);
  z:=concat('Hole Datei von ',z);
  set_dtext(p_dateianf,anfvon,z,system_font,te_left);
  center_dialog(p_dateianf);
  dummy:=do_dialog(p_dateianf,0);
  IF dummy=anfanf THEN
  BEGIN
    WHILE puffer.point^.sendreq DO;
    get_dedit(p_dateianf,anfpfad,pfad);
    FOR i:=1 TO length(pfad) DO
      puffer.point^.out_puffer[i+2]:=ord(pfad[i]);
    puffer.point^.out_puffer[0]:=von+16*puffer.point^.nummer;
    puffer.point^.out_puffer[1]:=i+2;
    puffer.point^.out_puffer[2]:=1;
    puffer.point^.out_puffer[i+3]:=0;
    raus := false;
    standard_send(von,raus);
  END;
  end_dialog(p_dateianf);
END;


PROCEDURE datanford;
VAR auswahl,meldtext,vergleich:str255;
    i,empf:integer;
    zugriff:text;
    freigabe:boolean;
BEGIN
  auswahl:='';
  WITH puffer.point^ DO
  BEGIN
    FOR i:=3 TO in_puffer[1]-1 DO
      BEGIN
        IF (in_puffer[i]>96) AND (in_puffer[i]<123)
          THEN in_puffer[i]:=in_puffer[i]-32;   {in Grossbuchst. wandeln}
        auswahl:=concat(auswahl,chr(in_puffer[i]));
      END;
    empf:=in_puffer[0] DIV 16;
    receivereq:=false;
    freigabe:=false;
    io_check(false);
    reset(zugriff,concat(midipfad,'midinet.inf'));
    IF io_result=0 THEN
    BEGIN
      REPEAT
        readln(zugriff,vergleich);
        IF pos(vergleich,auswahl)=1 THEN freigabe:=true;
      UNTIL eof(zugriff);
      close(zugriff)
    END;
    io_check(true);
    IF freigabe THEN transfer(auswahl,empf)
    ELSE
      meldung(empf,'Die angeforderte Datei ist gesperrt !');
  END
END;


PROCEDURE aktion;
VAR an,wahl,state,dumdidum:integer;
    z : str255;
BEGIN
REPEAT
  center_dialog(p_midi1);
  state := obj_state(p_midi1,nachri);
  obj_setstate(p_midi1,nachri,state & $fe,false);
  state := obj_state(p_midi1,datei);
  obj_setstate(p_midi1,datei,state & $fe,false);
  state := obj_state(p_midi1,dateihol);
  obj_setstate(p_midi1,dateihol,state & $fe,false);
  state := obj_state(p_midi1,ausgang);
  obj_setstate(p_midi1,ausgang,state & $fe,false);
  wahl := do_dialog(p_midi1,0);
  end_dialog(p_midi1);
  let_redraw;
  an_set := [];
  IF obj_state(p_midi1,em1 ) & selected <>0 THEN an_set := an_set + [1];
  IF obj_state(p_midi1,em2 ) & selected <>0 THEN an_set := an_set + [2];
  IF obj_state(p_midi1,em3 ) & selected <>0 THEN an_set := an_set + [3];
  IF obj_state(p_midi1,em4 ) & selected <>0 THEN an_set := an_set + [4];
  IF obj_state(p_midi1,em5 ) & selected <>0 THEN an_set := an_set + [5];
  IF obj_state(p_midi1,em6 ) & selected <>0 THEN an_set := an_set + [6];
  IF obj_state(p_midi1,em7 ) & selected <>0 THEN an_set := an_set + [7];
  IF obj_state(p_midi1,em8 ) & selected <>0 THEN an_set := an_set + [8];
  IF obj_state(p_midi1,em9 ) & selected <>0 THEN an_set := an_set + [9];
  IF obj_state(p_midi1,em10) & selected <>0 THEN an_set := an_set + [10];
  IF obj_state(p_midi1,em11) & selected <>0 THEN an_set := an_set + [11];
  IF obj_state(p_midi1,em12) & selected <>0 THEN an_set := an_set + [12];
  IF obj_state(p_midi1,em13) & selected <>0 THEN an_set := an_set + [13];
  IF obj_state(p_midi1,em14) & selected <>0 THEN an_set := an_set + [14];
  IF obj_state(p_midi1,em15) & selected <>0 THEN an_set := an_set + [15]
UNTIL (an_set <> []) OR (wahl = ausgang);
CASE wahl OF
          nachri : nachrichtsend;
          datei  : BEGIN
                     WITH puffer.point^ DO
                       IF nummer IN an_set THEN
                         an_set := an_set - [nummer];
                     IF an_set <> [] THEN dateisend;
                   END;
          dateihol : BEGIN
                       WITH puffer.point^ DO
                         IF nummer IN an_set THEN
                           an_set := an_set - [nummer];
                       IF an_set <> [] THEN holedatei;
                     END;
          ausgang: ; {die leere Anweisung, aber das sofort !!!}
  END  { of K„s }
END;


PROCEDURE dateiempfang;
VAR z : str255;
    fn : string;
    i,dummy,absender,h_nummer,state : integer;
    schluss,ausgewaehlt : boolean;
    vorgabe,auswahl : path_name;
    datei : PACKED FILE OF byte;

  PROCEDURE quittung;
  BEGIN
    WITH puffer.point^ DO
      REPEAT
        out_puffer[0] := nummer*16 + absender;
        out_puffer[1] := 3;
        out_puffer[2] := 0;
        out_puffer[3] := ord('Q');
        out_puffer[4] := 0;
        ack[absender] := false;
        sendreq := true;
        WHILE sendreq DO;
        busy := false;
        WHILE NOT busy DO;
        IF NOT ack[absender] THEN
          BEGIN
          state := obj_state(p_empfint,eiknopf);
          obj_setstate(p_empfint,eiknopf,state & $fe,false);
          int_in_string(absender,z);
          z := concat('(',z,')');
          set_dtext(p_empfint,empfan,z,system_font,te_left);
          center_dialog(p_empfint);
          dummy := do_dialog(p_empfint,0);
          end_dialog(p_empfint);
          let_redraw
          END
      UNTIL ack[absender] AND ok_flag
  END;

BEGIN
  center_dialog(p_datin);
  absender:=puffer.point^.in_puffer[0] DIV 16;
  int_in_string(absender,z);
  z:=concat('Absender: ',z);
  set_dtext(p_datin,absend,z,system_font,te_left);
  fn := '';
  FOR i:=3 TO puffer.point^.in_puffer[1] + 1 DO
    fn := concat(fn,chr(puffer.point^.in_puffer[i]));
  z := concat('Die Datei ',fn);
  set_dtext(p_datin,datname,z,system_font,te_left);
  state := obj_state(p_datin,pfadwahl);
  obj_setstate(p_datin,pfadwahl,state & $fe,false);
  state := obj_state(p_datin,pfada);
  obj_setstate(p_datin,pfada,state & $fe,false);
  state := obj_state(p_datin,pfadb);
  obj_setstate(p_datin,pfadb,state & $fe,false);
  state := obj_state(p_datin,pfadc);
  obj_setstate(p_datin,pfadc,state & $fe,false);
  state := obj_state(p_datin,pfadd);
  obj_setstate(p_datin,pfadd,state & $fe,false);
  dummy:=do_dialog(p_datin,0);
  end_dialog(p_datin);
  let_redraw;
  CASE dummy OF
             pfada : auswahl := concat('A:\',fn);
             pfadb : auswahl := concat('B:\',fn);
             pfadc : auswahl := concat('C:\',fn);
             pfadd : auswahl := concat('D:\',fn);
             ELSE  : REPEAT
                       get_path(vorgabe);
                       auswahl:=concat(vorgabe,fn);
                       vorgabe:=concat(vorgabe,'*.*');
                       ausgewaehlt := get_in_file(vorgabe,auswahl);
                       let_redraw
                     UNTIL ausgewaehlt
       END;
  io_check(false);
  rewrite(datei,auswahl);
  WHILE io_result<>0 DO
  BEGIN
    REPEAT
      get_path(vorgabe);
      auswahl:=concat(vorgabe,fn);
      vorgabe:=concat(vorgabe,'*.*');
      ausgewaehlt:=get_in_file(vorgabe,auswahl)
    UNTIL ausgewaehlt;
    rewrite(datei,auswahl)
  END;
  io_check(true);
  h_nummer := handle(datei);
  quittung;
  int_in_string(absender,z);
  z := concat('Empfangen von: ',z);
  set_dtext(p_infile,infnr,z,system_font,te_left);
  z := concat('Lesen von:      ',fn);
  set_dtext(p_infile,infin,z,system_font,te_left);
  z := concat('Schreiben nach: ',auswahl);
  set_dtext(p_infile,infout,z,system_font,te_left);
  center_dialog(p_infile);
  objc_draw(p_infile,0,1,0,0,639,399);
  puffer.point^.auto_ack := false;
  puffer.point^.receivereq := false;
  schluss := false;
  WITH puffer.point^ DO
  REPEAT
    WHILE NOT receivereq DO;
    IF (in_puffer[0] DIV 16 = absender) THEN
      BEGIN
      send_ack(nummer,absender);
      schluss := (in_puffer[in_puffer[1]+1] = 0);
      IF NOT schluss THEN receivereq := false;
      fwrite(h_nummer,in_puffer[1]-1,in_puf_adr + 2)
      END
    ELSE receivereq:=false;
    IF NOT schluss THEN frei
  UNTIL schluss;
  puffer.point^.auto_ack := true;
  puffer.point^.receivereq:=false;
  frei;
  close(datei);
  end_dialog(p_infile);
  let_redraw
END;


PROCEDURE empfang;
BEGIN
  CASE puffer.point^.in_puffer[2] OF
  0 : dateiempfang;
  1 : datanford;
  ELSE : nachrempfang
  END
END;


BEGIN
ap_id:=init_gem;
IF ap_id>=0 THEN
  BEGIN
    get_path(midipfad);
    accname:='  MIDInet Server';
    menu_id:=menu_register(ap_id,accname);
      event:=get_event(e_timer,0,0,0,3000,
                       false,0,0,0,0,false,0,0,0,0,
                       msg,dummy,dummy,dummy,dummy,dummy,dummy);
    init_mouse;
    new(puffer.point); { Puffer erzeugen }
    in_puf_adr := puffer.adr + 72;  {Adresse des Eingabepuffers}
    new(hpuffer.ptr);  {Hilfspuffer erzeugen}
    res_laden; { Resource laden und Nummer feststellen }
    installieren(puffer.adr);
    clear_midi_buffer;
    frei;
    WHILE true DO
    BEGIN { Event-loop }
      event:=get_event(e_message | e_timer,0,0,0,100,
                       false,0,0,0,0,false,0,0,0,0,
                       msg,dummy,dummy,dummy,dummy,dummy,dummy);
      IF puffer.point^.receivereq THEN empfang;
      IF event&e_message<>0
        THEN IF (msg[0]=ac_open) THEN aktion
    END;
    exit_gem
  END;
END.