Entwickler-Ecke :: Thema anzeigen - HTML-Unit Sinnvoll ?

Kokel - Mi 28.09.05 22:04
Titel: HTML-Unit Sinnvoll ?

Ich habe hier mal folgendes Programmiert:

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:

unit html;

interface
Uses classes, sysutils;
function  HTMLText(v:string):string;// Übersetzt einen String in einen HTML- String
procedure HTMLNeu(Dateiname,titel:string);
procedure HTMLzu;

implementation
var 
Datei: TextFile;

procedure HTMLNeu(Dateiname,titel:string);
var s:string;
begin
  AssignFile(Datei,Dateiname+'.html');
  Rewrite(Datei);
  WriteLn(Datei,'<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN"');
  WriteLn(Datei,'"http://www.w3.org/TR/html4/loose.dtd">');
  WriteLn(Datei,'<HTML>');
  WriteLn(Datei,'<HEAD>');
  WriteLn(Datei,'<TITLE>'+titel+'</TITLE>');
  WriteLn(Datei,'</HEAD>');
end;

procedure HTMLzu;
begin
  WriteLn(Datei,'</P>');
  WriteLn(Datei);
  WriteLn(Datei,'</BODY>');
  WriteLn(Datei,'</HTML>');
  CloseFile(Datei);
end;
// Übersetzt einen String in einen HTML- String
function  HTMLText(v:string):string;
var f:integer;
    ve:string;
begin
  result:='';
  for f:=1 to length(v) do begin
    ve:=v[f];
    // benannte HTML - Zeichen
    if v[f]='<' then ve:='<';
    if v[f]='>' then ve:='>';
    if v[f]='&' then ve:='&';
    if v[f]='"' then ve:='"';
    // Benannte Zeichen für Umlaute und scharfes s den Zeichensatz ISO 8859-1
    if v[f]='Ä' then ve:='Ä';
    if v[f]='Ö' then ve:='Ö';
    if v[f]='Ü' then ve:='Ü';
    if v[f]='ä' then ve:='ä';
    if v[f]='ö' then ve:='ö';
    if v[f]='ü' then ve:='ü';
    if v[f]='ß' then ve:='ß';
  // Mathematische Zeichen
    if v[f]='µ' then ve:='µ';
    if v[f]='°' then ve:='°';
    if v[f]='±' then ve:='±';
    if v[f]='-' then ve:='−';
    if v[f]='˜' then ve:='≈';
    if v[f]='¹' then ve:='¹';
    if v[f]='²' then ve:='²';
    if v[f]='³' then ve:='³';
    if v[f]='¼' then ve:='¼';
    if v[f]='½' then ve:='½';
    if v[f]='¾' then ve:='¾';
    if v[f]='Ø' then ve:='Ø';
    if v[f]='÷' then ve:='÷';
    if v[f]='ø' then ve:='ø';
    if v[f]='‰' then ve:='‰';
    if v[f]='''' then ve:='′';
    // Rechtliche Zeichen
    if v[f]='§' then ve:='§';
    if v[f]='©' then ve:='©';
    if v[f]='®' then ve:='®';
    if v[f]='™' then ve:='™';
    // Andere zeichen
    if v[f]='€' then ve:='€';
    if v[f]='é' then ve:='é';
    if v[f]='è' then ve:='è';
    if v[f]='ê' then ve:='ê';
    if v[f]='â' then ve:='â';
    if v[f]='à' then ve:='à';
    if v[f]='á' then ve:='á';
    if v[f]='û' then ve:='û';
    if v[f]='ú' then ve:='ú';
    if v[f]='ù' then ve:='ù';
    if v[f]='ô' then ve:='ô';
    if v[f]='É' then ve:='É';
    if v[f]='È' then ve:='È';
    if v[f]='Ê' then ve:='Ê';
    if v[f]='Â' then ve:='Â';
    if v[f]='À' then ve:='À';
    if v[f]='Á' then ve:='Á';
    if v[f]='Û' then ve:='Û';
    if v[f]='Ú' then ve:='Ú';
    if v[f]='Ù' then ve:='Ù';
    if v[f]='Ô' then ve:='Ô';
    if v[f]='¡' then ve:='¡';
    if v[f]='¢' then ve:='¢';
    if v[f]='£' then ve:='£';
    if v[f]='¤' then ve:='¤';
    if v[f]='¥' then ve:='¥';
    if v[f]='¦' then ve:='¦';
    if v[f]='¨' then ve:='¨';
    if v[f]='ª' then ve:='ª';
    if v[f]='«' then ve:='«';
    if v[f]='¬' then ve:='¬';
    if v[f]='' then ve:='';
    if v[f]='¯' then ve:='¯';
    if v[f]='´' then ve:='´';
    if v[f]='¶' then ve:='¶';
    if v[f]='·' then ve:='·';
    if v[f]='¸' then ve:='¸';
    if v[f]='»' then ve:='»';
    if v[f]='¿' then ve:='¿';
    if v[f]='Ã' then ve:='Ã';
    if v[f]='Ä' then ve:='Ä';
    if v[f]='Å' then ve:='Å';
    if v[f]='Æ' then ve:='Æ';
    if v[f]='Ç' then ve:='Ç';
    if v[f]='Ë' then ve:='Ë';
    if v[f]='Ì' then ve:='Ì';
    if v[f]='Í' then ve:='Í';
    if v[f]='Î' then ve:='Î';
    if v[f]='Ï' then ve:='Ï';
    if v[f]='Ð' then ve:='Ð';
    if v[f]='Ñ' then ve:='Ñ';
    if v[f]='Ò' then ve:='Ò';
    if v[f]='Ó' then ve:='Ó';
    if v[f]='Õ' then ve:='Õ';
    if v[f]='×' then ve:='×';
    if v[f]='Ý' then ve:='Ý';
    if v[f]='Þ' then ve:='Þ';
    if v[f]='ã' then ve:='ã';
    if v[f]='å' then ve:='å';
    if v[f]='æ' then ve:='æ';
    if v[f]='ç' then ve:='ç';
    if v[f]='ë' then ve:='ë';
    if v[f]='ì' then ve:='ì';
    if v[f]='í' then ve:='í';
    if v[f]='î' then ve:='î';
    if v[f]='ï' then ve:='ï';
    if v[f]='ð' then ve:='ð';
    if v[f]='ñ' then ve:='ñ';
    if v[f]='ò' then ve:='ò';
    if v[f]='ó' then ve:='ó';
    if v[f]='õ' then ve:='õ';
    if v[f]='ý' then ve:='ý';
    if v[f]='þ' then ve:='þ';
    if v[f]='ÿ' then ve:='ÿ';
    if v[f]='„' then ve:='„';
    result:=result+ve;
  end;
end;
end.

Soweit so gut. Das soll also eine Unit werden die mir die Arbeit mit den HTML- Seiten erleichtern soll. Diese Unit funktioniert auch.
Da ich zur Zeit an einer größerden Internetseite arbeite werde ich diese wohl brauchen. Jedenfalls die function HTMLtext ist okay. Bei den anderen sachen komme ich so ins grübeln. :gruebel:
Denn ich hatte schon mal so ein ähnlich großes Projekt welches ich mit dem Programm "Shopbuilder" lösen konnte. Dort konnte man mittels sogenannten "Templates" ein Design erstellen und von der, wohl in Delphi geschriebenen , Datenbank füllen lassen.Nun möchte ich aber keinen online shop sondern ein individuell angepasstes System erstellen.

Da meine Internetseite aus 250 Einzelseiten besteht , und ich da ca. 2500 Links von Hand Verknüpfen mußte und es sich dabei erst um ca 12% des Gesamtvolumens handelt benötige ich eine Datenbank. Zur Zeit habe ich die Seite provisorisch mit Netobject ins Netz gestellt. (wegen der Zugriffe) Aber allein schon bei den Verknüpfungen (Nach 12 Stunden konnte ich gerade noch Mama sagen) ist mir klargeworden , dass ich so nicht weitermachen kann. Bei 2000 Einzelseiten dürften die Links dann prportional zunehmen (20.000 und mehr)Zumal ich gelesen und auch gemerkt habe (Absturtz von Netobject 10 Stunden platt) das man bei Netobjekt 7 Irgendwann an der Kapazitätsgrenze ist.

Aber nun wieder zur Unit. Muss ich das alles erfinden ? Gibt es nicht sowas schon ?
Bis vorgestern dachte ich noch ich müsste das.Aber dann bin ich auf die Indy Komponenten gestoßen.
Das wäre natürlich klasse , wenn ich das mit den Templates hinkriegen würde.
Ich bin da auch auf eine Komponente Namens "TPageProducer" gestoßen. Nur leider wird an dieser Stelle meine deutsche Version , englisch. Und das kann ich irgendwie nicht so gut. :oops:

Moderiert von Christian S.: Topic aus Delphi Language (Object-Pascal) / CLX verschoben am Mi 28.09.2005 um 22:28

retnyg - So 09.10.05 13:38

deine prozedur war furchtbar langsam, wegen der 1000 if's und der dauernden speicheralloziierung bei deinen stringoperationen, ich hab das mal etwas umgeschrieben und ne lookuptabelle erstellt.

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:
183:
184:
185:
186:
187:
188:
189:
190:
191:
192:
193:
194:
195:
196:
197:
198:
199:
200:
201:
202:
203:
204:
205:
206:
207:
208:
209:
210:
211:
212:
213:
214:
215:
216:
217:
218:
219:
220:
221:
222:
223:
224:
225:
226:
227:
228:
229:
230:
231:
232:
233:
234:
235:
236:
237:
238:
239:
240:
241:
242:
243:
244:
245:
246:
247:
248:
249:
250:
251:
252:
253:
254:
255:

function string2html(s:string):string;
type THTMLEntity = record
        html: string[8];
        len : integer;
     end;

CONST htmltab : array [32..255] of THTMLEntity = (
(html:' '; len:1),
(html:'!'; len:1),
(html:'"'; len:1),
(html:'#'; len:1),
(html:'$'; len:1),
(html:'%'; len:1),
(html:'&'; len:5),
(html:'′'; len:8),
(html:'('; len:1),
(html:')'; len:1),
(html:'*'; len:1),
(html:'+'; len:1),
(html:','; len:1),
(html:'−'; len:7),
(html:'.'; len:1),
(html:'/'; len:1),
(html:'0'; len:1),
(html:'1'; len:1),
(html:'2'; len:1),
(html:'3'; len:1),
(html:'4'; len:1),
(html:'5'; len:1),
(html:'6'; len:1),
(html:'7'; len:1),
(html:'8'; len:1),
(html:'9'; len:1),
(html:':'; len:1),
(html:';'; len:1),
(html:'<'; len:1),
(html:'='; len:1),
(html:'>'; len:1),
(html:'?'; len:1),
(html:'@'; len:1),
(html:'A'; len:1),
(html:'B'; len:1),
(html:'C'; len:1),
(html:'D'; len:1),
(html:'E'; len:1),
(html:'F'; len:1),
(html:'G'; len:1),
(html:'H'; len:1),
(html:'I'; len:1),
(html:'J'; len:1),
(html:'K'; len:1),
(html:'L'; len:1),
(html:'M'; len:1),
(html:'N'; len:1),
(html:'O'; len:1),
(html:'P'; len:1),
(html:'Q'; len:1),
(html:'R'; len:1),
(html:'S'; len:1),
(html:'T'; len:1),
(html:'U'; len:1),
(html:'V'; len:1),
(html:'W'; len:1),
(html:'X'; len:1),
(html:'Y'; len:1),
(html:'Z'; len:1),
(html:'['; len:1),
(html:'\'; len:1),
(html:']'; len:1),
(html:'^'; len:1),
(html:'_'; len:1),
(html:'`'; len:1),
(html:'a'; len:1),
(html:'b'; len:1),
(html:'c'; len:1),
(html:'d'; len:1),
(html:'e'; len:1),
(html:'f'; len:1),
(html:'g'; len:1),
(html:'h'; len:1),
(html:'i'; len:1),
(html:'j'; len:1),
(html:'k'; len:1),
(html:'l'; len:1),
(html:'m'; len:1),
(html:'n'; len:1),
(html:'o'; len:1),
(html:'p'; len:1),
(html:'q'; len:1),
(html:'r'; len:1),
(html:'s'; len:1),
(html:'t'; len:1),
(html:'u'; len:1),
(html:'v'; len:1),
(html:'w'; len:1),
(html:'x'; len:1),
(html:'y'; len:1),
(html:'z'; len:1),
(html:'{'; len:1),
(html:'|'; len:1),
(html:'}'; len:1),
(html:'~'; len:1),
(html:''; len:1),
(html:'€'; len:6),
(html:'�'; len:1),
(html:'‚'; len:1),
(html:'ƒ'; len:1),
(html:'„'; len:7),
(html:'…'; len:1),
(html:'†'; len:1),
(html:'‡'; len:1),
(html:'ˆ'; len:1),
(html:'‰'; len:8),
(html:'Š'; len:1),
(html:'‹'; len:1),
(html:'Œ'; len:1),
(html:'�'; len:1),
(html:'Ž'; len:1),
(html:'�'; len:1),
(html:'�'; len:1),
(html:'‘'; len:1),
(html:'’'; len:1),
(html:'“'; len:1),
(html:'”'; len:1),
(html:'•'; len:1),
(html:'–'; len:1),
(html:'—'; len:1),
(html:'≈'; len:7),
(html:'™'; len:7),
(html:'š'; len:1),
(html:'›'; len:1),
(html:'œ'; len:1),
(html:'�'; len:1),
(html:'ž'; len:1),
(html:'Ÿ'; len:1),
(html:' '; len:1),
(html:'¡'; len:7),
(html:'¢'; len:6),
(html:'£'; len:7),
(html:'¤'; len:8),
(html:'¥'; len:5),
(html:'¦'; len:8),
(html:'§'; len:6),
(html:'¨'; len:5),
(html:'©'; len:6),
(html:'ª'; len:6),
(html:'«'; len:7),
(html:'¬'; len:5),
(html:''; len:1),
(html:'®'; len:5),
(html:'¯'; len:6),
(html:'°'; len:5),
(html:'±'; len:8),
(html:'²'; len:6),
(html:'³'; len:6),
(html:'´'; len:7),
(html:'µ'; len:7),
(html:'¶'; len:6),
(html:'·'; len:8),
(html:'¸'; len:7),
(html:'¹'; len:6),
(html:'º'; len:1),
(html:'»'; len:7),
(html:'¼'; len:8),
(html:'½'; len:8),
(html:'¾'; len:8),
(html:'¿'; len:8),
(html:'À'; len:8),
(html:'Á'; len:8),
(html:'Â'; len:7),
(html:'Ã'; len:8),
(html:'Ä'; len:6),
(html:'Å'; len:7),
(html:'Æ'; len:7),
(html:'Ç'; len:8),
(html:'È'; len:8),
(html:'É'; len:8),
(html:'Ê'; len:7),
(html:'Ë'; len:6),
(html:'Ì'; len:8),
(html:'Í'; len:8),
(html:'Î'; len:7),
(html:'Ï'; len:6),
(html:'Ð'; len:5),
(html:'Ñ'; len:8),
(html:'Ò'; len:8),
(html:'Ó'; len:8),
(html:'Ô'; len:7),
(html:'Õ'; len:8),
(html:'Ö'; len:6),
(html:'×'; len:7),
(html:'Ø'; len:8),
(html:'Ù'; len:8),
(html:'Ú'; len:8),
(html:'Û'; len:7),
(html:'Ü'; len:6),
(html:'Ý'; len:8),
(html:'Þ'; len:6),
(html:'ß'; len:7),
(html:'à'; len:8),
(html:'á'; len:8),
(html:'â'; len:7),
(html:'ã'; len:8),
(html:'ä'; len:6),
(html:'å'; len:7),
(html:'æ'; len:7),
(html:'ç'; len:8),
(html:'è'; len:8),
(html:'é'; len:8),
(html:'ê'; len:7),
(html:'ë'; len:6),
(html:'ì'; len:8),
(html:'í'; len:8),
(html:'î'; len:7),
(html:'ï'; len:6),
(html:'ð'; len:5),
(html:'ñ'; len:8),
(html:'ò'; len:8),
(html:'ó'; len:8),
(html:'ô'; len:7),
(html:'õ'; len:8),
(html:'ö'; len:6),
(html:'÷'; len:8),
(html:'ø'; len:8),
(html:'ù'; len:8),
(html:'ú'; len:8),
(html:'û'; len:7),
(html:'ü'; len:6),
(html:'ý'; len:8),
(html:'þ'; len:7),
(html:'ÿ'; len:6));

var l,cnt,lg : integer;
    pin, pout : pchar;
begin
    l:=length(s);
    setlength(result, l*8);
    pout := @result[1];
    pin  := @s[1];
    lg := 0;
    while cardinal(pin) <= cardinal(pointer(@s[l])) do begin
      cnt := 1;
      case byte(pin^) of
           0..31  : pout^ := pin^;
           32..255: begin
                      cnt := htmltab[byte(pin^)].len;
                      move(pointer(@htmltab[byte(pin^)].html[1])^, pout^, cnt);
                    end;
      end;
      inc(pin);
      inc(pout, cnt);
      inc(lg, cnt);
    end;
    setlength(result, lg);
end;

/edit: da hat der beitragseditor einige werte vermurkst, drum häng ich den code an

Kokel - Mi 19.10.05 22:39

HAllo PEPE !
Ich würde mich freuen wenn du mal das Tool hochlädst ich ringe schon ne ganze zeit nach einer Lösung. Leider komme ich durch die Vorschläge hier aus diesem Forum immer wieder von meinem eigentlichen Ziel ab. Aber ich bin nun mal so , dass ich Vorschläge nicht einfach blind einbaue , sondern ein wenig durchleuchte. Denn nur so kann ich den Quelltext, wenn nötig verändern. Und es gibt hier durchaus gute Leute.
Wie z.B. retgyn der durch das erstellen einer Tabelle im Speicher die Durchlaufzeit extrem verkürzt hat. Und mich somit dazu gebracht mich noch ein wenig mit pointer zu beschäftigen. Die ich zuvor für ziemlich wertlos hielt.
Deswegen möchte ich mich hier nochmal bei retgyn bedanken.
Wenn mir jemand , in diesem Zusammenhang ,eine Liste mit Mnemonics und dessen Prozessortakte zukommen lassen würde wäre ich sehr dankbar.

AN MSCH.
Also im IE läüft das recht gut. Müßte mir mal die anderen Browser bei Gelegenheit installieren. Aber zunächst einmal vertrau ich da dem stefan münz mit seinem SELF-HTML und da steht irgendwie nichts von Problemen. Desweiteren denke ich nicht das ich alle Übersetzungen benötigen werde, die in der Procedure HTML-Schreiben vorhanden sind. Aber richtig wäre es schon die verkehrten rauszuschmeißen. Aber das mit der Schleife wird auch wieder die Performance drücken.
Danke für den Tipp mit dem DHTMED.OCX werd ich mir mal ansehen.Obwohl es mir davor graut (Hab mir schon ein paar mal das Tutorial von asserbad durchgelesen aber bei der arbeit mit DLL's hab ich irgendwie immer ne Blokade im Kopf und Mißerfolge. :( ) Und die Einarbeitung darin wird mal wieder ein paar Tage in anspruch nehmen. Naja , aber irgendwann muss man da wohl sowieso mal dran. Über DLL's hab ich immer so ne negative Einstellung wegen Versionsprobleme und weitergabe , copywrights . Aber diesmal bleibt die DLL bei mir.Ich schau mir das mal an. Und wenn ich Hilfe brauch melde ich mich bei dir . Schon mal vielen Dank im vorraus.

So , nun zu der aktuallisierten Unit.
Ich habe hier also jetzt die häufig verwendeten Texte als Konstanten deklariert. ( Wegen Geschwindigkeit) .
Als Neuerung ist es nun möglich eine HTML-Tabelle , durch die Übergabe einer Stringlist und der Anzahl der Spalten als Integerwert , zu erstellen. (O Mann ! Was für'n Satz.) Ich habe erstmal den Tabellenkopf mit border 1 installiert das werde ich auch noch ändern.

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:
183:
184:
185:
186:
187:
188:
189:
190:
191:
192:
193:
194:
195:
196:
197:
198:
199:
200:
201:
202:
203:
204:
205:
206:
207:
208:
209:
210:
211:
212:
213:
214:
215:
216:
217:
218:
219:
220:
221:
222:
223:
224:
225:
226:
227:
228:
229:
230:
231:
232:
233:
234:
235:
236:
237:
238:
239:
240:
241:
242:
243:
244:
245:
246:
247:
248:
249:
250:
251:
252:
253:
254:
255:
256:
257:
258:
259:
260:
261:
262:
263:
264:
265:
266:
267:
268:
269:
270:
271:
272:
273:
274:
275:
276:
277:
278:
279:
280:
281:
282:
283:
284:
285:
286:
287:
288:
289:
290:
291:
292:
293:
294:
295:
296:
297:
298:
299:
300:
301:
302:
303:
304:
305:
306:
307:
308:
309:
310:
311:
312:
313:
314:
315:
316:
317:
318:
319:
320:
321:
322:
323:
324:
325:
326:
327:
328:
329:
330:
331:
332:
333:
334:
335:
336:
337:
338:
339:
340:
341:
342:
343:
344:

unit html;

interface
Uses classes, sysutils;
function HTMLText(s:string):string;// Übersetzt einen String in einen HTML- String
procedure HTMLNeu(Dateiname,titel:string); // Öffnet DAtei und schreibt den kopf
procedure HTMLSchreiben(s:string); // Text in HTML - Text übersetzen
Procedure HTMLTabelle(liste:tstrings;spalten:integer);// Erstellt HTML-Tabelle
procedure HTMLzu;// Ende und Datei schließen.
implementation


const
 HTKopf='<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN"'+#13#10+
        '"http://www.w3.org/TR/html4/loose.dtd">'+#13#10+
        '<HTML>'+#13#10+'<HEAD>';
 HTEnde='</BODY>'+#13#10+'</HTML>';
 HTTabellenKopf='<table border="1">'+#13#10+'<tr>';
 HTT_Th      ='<th>';
 HTT_The     ='</th>';
 HTT_TR      ='<tr>';
 HTT_TRETR   ='</tr><tr>';
 HTT_TD      ='<td>';
 HTT_TDE     ='</td>';
 HTT_TRTA    ='</tr>'+#13#10+'</table>';
 HTT_TI      ='<TITLE>';
 HTT_TIE     ='</TITLE>';
 HTT_HE      ='</HEAD>';



var
Datei: TextFile;
 // neu
 // macht aus einer Stringlist eine Tabelle   in HTML
Procedure HTMLTabelle(liste:tstrings;spalten:integer);
var
     zeile,f,f1:integer;
begin
 if liste.Count div spalten < 2 then exit;
 f:=0;
 // Diese Zeilen werden  noch verändert.
 // Tabellenkopf wird später über eine init Procedure ersetzt.
 writeln(Datei,'<table border="1">');
 zeile:=liste.Count div spalten;
 writeln(Datei,HTT_TR);
 repeat
   writeln(datei,HTT_Th+ HTMLText(liste[f]) + HTT_The);
   inc(f);
 until f=spalten;
 f1:=2;
 repeat
   writeln(datei,HTT_TRETR);
   repeat
   writeln(datei,HTT_TD+ HTMLText(liste[f]) + HTT_TDE);
   inc(f);
   until f=spalten*f1;
  inc(f1);
 until f1=zeile+1;
 writeln(Datei,HTT_TRTA);
 end;

procedure HTMLNeu(Dateiname,titel:string);
begin
  AssignFile(Datei,Dateiname+'.html');
  Rewrite(Datei);
  WriteLn(Datei,HTKopf);
  WriteLn(Datei,HTT_TI+titel+HTT_TIE);
  WriteLn(Datei,HTT_HE);
end;

procedure HTMLzu;
begin
  WriteLn(Datei);
  WriteLn(Datei,HTEnde);
  CloseFile(Datei);
end;


procedure HTMLSchreiben(s:string);
begin
   WriteLn(Datei,s);
end;

// Schnelle Übersetzungsrutine von retnyg !!
// Übersetzt text sehr schnell.
// ist für mich wichtig da ich diese sehr häufig benutze.
function HTMLText(s:string):string;
type THTMLEntity = record
        html: string[8];
        len : integer;
     end;
 // Erstellt eine Tabelle im Speicher und verkürzt somit die Durchlaufzeit.
CONST htmltab : array [32..255] of THTMLEntity = (
(html:' '; len:1),
(html:'!'; len:1),
(html:'"'; len:1),
(html:'#'; len:1),
(html:'$'; len:1),
(html:'%'; len:1),
(html:'&'; len:5),
(html:'′'; len:8),
(html:'('; len:1),
(html:')'; len:1),
(html:'*'; len:1),
(html:'+'; len:1),
(html:','; len:1),
(html:'−'; len:7),
(html:'.'; len:1),
(html:'/'; len:1),
(html:'0'; len:1),
(html:'1'; len:1),
(html:'2'; len:1),
(html:'3'; len:1),
(html:'4'; len:1),
(html:'5'; len:1),
(html:'6'; len:1),
(html:'7'; len:1),
(html:'8'; len:1),
(html:'9'; len:1),
(html:':'; len:1),
(html:';'; len:1),
(html:'<'; len:1),
(html:'='; len:1),
(html:'>'; len:1),
(html:'?'; len:1),
(html:'@'; len:1),
(html:'A'; len:1),
(html:'B'; len:1),
(html:'C'; len:1),
(html:'D'; len:1),
(html:'E'; len:1),
(html:'F'; len:1),
(html:'G'; len:1),
(html:'H'; len:1),
(html:'I'; len:1),
(html:'J'; len:1),
(html:'K'; len:1),
(html:'L'; len:1),
(html:'M'; len:1),
(html:'N'; len:1),
(html:'O'; len:1),
(html:'P'; len:1),
(html:'Q'; len:1),
(html:'R'; len:1),
(html:'S'; len:1),
(html:'T'; len:1),
(html:'U'; len:1),
(html:'V'; len:1),
(html:'W'; len:1),
(html:'X'; len:1),
(html:'Y'; len:1),
(html:'Z'; len:1),
(html:'['; len:1),
(html:'\'; len:1),
(html:']'; len:1),
(html:'^'; len:1),
(html:'_'; len:1),
(html:'`'; len:1),
(html:'a'; len:1),
(html:'b'; len:1),
(html:'c'; len:1),
(html:'d'; len:1),
(html:'e'; len:1),
(html:'f'; len:1),
(html:'g'; len:1),
(html:'h'; len:1),
(html:'i'; len:1),
(html:'j'; len:1),
(html:'k'; len:1),
(html:'l'; len:1),
(html:'m'; len:1),
(html:'n'; len:1),
(html:'o'; len:1),
(html:'p'; len:1),
(html:'q'; len:1),
(html:'r'; len:1),
(html:'s'; len:1),
(html:'t'; len:1),
(html:'u'; len:1),
(html:'v'; len:1),
(html:'w'; len:1),
(html:'x'; len:1),
(html:'y'; len:1),
(html:'z'; len:1),
(html:'{'; len:1),
(html:'|'; len:1),
(html:'}'; len:1),
(html:'~'; len:1),
(html:''; len:1),
(html:'€'; len:6),
(html:''; len:1),
(html:'‚'; len:1),
(html:'ƒ'; len:1),
(html:'„'; len:7),
(html:'…'; len:1),
(html:'†'; len:1),
(html:'‡'; len:1),
(html:'ˆ'; len:1),
(html:'‰'; len:8),
(html:'Š'; len:1),
(html:'‹'; len:1),
(html:'Œ'; len:1),
(html:''; len:1),
(html:'Ž'; len:1),
(html:''; len:1),
(html:''; len:1),
(html:'‘'; len:1),
(html:'’'; len:1),
(html:'“'; len:1),
(html:'”'; len:1),
(html:'•'; len:1),
(html:'–'; len:1),
(html:'—'; len:1),
(html:'≈'; len:7),
(html:'™'; len:7),
(html:'š'; len:1),
(html:'›'; len:1),
(html:'œ'; len:1),
(html:''; len:1),
(html:'ž'; len:1),
(html:'Ÿ'; len:1),
(html:' '; len:1),
(html:'¡'; len:7),
(html:'¢'; len:6),
(html:'£'; len:7),
(html:'¤'; len:8),
(html:'¥'; len:5),
(html:'¦'; len:8),
(html:'§'; len:6),
(html:'¨'; len:5),
(html:'©'; len:6),
(html:'ª'; len:6),
(html:'«'; len:7),
(html:'¬'; len:5),
(html:''; len:1),
(html:'®'; len:5),
(html:'¯'; len:6),
(html:'°'; len:5),
(html:'±'; len:8),
(html:'²'; len:6),
(html:'³'; len:6),
(html:'´'; len:7),
(html:'µ'; len:7),
(html:'¶'; len:6),
(html:'·'; len:8),
(html:'¸'; len:7),
(html:'¹'; len:6),
(html:'º'; len:1),
(html:'»'; len:7),
(html:'¼'; len:8),
(html:'½'; len:8),
(html:'¾'; len:8),
(html:'¿'; len:8),
(html:'À'; len:8),
(html:'Á'; len:8),
(html:'Â'; len:7),
(html:'Ã'; len:8),
(html:'Ä'; len:6),
(html:'Å'; len:7),
(html:'Æ'; len:7),
(html:'Ç'; len:8),
(html:'È'; len:8),
(html:'É'; len:8),
(html:'Ê'; len:7),
(html:'Ë'; len:6),
(html:'Ì'; len:8),
(html:'Í'; len:8),
(html:'Î'; len:7),
(html:'Ï'; len:6),
(html:'Ð'; len:5),
(html:'Ñ'; len:8),
(html:'Ò'; len:8),
(html:'Ó'; len:8),
(html:'Ô'; len:7),
(html:'Õ'; len:8),
(html:'Ö'; len:6),
(html:'×'; len:7),
(html:'Ø'; len:8),
(html:'Ù'; len:8),
(html:'Ú'; len:8),
(html:'Û'; len:7),
(html:'Ü'; len:6),
(html:'Ý'; len:8),
(html:'Þ'; len:6),
(html:'ß'; len:7),
(html:'à'; len:8),
(html:'á'; len:8),
(html:'â'; len:7),
(html:'ã'; len:8),
(html:'ä'; len:6),
(html:'å'; len:7),
(html:'æ'; len:7),
(html:'ç'; len:8),
(html:'è'; len:8),
(html:'é'; len:8),
(html:'ê'; len:7),
(html:'ë'; len:6),
(html:'ì'; len:8),
(html:'í'; len:8),
(html:'î'; len:7),
(html:'ï'; len:6),
(html:'ð'; len:5),
(html:'ñ'; len:8),
(html:'ò'; len:8),
(html:'ó'; len:8),
(html:'ô'; len:7),
(html:'õ'; len:8),
(html:'ö'; len:6),
(html:'÷'; len:8),
(html:'ø'; len:8),
(html:'ù'; len:8),
(html:'ú'; len:8),
(html:'û'; len:7),
(html:'ü'; len:6),
(html:'ý'; len:8),
(html:'þ'; len:7),
(html:'ÿ'; len:6));
var l,cnt,lg : integer;
    pin, pout : pchar;
begin
    l:=length(s);
    setlength(result, l*8);
    pout := @result[1];
    pin  := @s[1];
    if pin=nil then exit;// von mir reingesetzt , falls ich mal einen leeren String übergebe.
    lg := 0;
    while cardinal(pin) <= cardinal(pointer(@s[l])) do begin
      cnt := 1;
      case byte(pin^) of
           0..31  : pout^ := pin^;
           32..255: begin
                      cnt := htmltab[byte(pin^)].len;  
                      move(pointer(@htmltab[byte(pin^)].html[1])^, pout^, cnt);
                    end;
      end;
      inc(pin);
      inc(pout, cnt);
      inc(lg, cnt);
    end;
    setlength(result, lg);
end;

end.

Entwickler-Ecke.de based on phpBB
Copyright 2002 - 2011 by Tino Teuber, Copyright 2011 - 2026 by Christian Stelzmann Alle Rechte vorbehalten.
Alle Beiträge stammen von dritten Personen und dürfen geltendes Recht nicht verletzen.
Entwickler-Ecke und die zugehörigen Webseiten distanzieren sich ausdrücklich von Fremdinhalten jeglicher Art!