WebSVN – oidplus – Diff – /trunk_dos/STRLIST.PAS


unit STRLIST;
 
(************************************************)
(* STRLIST.PAS                                  *)
(* Author:   Daniel Marschall                   *)
(* Revision: 2022-02-16                         *)
(* License:  Apache 2.0                         *)
(* This file contains:                          *)
(* - StringList implementation for Turbo Pascal *)
(************************************************)
 
interface
 
type
  PStringList = ^TStringList;
  TStringList = record
    init: boolean;
    element: string;
    next: PStringList;
  end;
 
procedure CreateList(var list: PStringList);
procedure FreeList(list: PStringList);
function ListContains(list: PStringList; val: string): boolean;
procedure ListClear(list: PStringList);
function ListAppend(list: PStringList; str: string): integer;
function ListCount(list: PStringList): integer;
function ListDeleteElementByIndex(list: PStringlist; idx: integer): boolean;
function ListDeleteElementByValue(list: PStringlist; val: string): boolean;
function ListGetElement(list: PStringList; idx: integer): string;
procedure ListSetElement(list: PStringList; idx: integer; value: string);
procedure ListInsert(list: PStringlist; str: string; idx: integer);
procedure ListSwapElement(list: PStringList; i, j: integer);
procedure SplitStrToList(str: string; list: PStringList; separator: string);
procedure OIDtoArcList(oid: string; list: PStringList);
procedure ListBubbleSortNumericString(list: PStringList);
function ListLoadFromFile(list: PStringList; filename: string): boolean;
function ListSaveToFile(list: PStringList; filename: string): boolean;
 
implementation
 
uses
  VtsFuncs;
 
procedure CreateList(var list: PStringList);
begin
  GetMem(list, SizeOf(TStringList));
  list^.init := false;
  list^.element := '';
  list^.next := nil;
end;
 
procedure FreeList(list: PStringList);
begin
  if list^.next <> nil then
    FreeList(list^.Next);
  FreeMem(list, SizeOf(TStringList));
end;
 
function ListContains(list: PStringList; val: string): boolean;
var
  i: integer;
begin
  ListContains := false;
  for i := 0 to ListCount(list)-1 do
  begin
    if ListGetElement(list, i) = val then
    begin
      ListContains := true;
      break;
    end;
  end;
end;
 
procedure ListClear(list: PStringList);
begin
  while ListCount(list) > 0 do
  begin
    ListDeleteElementByIndex(list, 0);
  end;
end;
 
function ListAppend(list: PStringList; str: string): integer;
var
  new: PStringList;
  tmp: PStringList;
  cnt: integer;
begin
  cnt := 0;
  if not list^.init then
  begin
   list^.element := str;
   list^.init := true;
  end
  else
  begin
    Inc(cnt);
    GetMem(new, sizeof(TStringList));
    new^.element := str;
    new^.next := nil;
    new^.init := true;
 
    tmp := list;
    while tmp^.next <> nil do
    begin
      tmp := tmp^.next;
      Inc(cnt);
    end;
 
    tmp^.next := new;
  end;
 
  ListAppend := cnt; (* Return the index where the new element was put *)
end;
 
function ListCount(list: PStringList): integer;
var
  cnt: integer;
  tmp: PStringList;
begin
  tmp := list;
  cnt := 0;
 
  if tmp^.init then
  begin
    repeat
      Inc(cnt);
      tmp := tmp^.next;
    until tmp = nil;
  end;
 
  ListCount := cnt;
end;
 
function ListDeleteElementByIndex(list: PStringlist; idx: integer): boolean;
var
  tmp, tmp2, prev: PStringList;
  i: integer;
begin
  ListDeleteElementByIndex := false;
  if idx < 0 then exit;
  if idx > ListCount(list)-1 then exit;
 
  tmp := list;
  prev := nil;
  i := 0;
  while i < idx do
  begin
    prev := tmp;
    tmp := tmp^.next;
    inc(i);
  end;
  if prev = nil then
  begin
    if tmp^.next = nil then
    begin
      tmp^.init := false;
    end
    else
    begin
      tmp^.init := true;
      tmp^.element := tmp^.next^.element;
      tmp2 := tmp^.next;
      tmp^.next := tmp^.next^.next;
      FreeMem(tmp2, SizeOf(TStringList));
    end;
  end
  else
  begin
    prev^.next := tmp^.next;
    FreeMem(tmp, SizeOf(TStringList));
  end;
 
  ListDeleteElementByIndex := true;
end;
 
function ListDeleteElementByValue(list: PStringlist; val: string): boolean;
var
  i: integer;
begin
  ListDeleteElementByValue := false;
  for i := 0 to ListCount(list)-1 do
  begin
    if ListGetElement(list, i) = val then
    begin
      ListDeleteElementByValue := ListDeleteElementByIndex(list, i);
      exit;
    end;
  end;
end;
 
function ListGetElement(list: PStringList; idx: integer): string;
var
  tmp: PStringList;
  i: integer;
begin
  if idx < 0 then exit;
  if idx > ListCount(list)-1 then exit;
 
  tmp := list;
  i := 0;
  while i < idx do
  begin
    tmp := tmp^.next;
    inc(i);
  end;
 
  ListGetElement := tmp^.element;
end;
 
procedure ListSetElement(list: PStringList; idx: integer; value: string);
var
  tmp: PStringList;
  i: integer;
begin
  if idx < 0 then exit;
  if idx > ListCount(list)-1 then exit;
 
  tmp := list;
  i := 0;
  while i < idx do
  begin
    tmp := tmp^.next;
    inc(i);
  end;
 
  tmp^.element := value;
end;
 
procedure ListInsert(list: PStringlist; str: string; idx: integer);
var
  tmp, new: PStringList;
  i: integer;
begin
  if idx < 0 then exit;
  if idx > ListCount(list)-1 then exit;
 
  tmp := list;
  i := 0;
  while i < idx do
  begin
    tmp := tmp^.next;
    inc(i);
  end;
 
  GetMem(new, sizeof(TStringList));
  new^.init := true;
  new^.next := tmp^.next;
  new^.element := tmp^.element;
 
  tmp^.element := str;
  tmp^.next := new;
  tmp^.init := true;
end;
 
procedure ListSwapElement(list: PStringList; i, j: integer);
var
  a, b: string;
begin
  a := ListGetElement(list, i);
  b := ListGetElement(list, j);
  ListSetElement(list, i, b);
  ListSetElement(list, j, a);
end;
 
procedure SplitStrToList(str: string; list: PStringList; separator: string);
var
  p: integer;
begin
  str := str + separator;
  repeat
    p := Pos(separator, str);
    ListAppend(list, Copy(str, 1, p-1));
    str := copy(str, p+Length(separator), Length(str)-p);
  until str = '';
end;
 
procedure OIDtoArcList(oid: string; list: PStringList);
begin
  SplitStrToList(oid, list, '.');
end;
 
procedure ListBubbleSortNumericString(list: PStringList);
var
  n, i: integer;
  a, b: string;
  swapped: boolean;
begin
  n := ListCount(list);
  while n>1 do
  begin
    i := 0;
    swapped := false;
    while i<n-1 do
    begin
      a := ListGetElement(list, i);
      b := ListGetElement(list, i+1);
      if CompareNumericString(a, b) > 0 then
      begin
        ListSwapElement(list, i, i+1);
        swapped := true;
      end;
      Inc(i);
    end;
    if not swapped then break;
    Dec(n);
  end;
end;
 
function ListLoadFromFile(list: PStringList; filename: string): boolean;
var
  f: Text;
  s: string;
begin
  Assign(f, filename);
 
  {$I-}
  Reset(f);
  {$I+}
  if IoResult <> 0 then
  begin
    ListLoadFromFile := false;
    (* Must not call Close(f) if file was never opened *)
    Exit;
  end;
 
  ListClear(list);
 
  while not EOF(f) do
  begin
    ReadLn(f, s);
    ListAppend(list, s);
  end;
 
  Close(f);
  ListLoadFromFile := true;
end;
 
function ListSaveToFile(list: PStringList; filename: string): boolean;
var
  f: Text;
  i: integer;
  s: string;
begin
  Assign(f, filename);
 
  {$I-}
  Rewrite(f);
  {$I+}
  if IoResult <> 0 then
  begin
    ListSaveToFile := false;
    (* Must not call Close(f) if file was never opened *)
    Exit;
  end;
 
  for i := 0 to ListCount(list)-1 do
  begin
    s := ListGetElement(list, i);
    WriteLn(f, s);
  end;
 
  Close(f);
  ListSaveToFile := true;
end;
 
end.
 

Rev 740	Rev 747
1	unit STRLIST;	1	unit STRLIST;
2		2
3	(************************************************)	3	(************************************************)
4	(* STRLIST.PAS *)	4	(* STRLIST.PAS *)
5	(* Author: Daniel Marschall *)	5	(* Author: Daniel Marschall *)
6	(* Revision: 2022-02-14 *)	6	(* Revision: 2022-02-16 *)
7	(* License: Apache 2.0 *)	7	(* License: Apache 2.0 *)
8	(* This file contains: *)	8	(* This file contains: *)
9	(* - StringList implementation for Turbo Pascal *)	9	(* - StringList implementation for Turbo Pascal *)
10	(************************************************)	10	(************************************************)
11		11
12	interface	12	interface
13		13
14	type	14	type
15	PStringList = ^TStringList;	15	PStringList = ^TStringList;
16	TStringList = record	16	TStringList = record
17	init: boolean;	17	init: boolean;
18	element: string;	18	element: string;
19	next: PStringList;	19	next: PStringList;
20	end;	20	end;
21		21
22	procedure CreateList(var list: PStringList);	22	procedure CreateList(var list: PStringList);
23	procedure FreeList(list: PStringList);	23	procedure FreeList(list: PStringList);
24	function ListContains(list: PStringList; val: string): boolean;	24	function ListContains(list: PStringList; val: string): boolean;
25	procedure ListClear(list: PStringList);	25	procedure ListClear(list: PStringList);
26	function ListAppend(list: PStringList; str: string): integer;	26	function ListAppend(list: PStringList; str: string): integer;
27	function ListCount(list: PStringList): integer;	27	function ListCount(list: PStringList): integer;
28	function ListDeleteElementByIndex(list: PStringlist; idx: integer): boolean;	28	function ListDeleteElementByIndex(list: PStringlist; idx: integer): boolean;
29	function ListDeleteElementByValue(list: PStringlist; val: string): boolean;	29	function ListDeleteElementByValue(list: PStringlist; val: string): boolean;
30	function ListGetElement(list: PStringList; idx: integer): string;	30	function ListGetElement(list: PStringList; idx: integer): string;
31	procedure ListSetElement(list: PStringList; idx: integer; value: string);	31	procedure ListSetElement(list: PStringList; idx: integer; value: string);
32	procedure ListInsert(list: PStringlist; str: string; idx: integer);	32	procedure ListInsert(list: PStringlist; str: string; idx: integer);
33	procedure ListSwapElement(list: PStringList; i, j: integer);	33	procedure ListSwapElement(list: PStringList; i, j: integer);
34	procedure SplitStrToList(str: string; list: PStringList; separator: string);	34	procedure SplitStrToList(str: string; list: PStringList; separator: string);
35	procedure OIDtoArcList(oid: string; list: PStringList);	35	procedure OIDtoArcList(oid: string; list: PStringList);
36	procedure ListBubbleSortNumericString(list: PStringList);	36	procedure ListBubbleSortNumericString(list: PStringList);
-		37	function ListLoadFromFile(list: PStringList; filename: string): boolean;
-		38	function ListSaveToFile(list: PStringList; filename: string): boolean;
37		39
38	implementation	40	implementation
39		41
40	uses	42	uses
41	VtsFuncs;	43	VtsFuncs;
42		44
43	procedure CreateList(var list: PStringList);	45	procedure CreateList(var list: PStringList);
44	begin	46	begin
45	GetMem(list, SizeOf(TStringList));	47	GetMem(list, SizeOf(TStringList));
46	list^.init := false;	48	list^.init := false;
47	list^.element := '';	49	list^.element := '';
48	list^.next := nil;	50	list^.next := nil;
49	end;	51	end;
50		52
51	procedure FreeList(list: PStringList);	53	procedure FreeList(list: PStringList);
52	begin	54	begin
53	if list^.next <> nil then	55	if list^.next <> nil then
54	FreeList(list^.Next);	56	FreeList(list^.Next);
55	FreeMem(list, SizeOf(TStringList));	57	FreeMem(list, SizeOf(TStringList));
56	end;	58	end;
57		59
58	function ListContains(list: PStringList; val: string): boolean;	60	function ListContains(list: PStringList; val: string): boolean;
59	var	61	var
60	i: integer;	62	i: integer;
61	begin	63	begin
62	ListContains := false;	64	ListContains := false;
63	for i := 0 to ListCount(list)-1 do	65	for i := 0 to ListCount(list)-1 do
64	begin	66	begin
65	if ListGetElement(list, i) = val then	67	if ListGetElement(list, i) = val then
66	begin	68	begin
67	ListContains := true;	69	ListContains := true;
68	break;	70	break;
69	end;	71	end;
70	end;	72	end;
71	end;	73	end;
72		74
73	procedure ListClear(list: PStringList);	75	procedure ListClear(list: PStringList);
74	begin	76	begin
75	while ListCount(list) > 0 do	77	while ListCount(list) > 0 do
76	begin	78	begin
77	ListDeleteElementByIndex(list, 0);	79	ListDeleteElementByIndex(list, 0);
78	end;	80	end;
79	end;	81	end;
80		82
81	function ListAppend(list: PStringList; str: string): integer;	83	function ListAppend(list: PStringList; str: string): integer;
82	var	84	var
83	new: PStringList;	85	new: PStringList;
84	tmp: PStringList;	86	tmp: PStringList;
85	cnt: integer;	87	cnt: integer;
86	begin	88	begin
87	cnt := 0;	89	cnt := 0;
88	if not list^.init then	90	if not list^.init then
89	begin	91	begin
90	list^.element := str;	92	list^.element := str;
91	list^.init := true;	93	list^.init := true;
92	end	94	end
93	else	95	else
94	begin	96	begin
95	Inc(cnt);	97	Inc(cnt);
96	GetMem(new, sizeof(TStringList));	98	GetMem(new, sizeof(TStringList));
97	new^.element := str;	99	new^.element := str;
98	new^.next := nil;	100	new^.next := nil;
99	new^.init := true;	101	new^.init := true;
100		102
101	tmp := list;	103	tmp := list;
102	while tmp^.next <> nil do	104	while tmp^.next <> nil do
103	begin	105	begin
104	tmp := tmp^.next;	106	tmp := tmp^.next;
105	Inc(cnt);	107	Inc(cnt);
106	end;	108	end;
107		109
108	tmp^.next := new;	110	tmp^.next := new;
109	end;	111	end;
110		112
111	ListAppend := cnt; (* Return the index where the new element was put *)	113	ListAppend := cnt; (* Return the index where the new element was put *)
112	end;	114	end;
113		115
114	function ListCount(list: PStringList): integer;	116	function ListCount(list: PStringList): integer;
115	var	117	var
116	cnt: integer;	118	cnt: integer;
117	tmp: PStringList;	119	tmp: PStringList;
118	begin	120	begin
119	tmp := list;	121	tmp := list;
120	cnt := 0;	122	cnt := 0;
121		123
122	if tmp^.init then	124	if tmp^.init then
123	begin	125	begin
124	repeat	126	repeat
125	Inc(cnt);	127	Inc(cnt);
126	tmp := tmp^.next;	128	tmp := tmp^.next;
127	until tmp = nil;	129	until tmp = nil;
128	end;	130	end;
129		131
130	ListCount := cnt;	132	ListCount := cnt;
131	end;	133	end;
132		134
133	function ListDeleteElementByIndex(list: PStringlist; idx: integer): boolean;	135	function ListDeleteElementByIndex(list: PStringlist; idx: integer): boolean;
134	var	136	var
135	tmp, tmp2, prev: PStringList;	137	tmp, tmp2, prev: PStringList;
136	i: integer;	138	i: integer;
137	begin	139	begin
138	ListDeleteElementByIndex := false;	140	ListDeleteElementByIndex := false;
139	if idx < 0 then exit;	141	if idx < 0 then exit;
140	if idx > ListCount(list)-1 then exit;	142	if idx > ListCount(list)-1 then exit;
141		143
142	tmp := list;	144	tmp := list;
143	prev := nil;	145	prev := nil;
144	i := 0;	146	i := 0;
145	while i < idx do	147	while i < idx do
146	begin	148	begin
147	prev := tmp;	149	prev := tmp;
148	tmp := tmp^.next;	150	tmp := tmp^.next;
149	inc(i);	151	inc(i);
150	end;	152	end;
151	if prev = nil then	153	if prev = nil then
152	begin	154	begin
153	if tmp^.next = nil then	155	if tmp^.next = nil then
154	begin	156	begin
155	tmp^.init := false;	157	tmp^.init := false;
156	end	158	end
157	else	159	else
158	begin	160	begin
159	tmp^.init := true;	161	tmp^.init := true;
160	tmp^.element := tmp^.next^.element;	162	tmp^.element := tmp^.next^.element;
161	tmp2 := tmp^.next;	163	tmp2 := tmp^.next;
162	tmp^.next := tmp^.next^.next;	164	tmp^.next := tmp^.next^.next;
163	FreeMem(tmp2, SizeOf(TStringList));	165	FreeMem(tmp2, SizeOf(TStringList));
164	end;	166	end;
165	end	167	end
166	else	168	else
167	begin	169	begin
168	prev^.next := tmp^.next;	170	prev^.next := tmp^.next;
169	FreeMem(tmp, SizeOf(TStringList));	171	FreeMem(tmp, SizeOf(TStringList));
170	end;	172	end;
171		173
172	ListDeleteElementByIndex := true;	174	ListDeleteElementByIndex := true;
173	end;	175	end;
174		176
175	function ListDeleteElementByValue(list: PStringlist; val: string): boolean;	177	function ListDeleteElementByValue(list: PStringlist; val: string): boolean;
176	var	178	var
177	i: integer;	179	i: integer;
178	begin	180	begin
179	ListDeleteElementByValue := false;	181	ListDeleteElementByValue := false;
180	for i := 0 to ListCount(list)-1 do	182	for i := 0 to ListCount(list)-1 do
181	begin	183	begin
182	if ListGetElement(list, i) = val then	184	if ListGetElement(list, i) = val then
183	begin	185	begin
184	ListDeleteElementByValue := ListDeleteElementByIndex(list, i);	186	ListDeleteElementByValue := ListDeleteElementByIndex(list, i);
185	exit;	187	exit;
186	end;	188	end;
187	end;	189	end;
188	end;	190	end;
189		191
190	function ListGetElement(list: PStringList; idx: integer): string;	192	function ListGetElement(list: PStringList; idx: integer): string;
191	var	193	var
192	tmp: PStringList;	194	tmp: PStringList;
193	i: integer;	195	i: integer;
194	begin	196	begin
195	if idx < 0 then exit;	197	if idx < 0 then exit;
196	if idx > ListCount(list)-1 then exit;	198	if idx > ListCount(list)-1 then exit;
197		199
198	tmp := list;	200	tmp := list;
199	i := 0;	201	i := 0;
200	while i < idx do	202	while i < idx do
201	begin	203	begin
202	tmp := tmp^.next;	204	tmp := tmp^.next;
203	inc(i);	205	inc(i);
204	end;	206	end;
205		207
206	ListGetElement := tmp^.element;	208	ListGetElement := tmp^.element;
207	end;	209	end;
208		210
209	procedure ListSetElement(list: PStringList; idx: integer; value: string);	211	procedure ListSetElement(list: PStringList; idx: integer; value: string);
210	var	212	var
211	tmp: PStringList;	213	tmp: PStringList;
212	i: integer;	214	i: integer;
213	begin	215	begin
214	if idx < 0 then exit;	216	if idx < 0 then exit;
215	if idx > ListCount(list)-1 then exit;	217	if idx > ListCount(list)-1 then exit;
216		218
217	tmp := list;	219	tmp := list;
218	i := 0;	220	i := 0;
219	while i < idx do	221	while i < idx do
220	begin	222	begin
221	tmp := tmp^.next;	223	tmp := tmp^.next;
222	inc(i);	224	inc(i);
223	end;	225	end;
224		226
225	tmp^.element := value;	227	tmp^.element := value;
226	end;	228	end;
227		229
228	procedure ListInsert(list: PStringlist; str: string; idx: integer);	230	procedure ListInsert(list: PStringlist; str: string; idx: integer);
229	var	231	var
230	tmp, new: PStringList;	232	tmp, new: PStringList;
231	i: integer;	233	i: integer;
232	begin	234	begin
233	if idx < 0 then exit;	235	if idx < 0 then exit;
234	if idx > ListCount(list)-1 then exit;	236	if idx > ListCount(list)-1 then exit;
235		237
236	tmp := list;	238	tmp := list;
237	i := 0;	239	i := 0;
238	while i < idx do	240	while i < idx do
239	begin	241	begin
240	tmp := tmp^.next;	242	tmp := tmp^.next;
241	inc(i);	243	inc(i);
242	end;	244	end;
243		245
244	GetMem(new, sizeof(TStringList));	246	GetMem(new, sizeof(TStringList));
245	new^.init := true;	247	new^.init := true;
246	new^.next := tmp^.next;	248	new^.next := tmp^.next;
247	new^.element := tmp^.element;	249	new^.element := tmp^.element;
248		250
249	tmp^.element := str;	251	tmp^.element := str;
250	tmp^.next := new;	252	tmp^.next := new;
251	tmp^.init := true;	253	tmp^.init := true;
252	end;	254	end;
253		255
254	procedure ListSwapElement(list: PStringList; i, j: integer);	256	procedure ListSwapElement(list: PStringList; i, j: integer);
255	var	257	var
256	a, b: string;	258	a, b: string;
257	begin	259	begin
258	a := ListGetElement(list, i);	260	a := ListGetElement(list, i);
259	b := ListGetElement(list, j);	261	b := ListGetElement(list, j);
260	ListSetElement(list, i, b);	262	ListSetElement(list, i, b);
261	ListSetElement(list, j, a);	263	ListSetElement(list, j, a);
262	end;	264	end;
263		265
264	procedure SplitStrToList(str: string; list: PStringList; separator: string);	266	procedure SplitStrToList(str: string; list: PStringList; separator: string);
265	var	267	var
266	p: integer;	268	p: integer;
267	begin	269	begin
268	str := str + separator;	270	str := str + separator;
269	repeat	271	repeat
270	p := Pos(separator, str);	272	p := Pos(separator, str);
271	ListAppend(list, Copy(str, 1, p-1));	273	ListAppend(list, Copy(str, 1, p-1));
272	str := copy(str, p+Length(separator), Length(str)-p);	274	str := copy(str, p+Length(separator), Length(str)-p);
273	until str = '';	275	until str = '';
274	end;	276	end;
275		277
276	procedure OIDtoArcList(oid: string; list: PStringList);	278	procedure OIDtoArcList(oid: string; list: PStringList);
277	begin	279	begin
278	SplitStrToList(oid, list, '.');	280	SplitStrToList(oid, list, '.');
279	end;	281	end;
280		282
281	procedure ListBubbleSortNumericString(list: PStringList);	283	procedure ListBubbleSortNumericString(list: PStringList);
282	var	284	var
283	n, i: integer;	285	n, i: integer;
284	a, b: string;	286	a, b: string;
285	swapped: boolean;	287	swapped: boolean;
286	begin	288	begin
287	n := ListCount(list);	289	n := ListCount(list);
288	while n>1 do	290	while n>1 do
289	begin	291	begin
290	i := 0;	292	i := 0;
291	swapped := false;	293	swapped := false;
292	while i<n-1 do	294	while i<n-1 do
293	begin	295	begin
294	a := ListGetElement(list, i);	296	a := ListGetElement(list, i);
295	b := ListGetElement(list, i+1);	297	b := ListGetElement(list, i+1);
296	if CompareNumericString(a, b) > 0 then	298	if CompareNumericString(a, b) > 0 then
297	begin	299	begin
298	ListSwapElement(list, i, i+1);	300	ListSwapElement(list, i, i+1);
299	swapped := true;	301	swapped := true;
300	end;	302	end;
301	Inc(i);	303	Inc(i);
302	end;	304	end;
303	if not swapped then break;	305	if not swapped then break;
304	Dec(n);	306	Dec(n);
305	end;	307	end;
306	end;	308	end;
-		309
-		310	function ListLoadFromFile(list: PStringList; filename: string): boolean;
-		311	var
-		312	f: Text;
-		313	s: string;
-		314	begin
-		315	Assign(f, filename);
-		316
-		317	{$I-}
-		318	Reset(f);
-		319	{$I+}
-		320	if IoResult <> 0 then
-		321	begin
-		322	ListLoadFromFile := false;
-		323	(* Must not call Close(f) if file was never opened *)
-		324	Exit;
-		325	end;
-		326
-		327	ListClear(list);
-		328
-		329	while not EOF(f) do
-		330	begin
-		331	ReadLn(f, s);
-		332	ListAppend(list, s);
-		333	end;
-		334
-		335	Close(f);
-		336	ListLoadFromFile := true;
-		337	end;
-		338
-		339	function ListSaveToFile(list: PStringList; filename: string): boolean;
-		340	var
-		341	f: Text;
-		342	i: integer;
-		343	s: string;
-		344	begin
-		345	Assign(f, filename);
-		346
-		347	{$I-}
-		348	Rewrite(f);
-		349	{$I+}
-		350	if IoResult <> 0 then
-		351	begin
-		352	ListSaveToFile := false;
-		353	(* Must not call Close(f) if file was never opened *)
-		354	Exit;
-		355	end;
-		356
-		357	for i := 0 to ListCount(list)-1 do
-		358	begin
-		359	s := ListGetElement(list, i);
-		360	WriteLn(f, s);
-		361	end;
-		362
-		363	Close(f);
-		364	ListSaveToFile := true;
-		365	end;
307		366
308	end.	367	end.
309		368

Subversion Repositories oidplus

oidplus/trunk_dos/STRLIST.PAS – Rev 740 → 747