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
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
|
{********[ SOURCE FILE OF GRAPHICAL FREE VISION ]**********}
{ }
{ System independent GRAPHICAL clone of HISTLIST.PAS }
{ }
{ Interface Copyright (c) 1992 Borland International }
{ }
{ Copyright (c) 1996, 1997, 1998, 1999 by Leon de Boer }
{ ldeboer@attglobal.net - primary e-mail address }
{ ldeboer@starwon.com.au - backup e-mail address }
{ }
{****************[ THIS CODE IS FREEWARE ]*****************}
{ }
{ This sourcecode is released for the purpose to }
{ promote the pascal language on all platforms. You may }
{ redistribute it and/or modify with the following }
{ DISCLAIMER. }
{ }
{ This SOURCE CODE is distributed "AS IS" WITHOUT }
{ WARRANTIES AS TO PERFORMANCE OF MERCHANTABILITY OR }
{ ANY OTHER WARRANTIES WHETHER EXPRESSED OR IMPLIED. }
{ }
{*****************[ SUPPORTED PLATFORMS ]******************}
{ 16 and 32 Bit compilers }
{ DOS - Turbo Pascal 7.0 + (16 Bit) }
{ DPMI - Turbo Pascal 7.0 + (16 Bit) }
{ - FPC 0.9912+ (GO32V2) (32 Bit) }
{ WINDOWS - Turbo Pascal 7.0 + (16 Bit) }
{ - Delphi 1.0+ (16 Bit) }
{ WIN95/NT - Delphi 2.0+ (32 Bit) }
{ - Virtual Pascal 2.0+ (32 Bit) }
{ - Speedsoft Sybil 2.0+ (32 Bit) }
{ - FPC 0.9912+ (32 Bit) }
{ OS2 - Virtual Pascal 1.0+ (32 Bit) }
{ }
{******************[ REVISION HISTORY ]********************}
{ Version Date Fix }
{ ------- --------- --------------------------------- }
{ 1.00 11 Nov 96 First DOS/DPMI platform release. }
{ 1.10 13 Jul 97 Windows platform code added. }
{ 1.20 29 Aug 97 Platform.inc sort added. }
{ 1.30 13 Oct 97 Delphi 2 32 bit code added. }
{ 1.40 05 May 98 Virtual pascal 2.0 code added. }
{ 1.50 30 Sep 99 Complete recheck preformed }
{ 1.51 03 Nov 99 FPC windows support added }
{**********************************************************}
UNIT HistList;
{<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
INTERFACE
{<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
{====Include file to sort compiler platform out =====================}
{$I Platform.inc}
{====================================================================}
{==== Compiler directives ===========================================}
{$IFNDEF PPC_FPC}{ FPC doesn't support these switches }
{$F-} { Short calls are okay }
{$A+} { Word Align Data }
{$B-} { Allow short circuit boolean evaluations }
{$O+} { This unit may be overlaid }
{$G+} { 286 Code optimization - if you're on an 8088 get a real computer }
{$P-} { Normal string variables }
{$N-} { No 80x87 code generation }
{$E+} { Emulation is on }
{$ENDIF}
{$X+} { Extended syntax is ok }
{$R-} { Disable range checking }
{$S-} { Disable Stack Checking }
{$I-} { Disable IO Checking }
{$Q-} { Disable Overflow Checking }
{$V-} { Turn off strict VAR strings }
{====================================================================}
USES FVCommon, Objects; { Standard GFV units }
{***************************************************************************}
{ INTERFACE ROUTINES }
{***************************************************************************}
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
{ HISTORY SYSTEM CONTROL ROUTINES }
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
{-InitHistory--------------------------------------------------------
Initializes the history system usually called from Application.Init
30Sep99 LdB
---------------------------------------------------------------------}
PROCEDURE InitHistory;
{-DoneHistory--------------------------------------------------------
Destroys the history system usually called from Application.Done
30Sep99 LdB
---------------------------------------------------------------------}
PROCEDURE DoneHistory;
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
{ HISTORY ITEM ROUTINES }
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
{-HistoryCount-------------------------------------------------------
Returns the number of strings in the history list with ID number Id.
30Sep99 LdB
---------------------------------------------------------------------}
FUNCTION HistoryCount (Id: Byte): Word;
{-HistoryStr---------------------------------------------------------
Returns the Index'th string in the history list with ID number Id.
30Sep99 LdB
---------------------------------------------------------------------}
FUNCTION HistoryStr (Id: Byte; Index: Sw_Integer): String;
{-ClearHistory-------------------------------------------------------
Removes all strings from all history lists.
30Sep99 LdB
---------------------------------------------------------------------}
PROCEDURE ClearHistory;
{-HistoryAdd---------------------------------------------------------
Adds the string Str to the history list indicated by Id.
30Sep99 LdB
---------------------------------------------------------------------}
PROCEDURE HistoryAdd (Id: Byte; Const Str: String);
function HistoryRemove(Id: Byte; Index: Sw_Integer): boolean;
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
{ HISTORY STREAM STORAGE AND RETREIVAL ROUTINES }
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
{-LoadHistory--------------------------------------------------------
Reads the application's history block from the stream S by reading the
size of the block, then the block itself. Sets HistoryUsed to the end
of the block read. Use LoadHistory to restore a history block saved
with StoreHistory
30Sep99 LdB
---------------------------------------------------------------------}
PROCEDURE LoadHistory (Var S: TStream);
{-StoreHistory--------------------------------------------------------
Writes the currently used portion of the history block to the stream
S, first writing the length of the block then the block itself. Use
the LoadHistory procedure to restore the history block.
30Sep99 LdB
---------------------------------------------------------------------}
PROCEDURE StoreHistory (Var S: TStream);
{***************************************************************************}
{ INITIALIZED PUBLIC VARIABLES }
{***************************************************************************}
{---------------------------------------------------------------------------}
{ INITIALIZED DOS/DPMI/WIN/NT/OS2 VARIABLES }
{---------------------------------------------------------------------------}
CONST
HistorySize: sw_integer = 64*1024; { Maximum history size }
HistoryUsed: sw_integer = 0; { History used }
HistoryBlock: Pointer = Nil; { Storage block }
{<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
IMPLEMENTATION
{<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
{***************************************************************************}
{ PRIVATE RECORD DEFINITIONS }
{***************************************************************************}
{---------------------------------------------------------------------------}
{ THistRec RECORD DEFINITION
Zero 1 byte, start marker
Id 1 byte, History id
<shortstring> 1 byte length+string data, Contents
}
{***************************************************************************}
{ UNINITIALIZED PRIVATE VARIABLES }
{***************************************************************************}
{---------------------------------------------------------------------------}
{ UNINITIALIZED DOS/DPMI/WIN/NT/OS2 VARIABLES }
{---------------------------------------------------------------------------}
VAR
CurId: Byte; { Current history id }
CurString: PString; { Current string }
{***************************************************************************}
{ PRIVATE UNIT ROUTINES }
{***************************************************************************}
{---------------------------------------------------------------------------}
{ StartId -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Sep99 LdB }
{---------------------------------------------------------------------------}
PROCEDURE StartId (Id: Byte);
BEGIN
CurId := Id; { Set current id }
CurString := HistoryBlock; { Set current string }
END;
{---------------------------------------------------------------------------}
{ DeleteString -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Sep99 LdB }
{---------------------------------------------------------------------------}
PROCEDURE DeleteString;
VAR Len: Sw_Integer; P, P2: PChar;
BEGIN
P := PChar(CurString); { Current string }
P2 := PChar(CurString); { Current string }
Len := PByte(P2)^+3; { Length of data }
Dec(P, 2); { Correct position }
Inc(P2, PByte(P2)^+1); { Next hist record }
{ Shuffle history }
Move(P2^, P^, Pointer(HistoryBlock) + HistoryUsed - Pointer(P2) );
Dec(HistoryUsed, Len); { Adjust history used }
END;
{---------------------------------------------------------------------------}
{ AdvanceStringPtr -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Sep99 LdB }
{---------------------------------------------------------------------------}
PROCEDURE AdvanceStringPtr;
VAR P: PChar;
BEGIN
While (CurString <> Nil) Do Begin
If (Pointer(CurString) >= Pointer(HistoryBlock) + HistoryUsed) Then Begin{ Last string check }
CurString := Nil; { Clear current string }
Exit; { Now exit }
End;
Inc(PChar(CurString), PByte(CurString)^+1); { Move to next string }
If (Pointer(CurString) >= Pointer(HistoryBlock) + HistoryUsed) Then Begin{ Last string check }
CurString := Nil; { Clear current string }
Exit; { Now exit }
End;
P := PChar(CurString); { Transfer record ptr }
Inc(PChar(CurString), 2); { Move to string }
if (P^<>#0) then
RunError(215);
Inc(P);
If (P^ = Chr(CurId)) Then Exit; { Found the string }
End;
END;
{---------------------------------------------------------------------------}
{ InsertString -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Sep99 LdB }
{---------------------------------------------------------------------------}
PROCEDURE InsertString (Id: Byte; Const Str: String);
VAR P, P1, P2: PChar;
BEGIN
while (HistoryUsed+Length(Str)+3>HistorySize) do
begin
P:=PChar(HistoryBlock);
while Pointer(P)<Pointer(HistoryBlock)+HistorySize do
begin
if Pointer(P)+Length(PShortString(P+2)^)+6+Length(Str) >
Pointer(HistoryBlock)+HistorySize then
begin
Dec(HistoryUsed,Length(PShortString(P+2)^)+3);
FillChar(P^,Pointer(HistoryBlock)+HistorySize-Pointer(P),#0);
break;
end;
Inc(P,Length(PShortString(P+2)^)+3);
end;
end;
P1 := PChar(HistoryBlock)+1; { First history record }
P2 := P1+Length(Str)+3; { History record after }
Move(P1^, P2^, HistoryUsed - 1); { Shuffle history data }
P1^:=#0; { Set marker byte }
Inc(P1);
P1^:=Chr(Id); { Set history id }
Inc(P1);
Move(Str[0], P1^, Length(Str)+1); { Set history string }
Inc(HistoryUsed, Length(Str)+3); { Inc history used }
END;
{***************************************************************************}
{ INTERFACE ROUTINES }
{***************************************************************************}
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
{ HISTORY SYSTEM CONTROL ROUTINES }
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
{---------------------------------------------------------------------------}
{ InitHistory -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Sep99 LdB }
{---------------------------------------------------------------------------}
PROCEDURE InitHistory;
BEGIN
if HistorySize>0 then
GetMem(HistoryBlock, HistorySize); { Allocate block }
ClearHistory; { Clear the history }
END;
{---------------------------------------------------------------------------}
{ DoneHistory -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Sep99 LdB }
{---------------------------------------------------------------------------}
PROCEDURE DoneHistory;
BEGIN
If (HistoryBlock <> Nil) Then { History block valid }
begin
FreeMem(HistoryBlock); { Release history block }
HistoryBlock:=nil;
end;
END;
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
{ HISTORY ITEM ROUTINES }
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
{---------------------------------------------------------------------------}
{ HistoryCount -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Sep99 LdB }
{---------------------------------------------------------------------------}
FUNCTION HistoryCount(Id: Byte): Word;
VAR Count: Word;
BEGIN
StartId(Id); { Set to first record }
Count := 0; { Clear count }
If (HistoryBlock <> Nil) Then Begin { History initalized }
AdvanceStringPtr; { Move to first string }
While (CurString <> Nil) Do Begin
Inc(Count); { Add one to count }
AdvanceStringPtr; { Move to next string }
End;
End;
HistoryCount := Count; { Return history count }
END;
{---------------------------------------------------------------------------}
{ HistoryStr -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Sep99 LdB }
{---------------------------------------------------------------------------}
FUNCTION HistoryStr(Id: Byte; Index: Sw_Integer): String;
VAR I: Sw_Integer;
BEGIN
StartId(Id); { Set to first record }
If (HistoryBlock <> Nil) Then Begin { History initalized }
For I := 0 To Index Do AdvanceStringPtr; { Find indexed string }
If (CurString <> Nil) Then
HistoryStr := CurString^ Else { Return string }
HistoryStr := ''; { Index not found }
End Else HistoryStr := ''; { History uninitialized }
END;
{---------------------------------------------------------------------------}
{ ClearHistory -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Sep99 LdB }
{---------------------------------------------------------------------------}
PROCEDURE ClearHistory;
BEGIN
If (HistoryBlock <> Nil) Then Begin { History initiated }
PChar(HistoryBlock)^ := #0; { Clear first byte }
HistoryUsed := 1; { Set position }
End;
END;
{---------------------------------------------------------------------------}
{ HistoryAdd -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Sep99 LdB }
{---------------------------------------------------------------------------}
PROCEDURE HistoryAdd (Id: Byte; Const Str: String);
BEGIN
If (Str = '') Then Exit; { Empty string exit }
If (HistoryBlock = Nil) Then Exit; { History uninitialized }
StartId(Id); { Set current data }
AdvanceStringPtr; { Find the string }
While (CurString <> nil) Do Begin
If (Str = CurString^) Then DeleteString; { Delete duplicates }
AdvanceStringPtr; { Find next string }
End;
InsertString(Id, Str); { Add new history item }
END;
function HistoryRemove(Id: Byte; Index: Sw_Integer): boolean;
var
I: Sw_Integer;
begin
StartId(Id);
for I := 0 to Index do
AdvanceStringPtr; { Find the string }
if CurString <> nil then
begin
DeleteString;
HistoryRemove:=true;
end
else
HistoryRemove:=false;
end;
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
{ HISTORY STREAM STORAGE AND RETREIVAL ROUTINES }
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
{---------------------------------------------------------------------------}
{ LoadHistory -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Sep99 LdB }
{---------------------------------------------------------------------------}
PROCEDURE LoadHistory (Var S: TStream);
VAR Size: sw_integer;
BEGIN
S.Read(Size, sizeof(Size)); { Read history size }
If (HistoryBlock <> Nil) Then Begin { History initialized }
If (Size <= HistorySize) Then Begin
S.Read(HistoryBlock^, Size); { Read the history }
HistoryUsed := Size; { History used }
End Else S.Seek(S.GetPos + Size); { Move stream position }
End Else S.Seek(S.GetPos + Size); { Move stream position }
END;
{---------------------------------------------------------------------------}
{ StoreHistory -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Sep99 LdB }
{---------------------------------------------------------------------------}
PROCEDURE StoreHistory (Var S: TStream);
VAR Size: sw_integer;
BEGIN
If (HistoryBlock = Nil) Then Size := 0 Else { No history data }
Size := HistoryUsed; { Size of history data }
S.Write(Size, sizeof(Size)); { Write history size }
If (Size > 0) Then S.Write(HistoryBlock^, Size); { Write history data }
END;
END.
|
