home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / sonderh1 / dfxm.inc < prev    next >
Encoding:
Text File  |  1987-06-10  |  14.2 KB  |  356 lines
  1. (*-------------------------------------------------------------------------*)
  2. (*                            DFXM.INC                                     *)
  3. (*        Senden und Empfangen einer Datei nach dem XModem-Protokoll       *)
  4.  
  5.  
  6. (*------------------------- XModem senden ---------------------------------*)
  7. (*                                                                         *)
  8.  
  9.   (* Auf Zeichen an der Schnittstelle warten und ggf. durch Tastendruck *)
  10.   (* abbrechen. Wird fuer das XModem-Protokoll benoetigt, da aus        *)
  11.   (* Portabilitaetsgruenden kein Timeout implementiert ist.             *)
  12. FUNCTION XM_Warte_auf_Zeichen : CHAR;
  13.  
  14. BEGIN
  15.   REPEAT UNTIL (InpStatus OR KeyPressed);
  16.   IF KeyPressed THEN
  17.     XM_Warte_auf_Zeichen := CAN
  18.   ELSE
  19.     XM_Warte_auf_Zeichen := InpSIO
  20. END;
  21.  
  22.  
  23. OVERLAY PROCEDURE XModem_Senden;
  24.  
  25. LABEL Exit; (* Fuer "Notausgang" im Fehlerfall. *)
  26.  
  27. TYPE TBlock = ARRAY[1..128] OF CHAR;
  28.  
  29. (*========================================================================*)
  30. (*          VORSCHLAG FUER TYPENDEFINITION, falls man BlockWrite          *)
  31. (*      und -Read selber implementieren muss (siehe Begleitartikel).      *)
  32. (* TYPE NoTypeFile = FILE OF INTEGER;                                     *)
  33. (*        Ist am ehesten geeignet um verschiedene Dateitypen zu lesen.    *)
  34. (*========================================================================*)
  35.  
  36. VAR i, BlockNr, Nr,
  37.     ErrorCounter,
  38.     PruefSum           : INTEGER;
  39.     Name               : String255;
  40.     Block              : TBlock;
  41.     Zeichen            : CHAR;
  42.     Fehler, EndFlag    : BOOLEAN;
  43.     f                  : FILE; (* Typfreier Parameter ! Turbo-spezifisch !  *)
  44.            (* Wird fuer Turbo Pascal BlockRead/-Write unter CP/M benoetigt. *)
  45.            (* Unter MS-DOS tut es auch ein TEXT-File.                       *)
  46.       (* Fuer Eigenimplementation von BlockRead/-Write --> f : NoTypeFile;  *)
  47.  
  48.  
  49.   (*============== IMPLEMENTATIONSVORSCHLAG BlockRead =====================*)
  50.   (* Turbo Pascal erlaubt es aus typfreien Dateien (f) mit BlockRead in    *)
  51.   (* eine Puffervariable (Block) n Bloecke (Dummy) a 128 Byte zu uebertra- *)
  52.   (* gen. Hier wird dieses Verhalten mit einem FILE OF INTEGER nachgebil-  *)
  53.   (* det, dessen Elemente dann in Zeichen aufgespalten in das CHARacter-   *)
  54.   (* Array Block uebertragen werden. Der Parameter Dummy fuer die Anzahl   *)
  55.   (* der zu uebertragenden Bloecke ist hier wirkungslos, es wird immer     *)
  56.   (* genau ein 128 Byte-Block uebertragen.                                 *)
  57.   (*                                                                       *)
  58.   (*  procedure BlockRead(var f : NoTypeFile; var Block : TBlock;          *)
  59.   (*                      Dummy : integer);                                *)
  60.   (*                                                                       *)
  61.   (*  var w, i : integer;                                                  *)
  62.   (*                                                                       *)
  63.   (*  begin                                                                *)
  64.   (*    for i := 1 to 64 do                                                *)
  65.   (*      if not eof(f) then begin                                         *)
  66.   (*        read(f,w);                                                     *)
  67.   (*        Block[2*i-1] := chr(lo(w));                                    *)
  68.   (*        Block[2*i] := chr(hi(w))                                       *)
  69.   (*      end                                                              *)
  70.   (*      else begin                                                       *)
  71.   (*        Block[2*i-1] := chr(0);                                        *)
  72.   (*        Block[2*i] := chr(0)                                           *)
  73.   (*      end                                                              *)
  74.   (*  end;                                                                 *)
  75.   (*=======================================================================*)
  76.  
  77.  
  78. BEGIN
  79.   ClrScr;
  80.  
  81.   (* Datei erfragen *)
  82.   WriteLn(INV_EIN,'XMODEM Datei Senden',INV_AUS);
  83.   WriteLn;
  84.   Fehler := TRUE;
  85.   REPEAT
  86.     Write(' Dateiname ? (Abbruch mit leerer Eingabe) : ');
  87.     ReadLn(Name);
  88.     IF Length(Name) > 0 THEN BEGIN
  89.       Assign(f,Name);
  90. (*$I-*)
  91.       ReSet (f);
  92. (*$I+*)
  93.       Fehler := IOFehler
  94.     END
  95.   UNTIL (NOT Fehler) OR (Length(Name) = 0);
  96.  
  97.   (* Uebertragung der Daten *)
  98.   IF NOT Fehler THEN BEGIN
  99.     WriteLn;
  100.     WriteLn('   WARTEN auf Initial Not-Acknowledge (Ready-Signal)');
  101.     REPEAT
  102.       Zeichen := XM_Warte_auf_Zeichen
  103.     UNTIL Zeichen IN [NAK,CAN];
  104.     IF Zeichen = CAN THEN
  105.       WriteLn(BELL,INV_EIN,' Uebertragung wurde abgebrochen !',INV_AUS)
  106.     ELSE BEGIN
  107.  
  108.       (* Uebertragung *)
  109.       BlockRead(f,Block,1);
  110.       ErrorCounter := 0;
  111.       BlockNr := 1;
  112.       EndFlag := FALSE;
  113.       WHILE (NOT EndFlag) AND (ErrorCounter < 10) DO BEGIN
  114.         EndFlag := Eof(f);
  115.         Nr := Lo(BlockNr);
  116.         WriteLn;
  117.         WriteLn('   BLOCK ',BlockNr,' wird gerade gesendet. ');
  118.         Sende_Zeichen(SOH);            (* Start of Header *)
  119.         Sende_Zeichen(Chr(Nr));        (* Blocknummer senden *)
  120.         Sende_Zeichen(Chr(255 - Nr));  (* Komplement senden  *)
  121.  
  122.         (* Datenuebertragung *)
  123.         PruefSum := 0;
  124.         FOR i := 1 TO 128 DO BEGIN             (* 128 Datenbytes senden *)
  125.           Sende_Zeichen(Block[i]);
  126.           PruefSum := PruefSum + Ord(Block[i]) (* Pruefsumme errechnen *)
  127.         END;
  128.         Sende_Zeichen(Chr(Lo(PruefSum)));      (* Pruefsumme senden *)
  129.  
  130.         (* Auf Antwort warten und reagieren *)
  131.         Zeichen := XM_Warte_auf_Zeichen;
  132.         IF Zeichen = CAN THEN BEGIN            (* abgebrochen *)
  133.           WriteLn(INV_EIN,' UEBERTRAGUNG ABGEBROCHEN ',INV_EIN);
  134.           GOTO Exit
  135.         END;
  136.         IF Zeichen = ACK THEN BEGIN            (* alles klar *)
  137.           WriteLn('   Achnowledge (Empfangsbestaetigung) fuer Block ',
  138.                   BlockNr:5,' erhalten. ');
  139.  
  140.           (* Naechsten Block von Massenspeicher lesen *)
  141.           IF NOT EndFlag THEN BEGIN
  142.             BlockRead(f,Block,1);
  143.             IF IOFehler THEN         (* Katastrophe auf der Diskette *)
  144.               GOTO Exit;
  145.             BlockNr := Succ(BlockNr)
  146.           END;
  147.           ErrorCounter := 0;
  148.         END
  149.         ELSE BEGIN
  150.           ErrorCounter := Succ(ErrorCounter);
  151.           WriteLn(BELL,INV_EIN,
  152.                   ' Not Acknowledge (Fehlermeldung) fuer Block ',BlockNr:5,
  153.                   ' erhalten ! ',INV_AUS)
  154.         END
  155.       END
  156.     END;
  157.  
  158.     IF ErrorCounter >= 10 THEN (* Abbrechen, bringt nicht's mehr *)
  159.       Sende_Zeichen(CAN)
  160.     ELSE                      (* Alles in Butter *)
  161.       Sende_Zeichen(EOT);
  162. (*$I-*)
  163.     Close(f);
  164. (*$I+*)
  165.     Fehler := IOFehler (* Close ist hoffentlich gutgegangen *)
  166.   END;
  167.   Exit:   (* "Notausgang" *)
  168. END;
  169.  
  170.  
  171.  
  172. (*---------------------- XModem empfangen -----------------------------------*)
  173. (*                                                                           *)
  174. OVERLAY PROCEDURE XModem_Empfangen;
  175.  
  176.    (* HINWEIS : Es muss genug Platz auf der Diskette zum sichern der Datei *)
  177.    (*           sein, da Fehler aufgrund voller Diskette nicht abgefangen  *)
  178.    (*           werden.                                                    *)
  179.  
  180. TYPE TBlock = ARRAY[1..128] OF CHAR;
  181.  
  182. (*========================================================================*)
  183. (*          VORSCHLAG FUER TYPENDEFINITION, falls man BlockWrite          *)
  184. (*      und -Read selber implementieren muss (siehe Begleitartikel).      *)
  185. (* TYPE NoTypeFile = FILE OF INTEGER;                                     *)
  186. (*        Ist am ehesten geeignet um verschiedene Dateitypen zu lesen.    *)
  187. (*========================================================================*)
  188.  
  189. VAR Zeichen, merke_BlNr,
  190.     Dummy                      : CHAR;
  191.     PruefSum, BlockNummer,
  192.     BlNr, ErrorCount, Grund    : INTEGER;
  193.     Name                       : STRING[16];
  194.     Block                      : TBlock;
  195.     ErrorFlag, Fehler          : BOOLEAN;
  196.     f                          : FILE;
  197.     (* Fuer Eigenimplementation von BlockRead/-Write --> f : NoTypeFile; *)
  198.  
  199.   (*=========== IMPLEMENTATIONSVORSCHLAG BlockWrite ====================*)
  200.   (*                 Analog BlockRead (s.o.)                            *)
  201.   (*                                                                    *)
  202.   (* procedure BlockWrite(var f : NoTypeFile; Block : TBlock;           *)
  203.   (*                        Dummy : integer);                           *)
  204.   (*                                                                    *)
  205.   (* var w, i : integer;                                                *)
  206.   (*                                                                    *)
  207.   (* begin                                                              *)
  208.   (*   for i := 1 to 64 do begin                                        *)
  209.   (*     w := ord(Block[2*i-1]) + 256*ord(Block[2*i]);                  *)
  210.   (*     write(f,w)                                                     *)
  211.   (*   end                                                              *)
  212.   (* end;                                                               *)
  213.   (*====================================================================*)
  214.  
  215.  
  216.  
  217. BEGIN
  218.   ClrScr;
  219.   ErrorFlag := FALSE;
  220.   ErrorCount := 0;
  221.   BlockNummer := 1;
  222.  
  223.   (* Dateiname erfragen *)
  224.   WriteLn(INV_EIN,'XMODEM Datei Empfangen',INV_AUS);
  225.   WriteLn;
  226.   Fehler := TRUE;
  227.   REPEAT
  228.     Write(' Dateiname (Abbruch mit leerer Eingabe): ');
  229.     ReadLn(Name);
  230.     IF Length(Name) > 0 THEN BEGIN
  231.       Assign(f,Name);
  232. (*$I-*)
  233.       ReWrite(f);
  234. (*$I+*)
  235.       Fehler := IOFehler
  236.     END
  237.   UNTIL (NOT Fehler) OR (Length(Name) = 0);
  238.  
  239.   (* Uebertragung *)
  240.   IF NOT Fehler THEN BEGIN
  241.     WriteLn(' Starten sie bitte die Uebertragung mit Tastendruck');
  242.     REPEAT UNTIL KeyPressed;   (* Tastendruck abwarten *)
  243.     WriteLn;
  244.     ClearKeyBuf;
  245.     BlNr := BlockNummer;       (* BlNr ist die Blocknummer modulo 255 *)
  246.     Sende_Zeichen(NAK);        (* Initial Not Acknowlege senden *)
  247.     WriteLn('   Warten auf Blockanfang/Uebertragungsende');
  248.     REPEAT                            (*  abwarten *)
  249.       Zeichen := XM_Warte_auf_Zeichen;
  250.     UNTIL Zeichen IN [CAN,SOH,EOT];
  251.     IF Zeichen IN [CAN,EOT] THEN
  252.       WriteLn(INV_EIN,BELL,' Uebertragung wurde abgebrochen ! ',INV_AUS)
  253.     ELSE BEGIN                          (* Empfangen kann losgehen *)
  254.  
  255.       (** Anfang Uebertragunsgschleife *)
  256.       REPEAT
  257.         Zeichen := XM_Warte_auf_Zeichen; (* Blocknummer holen und in *)
  258.         merke_BlNr := Zeichen;           (* merke_BlNr merken     *)
  259.  
  260.         (* Die drei Fehlerfaelle ueberpruefen *)
  261.         IF Ord(Zeichen) <> BlNr THEN BEGIN       (* Falsche Blocknummer *)
  262.           ErrorFlag := TRUE;
  263.           Grund := 1
  264.         END;
  265.  
  266.         IF NOT ErrorFlag THEN BEGIN
  267.           Zeichen := XM_Warte_auf_Zeichen;
  268.           IF Ord(Zeichen) <> 255 - BlNr THEN BEGIN (* Falsches Komplement *)
  269.             ErrorFlag := TRUE;
  270.             Grund := 2
  271.           END;
  272.  
  273.           IF NOT ErrorFlag THEN BEGIN
  274.             (* 128 Datenbytes in Block einlesen und die Pruefsumme bilden *)
  275.             PruefSum := 0;
  276.             i := 0;
  277.             REPEAT
  278.               Zeichen := XM_Warte_auf_Zeichen;
  279.               i := Succ(i);
  280.               PruefSum := PruefSum + Ord(Zeichen);
  281.               Block[i] := Zeichen;
  282.             UNTIL i = 128;
  283.             PruefSum := Lo(PruefSum);          (* Pruefsumme berechnen *)
  284.             Zeichen := XM_Warte_auf_Zeichen;   (* Pruefsumme empfangen und *)
  285.             IF Zeichen <> Chr(PruefSum) THEN BEGIN (* vergleichen          *)
  286.               ErrorFlag := TRUE;
  287.               Grund := 3
  288.             END
  289.           END
  290.         END;
  291.  
  292.         (* Im Fehlerfall die Schnittstelle "saeubern" *)
  293.         IF ErrorFlag THEN BEGIN
  294.           Delay(40);
  295.           WHILE InpStatus DO BEGIN
  296.             Dummy := InpSIO;
  297.             IF NOT InpStatus THEN Delay(40) (* 40 millisec warten *)
  298.           END
  299.         END;
  300.  
  301.         (* Speichern der Daten *)
  302.         IF NOT ErrorFlag THEN BEGIN
  303.           BlockNummer := Succ(BlockNummer);
  304.           BlNr := Lo(BlockNummer);
  305.           IF merke_BlNr = Chr(Pred(BlNr)) THEN
  306.             BlockWrite(f,Block,1);
  307.           ErrorCount := 0;
  308.           WriteLn('Block ',Pred(BlockNummer):5,' richtig empfangen !');
  309.           Sende_Zeichen(ACK);
  310.         END
  311.         ELSE BEGIN             (* Sonst Fehlermeldung *)
  312.           ErrorFlag := FALSE;
  313.           ErrorCount := Succ(ErrorCount);
  314.           WriteLn(BELL,'   Block ',BlockNummer:5,' zum ',ErrorCount:2,
  315.                   ' mal falsch empfangen !');
  316.           Write('   GRUND : ');
  317.           CASE Grund OF
  318.             1 : WriteLn ('Blocknummer falsch !');
  319.             2 : WriteLn ('Blocknummerkomplement falsch !');
  320.             3 : WriteLn ('Pruefsumme falsch !')
  321.           END;
  322.           Sende_Zeichen(NAK)  (* schiefgegangen *)
  323.         END;
  324.  
  325.         IF ErrorCount < 10 THEN BEGIN    (* Wenn kein Abbruch *)
  326.           WriteLn('   Warten auf Blockanfang/Uebertragungsende ');
  327.           REPEAT
  328.             Zeichen := XM_Warte_auf_Zeichen;  (* Erste Zeichen des   *)
  329.           UNTIL Zeichen IN [CAN,SOH,EOT]      (* naechsten Block     *)
  330.         END
  331.       UNTIL (Zeichen IN [CAN,EOT]) OR (ErrorCount >= 10);
  332.       (** Ende Uebertragunsschleife **)
  333.  
  334.       IF (ErrorCount >= 10) OR (Zeichen = CAN) THEN
  335.         WriteLn(INV_EIN,BELL,
  336.                 ' !!! UEBERTRAGUNG FEHLERHAFT ABGEBROCHEN !!!',INV_AUS);
  337.       IF (ErrorCount >= 10) AND (Zeichen <> CAN) THEN
  338.         (* Versuchen ein CAN abzusetzen *)
  339.         FOR i := 1 TO 10 DO     (* 10 mal anklopfen *)
  340.           IF OutStatus THEN
  341.             Sende_Zeichen(CAN)
  342.           ELSE                  (* Sitzen die auf den Ohren ?! *)
  343.             Delay(40);
  344.       IF Zeichen = EOT THEN     (* O.K. -- Feierabend *)
  345.         Sende_Zeichen(ACK);
  346. (*$I-*)
  347.       Close(f);
  348. (*$I-*)
  349.       Fehler := IOFehler (* Close ist hoffentlich gutgegangen *)
  350.     END
  351.   END
  352. END;
  353.  
  354. (*-------------------------------------------------------------------------*)
  355. (*                           Ende DFXM.INC                                 *)
  356.