+3 8(066) 185-39-18
fПредмет:
Тип роботи:
Курсова робота
К-сть сторінок:
82
Мова:
Українська
aux:=obj_list;
obj_list:=obj_list^.next;
dispose(aux);
end;
end;
procedure ReadPathFile(var path:string;var Header:header_ptr);
var dir,unit_dirs:string;
i:integer;
begin
header:=nil;
read_file(path,pointer(header),0,sizeof(header^));
if header = nil then
begin
unit_dirs:=uses_path;
while (unit_dirs<>'') and (header=nil) do
begin
i:=pos(';',unit_dirs);
if i=0 then
i:=length(unit_dirs)+1;
dir := copy(unit_dirs,1,i-1);
unit_dirs := copy(unit_dirs,i+1,255);
if dir[length(dir)] <> '\' then
dir := dir + '\';
read_file(dir+path,pointer(header),0,sizeof(header^));
end;
if header<>nil then
path:=dir+path;
end;
end;
procedure add_unit(const objname:string;info : unit_ptr);
var
size,total:word;
header:header_ptr;
unit_obj:obj_ptr;
junk : pointer;
obj_info : unit_ptr;
info_ofs,offset : word;
tpl_item : tpl_item_ptr;
procedure load_buffer;
var i:integer;
begin
with unit_list[num_known]^ do
begin
path := objname+unit_ext;
ReadPathFile(path,header);
if header <> nil then
begin
if header^.file_id <> tpu_file_id then
begin
HaltError('Error: file '+path+' is not a TP '+
{$IFDEF UNIT60}
'6.0'
{$ELSE}
'7.0'
{$ENDIF}
+' .TPU file!');
end;
read_file(path,pointer(buffer),0,header^.sym_size);
if buffer <> nil then
begin
has_symbols := true;
header:=header_ptr(buffer);
end;
exit;
end;
path := '';
tpl_item := tpl_buffer.first;
while tpl_item<>nil do
begin
header := header_ptr(tpl_item^.buffer);
if (header^.file_id <> tpu_file_id) then
begin
HaltError('Error searching '+tpl_name+'. It is not a TP library!');
end;
unit_obj := add_only_offset(header,header^.ofs_this_unit);
if upper(unit_obj^.name) = upper(objname) then
begin
buffer := pointer(header);
has_symbols := true;
exit;
end;
tpl_item:=tpl_item^.next;
end;
WriteOutput('Warning: Can''t find unit '+objname);
end;
end;
var
existing : unit_list_ptr;
D: DirStr;
N: NameStr;
E: ExtStr;
begin
existing := get_unit_by_name(objname);
if existing <> nil then
with existing^ do
begin
if (info <> nil)
and (existing^.buffer <> nil)
and (checksum <> info^.checksum) then
begin
writeln('Warning: checksum for unit ',name,' is ',hexword(checksum),' in ',
path);
has_symbols := false;
freemem(buffer,header^.sym_size);
buffer := nil;
end;
exit;
end;
inc(num_known);
new(unit_list[num_known]);
with unit_list[num_known]^ do
begin
name := upper(objname);
obj_list := nil;
proc_list := nil;
buffer := nil;
has_symbols := false;
load_buffer;
if has_symbols then
begin
FSplit(name, D, N, E);
name:=N;
own_record := header_ptr(buffer)^.ofs_this_unit;