home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Collection of Hack-Phreak Scene Programs
/
cleanhpvac.zip
/
cleanhpvac
/
OOPTUT34.ZIP
/
OBCOMPAT.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1993-06-14
|
6KB
|
243 lines
{$A+,B-,D+,E+,F-,G-,I+,L+,N-,O-,R-,S+,V+,X-}
{$M 16384,0,6000}
program object_compatability;
{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
{ Program to show dynamic objects and to illustrate the compatability }
{ of descendant objects with ancestors. A simple database situation is }
{ created with Surname and Forenames having a descendant, Address, which }
{ in turn has a descendant, Phone. As in the Borland program, LISTDEMO, }
{ a Node record is created on the Heap and this points to the data item }
{ and to the next Node record. }
{ The program uses the Exec procedure to call DOS Debug to inspect the }
{ data on the Heap. }
{ }
{ OBCOMPAT.PAS -> .EXE R Shaw 2.11.92 and 22.11.92 }
{________________________________________________________________________}
uses Dos, Crt, Hexa;
type
Str10 = string[10];
Str15 = string[15];
Str20 = string[20];
Str30 = string[30];
Str40 = string[40];
PName = ^TName;
TName = object
Surname : str20;
Forenames : str40;
Constructor Init(SName: str20; Fnames: str40);
Destructor Done; virtual;
end;
PAddress = ^TAddress;
TAddress = object(TName)
Street : str30;
Town : str20;
County : str20;
PostCode : str10;
Constructor Init(St: str30; T: str20; C: str20; Code: str10);
end;
PPhone = ^TPhone;
TPhone = object(TAddress)
Number : string[15];
Constructor Init(Num: str15);
end;
PNode = ^TNode;
TNode = record
Item: PName;
Next: PNode;
end;
PList = ^TList;
TList = object
Nodes: PNode;
constructor Init;
destructor Done; virtual;
procedure Add(Item: PName);
end;
var
HeapTop : ^integer;
SegHeap, OfsHeap : word;
SegHeapX,OfsHeapX : string;
i : integer;
ContactList : TList;
NamePtr : PName;
AddressPtr : PAddress;
PhonePtr : PPhone;
choice : integer;
Code : Str10;
Num : Str15;
SName,T,C : Str20;
FNames : Str40;
St : Str30;
reply : char;
procedure InitData;
begin
Code := '';
Num := '';
Sname := '';
Fnames := '';
T := '';
C := '';
St := '';
end;
Constructor TName.Init(SName: str20; Fnames: str40);
begin
Surname := SName;
Forenames := FNames;
end;
Constructor TAddress.Init(St: str30; T: str20; C: str20; Code: str10);
begin
TName.Init(SName,FNames);
Street := St;
Town := T;
County := C;
PostCode := Code;
end;
Constructor TPhone.Init(Num: str15);
begin
TAddress.Init(St,T,C,Code);
Number := Num;
end;
{--------------------------------------------------------}
{ TList's method implementations: }
{--------------------------------------------------------}
constructor TList.Init;
begin
Nodes := nil;
end;
destructor TName.Done;
begin
end;
destructor TList.Done;
var
N: PNode;
begin
while Nodes <> nil do
begin
N := Nodes;
Nodes := N^.Next;
Dispose(N^.Item, Done);
Dispose(N);
end;
end;
procedure TList.Add(Item: PName);
var
N: PNode;
begin
New(N);
N^.Item := Item;
N^.Next := Nodes;
Nodes := N;
end;
Function DebugPath : Pathstr;
var
DPath : PathStr;
begin
DPath := '';
DPath := FSearch('DEBUG.EXE', GetEnv('PATH'));
If DPath = '' then DPath := FSearch('DEBUG.COM', GetEnv('PATH'));
If DPath = '' then
begin
writeln('DEBUG file not found. Please check your DOS system.');
writeln;
writeln('Press any key to continue: ');
repeat until keypressed;
end;
DebugPath := DPath;
end; {of Function DebugPath}
{Main}
begin
ClrScr;
Mark(HeapTop);
SegHeap := Seg(HeapTop^);
OfsHeap := Ofs(HeapTop^);
SegHeapX := IntToHex(SegHeap);
OfsHeapX := IntToHex(OfsHeap);
For i := OfsHeap to (OfsHeap + 1000) do Mem[SegHeap:i] := 0;
ContactList.Init;
Repeat
InitData;
writeln;
writeln('Please indicate type of entry by pressing the appropriate number key: ');
writeln;
writeln(' 1 Names only');
writeln(' 2 Names and address');
writeln(' 3 Names and address and phone number');
writeln;
write('Please select now: ');
repeat
readln(choice);
until choice in [1..3];
writeln;
write('Surname: ');
readln(SName);
write('Forenames: ');
readln(FNames);
writeln;
if choice = 1 then
begin
NamePtr := New(PName,Init(SName,FNames));
ContactList.Add(NamePtr);
end;
if (choice = 2) or (choice = 3) then
begin
write('Street: ');
readln(St);
write('Town: ');
readln(T);
write('County: ');
readln(C);
write('Code: ');
readln(Code);
end;
if choice = 2 then
begin
AddressPtr := New(PAddress,Init(St,T,C,Code));
ContactList.Add(AddressPtr);
end;
if choice = 3 then
begin
write('Phone Number: ');
readln(Num);
PhonePtr := New(PPhone,Init(Num));
ContactList.Add(PhonePtr);
end;
writeln;
write('Press C to continue or Q to quit: ');
reply := readkey;
until UpCase(reply) = 'Q';
writeln;
writeln('HeapTop address is ',SegHeapX,':',OfsHeapX);
writeln;
writeln('DOS Debug now entered from program by means of Exec procedure.');
writeln('Please type D followed by a space and then the HeapOrg address, as above.');
writeln('Then continue to type D until end of collection. Then type Q.');
SwapVectors;
Exec(DebugPath,'');
If DosError <> 0 then writeln('Dos error # ',DosError);
SwapVectors;
ContactList.Done;
end.