{ ------------------------------------------------------------------------- ------------------- Programmname : Bestätigung Version 1.3 ------------- ------------------- Autor : Peter Steves ------------- ------------------- Demonstriert die Behandlung Z-Netz - ------------- ------------------- kompatibler Pufferdateien mit Hilfe der ------------- ------------------- Z-Netz-Unit. ------------- ------------------------------------------------------------------------- ------------------- Alle Rechte Vorbehalten. ------------- ------------------- (c) 1992 Peter Steves. ------------- -------------------------------------------------------------------------} PROGRAM BackWrite; USES Z_Netz; {$ Opt b- } {Compileroption b- = keine Unterbrechung} {$incl "libraries/dos.h"} { Wird für SEEK() benötigt. s.u.} TYPE p_Liste = ^Liste; { Es gibt innerhalb des Z-Netzes die} Liste = RECORD { Möglichkeit, PMs verschlüsselt zu } Folge: STRING; { Verschicken. Zur Kennzeichnung der} Next : p_Liste; { Codierung wird eine bestimmte Zeichen-} END; { folge vor den Betreff gehängt. } { Das rogramm bietet die möglichkeit auch solche PMs zu bestätigen. Dazu müssen dann aber die Zeichenfolgen bekannt, in einer Datei gespeichert sein. Die eingetragenen Kürzel werden in eine Liste eingelesen, die auf diesem Typ aufbaut.} VAR Eingabe,Ausgabe : PUFFER; { Ein- und Ausgabedatei} erster_Listenpunkt : p_Liste;{ Zeiher auf den ersten Listenpunkt. s.o.} Neu_Header , { Headerrecords aus der Z-Netz-Unit. Zum} Header : Z_Header; { einlesen und bearbeiten der Nachrict} TempMsg : PUFFER; { Hilfsdatei zum Ermitteln EB Länge} Gefunden : INTEGER; { Zählvariable : Gefundene EBs} MsgTxt , { Hilfsvariable für DOS-Output} BoxName : STRING; { Name der Mailbox} Err,Länge : INTEGER; { Err: Fürs Dos Länge:Verschiedenes} FUNCTION Parameter(Nummer: INTEGER) : STRING; { Diese Funktion ermittelt den Parameter mit der Angegebenen Nummer. Sehr nützlich! Wer will kann sie weiterverwenden. Übrigens funktioniert die Funktion sowohl aus der Entwicklungsumgebung, als auch aus der Shell.} VAR Backup: STRING; { Hiermit wird eine Kopie von ParameterStr erzeugt} Zaehler : INTEGER;{ Wie der Name schon sagt ... 1.2.3.4 .. GÄHN ... } BEGIN Backup:=ParameterStr; IF POS(#10,Backup)<>0 THEN Backup[Pos(#10,Backup)]:=#0; { Aus der Shell heraus endet ParameterSTr mit #10 Pascall brauch an der Stelle #0 also ersetzen.} Backup:=Backup+" "; {Am Ende muß ein Leerzeichen sein.} WHILE Backup[1]=" " DO DELETE (Backup,1,1); { Am Abfang darf keins sein.} FOR Zaehler:=1 TO Nummer-1 DO DELETE (Backup,1,POS(" ",Backup)); {Eigentlich einfach oder? Es wird solange der vorderste Parameter gelöscht wie Parameter vor dem gewünschten stehen.} IF POS(" ",Backup)=0 THEN Parameter:=Backup { Wenn der gewünschte Parameter der letzte ist, dann ist auch kein Leerzeichen mehr da ...} ELSE Parameter:=COPY(Backup,1,Pos(" ",Backup)-1); {Ansonsten muß man den Parameter halt rausschneiden.} END; PROCEDURE Öffnen(VAR Erster_Folge : p_Liste; VAR Eingabe,Ausgabe : PUFFER); { Öffnet die Puffer und liest die Liste für die Anfangs- buchstaben im Betreff ein.} VAR Datei : TEXT; Alt,Neu : p_Liste; Hilfe , ERRTXT : STRING; BEGIN BoxName:=Parameter(1); { Ich welcher Box ist der User? } {$I-} Hilfe:=Parameter(2); Assign (Eingabe,Hilfe); Reset (Eingabe); {$I+} Errtxt:="Konnte Eingabepuffer `"+Hilfe+"` nicht finden"; IF IOResult<>0 THEN ERROR (errtxt); IF FileSize(Eingabe)<20 THEN ERROR ("EingabePuffer leer!"); Buffer(Eingabe,2048); { Tja - Der Eingangspuffer wird geöffnet. und mit einem Pufferspeicher von 2048 Bytes versort. (Wenn es ihn gibt und er nicht leer ist} {$I-} Hilfe:=Parameter(3); Assign (Ausgabe,Hilfe); Rewrite (Ausgabe); {$I+} Errtxt:="Konnte Ausgabepuffer `"+Hilfe+"` nicht finden"; IF IOResult<>0 THEN ERROR (errtxt); Buffer (Ausgabe,512); { Ausgabe öffnen. Das ists. Außerdem einen kleinen Pufferspeicher.} {$I-} RESET (Datei,"S:Rewrite.dat"); {$I+} Erster_Folge:=NIL; IF IOResult=0 THEN BEGIN IF FileSize(Datei)>0 THEN BEGIN NEW (Neu); ReadLn (Datei,Neu^.Folge); Erster_Folge:=Neu; Alt:=Neu; While FileSize(datei)>FilePos(datei) DO BEGIN NEW (Neu); Neu^.next:=Alt; ReadLn(Datei,Neu^.Folge); Alt:=Neu; END; END ; Close(Datei); END ; { Ich HASSE es jemanden das erzeugen einer Liste zu erklären. Mr.B* ist außerdem der beste Beweis dafür, daß ich es nicht gut erklären kann. Außerdem sind Listen was für C. Kurz und gut : Keine Erklärung hier. Es wird halt die Liste mit den Code-Betreffs eingelesen. THATS IT } { * name von der Redaktion geändert?} END; PROCEDURE WriteMsg(VAR Datei : PUFFER); VAR Z : INTEGER; Nachricht : STRING; BEGIN Nachricht:=Copy(Header.Datum,5,2)+"."; Nachricht:=Nachricht+Copy(Header.Datum,3,2)+"."; Nachricht:=Nachricht+Copy(Header.Datum,1,2); WriteCrLf (Datei,"Empfangsbestaetigung V1.1 (c) P. Steves 1992"); WriteCrLf (Datei,""); WriteCrLf (Datei,CONCAT("Ihre Nachricht vom ",Nachricht," mit dem Betreff")); WriteCrLf (Datei,Header.Betreff); WriteCrLf (Datei,CONCAT("ist beim Empfaenger ",Header.Empfänger+"@"+Boxname," angekommen!")); WriteCrLf (Datei,""); END; { Diese Procedure benutzt die Headerdaten, um eine Empfangsbestätigung in eine Datei zu schreiben. Man beachte WriteCrLf. Das einzig Interessante ist das zerlegen des Datumsstrings. } FUNCTION Antwort_gefordert(Betreff : STRING;Liste : p_Liste) : BOOLEAN; { Diese Funktion prüft, ob bei der übergebenen Nachricht eine EB verlangt wird. } VAR Code : p_Liste; { Dieser Zeiger Hangelt sich durch die Liste } BEGIN Code :=Liste; {Suchzeiger auf Listenkopf setzen.} Antwort_gefordert:=FALSE;{Man weis ja noch nicht genau ... } IF Header.Empfänger[1]<>"/" THEN BEGIN { Die erste Begingung. Einfach, kurz und Schmerzlos. PMs mit einem / am Empfängeranfang sind selten. PMs ohne @BOX habe ich aber schon gehabt. PMs wie /Aktiv-Treff/Zurbox/Diskurs@TREFF.ZER werden also nie bestätigt. } WHILE Code<>NIL DO {Liste durchhangeln. } BEGIN IF COPY(Betreff,1,Length(Code^.Folge))=Code^.Folge THEN Betreff:=Copy (Betreff,Length(Code^.Folge)+1,Length(Betreff)); { Wenn die Anfangsbuchstaben des Betreffs mit dem kürzel des bearbeiteten Listenpunktes , übereinstimmen, dann wird dieser Teil des Betreffs abgeschnitten.} Code:=Code^.Next; {Und auf jeden Fall wird der nächste Listenpunkt angegangen. Erst wenn Code^.Next=NIL ist, es also kein weiteres Element gibt, ist es vollbracht.} END; IF Copy (Betreff,1,2)="##" THEN Antwort_gefordert:=True; { Tjö. Fängt der Betreff nun mit ## an? Na dann solls bestätigt werden. Also Fkt -> TRUE!} END; END; BEGIN Öffnen (erster_Listenpunkt,Eingabe,Ausgabe); {Dateien öffnen} Gefunden:=0; { EBZähler auf 0} For Länge:=1 to Length(Boxname) DO Boxname[Länge]:=UpCase(Boxname[Länge]); { Boxname in Großbuchstaben wandeln. Geht das auch einfacher? Ich habe nur UpCase für einzelne Zeichen gefunden.} MsgTxt:="Bestätigung V1.3 © by P.Steves 1992"#10#10; err:=DosWrite(DosOutPut,^MsgTxt,length(MsgTxt)); MsgTxt:="Geschrieben in Kick-pascal 2.0 von MAXON Computer"#10#10; err:=DosWrite(DosOutPut,^MsgTxt,length(MsgTxt)); MsgTxt:="(Dieser Text muß laut Handbuch da stehen und gibt "#10; err:=DosWrite(DosOutPut,^MsgTxt,length(MsgTxt)); MsgTxt:="in keinerlei Weise meine persönliche Meinung "#10; err:=DosWrite(DosOutPut,^MsgTxt,length(MsgTxt)); MsgTxt:="zu diesem Produkt wieder)"#10; err:=DosWrite(DosOutPut,^MsgTxt,length(MsgTxt)); MsgTxt:=#10#10#10#10; err:=DosWrite(DosOutPut,^MsgTxt,length(MsgTxt)); { Bei der Programmierung gab es immer wieder Probleme mit WriteLn! Aus der Entwicklungsumgebung lief das Programm wunderbar. Aus dem Shell gar nicht. Es gab immer wieder den Fehler File not open! Obwohl ich die gleichen Parameter verwendet habe. Nach langem Suchen fand ich hraus, das KP nicht etwa bei einer Dateioperation, sondern beim 2. oder 2. WriteLn auf die Standartausgabe diesen Fehler meldet!!!!! Also verwende ich für Bildschirmausgaben das entsprechende Doskommando. Zum Testen sollte das man KP von der Shell aus Starten. Denn dorthin gehen dann die Ausgben. Wo die beim WBStart hingehen? KEINE AHNUNG. Anscheinend wird dabei aber auf die Platte geschrieben. Außerdem besteht absturzgefahr. (Will jemand wissen, wie oft zuerst auf die Platte geschrieben wurde und dann der Computer abschmierte? Seit ich KP habe, hab ich immer ein aktuelles Backup. Fast immer. naja immer wenn ich es nicht bauche.} REPEAT CBreak; { Damit man auch abbrechen kann .} GetHeader(Eingabe,Header); { Header aus der Originaldatei lesen.} Seek (Eingabe,FilePos(Eingabe)+Header.Länge); { Eigentliche Nachricht überspringen.} IF Antwort_Gefordert(Header.Betreff,erster_Listenpunkt) THEN BEGIN Rewrite (TempMsg,"t:TempMsg"); WriteMsg(TempMsg); Close (TempMsg); Reset (TempMsg,"t:TempMsg"); IF (Copy(Header.Absender,Pos("@",Header.Absender)+1,Length(Header.Absender)-(Pos("@",Header.Absender))))=BoxName THEN Header.Absender:=COPY (Header.Absender,1,POS("@",Header.Absender)-1); neu_Header:=Header; { Wenn eine Antwort gefordert ist (siehe Fkt.) wird zunächst eine Temporäre Datei mit der EB erzeugt, um herauszufinden, wie lang sie ist. Dann wird eine kopie des Headers erzeugt. Diese Kopie wird wie folgt zum Header der EB umgestrickt ... } WITH Neu_Header DO BEGIN Exchange (Empfänger,Absender); Betreff:=CONCAT("Empfangsbestaetigung:",MsgID); Datum:=DateString; Pfad:=""; MsgID:=Msg_ID("s:Zähler",CONCAT(Absender,"@",COPY(boxname,1,POS(".zer",boxname)-1))); Typ:="T"; Länge:=FileSize(TempMsg); END; PutHeader(Ausgabe,Neu_Header); { ... und in den Ausgabepuffer geschrieben.} WriteMsg(Ausgabe); {Dann wird die eigentliche EB drangehängt} Close(TempMsg); { Und die Temporäger Datei geschlossen} err:=DeleteFile("t:tempmsg"); INC (Gefunden); { Achja - der Zähler für die Anzeige.} END; MsgTxt:="Durchsuche "+IntStr(FilePos(Eingabe)); MsgTxt:=MsgTxt+" aus "+IntStr(FileSize(Eingabe)); MsgTxt:=MsgTxt+" Gefunden "+IntStr(gefunden); MsgTxt:=MsgTxt+#13; { Und der Progress - Indikator. Da nur #13 geschrieben wirdm bleibt der CUsor in der Zeil.} err:=DosWrite (DosOutPut,^MsgTxt,Length(MsgTxt)); UNTIL FileSize(Eingabe)<=FilePos(Eingabe); { Mit EOF gabs schonmal Probleme. Warum weis ich nicht. So geht aber auf jeden Fall.} Close (Eingabe); Close (Ausgabe); { Dateien schließen } err:=DeleteFile ("t:TempMsg"); { Eventuelles Temporäres File löschen.} END.