program StripHTML; uses ColWrite,LinStat,Crt; const StripBegin='<'; StripEnd='>'; var OutF, InF: text; OutFN, InFN: string; choice: char; OutFM: byte; tmp: string; procedure Abort(errmsg: string); begin Wcheck('%%140#fail'); WriteLn; if errmsg<>'HELP' then begin TextColor(12+blink); Write('FEHLER: '); TextColor(12); WriteLn(errmsg); end; TextColor(15); WriteLn; WriteLn('Syntax: ',ParamStr(0),' '); TextColor(7); WriteLn; WriteLn(' ist der Dateiname OHNE ENDUNG. Die Eingabedatei muá auf .HTM'); WriteLn('enden und die Ausgabedatei wird auf .TXT enden.'); WriteLn; CWrite('Beispiel: %%15#'); Write(ParamStr(0)); CWriteLn(' CHATLOG%%7#'); WriteLn; WriteLn(' Entfernt alle HTML-Tags aus CHATLOG.HTM und speichert das Ergebnis'); WriteLn(' in der Datei CHATLOG.TXT.'); Halt; end; procedure FileIError(EC: integer); begin Wcheck('%%140#fail'); WriteLn; TextColor(12); WriteLn('Der Fehler ',EC,' trat w„hrend des Versuches, die Datei ''',InFN,''' zu'); WriteLn('”ffnen, auf.'); WriteLn; CWriteLn('%%7#M”gliche Fehlerursachen: ùDateiname/Pfadangabe falsch geschrieben'); WriteLn(' ùDatei wird gerade von anderer Anwendung benutzt'); WriteLn(' ùkurzer Dateiname entspricht nicht den Anfangs-'); WriteLn(' buchstaben des LFNs'); WriteLn(' ùDatei befindet sich nicht im aktuellen Verzeichnis'); WriteLn; CWriteLn('%%14#-=+ Bitte drcken Sie eine Taste +=-'); TextColor(8); ReadKey; Halt; end; procedure Init; begin ClrScr; CWriteLn('%%14,1# -=+ StripHTML +=- %%7,0#'); WriteLn; WStat('Parameter testen'); if ParamCount=0 then Abort('HELP'); if ((ParamStr(1)='/?') OR (ParamStr(1)='-?')) then Abort('HELP'); if ParamCount>1 then Abort('Zu viele Parameter angegeben - nur 1 ben”tigt!'); Wcheck('%%10# OK '); WStat('Vervollst„ndige Dateinamen'); OutFN := ParamStr(1)+'.txt'; InFN := ParamStr(1)+'.htm'; Wcheck('%%10# OK '); WStat('Dateivariablen zuweisen'); Assign(InF,InFN); Assign(OutF,OutFN); Wcheck('%%10# OK '); WStat('Prfe Eingabedatei'); {$I-} Reset(InF); {$I+} if IOResult<>0 then FileIError(IOResult); Close(InF); Wcheck('%%10# OK '); WStat('Prfe Ausgabedatei'); {$I-} Reset(OutF); {$I+} if IOResult=0 then begin Wcheck('%%14#WARN'); Close(OutF); WriteLn; CWriteLn('%%12#Die Ausgabedatei existiert schon!%%7#'); WriteLn('M”chten Sie die Ausgabedatei [U]eberschreiben, die neuen Daten'); Write('an sie [A]nh„ngen oder den Vorgang a[b]brechen (U/A/b) ? '); choice := ReadKey; Window(1,8,80,11); ClrScr; Window(1,1,80,25); GotoXY(1,8); case choice of 'a','A': OutFM := 1; 'u','U': OutFM := 2; 'b','B': begin WriteLn; WriteLn('Bitte geben Sie eine andere Datei an, oder bennen die momentane um.'); Halt; end; end; end else begin Wcheck('%%10# OK '); end; end; procedure OpenIO; begin WStat('Eingabedatei ”ffnen'); Reset(InF); Wcheck('%%10# OK '); WStat('Ausgabedatei ”ffnen'); case OutFM of 1: begin Append(OutF); Wcheck('%%14#APPD'); end; 2: begin Rewrite(OutF); Wcheck('%%12#DELE'); end; 0: begin Rewrite(OutF); Wcheck('%%10# OK '); end; end; end; procedure CloseIO; begin WStat('Eingabedatei schlieáen'); Close(InF); Wcheck('%%10# OK '); WStat('Ausgabedatei schlieáen'); Close(OutF); Wcheck('%%10# OK '); end; procedure Strip(var tmp: string); var i,j: integer; last: integer; temp: string; begin temp := ''; last := 1; for i:=1 to Length(tmp) do begin if Copy(tmp,i,1)=StripBegin then begin temp:=temp+Copy(tmp,last,i-last); for j:=i to Length(tmp) do begin if Copy(tmp,j,1)=StripEnd then begin last := j+1; break; end; end; end; end; temp := temp+Copy(tmp,last,Length(tmp)-last+1); tmp := temp; end; begin Init; OpenIO; WStat('Entferne Daten zwischen '''+StripBegin+''' und '''+StripEnd+''''); while NOT Eof(InF) do begin ReadLn(InF,tmp); Strip(tmp); WriteLn(OutF,tmp); end; Wcheck('%%10# OK '); CloseIO; end.