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


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

Subversion Repositories oidplus

oidplus/trunk_dos/STRLIST.PAS – Rev 748 → 992