home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Turbo Toolbox
/
Turbo_Toolbox.iso
/
sonderh1
/
dfxm.inc
< prev
next >
Wrap
Text File
|
1987-06-10
|
15KB
|
356 lines
(*-------------------------------------------------------------------------*)
(* DFXM.INC *)
(* Senden und Empfangen einer Datei nach dem XModem-Protokoll *)
(*------------------------- XModem senden ---------------------------------*)
(* *)
(* Auf Zeichen an der Schnittstelle warten und ggf. durch Tastendruck *)
(* abbrechen. Wird fuer das XModem-Protokoll benoetigt, da aus *)
(* Portabilitaetsgruenden kein Timeout implementiert ist. *)
FUNCTION XM_Warte_auf_Zeichen : CHAR;
BEGIN
REPEAT UNTIL (InpStatus OR KeyPressed);
IF KeyPressed THEN
XM_Warte_auf_Zeichen := CAN
ELSE
XM_Warte_auf_Zeichen := InpSIO
END;
OVERLAY PROCEDURE XModem_Senden;
LABEL Exit; (* Fuer "Notausgang" im Fehlerfall. *)
TYPE TBlock = ARRAY[1..128] OF CHAR;
(*========================================================================*)
(* VORSCHLAG FUER TYPENDEFINITION, falls man BlockWrite *)
(* und -Read selber implementieren muss (siehe Begleitartikel). *)
(* TYPE NoTypeFile = FILE OF INTEGER; *)
(* Ist am ehesten geeignet um verschiedene Dateitypen zu lesen. *)
(*========================================================================*)
VAR i, BlockNr, Nr,
ErrorCounter,
PruefSum : INTEGER;
Name : String255;
Block : TBlock;
Zeichen : CHAR;
Fehler, EndFlag : BOOLEAN;
f : FILE; (* Typfreier Parameter ! Turbo-spezifisch ! *)
(* Wird fuer Turbo Pascal BlockRead/-Write unter CP/M benoetigt. *)
(* Unter MS-DOS tut es auch ein TEXT-File. *)
(* Fuer Eigenimplementation von BlockRead/-Write --> f : NoTypeFile; *)
(*============== IMPLEMENTATIONSVORSCHLAG BlockRead =====================*)
(* Turbo Pascal erlaubt es aus typfreien Dateien (f) mit BlockRead in *)
(* eine Puffervariable (Block) n Bloecke (Dummy) a 128 Byte zu uebertra- *)
(* gen. Hier wird dieses Verhalten mit einem FILE OF INTEGER nachgebil- *)
(* det, dessen Elemente dann in Zeichen aufgespalten in das CHARacter- *)
(* Array Block uebertragen werden. Der Parameter Dummy fuer die Anzahl *)
(* der zu uebertragenden Bloecke ist hier wirkungslos, es wird immer *)
(* genau ein 128 Byte-Block uebertragen. *)
(* *)
(* procedure BlockRead(var f : NoTypeFile; var Block : TBlock; *)
(* Dummy : integer); *)
(* *)
(* var w, i : integer; *)
(* *)
(* begin *)
(* for i := 1 to 64 do *)
(* if not eof(f) then begin *)
(* read(f,w); *)
(* Block[2*i-1] := chr(lo(w)); *)
(* Block[2*i] := chr(hi(w)) *)
(* end *)
(* else begin *)
(* Block[2*i-1] := chr(0); *)
(* Block[2*i] := chr(0) *)
(* end *)
(* end; *)
(*=======================================================================*)
BEGIN
ClrScr;
(* Datei erfragen *)
WriteLn(INV_EIN,'XMODEM Datei Senden',INV_AUS);
WriteLn;
Fehler := TRUE;
REPEAT
Write(' Dateiname ? (Abbruch mit leerer Eingabe) : ');
ReadLn(Name);
IF Length(Name) > 0 THEN BEGIN
Assign(f,Name);
(*$I-*)
ReSet (f);
(*$I+*)
Fehler := IOFehler
END
UNTIL (NOT Fehler) OR (Length(Name) = 0);
(* Uebertragung der Daten *)
IF NOT Fehler THEN BEGIN
WriteLn;
WriteLn(' WARTEN auf Initial Not-Acknowledge (Ready-Signal)');
REPEAT
Zeichen := XM_Warte_auf_Zeichen
UNTIL Zeichen IN [NAK,CAN];
IF Zeichen = CAN THEN
WriteLn(BELL,INV_EIN,' Uebertragung wurde abgebrochen !',INV_AUS)
ELSE BEGIN
(* Uebertragung *)
BlockRead(f,Block,1);
ErrorCounter := 0;
BlockNr := 1;
EndFlag := FALSE;
WHILE (NOT EndFlag) AND (ErrorCounter < 10) DO BEGIN
EndFlag := Eof(f);
Nr := Lo(BlockNr);
WriteLn;
WriteLn(' BLOCK ',BlockNr,' wird gerade gesendet. ');
Sende_Zeichen(SOH); (* Start of Header *)
Sende_Zeichen(Chr(Nr)); (* Blocknummer senden *)
Sende_Zeichen(Chr(255 - Nr)); (* Komplement senden *)
(* Datenuebertragung *)
PruefSum := 0;
FOR i := 1 TO 128 DO BEGIN (* 128 Datenbytes senden *)
Sende_Zeichen(Block[i]);
PruefSum := PruefSum + Ord(Block[i]) (* Pruefsumme errechnen *)
END;
Sende_Zeichen(Chr(Lo(PruefSum))); (* Pruefsumme senden *)
(* Auf Antwort warten und reagieren *)
Zeichen := XM_Warte_auf_Zeichen;
IF Zeichen = CAN THEN BEGIN (* abgebrochen *)
WriteLn(INV_EIN,' UEBERTRAGUNG ABGEBROCHEN ',INV_EIN);
GOTO Exit
END;
IF Zeichen = ACK THEN BEGIN (* alles klar *)
WriteLn(' Achnowledge (Empfangsbestaetigung) fuer Block ',
BlockNr:5,' erhalten. ');
(* Naechsten Block von Massenspeicher lesen *)
IF NOT EndFlag THEN BEGIN
BlockRead(f,Block,1);
IF IOFehler THEN (* Katastrophe auf der Diskette *)
GOTO Exit;
BlockNr := Succ(BlockNr)
END;
ErrorCounter := 0;
END
ELSE BEGIN
ErrorCounter := Succ(ErrorCounter);
WriteLn(BELL,INV_EIN,
' Not Acknowledge (Fehlermeldung) fuer Block ',BlockNr:5,
' erhalten ! ',INV_AUS)
END
END
END;
IF ErrorCounter >= 10 THEN (* Abbrechen, bringt nicht's mehr *)
Sende_Zeichen(CAN)
ELSE (* Alles in Butter *)
Sende_Zeichen(EOT);
(*$I-*)
Close(f);
(*$I+*)
Fehler := IOFehler (* Close ist hoffentlich gutgegangen *)
END;
Exit: (* "Notausgang" *)
END;
(*---------------------- XModem empfangen -----------------------------------*)
(* *)
OVERLAY PROCEDURE XModem_Empfangen;
(* HINWEIS : Es muss genug Platz auf der Diskette zum sichern der Datei *)
(* sein, da Fehler aufgrund voller Diskette nicht abgefangen *)
(* werden. *)
TYPE TBlock = ARRAY[1..128] OF CHAR;
(*========================================================================*)
(* VORSCHLAG FUER TYPENDEFINITION, falls man BlockWrite *)
(* und -Read selber implementieren muss (siehe Begleitartikel). *)
(* TYPE NoTypeFile = FILE OF INTEGER; *)
(* Ist am ehesten geeignet um verschiedene Dateitypen zu lesen. *)
(*========================================================================*)
VAR Zeichen, merke_BlNr,
Dummy : CHAR;
PruefSum, BlockNummer,
BlNr, ErrorCount, Grund : INTEGER;
Name : STRING[16];
Block : TBlock;
ErrorFlag, Fehler : BOOLEAN;
f : FILE;
(* Fuer Eigenimplementation von BlockRead/-Write --> f : NoTypeFile; *)
(*=========== IMPLEMENTATIONSVORSCHLAG BlockWrite ====================*)
(* Analog BlockRead (s.o.) *)
(* *)
(* procedure BlockWrite(var f : NoTypeFile; Block : TBlock; *)
(* Dummy : integer); *)
(* *)
(* var w, i : integer; *)
(* *)
(* begin *)
(* for i := 1 to 64 do begin *)
(* w := ord(Block[2*i-1]) + 256*ord(Block[2*i]); *)
(* write(f,w) *)
(* end *)
(* end; *)
(*====================================================================*)
BEGIN
ClrScr;
ErrorFlag := FALSE;
ErrorCount := 0;
BlockNummer := 1;
(* Dateiname erfragen *)
WriteLn(INV_EIN,'XMODEM Datei Empfangen',INV_AUS);
WriteLn;
Fehler := TRUE;
REPEAT
Write(' Dateiname (Abbruch mit leerer Eingabe): ');
ReadLn(Name);
IF Length(Name) > 0 THEN BEGIN
Assign(f,Name);
(*$I-*)
ReWrite(f);
(*$I+*)
Fehler := IOFehler
END
UNTIL (NOT Fehler) OR (Length(Name) = 0);
(* Uebertragung *)
IF NOT Fehler THEN BEGIN
WriteLn(' Starten sie bitte die Uebertragung mit Tastendruck');
REPEAT UNTIL KeyPressed; (* Tastendruck abwarten *)
WriteLn;
ClearKeyBuf;
BlNr := BlockNummer; (* BlNr ist die Blocknummer modulo 255 *)
Sende_Zeichen(NAK); (* Initial Not Acknowlege senden *)
WriteLn(' Warten auf Blockanfang/Uebertragungsende');
REPEAT (* abwarten *)
Zeichen := XM_Warte_auf_Zeichen;
UNTIL Zeichen IN [CAN,SOH,EOT];
IF Zeichen IN [CAN,EOT] THEN
WriteLn(INV_EIN,BELL,' Uebertragung wurde abgebrochen ! ',INV_AUS)
ELSE BEGIN (* Empfangen kann losgehen *)
(** Anfang Uebertragunsgschleife *)
REPEAT
Zeichen := XM_Warte_auf_Zeichen; (* Blocknummer holen und in *)
merke_BlNr := Zeichen; (* merke_BlNr merken *)
(* Die drei Fehlerfaelle ueberpruefen *)
IF Ord(Zeichen) <> BlNr THEN BEGIN (* Falsche Blocknummer *)
ErrorFlag := TRUE;
Grund := 1
END;
IF NOT ErrorFlag THEN BEGIN
Zeichen := XM_Warte_auf_Zeichen;
IF Ord(Zeichen) <> 255 - BlNr THEN BEGIN (* Falsches Komplement *)
ErrorFlag := TRUE;
Grund := 2
END;
IF NOT ErrorFlag THEN BEGIN
(* 128 Datenbytes in Block einlesen und die Pruefsumme bilden *)
PruefSum := 0;
i := 0;
REPEAT
Zeichen := XM_Warte_auf_Zeichen;
i := Succ(i);
PruefSum := PruefSum + Ord(Zeichen);
Block[i] := Zeichen;
UNTIL i = 128;
PruefSum := Lo(PruefSum); (* Pruefsumme berechnen *)
Zeichen := XM_Warte_auf_Zeichen; (* Pruefsumme empfangen und *)
IF Zeichen <> Chr(PruefSum) THEN BEGIN (* vergleichen *)
ErrorFlag := TRUE;
Grund := 3
END
END
END;
(* Im Fehlerfall die Schnittstelle "saeubern" *)
IF ErrorFlag THEN BEGIN
Delay(40);
WHILE InpStatus DO BEGIN
Dummy := InpSIO;
IF NOT InpStatus THEN Delay(40) (* 40 millisec warten *)
END
END;
(* Speichern der Daten *)
IF NOT ErrorFlag THEN BEGIN
BlockNummer := Succ(BlockNummer);
BlNr := Lo(BlockNummer);
IF merke_BlNr = Chr(Pred(BlNr)) THEN
BlockWrite(f,Block,1);
ErrorCount := 0;
WriteLn('Block ',Pred(BlockNummer):5,' richtig empfangen !');
Sende_Zeichen(ACK);
END
ELSE BEGIN (* Sonst Fehlermeldung *)
ErrorFlag := FALSE;
ErrorCount := Succ(ErrorCount);
WriteLn(BELL,' Block ',BlockNummer:5,' zum ',ErrorCount:2,
' mal falsch empfangen !');
Write(' GRUND : ');
CASE Grund OF
1 : WriteLn ('Blocknummer falsch !');
2 : WriteLn ('Blocknummerkomplement falsch !');
3 : WriteLn ('Pruefsumme falsch !')
END;
Sende_Zeichen(NAK) (* schiefgegangen *)
END;
IF ErrorCount < 10 THEN BEGIN (* Wenn kein Abbruch *)
WriteLn(' Warten auf Blockanfang/Uebertragungsende ');
REPEAT
Zeichen := XM_Warte_auf_Zeichen; (* Erste Zeichen des *)
UNTIL Zeichen IN [CAN,SOH,EOT] (* naechsten Block *)
END
UNTIL (Zeichen IN [CAN,EOT]) OR (ErrorCount >= 10);
(** Ende Uebertragunsschleife **)
IF (ErrorCount >= 10) OR (Zeichen = CAN) THEN
WriteLn(INV_EIN,BELL,
' !!! UEBERTRAGUNG FEHLERHAFT ABGEBROCHEN !!!',INV_AUS);
IF (ErrorCount >= 10) AND (Zeichen <> CAN) THEN
(* Versuchen ein CAN abzusetzen *)
FOR i := 1 TO 10 DO (* 10 mal anklopfen *)
IF OutStatus THEN
Sende_Zeichen(CAN)
ELSE (* Sitzen die auf den Ohren ?! *)
Delay(40);
IF Zeichen = EOT THEN (* O.K. -- Feierabend *)
Sende_Zeichen(ACK);
(*$I-*)
Close(f);
(*$I-*)
Fehler := IOFehler (* Close ist hoffentlich gutgegangen *)
END
END
END;
(*-------------------------------------------------------------------------*)
(* Ende DFXM.INC *)