home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1988 / 01 / dynstr.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1987-10-26  |  14.1 KB  |  305 lines
  1. (* ----------------------------------------------------------------------- *)
  2. (*                               DYNSTR.PAS                                *)
  3. (*                 dynamische Stringverwaltung in Pascal                   *)
  4. (*         Bibliothek fuer Turbo-Pacal und MS-DOS  Version 1.0             *)
  5. (*                  (C) 1987   Walter Christ  & PASCAL INT.                *)
  6. (* ----------------------------------------------------------------------- *)
  7. Type                               (* Typedeklaration dynamischer String   *)
  8.   DynString = RECORD
  9.                 anz : integer;
  10.                 case integer of
  11.                   1 : (st      : ^char);
  12.                   2 : (adr,seg : integer;)
  13.               end;
  14.   CharPointer = RECORD case integer of      (* Typdeklaration Char-Zeiger  *)
  15.                   1 : (st      : ^char);
  16.                   2 : (adr,seg : integer;)
  17.                 end;
  18.   MaxPascalString = string[255];                 (* Groesster Pascalstring *)
  19. var
  20.   RTE       : boolean;                              (* RunTimeError - Flag *)
  21. (* ----------------------------------------------------------------------- *)
  22. (* Laufzeitfehler der Library - es ist nicht mehr genuegend Speicher vor-  *)
  23. (*                                  vorhanden:                             *)
  24. PROCEDURE RunTimeError;
  25. BEGIN
  26.   RTE := TRUE;                                        (* Error Flag setzen *)
  27.   (* Hier koennen programmspezifische Fehlerbehandlungen eingefuegt werden *)
  28. END;
  29. (* ----------------------------------------------------------------------- *)
  30. (* einem dynamischen String einen Wert zuweisen. 'pastring' kann ein be-   *)
  31. (*                      liebiger Pascalstring sein:                        *)
  32. procedure DefDynString (var dst : dynstring; pastring : maxpascalstring );
  33. var  helppointer, merker : charpointer;   i : integer;
  34. BEGIN
  35.   if (dst.anz > 0) THEN FreeMem(dst.st,dst.anz);  (* alten Inhalt loeschen *)
  36.   (* neuen Speicherplatz holen *)
  37.   if ((MaxAvail-1) < Length(pastring)/16) THEN
  38.     BEGIN  RunTimeError;  dst.anz := 0;  END
  39.   ELSE
  40.     BEGIN
  41.       GetMem(dst.st,Length(pastring));
  42.       merker.st := dst.st;                           (* Pointer ausrichten *)
  43.       helppointer.st := Addr(pastring[1]);
  44.       for i := 1 to ord(pastring[0]) do begin           (* Inhalt kopieren *)
  45.         merker.st^ := helppointer.st^;
  46.         merker.adr := succ(merker.adr);
  47.         helppointer.adr := succ(helppointer.adr);
  48.       END;
  49.       dst.anz := ord(pastring[0]);                        (* Laenge setzen *)
  50.     END;
  51. END;
  52. (* ----------------------------------------------------------------------- *)
  53. (*   Dynamische String aneinanderreihen. 'dst2' wird an 'dst' angehaengt   *)
  54. procedure ConcatDynString (var dst : dynstring; dst2 : dynstring );
  55. var  helppointer, merker, merker2 : charpointer;  i : integer;
  56. BEGIN
  57.   merker.st := dst.st;                             (* alten Bereich merken *)
  58.   helppointer.st := dst.st;                    (* neuen Bereich anfordern: *)
  59.   if ((MaxAvail-1) < (dst.anz+dst2.anz)/16 ) THEN  RunTimeError
  60.   ELSE BEGIN
  61.     GetMem(dst.st,dst.anz + dst2.anz);
  62.     merker2.st := dst.st;                          (* neuen Bereich merken *)
  63.     for i := 1 to dst.anz do begin      (* 'dst' in neuen Bereich kopieren *)
  64.       merker2.st^ := merker.st^;
  65.       merker2.adr := succ(merker2.adr);
  66.       merker.adr  := succ(merker.adr);
  67.     END;
  68.     merker.st := dst2.st;
  69.     for i := 1 to dst2.anz do BEGIN    (* 'dst2' in neuen Bereich kopieren *)
  70.       merker2.st^ := merker.st^;
  71.       merker2.adr := succ(merker2.adr);
  72.       merker.adr  := succ(merker.adr);
  73.     END;
  74.     if (dst.anz > 0) THEN FreeMem(helppointer.st,dst.anz);
  75.     dst.anz := dst.anz + dst2.anz;
  76.   END;
  77. END;
  78. (* ----------------------------------------------------------------------- *)
  79. (*                 dynamischer String auf Bildschirm ausgeben:             *)
  80. PROCEDURE PrintDynString (dst : dynstring);
  81. var  st : charpointer;  i : integer;
  82. BEGIN
  83.   st.st := dst.st;
  84.   for i := 1 to dst.anz do BEGIN
  85.                (* Hier laesst sich leicht ein System-Aufruf implementieren *)
  86.     write(st.st^);
  87.     st.adr := succ(st.adr);
  88.   END;
  89. END;
  90. (* ----------------------------------------------------------------------- *)
  91. (* dynamischer String auf Bildschirm ausgeben, danach in neue Zeile gehen: *)
  92. PROCEDURE PrintLnDynString (dst : dynstring);
  93. BEGIN  printdynstring(dst);  writeln;  END;
  94. (* ----------------------------------------------------------------------- *)
  95. (* Insert-Funktion fuer dynamische Strings. 'Obj' und 'Target'-String      *)
  96. (*                   muessen beide dynamische String sein:                 *)
  97. PROCEDURE InsertDynString (Obj :dynstring; var Target : dynstring ;
  98.                            Pos : integer);
  99. var  helppointer, merker, merker2, merker3 : charpointer;  i : integer;
  100. BEGIN                                 (* Gueltigkeitsbereich ueberpruefen: *)
  101.   if (Pos > Target.anz) THEN Pos := Target.anz + 1;
  102.   if ( Pos < 1 ) THEN Pos := 1;
  103.   merker.st := target.st;                          (* alten Bereich merken *)
  104.   helppointer.st := target.st;                 (* neuen Bereich anfordern: *)
  105.   if (MaxAvail-1 < (obj.anz + Target.anz)/16) THEN  RunTimeError
  106.   ELSE BEGIN
  107.     GetMem(target.st,obj.anz + Target.anz);
  108.     merker2.st := target.st;                       (* neuen Bereich merken *)
  109.     for i := 1 to Pos-1 do BEGIN     (* 'target' in neuen Bereich kopieren *)
  110.       merker2.st^ := merker.st^;
  111.       merker2.adr := succ(merker2.adr);
  112.       merker.adr  := succ(merker.adr);
  113.     END;
  114.     merker3.st := obj.st;               (* 'obj' in neuen Bereich kopieren *)
  115.     for i := 1 to obj.anz do BEGIN
  116.       merker2.st^ := merker3.st^;
  117.       merker2.adr := succ(merker2.adr);
  118.       merker3.adr  := succ(merker3.adr);
  119.     END;
  120.     for i := pos to Target.anz do BEGIN        (* Target 2. Teil kopieren  *)
  121.       merker2.st^ := merker.st^;
  122.       merker2.adr := succ(merker2.adr);
  123.       merker.adr  := succ(merker.adr);
  124.     END;
  125.     if (target.anz > 0) THEN  FreeMem(helppointer.st,target.anz);
  126.     target.anz := target.anz + obj.anz;
  127.   END;
  128. END;
  129. (* ----------------------------------------------------------------------- *)
  130. (*                 Delete-Prozedur fuer dynamische Strings:                *)
  131. PROCEDURE DeleteDynString (var St :dynstring; Pos :integer; Num :integer);
  132. var  merker, merker2, helppointer : charpointer;  i : integer;
  133. BEGIN
  134.   if (Pos+Num <= st.anz ) THEN BEGIN
  135.     helppointer.st := st.st;
  136.     merker.st := st.st;
  137.     if (MaxAvail -1 < (st.anz-num)/16) THEN  RunTimeError
  138.     ELSE BEGIN
  139.       GetMem(st.st,st.anz-num);
  140.       merker2.st := st.st;
  141.       for i := 1 to Pos do BEGIN                  (* String Teil1 kopieren *)
  142.         merker2.st^ := merker.st^;
  143.         merker.adr := succ(merker.adr);
  144.         merker2.adr := succ(merker2.adr);
  145.       END;
  146.       merker.adr := helppointer.adr + num + pos;
  147.       for i := Pos + num to st.anz do BEGIN       (* String Teil2 kopieren *)
  148.         merker2.st^ := merker.st^;
  149.         merker.adr := succ(merker.adr);
  150.         merker2.adr := succ(merker2.adr);
  151.       END;             (* Speicherplatz von geloeschten Zeichen freigeben: *)
  152.       FreeMem(helppointer.st,st.anz);
  153.       st.anz := st.anz - num;
  154.     END;
  155.   END;
  156. END;
  157. (* ----------------------------------------------------------------------- *)
  158. (*                     Copy-Funktion fuer dynamische Strings               *)
  159. PROCEDURE CopyDynString (var dst,src : dynstring; pos,num : integer);
  160. var   merker, merker2, helppointer : charpointer;  i : integer;
  161. BEGIN
  162.   if (pos + num <= src.anz ) THEN BEGIN
  163.     helppointer.st := dst.st;                (* neuen Speicherplatz holen: *)
  164.     if (Maxavail-1 < num/16) THEN RunTimeError
  165.     ELSE BEGIN
  166.       GetMem(dst.st,num);                           (* Pointer ausrichten: *)
  167.       merker.st := dst.st;
  168.       merker2.st := src.st;
  169.       merker2.adr := merker2.adr + pos;
  170.       for i := 1 to num do BEGIN                        (* Inhalt kopieren *)
  171.         merker.st^ := merker2.st^;
  172.         merker.adr := succ(merker.adr);
  173.         merker2.adr := succ(merker2.adr);
  174.       END;                                       (* alten Inhalt loeschen: *)
  175.       if dst.anz > 0 THEN FreeMem(helppointer.st,dst.anz);
  176.       dst.anz := num;                                     (* Laenge setzen *)
  177.     END;
  178.   END;
  179. END;
  180. (* ----------------------------------------------------------------------- *)
  181. (*                      einen dynamischen String loeschen                  *)
  182. PROCEDURE ClearDynString (var str : dynstring);
  183. BEGIN
  184.   if str.anz > 0 THEN BEGIN                         (* Speicher freigeben: *)
  185.     FreeMem(str.st,str.anz);  str.anz := 0;
  186.   END;
  187. END;
  188. (* ----------------------------------------------------------------------- *)
  189. (*                    einen dynamischen String initialisieren              *)
  190. PROCEDURE InitDynString (var str : dynstring);
  191. BEGIN  str.anz := 0;  END;
  192. (* ----------------------------------------------------------------------- *)
  193. (*               der Inhalt von 'dst' wird nach 'src' kopiert              *)
  194. PROCEDURE AssignDynString (var dst : dynstring; src : dynstring);
  195. var  merker, merker2 : charpointer;  i : integer;
  196. BEGIN
  197.   if dst.anz > 0 THEN FreeMem(dst.st,dst.anz); (* alten Speicher freigeben *)
  198.   if Maxavail-1 < src.anz/16 THEN                    (* Speicher anfordern *)
  199.     BEGIN  RunTimeError; dst.anz := 0;  END
  200.   ELSE BEGIN
  201.     Getmem(dst.st,src.anz);
  202.     merker.st := src.st;                             (* Pointer ausrichten *)
  203.     merker2.st := dst.st;
  204.     for i := 1 to src.anz do begin                             (* kopieren *)
  205.       merker2.st^ := merker.st^;
  206.       merker2.adr := succ(merker2.adr);
  207.       merker.adr  := succ(merker.adr);
  208.     END;
  209.     dst.anz := src.anz;
  210.   END;
  211. END;
  212. (* ----------------------------------------------------------------------- *)
  213. (*      diese Funktion liefert die Laenge eines dynamischen Strings        *)
  214. FUNCTION LenDynString (str : dynstring ) : integer;
  215. BEGIN  Lendynstring := str.anz;  END;
  216. (* ----------------------------------------------------------------------- *)
  217. (*   diese Funktion liefert ein Zeichen aus einem dynamischen String       *)
  218. FUNCTION DynChar (str : dynstring; pos : integer) : char;
  219. var  merker : charpointer;
  220. BEGIN                                               (* Pointer ausrichten: *)
  221.   merker.st := str.st;  merker.adr := merker.adr+pos;  DynChar := merker.st^;
  222. END;
  223. (* ----------------------------------------------------------------------- *)
  224. (*  Mit dieser Funktion kann man ein Zeichen innerhalb eines dyn. Strings  *)
  225. (*                              ueberschreiben                             *)
  226. PROCEDURE AssignChar (var str : dynstring; pos : integer; ch : char);
  227. var  merker : charpointer;
  228. BEGIN                                               (* Pointer ausrichten: *)
  229.   merker.st := str.st;  merker.adr := merker.adr+pos;  merker.st^ := ch;
  230. END;
  231. (* ----------------------------------------------------------------------- *)
  232. (*                    lexikalischer Vergleich dyn. Strings                 *)
  233. (*     Ergebniswerte: 1  stra > strb, 0  stra = strb,  -1  stra < strb     *)
  234. FUNCTION CmpDynString (stra,strb : dynstring) : integer;
  235. VAR  merker, merker2 : charpointer;  i, ex : integer;
  236. BEGIN
  237.   i := 1;  merker.st := stra.st;  merker2.st := strb.st;  ex := -2;
  238.   while (i <= stra.anz) and (ex = -2) do BEGIN
  239.     if i > strb.anz THEN  ex := 1                    (* stra groesser strb *)
  240.     ELSE if merker.st^ = merker2.st^ THEN
  241.       BEGIN                            (* naechstes Zeichen positionieren: *)
  242.         merker.adr := succ(merker.adr);  merker2.adr := succ(merker2.adr);
  243.         i := succ(i);
  244.       END
  245.     ELSE
  246.       BEGIN
  247.         if merker.st^ < merker2.st^ THEN  ex := -1    (* stra kleiner strb *)
  248.         ELSE ex := 1;                                (* stra groesser strb *)
  249.       END;
  250.   END;
  251.   if ex = -2 THEN
  252.     if stra.anz = strb.anz THEN  ex := 0                   (* beide gleich *)
  253.     ELSE  ex := -1;                                   (* stra kleiner strb *)
  254.   CmpDynString := ex;
  255. END;
  256. (* ----------------------------------------------------------------------- *)
  257. (*              Convertierung dynamischer nach Pascal String               *)
  258. PROCEDURE ConvDynString (stra : dynstring; var pascalstr : maxpascalstring);
  259. Var  i, anz : integer;  merker : charpointer;
  260. BEGIN
  261.   merker.st := stra.st;                              (* Pointer ausrichten *)
  262.   anz := stra.anz;                                      (* Inhalt kopieren *)
  263.   if anz > 255 THEN anz := 255;
  264.   for i := 1 to anz do begin                                   (* kopieren *)
  265.     pascalstr[i] := merker.st^;
  266.     merker.adr := succ(merker.adr);
  267.   END;
  268.   pascalstr[0] := chr(anz);                               (* Laenge setzen *)
  269. END;
  270. (* ----------------------------------------------------------------------- *)
  271. (*                   Testprogramm fuer dynamische Strings                  *)
  272. var
  273.   a,b,c,d,e : dynstring;
  274.   i         : integer;
  275.   p         : maxpascalstring;
  276. BEGIN
  277.   InitDynString(a);  InitDynstring(b);  InitDynstring(c);
  278.   InitDynstring(d);  InitDynString(e);
  279.   DefDynString(a,'Dies ist ein Programm fuer');
  280.   DefDynString(b,'dynamische Strings');
  281.   DefDynString(c,'Test-');
  282.   InsertDynString(c,a,14);  ConcatDynString(d,a);
  283.   ConcatDynString(d,b);     DefDynString(c,' ');
  284.   InsertDynString(c,d,32);  PrintlnDynString(d);
  285.   AssignDynString(e,d);     PrintlnDynString(e);
  286.   DeleteDynString(e,18,9);  PrintlnDynString(e);
  287.   AssignChar(e,17,' ');     PrintlnDynString(e);
  288.   writeln('d groesser e ?',CmpDynString(d,e));
  289.   DefDynString(d,'Aha');
  290.   writeln('d groesser e ?',CmpDynString(d,e));
  291.   AssignDynString(e,d);
  292.   writeln('d groesser e ?',CmpDynString(d,e));
  293.   p := 'Pascalstring';      DefDynSTring(d,p);
  294.   ConvDynString(d,p);       writeln(p);
  295.   DefDynString(e,'*');
  296.   for i := 1 to 10 do BEGIN
  297.     ConCatDynString(e,e);  PrintDynString(e);
  298.     writeln('==>',Lendynstring(e));
  299.   END;
  300.   CopyDynString(d,e,1000,3);  PrintDynString(d);
  301.   writeln('vorhandener Speicherplatz :',MaxAvail);
  302.   ClearDynString(e);
  303.   writeln('vorhandener Speicherplatz :',MaxAvail);
  304. END.
  305.