{$A+,B-,D+,E+,F-,G+,I+,L+,N-,P-,Q-,R-,S+,T-,V-,X+,Y+}
{$ifdef DPMI}
{$M 65520}
{$endif}
{$define xDEBUG}
program HOST;
uses
{$ifndef unix}
{$ifdef DPMI}
 crt,
{$else}
 wincrt,
{$endif}
{$else}
 xcrt,
{$endif}
 data,
 dos,
 kb,
 ovrfirst,
 swapit,
 tstring,
 types,
 menus4,
 utils,
 vbios,
 wstrings;

const
 c_none=0;
 c_ship=1;
 c_plan=2;
 c_Base=3;
 c_Miss=4;
 c_nation=5;
 c_intern=6;
 c_Entd=7;
 c_Punkt=8;
 c_System=9;


var
 usedrassen,		{ flags for races declared as active }
 filetag:longint;	{ currend file tag (identical for all current files }
 Turn_nr:word;		{ current turn number }

 nrplans,		{ total number of plans,ships,bases,mfields }
 nrships,
 nrbases,
 nrmfelder:word;
 plan:tap_hplanet;	{ global data }
 ship:tap_hschiff;
 base:tap_hbasis;
 mfeld:tap_hmfeld;

 rnrplans,		{ local data }
 rnrships,
 rnrbases,
 rnmsgs:array[0..31] of word;
 rplan:array[0..31] of tap_hplanet;
 rship:array[0..31] of tap_hschiff;
 rbase:array[0..31] of tap_hbasis;
 rmsgs:array[0..31] of  tp_hmsgs;
 rwmsg:array[0..31] of  ta_wmsg;

 planetschg:array[0..999] of byte;	{ "changed" flags }
 baseschg:array[0..1199] of byte;
 shipschg:array[0..3499] of byte;
 game,					{ global game files }
 game2:file;
 racesa:array[0..31] of boolean;	{ racefile Available }
 romcode:array[0..31] of longint;	{ racefile Romcode / Pwd }
 pwd:array[0..31] of string15;

type
 o_message=object			{ Message Server Object: }
  constructor init;                     {  supplies Messages }
  destructor done;
  procedure write(co1,co2,co3:byte;r:longint;text:wstring);
	{ sends message <text> concerning co1,co2,co3 to races in r }
  private
  mc:array[0..31] of t_message;		{ Message Cache }
  d:array[0..31] of word;
  mf:array[0..31]of file;		{ Message Files }
  smf:array[0..31] of longint;
  c1,c2,c3:byte;			{ Concern/race cache: }
  rc:longint;				{  used to validate cache }
  procedure flush;			{ flushes data to disk }
 end;

var
 msg:o_message;

procedure ende;
{ regular end }
var
 i,y:byte;
begin
 y:=wherey;
 if y>23 then begin
  for i:=0 to 24 do writeln;
  y:=25;
 end;
 setvideomode($83);
 setcursorxy(0,y-1,0);
 system.halt;
end;

procedure halt;
{ abend on error }
begin
 textattr:=$c;
 write('!Abbruch! -=ð>(Taste)<ð=-');
 textattr:=7;
 if kbreadkey=#0 then kbreadkey;
 writeln(strings(#8,15),spaces(15));
 ende;
end;

function blockload(var f:file;var target;n:word):boolean;
{encrypted reading}
type
 a=array[0..0] of byte;
var
 r:word;
 i:word;
begin
 if n<>0 then begin
  {$i-}
  if ioresult=0 then;
  blockread(f,target,n,r);
  blockload:=(r=n)and(ioresult=0);
  for i:=0 to n-1 do a(target)[i]:=a(target)[i] xor lo(i) xor $be;
  {$i+}
 end else blockload:=true;
end;

function blocksave(var f:file;var target;n:word):boolean;
{encrypted writing}
type
 a=array[0..0] of byte;
var
 i,
 r:word;
begin
 if n<>0 then begin
  {$i-}
  if ioresult=0 then;
  for i:=0 to n-1 do a(target)[i]:=a(target)[i] xor lo(i) xor $be;
  blockwrite(f,target,n,r);
  for i:=0 to n-1 do a(target)[i]:=a(target)[i] xor lo(i) xor $be;
  blocksave:=(r=n)and(ioresult=0);
  {$i+}
 end else blocksave:=true;
end;

function israce(n:byte):boolean;
var
 sr:searchrec;
 s:string;
begin
 s:=path+'RACE-'+az10[n+1]+'.HST';
 findfirst(s,anyfile and not volumeid,sr);
 israce:=doserror=0;
end;

function isracechg(n:byte):boolean;
var
 sr:searchrec;
 s:string;
begin
 s:=path+'RACE-'+az10[n+1]+'.CHG';
 findfirst(s,anyfile and not volumeid,sr);
 isracechg:=doserror=0;
end;

procedure clearfflag(var f:file);
begin
{$i-}
 setfattr(f,0);
 if ioresult=0 then;
{$i+}
end;

function raceused(i:byte):boolean;
begin
 raceused:=(longint(1) shl i) and usedrassen <>0;
end;

constructor o_message.init;
var
 i,
 j:byte;
begin
 fillchar(mc,sizeof(mc),0);
 rc:=0;
 fillchar(smf,sizeof(smf),0);
 for i:=0 to 31 do begin
  assign(mf[i],path+'RACE-'+az10[i+1]+'.MSG');
  setfattr(mf[i],0);
  if raceused(i) then begin
   clearfflag(mf[i]);
   rewrite(mf[i]);
   close(mf[i]);
  end else begin
   {$i-}
   erase(mf[i]);
   if ioresult=0 then;
   {$i+}
  end;
 end;
end;

destructor o_message.done;
begin
 flush;
end;

procedure o_message.flush;
var
 i:byte;
 j:integer;
 s:string;
 tagsave:t_hmsgtag;

 procedure save;
 var
  j:byte;
 begin
  filemode:=2;
  reset(mf[i],1);
  seek(mf[i],rmsgs[i]^[d[i]].ofs);
  for j:=0 to 29 do begin
   s:=getstring(mc[i,j]);
   blocksave(mf[i],s[0],1);
   blocksave(mf[i],s[1],length(s));
  end;
  smf[i]:=filesize(mf[i]);
  close(mf[i]);
 end;

begin
 for i:=0 to 31 do if (longint(1) shl i) and rc<>0 then begin
  with rmsgs[i]^[d[i]] do if lines<>0 then begin
   if d[i]>0 then with rmsgs[i]^[rnmsgs[i]-1] do begin
    { write closed to last message }
    inc(rmsgs[i]^[d[i]].free,free);
    dec(rmsgs[i]^[d[i]].ofs,free);
    free:=0;
   end else begin
    { write closed to top of file }
    inc(free,ofs);
    ofs:=0;
   end;
   if d[i]=rnmsgs[i] then begin
    { if after "last" message in list: will fit perfectly, must be counted }
    free:=0;
    inc(rnmsgs[i]);
   end;
   if free<0 then begin
    if rmsgs[i]^[0].ofs>=len
    then j:=-1
    else for j:=0 to integer(rnmsgs[i]-1)
	 do if rmsgs[i]^[j].free>=len then break;
    { find first}
    tagsave:=rmsgs[i]^[d[i]];
    if j<d[i] then begin
     move(rmsgs[i]^[j+1],rmsgs[j+2],(d[i]-j-1)*sizeof(tagsave));
     inc(rmsgs[i]^[d[i]].free,tagsave.len);
     if j>=0
     then begin
      tagsave.free:=rmsgs[i]^[j].free-tagsave.len;
      rmsgs[i]^[j].free:=0;
     end else tagsave.free:=rmsgs[i]^[1].ofs-tagsave.len;
     rmsgs[i]^[j+1]:=tagsave;
     d[i]:=j+1;
    end else begin
     move(rmsgs[d[i]+1],rmsgs[d[i]],(j-d[i])*sizeof(tagsave));
     if d[i]>0
     then inc(rmsgs[i]^[d[i]-1].free,tagsave.len);
     rmsgs[i]^[j]:=tagsave;
     with rmsgs[i]^[j-1] do begin
      rmsgs[i]^[j].ofs:=ofs+len;
      if j=rnmsgs[i]
      then free:=0
      else rmsgs[i]^[j].free:=free-tagsave.len;
      free:=0;
     end;
     d[i]:=j;
    end;
   end;
   save;
  end;
 end;
end;

procedure o_message.write(co1,co2,co3:byte;r:longint;text:wstring);
var
 s:array[0..29] of string;	{ converted strings from text }
 t:string;
 st,				{ number of strings in s }
 i,
 k,
 l:byte;
 j,
 ladd:word;			{ file ofs increment by appending message }
 c,				{ close this message page after output }
 f:boolean;			{ flush cache }
begin
{ *** (Ende=#12):EOP }
 c:=false;
 if text.s[text.len-1]=#12 then begin
  c:=true;
  dec(text.len);
 end;
{ *** Convert #13 to line break & add line lenghts }
 st:=0;
 ladd:=0;
 while (text.len<>0)and(st<30) do begin
  j:=text.posc(#13);
  if j=$ffff then j:=text.len+1;
  s[st]:=text.copyp(0,j);
  inc(st);
  inc(ladd,j-1);
  text.delete(0,j+1);
 end;
 { testing for Cache }
 f:=(r<>rc)or(c1<>co1)or(c2<>co2)or(c3<>co3);
 { test, if enough space in cache }
 if not f
 then for i:=0 to 31
 do if((longint(1) shl i) and r<>0)and(rmsgs[i]^[d[i]].lines+st>30)
 then begin
  f:=true;
  break;
 end;
 if f then begin
  flush;
  { flush cache }
  for i:=0 to 31 do if (longint(1) shl i) and r<>0 then begin
   for j:=0 to 29 do setstring(mc[i,j],'');
   d[i]:=rnmsgs[i];
   if rnmsgs[i]<>0
   then for j:=0 to rnmsgs[i]-1
   do with rmsgs[i]^[j]
   do if (concern1=co1)and(concern2=co2)and(concern3=co3)and(lines+st<=30)
   then begin
    { find available message slot }
    d[i]:=j;
    seek(mf[i],ofs);
    for k:=0 to 29 do begin
     blockload(mf[i],t,1);
     l:=byte(t[0]);
     blockload(mf[i],t[1],l);
     setstring(mc[i,k],t);
    end;
    break;
   end;
   if d[i]=rnmsgs[i] then with rmsgs[i]^[rnmsgs[i]] do begin
    { on new message set new basic data }
    concern1:=co1;
    concern2:=co2;
    concern3:=co3;
    len:=30;
    lines:=0;
    free:=0;
    ofs:=smf[i];
   end;
  end;
  { store for cache }
  c1:=co1;
  c2:=co2;
  c3:=co3;
  rc:=r;
 end;
 for i:=0 to 31 do if (longint(1) shl i) and r<>0 then begin
  { Strings anh„ngen }
  with rmsgs[i]^[d[i]] do begin
   if st<>0
   then for j:=0 to st-1
	do setstring(mc[i,lines+j],s[j]);
   inc(lines,st);
   inc(len,ladd);
   dec(free,ladd);
   if c and (lines=0) then lines:=30;
  end;
 end;
end;


type
 srec=record
  j1,j2,jx:word;
  race:byte;		{ race to find/found }
 end;

function sfind(idx:longint;var s:srec;first:boolean):boolean;
{idx=id or x}
var
 x:word absolute idx;
 i1,i2,im,ix:word;
 id2:longint;
 racef:byte;
begin
 sfind:=true;
 if first
 then racef:=0
 else racef:=s.race+1;

 if racef<32
 then with s
 do repeat
  if racesa[racef]
  then begin
   i2:=rnrships[racef]-1;
   i1:=i1 div 500;
   ix:=i1 mod 500;
   repeat
    pg_access(rship[racef,0,i1].h);
    id2:=rship[racef,0,i1].p^[0].id_nr;
    if id2<idx then begin
     if i1=0 then exit;
     dec(i1);
     ix:=499;
    end;
   until id2>=idx;
   j1:=i1;
   jx:=ix;
   race:=racef;

   if id2=idx then begin
    j2:=0;
    exit;
   end;
   if rship[racef,0,i1].p^[ix].id_nr=idx then begin
    j2:=ix;
    exit;
   end;
   im:=0;
   repeat
    i2:=(ix+im) shr 1;
    id2:=rship[racef,0,i1].p^[i2].id_nr;
    if id2<idx then begin
     ix:=i2;
    end else if id2>idx then begin
     im:=i2;
    end else begin
     j2:=i2;
     exit;
    end;
   until ix-im<=1;

   im:=0
  end;
  inc(racef);
 until racef>31;
 sfind:=false;
end;

{####################################################################}

procedure checkrace;
var
 i:byte;
 var
  a,
  b,
  o:word;
  z,
  c:char;
  sc:byte;
begin
 a:=0;
 b:=0;
 o:=0;
 for i:=0 to 31 do if raceused(i) then begin
  textattr:=7;
  write(rassen[i]:30,' (RACE-'+az10[i+1]+'.*) :');
  racesa[i]:=(isracechg(i) and israce(i));
  if not racesa[i] then begin
   textattr:=4;
   writeln('.CHG oder .HST fehlt!');
   inc(a);
  end else begin
   textattr:=2;
   writeln('vorhanden');
   inc(o);
  end;
 end else begin
  racesa[i]:=false;
  if israce(i) or isracechg(i) then begin
   textattr:=6;
   writeln('Zus„tzliche Dateien: RACE-'+az10[i+1]+'.*');
  end;
 end;

 if a>0 then begin
  textattr:=2;
  writeln(#10,o,' Spielerdateien vorhanden');
  textattr:=4;
  writeln(a,' Spielerdateien fehlen');
  z:=az10[random(36)+1];
  textattr:=$e;
  writeln(#10'Zum Starten "',z,'" dr�cken...');
  c:=upcase(kbreadkey);
  if c=#0 then sc:=byte(kbreadkey);
  if c<>z then halt;
 end else begin
  writeln(#10,o,' Spielerdateien vorhanden');
 end;
 textattr:=$a;
 writeln('Starte HOST...');
end;

procedure openhost;
var
 t:word;
 i:byte;

 procedure exit;
 begin
  textattr:=$c;
  writeln('Fehler beim ™ffnen von HOST.DB'#10#13#10+
	  'Spielverzeichnis korrekt angegeben???');
  halt;
 end;

begin
 {$i-}
 textattr:=$f;
 writeln('™ffne HOST.DB...');
 assign(game,path+'Host.db');
 clearfflag(game);
 reset(game,1);
 if ioresult<>0 then exit;
 if not blockload(game,filetag,sizeof(filetag)) then exit;
 if not blockload(game,usedrassen,sizeof(usedrassen)) then exit;
 if not blockload(game,turn_nr,sizeof(turn_nr)) then exit;
 blockload(game,nrplans,sizeof(nrplans));
 pg_access(plan[1,0].h);
 blockload(game,plan[1,0].p^,sizeof(plan[1,0].p^));
 if nrplans>500 then begin
  pg_access(plan[1,1].h);
  blockload(game,plan[1,1].p^,sizeof(plan[1,1].p^[1])*(nrplans-500));
 end;
 blockload(game,nrships,sizeof(nrships));
 t:=0;
 i:=0;
 while nrships>t do begin
  pg_access(ship[1,i].h);
  if nrships-t>=500
  then blockload(game,ship[1,i].p^,sizeof(ship[1,0].p^))
  else blockload(game,ship[1,i].p^,sizeof(ship[1,0].p^[1])*nrships-t);
  inc(i);
  inc(t,500);
 end;

 blockload(game,nrbases,sizeof(nrbases));
 t:=0;
 i:=0;
 while nrbases>t do begin
  pg_access(base[1,i].h);
  if nrbases-t>=300
  then blockload(game,base[1,i].p^,sizeof(base[1,0].p^))
  else blockload(game,base[1,i].p^,sizeof(base[1,0].p^[1])*nrbases-t);
  inc(i);
  inc(t,300);
 end;

 blockload(game,nrmfelder,sizeof(nrmfelder));
 if nrmfelder>0 then begin
  pg_access(mfeld[0].h);
  blockload(game,mfeld[0].p^,sizeof(mfeld[0].p^[1])*nrmfelder);
 end;
end;

procedure closehost;
var
 f:file;
 t:word;

 procedure halt;
 begin
  textattr:=$c;
  writeln('Fehler beim Speichern von HOST.DB');
  ende;
 end;

begin
 {$i-}
 assign(game2,'host.db$');
 if ioresult<>0 then halt;
 if not blocksave(game2,filetag,sizeof(filetag)) then halt;
 if not blocksave(game2,usedrassen,sizeof(usedrassen)) then halt;
 if not blocksave(game2,turn_nr,sizeof(turn_nr)) then halt;

(* blocksave(game,nrplans,sizeof(nrplans));
 blocksave(game,newplanet[0]^,sizeof(newplanet[0]^));
 if planetsanz>500 then blocksave(game,newplanet[1]^,
			      sizeof(newplanet[1]^[1])*(planetsanz-500));
 blocksave(game,nrships,sizeof(nrships));
 blocksave(game,newship^,sizeof(newship^[1])*nrships);
 w:=nrraces;
 blocksave(game,w,2);
 for i:=0 to 30
 do if not racesa[i]
 then for j:=i to 30
 do newbase[j]:=newbase[j+1];
 blocksave(game,newbase,sizeof(newbase[1])*nrraces);
 w:=0;
 blocksave(game,w,sizeof(w));{Minenfelder}*)
 close(game2);
 if ioresult<>0 then halt;
 close(game);
 if ioresult<>0 then halt;
 setfattr(game,0);
 if ioresult<>0 then halt;
 erase(game);
 if ioresult<>0 then halt;
 rename(game2,'HOST.db');
end;

procedure new_all;
var
 i,
 j,
 k:byte;
begin
 write('Anlegen der Datenstrukturen...   ');
 for i:=0 to 1 do begin
  with mfeld[i] do pg_getmemR(p,h,sizeof(mfeld[i].p^));
  for j:=0 to 1
   do with plan[i,j] do pg_getmemR(p,h,sizeof(plan[i,j].p^));
  for j:=0 to 3
   do with base[i,j] do pg_getmemR(p,h,sizeof(base[i,j].p^));
  for j:=0 to 6
   do with ship[i,j] do pg_getmemR(p,h,sizeof(ship[i,j].p^));
 end;
 for k:=0 to 31 do begin
  write(#8#8,k:2);
  for i:=0 to 1 do begin
   for j:=0 to 1
    do with rplan[k,i,j] do pg_getmemR(p,h,sizeof(rplan[k,i,j].p^));
   for j:=0 to 3
    do with rbase[k,i,j] do pg_getmemR(p,h,sizeof(rbase[k,i,j].p^));
   for j:=0 to 6
    do with rship[k,i,j] do pg_getmemR(p,h,sizeof(rship[k,i,j].p^));
  end;
  new(rmsgs[k]);
 end;
 fillchar(rnmsgs,sizeof(rnmsgs),0);
 writeln;
end;

procedure readraces;
var
 b,
 r,
 fn,
 i:byte;
 f:file;
 t:word;
 n:string63;
 dmy:pointer;
 ftag:longint;

 procedure fail(s:string);
 begin
  textattr:=$c;
  if s='' then writeln('Lesefehler!') else writeln(s);
  halt;
 end;

begin
 textattr:=$f;
 writeln('Lese Spielerdaten...');
 getmem(dmy,$ffff);
 for r:=0 to 31 do if raceused(r) then begin
 if not racesa[r] then begin
  textattr:=6;
  writeln(rassen[r]:30,': Fehlende Datei => ... wird ignoriert');
 end else begin
  textattr:=7;
  writeln(rassen[r],'...');
   n:=path+'RACE-'+az10[r+1];
   for fn:=0 to 1 do begin
    if ioresult<>0 then;
    if fn=0 then assign(f,n+'.HST') else assign(f,n+'.CHG');
    clearfflag(f);
    reset(f,1);
    if not blockload(f,dmy^,54) then fail('');{Text+Runde-Nr}
    if not blockload(f,ftag,4) then fail('');
    if ftag<>filetag then begin
     if fn=0 then fail('.HST : falsche Version')
     else fail('.CHG : falsche Version');
    end;
    if not blockload(f,romcode[r],4) then fail('');
    if not blockload(f,b,1) then fail('');
    if b<>0 then fail('falsches Dateiformat');
    if not blockload(f,pwd[r],16) then fail('');

    if not blockload(f,dmy^,4) then fail('');

    if not blockload(f,rnrplans[r],2) then fail('');
    if rnrplans[r]>0 then begin
     if rnrplans[r]>500 then begin
      pg_access(rplan[r,fn,0].h);
      if not blockload(f,rplan[r,fn,0].p^,sizeof(rplan[r,fn,0].p^)) then fail('');
      pg_access(rplan[r,fn,1].h);
      if not blockload(f,rplan[r,fn,1].p^,sizeof(rplan[r,fn,1].p^[0])*(rnrplans[r]-500)) then fail('');
     end else begin
      pg_access(rplan[r,fn,0].h);
      if not blockload(f,rplan[r,fn,0].p^,sizeof(rplan[r,fn,0].p^[0])*rnrplans[r]) then fail('');
     end;
    end;

    if not blockload(f,rnrbases[r],2) then fail('');
    i:=0;
    t:=0;
    while t<rnrbases[r] do begin
     pg_access(rbase[r,fn,i].h);
     if rnrbases[r]-t>300 then begin
      if not blockload(f,rbase[r,fn,i].p^,sizeof(rbase[r,fn,i].p^)) then fail('');
     end else begin
      if not blockload(f,rbase[r,fn,i].p^,sizeof(rbase[r,fn,i].p^[0])*(rnrbases[r]-t)) then fail('');
     end;
     inc(i);
     inc(t,300);
    end;

    if not blockload(f,rnrships[r],2) then fail('');
    i:=0;
    t:=0;
    while t<rnrships[r] do begin
     pg_access(rship[r,fn,i].h);
     if rnrships[r]-t>500 then begin
      if not blockload(f,rship[r,fn,i].p^,sizeof(rship[r,fn,i].p^)) then fail('');
     end else begin
      if not blockload(f,rship[r,fn,i].p^,sizeof(rship[r,fn,i].p^[0])*(rnrships[r]-t)) then fail('');
     end;
     inc(i);
     inc(t,500);
    end;

    if not blockload(f,t,2) then fail('');{Minenfelder}
    if not blockload(f,dmy^,sizeof(t_minenfeld)*t) then fail('');

    if not blockload(f,msganz,2) then fail('');
    if not blockload(f,dmy^,sizeof(t_msgtag)*msganz) then fail('');

    if not blockload(f,rwmsg[r],sizeof(rwmsg[1])) then fail('');

    close(f);
   end;
  end;
 end;
 freemem(dmy,$ffff);
end;

function compare(var a,b;len:word):boolean;assembler;
asm
 push ds
 les di,b
 lds si,a
 mov cx,len
 xor ax,ax
 rep cmpsb
 jne @not_equal
 inc ax
@not_equal:
 pop ds
end;

procedure compile;
 procedure makename(var s:string);
 var
  space:boolean;
  i:byte;
 begin
  space:=true;
  i:=1;
  while i<length(s) do begin
   if space and (s[i]=' ')
   then delete(s,1,1)
   else begin
    space:=s[i]=' ';
    inc(i);
   end;
  end;
  while s[length(s)]=' ' do delete(s,length(s),1);
 end;

 procedure checknames;
 var
  r,
  i,
  j,
  t:word;
  rc:longint;
  ws1:wstring;
 begin
  ws1.init(200);

  textattr:=$f;
  writeln('Einlesen der Namens„nderungen...');
  textattr:=7;
  fillchar(planetschg,sizeof(planetschg),$ff);
  fillchar(shipschg,  sizeof(planetschg),$ff);
  fillchar(baseschg,  sizeof(planetschg),$ff);
  for r:=0 to 31 do if racesa[r] and (rnrplans[r]<>0) then begin
   writeln(rassen[r],'...');
   for i:=0 to (rnrplans[r]-1) div 500 do begin
    if i=(rnrplans[r]-1) div 500
    then t:=(rnrplans[r]-1) mod 500
    else t:=500-1;
    pg_lock(rplan[r,1,i].h);
    pg_access(rplan[r,0,i].h);
    for j:=0 to t
    do if (rplan[r,0,i].p^[j].racetyp=r)and(rplan[r,0,i].p^[j].raceanz>0)
    and (rplan[r,1,i].p^[j].name<>rplan[r,0,i].p^[j].name)
    then with rplan[r,1,i].p^[j] do begin
     makename(name);
     if name<>'' then begin
      planetschg[id_nr]:=r;
      pg_access(plan[1,id_nr div 500].h);
      plan[1,id_nr div 500].p^[id_nr mod 500].name:=name;
     end;
    end;
    pg_unlock(rplan[r,1,i].h);
   end;

   for i:=0 to (rnrships[r]-1) div 500 do begin
    pg_lock(rship[r,0,i].h);
    pg_access(rship[r,1,i].h);
    if i=(rnrships[r]-1) div 500
    then t:=(rnrships[r]-1) mod 500
    else t:=500-1;
    for j:=0 to t
    do if (rship[r,0,i].p^[j].owner=r)
    and (rship[r,1,i].p^[j].schiffname<>rship[r,0,i].p^[j].schiffname)
    then with rship[r,1,i].p^[j] do begin
     makename(schiffname);
     if schiffname<>'' then begin
      shipschg[id_nr]:=r;
      ship[1,id_nr div 500].p^[id_nr mod 500].schiffname:=schiffname;
     end;
    end;
    pg_unlock(rship[r,0,i].h);
   end;

   for i:=0 to (rnrbases[r]-1) div 300 do begin
    pg_lock(rbase[r,0,i].h);
    pg_access(rbase[r,1,i].h);
    if i=(rnrships[r]-1) div 300
    then t:=(rnrships[r]-1) mod 300
    else t:=300-1;
    for j:=0 to t
    do if (rbase[r,0,i].p^[j].owner=r)
    and (rbase[r,1,i].p^[j].name<>rbase[r,0,i].p^[j].name)
    then with rbase[r,1,i].p^[j] do begin
     makename(name);
     if name<>'' then begin
      baseschg[id_nr]:=r;
      base[1,id_nr div 300].p^[id_nr mod 300].name:=name;
     end;
    end;
    pg_unlock(rbase[r,0,i].h);
   end;
  end;

  t:=0;
  textattr:=$f;
  writeln('Umbenennungspr�fung der:');
  textattr:=7;
  write('Planeten...');
  for i:=1 to nrplans-1 do if planetschg[i]<$fe then begin
   pg_lock(plan[1,i div 500].h);
   for j:=0 to i-1
   do begin
    pg_access(plan[1,j div 500].h);
    if plan[1,i div 500].p^[i mod 500].name=plan[1,j div 500].p^[j mod 500].name
    then begin
     rc:=0;
     if planetschg[j]<$fe
     then begin
      inc(t);
      pg_lock(plan[1,j div 500].h);
      pg_access(plan[0,j div 500].h);
      ws1.setp(plan[0,j div 500].p^[j mod 500].name+
	       ':'#13#0'C'#4'Umbenennung nach '#0'C'#$c+
	       plan[1,j div 500].p^[j mod 500].name+
	       #0'C'#4' fehlgeschlagen');
      msg.write(9,2,0,longint(1) shl planetschg[j],ws1);
      planetschg[j]:=$fe;
      plan[1,j div 500].p^[j mod 500].name:=plan[0,j div 500].p^[j mod 500].name;
      pg_unlock(plan[1,j div 500].h);
     end;
     inc(t);
     pg_access(plan[0,i div 500].h);
     ws1.setp(plan[0,i div 500].p^[i mod 500].name+
	      ':'#13#0'C'#4'Umbenennung nach '#0'C'#$c+
	     plan[1,i div 500].p^[i mod 500].name+
	     #0'C'#4' fehlgeschlagen');
     msg.write(9,2,0,longint(1) shl planetschg[i],ws1);
     planetschg[i]:=$fe;
     plan[1,i div 500].p^[i mod 500].name:=plan[0,i div 500].p^[i mod 500].name;
     i:=0;
     write(t:4,#8#8#8#8);
     msg.write(9,2,0,longint(1) shl planetschg[i],ws1);
     break;
    end;
   end;
   begin
   end;
   pg_unlock(plan[1,i div 500].h);
  end;

  write(#13#10'Schiffe... ');
  for i:=1 to nrships-1 do if shipschg[i]<$fe then begin
   pg_lock(ship[1,i div 500].h);
   for j:=0 to i-1
   do begin
    pg_access(ship[1,j div 500].h);
    if ship[1,i div 500].p^[i mod 500].Schiffname=ship[1,j div 500].p^[j mod 500].Schiffname
    then begin
     rc:=0;
     if shipschg[j]<$fe
     then begin
      inc(t);
      shipschg[j]:=$fe;
      pg_lock(ship[1,j div 500].h);
      pg_access(ship[0,j div 500].h);
      ws1.setp(ship[0,j div 500].p^[j mod 500].Schiffname+
	       ':'#13#0'C'#4'Umbenennung nach '#0'C'#$c+
	       ship[1,j div 500].p^[j mod 500].Schiffname+
	       #0'C'#4' fehlgeschlagen');
      msg.write(9,1,0,longint(1) shl shipschg[j],ws1);
      ship[1,j div 500].p^[j mod 500].Schiffname:=ship[0,j div 500].p^[j mod 500].Schiffname;
      pg_unlock(ship[1,j div 500].h);
     end;
     inc(t);
     shipschg[i]:=$fe;
     pg_access(ship[0,i div 500].h);
     ws1.setp(ship[0,i div 500].p^[i mod 500].Schiffname+
	      ':'#13#0'C'#4'Umbenennung nach '#0'C'#$c+
	     ship[1,i div 500].p^[i mod 500].Schiffname+
	     #0'C'#4' fehlgeschlagen');
     msg.write(9,1,0,longint(1) shl shipschg[i],ws1);
     ship[1,i div 500].p^[i mod 500].Schiffname:=ship[0,i div 500].p^[i mod 500].Schiffname;
     i:=0;
     write(t:4,#8#8#8#8);
     msg.write(9,2,0,longint(1) shl shipschg[i],ws1);
     break;
    end;
   end;
   begin
   end;
   pg_unlock(ship[1,i div 500].h);
  end;

  write(#13#10'Basen...   ');
  for i:=1 to nrbases-1 do if baseschg[i]<$fe then begin
   pg_lock(base[1,i div 500].h);
   for j:=0 to i-1
   do begin
    pg_access(base[1,j div 500].h);
    if base[1,i div 500].p^[i mod 500].name=base[1,j div 500].p^[j mod 500].name
    then begin
     rc:=0;
     if baseschg[j]<$fe
     then begin
      inc(t);
      baseschg[j]:=$fe;
      pg_lock(base[1,j div 500].h);
      pg_access(base[0,j div 500].h);
      ws1.setp(base[0,j div 500].p^[j mod 500].name+
	       ':'#13#0'C'#4'Umbenennung nach '#0'C'#$c+
	       base[1,j div 500].p^[j mod 500].name+
	       #0'C'#4' fehlgeschlagen');
      msg.write(9,1,0,longint(1) shl baseschg[j],ws1);
      base[1,j div 500].p^[j mod 500].name:=base[0,j div 500].p^[j mod 500].name;
      pg_unlock(base[1,j div 500].h);
     end;
     inc(t);
     baseschg[i]:=$fe;
     pg_access(base[0,i div 500].h);
     ws1.setp(base[0,i div 500].p^[i mod 500].name+
	      ':'#13#0'C'#4'Umbenennung nach '#0'C'#$c+
	     base[1,i div 500].p^[i mod 500].name+
	     #0'C'#4' fehlgeschlagen');
     msg.write(9,1,0,longint(1) shl baseschg[i],ws1);
     base[1,i div 500].p^[i mod 500].name:=base[0,i div 500].p^[i mod 500].name;
     i:=0;
     write(t:4,#8#8#8#8);
     msg.write(9,2,0,longint(1) shl baseschg[i],ws1);
     break;
    end;
   end;
   begin
   end;
   pg_unlock(base[1,i div 500].h);
  end;

  ws1.done;
  writeln(#13#10'Abgelehnte Žnderungen:',t:4);
 end;

 procedure removeunused;
 var
  r,
  i,
  j,
  rem:word;
 begin
  textattr:=$f;
  writeln('entferne unbenutzte Eintr„ge...');
  textattr:=7;
  for r:=0 to 31 do if racesa[r] then begin
   rem:=0;
   write(nstring(rassen[r]+'... ',40));
   if rnrplans[r]<>0 then begin
    i:=0;
    j:=0;
    pg_lock(rplan[r,0,0].h);
    pg_lock(rplan[r,1,0].h);
    while j<rnrplans[r]-1 do begin
     if compare(rplan[r,1,i div 500].p^[i mod 500],
		rplan[r,0,i div 500].p^[i mod 500],
		sizeof(rplan[r,0,i div 500].p^[i mod 500]))
     then begin
      inc(i);
      if i mod 500=0 then begin
       if i div 500-1<>j div 500 then begin
	pg_unlock(rplan[r,0,i div 500-1].h);
	pg_unlock(rplan[r,1,i div 500-1].h);
       end;
       pg_lock(rplan[r,0,i div 500].h);
       pg_lock(rplan[r,1,i div 500].h);
      end;
      inc(rem);
      dec(rnrplans[r]);
     end else begin
      if j<>i then begin
       move(rplan[r,1,i div 500].p^[i mod 500],
	    rplan[r,1,j div 500].p^[j mod 500],
	    sizeof(rplan[r,1,j div 500].p^[j mod 500]));
       move(rplan[r,0,i div 500].p^[i mod 500],
	    rplan[r,0,j div 500].p^[j mod 500],
	    sizeof(rplan[r,0,j div 500].p^[j mod 500]));
      end;
      inc(j);
      if j mod 500=0 then begin
       pg_unlock(rplan[r,0,j div 500-1].h);
       pg_unlock(rplan[r,1,j div 500-1].h);
       pg_lock(rplan[r,0,j div 500].h);
       pg_lock(rplan[r,1,j div 500].h);
      end;
      inc(i);
      if i mod 500=0 then begin
       if i div 500-1<>j div 500 then begin
	pg_unlock(rplan[r,0,i div 500-1].h);
	pg_unlock(rplan[r,1,i div 500-1].h);
       end;
       pg_lock(rplan[r,0,i div 500].h);
       pg_lock(rplan[r,1,i div 500].h);
      end;
     end;
    end;
    pg_unlock(rplan[r,0,j div 500].h);
    pg_unlock(rplan[r,1,j div 500].h);
    pg_unlock(rplan[r,0,i div 500].h);
    pg_unlock(rplan[r,1,i div 500].h);
   end;

   if rnrships[r]<>0 then begin
    i:=0;
    j:=0;
    pg_lock(rship[r,0,0].h);
    pg_lock(rship[r,1,0].h);
    while j<rnrships[r]-1 do begin
     if compare(rship[r,1,i div 500].p^[i mod 500],
		rship[r,0,i div 500].p^[i mod 500],
		sizeof(rship[r,0,i div 500].p^[i mod 500]))
     then begin
      inc(i);
      if i mod 500=0 then begin
       if i div 500-1<>j div 500 then begin
	pg_unlock(rship[r,0,i div 500-1].h);
	pg_unlock(rship[r,1,i div 500-1].h);
       end;
       pg_lock(rship[r,0,i div 500].h);
       pg_lock(rship[r,1,i div 500].h);
      end;
      inc(rem);
      dec(rnrships[r]);
     end else begin
      if j<>i then begin
       move(rship[r,1,i div 500].p^[i mod 500],
	    rship[r,1,j div 500].p^[j mod 500],
	    sizeof(rship[r,1,j div 500].p^[j mod 500]));
       move(rship[r,0,i div 500].p^[i mod 500],
	    rship[r,0,j div 500].p^[j mod 500],
	    sizeof(rship[r,0,j div 500].p^[j mod 500]));
      end;
      inc(j);
      if j mod 500=0 then begin
       pg_unlock(rship[r,0,j div 500-1].h);
       pg_unlock(rship[r,1,j div 500-1].h);
       pg_lock(rship[r,0,j div 500].h);
       pg_lock(rship[r,1,j div 500].h);
      end;
      inc(i);
      if i mod 500=0 then begin
       if i div 500-1<>j div 500 then begin
	pg_unlock(rship[r,0,i div 500-1].h);
	pg_unlock(rship[r,1,i div 500-1].h);
       end;
       pg_lock(rship[r,0,i div 500].h);
       pg_lock(rship[r,1,i div 500].h);
      end;
     end;
    end;
    pg_unlock(rship[r,0,j div 500].h);
    pg_unlock(rship[r,1,j div 500].h);
    pg_unlock(rship[r,0,i div 500].h);
    pg_unlock(rship[r,1,i div 500].h);
   end;

   if rnrbases[r]<>0 then begin
    i:=0;
    j:=0;
    pg_lock(rbase[r,0,0].h);
    pg_lock(rbase[r,1,0].h);
    while j<rnrbases[r]-1 do begin
     if compare(rbase[r,1,i div 300].p^[i mod 300],
		rbase[r,0,i div 300].p^[i mod 300],
		sizeof(rbase[r,0,i div 300].p^[i mod 300]))
     then begin
      inc(i);
      if i mod 500=0 then begin
       if i div 500-1<>j div 500 then begin
	pg_unlock(rbase[r,0,i div 500-1].h);
	pg_unlock(rbase[r,1,i div 500-1].h);
       end;
       pg_lock(rbase[r,0,i div 500].h);
       pg_lock(rbase[r,1,i div 500].h);
      end;
      inc(rem);
      dec(rnrbases[r]);
     end else begin
      if j<>i then begin
       move(rbase[r,1,i div 300].p^[i mod 300],
	    rbase[r,1,j div 300].p^[j mod 300],
	    sizeof(rbase[r,1,j div 300].p^[j mod 300]));
       move(rbase[r,0,i div 300].p^[i mod 300],
	    rbase[r,0,j div 300].p^[j mod 300],
	    sizeof(rbase[r,0,j div 300].p^[j mod 300]));
      end;
      inc(j);
      if j mod 500=0 then begin
       pg_unlock(rbase[r,0,j div 500-1].h);
       pg_unlock(rbase[r,1,j div 500-1].h);
       pg_lock(rbase[r,0,j div 500].h);
       pg_lock(rbase[r,1,j div 500].h);
      end;
      inc(i);
      if i mod 500=0 then begin
       if i div 500-1<>j div 500 then begin
	pg_unlock(rbase[r,0,i div 500-1].h);
	pg_unlock(rbase[r,1,i div 500-1].h);
       end;
       pg_lock(rbase[r,0,i div 500].h);
       pg_lock(rbase[r,1,i div 500].h);
      end;
     end;
    end;
    pg_unlock(rbase[r,0,j div 500].h);
    pg_unlock(rbase[r,1,j div 500].h);
    pg_unlock(rbase[r,0,i div 500].h);
    pg_unlock(rbase[r,1,i div 500].h);
   end;
   writeln(rem);

  end;
 end;

 procedure convertIt;

  procedure converts(var s1,s2:t_schiff);
  var
   i:byte;
  begin
   s1.Colons:=s2.Colons-s1.colons;
   s1.fighter:=s2.fighter-s1.fighter;
   s1.Cred:=s2.cred-s1.cred;
   s1.Supplies:=s2.supplies-s1.supplies;
   s1.Neutr:=s2.neutr-s1.neutr;
   s1.Molyb:=s2.molyb-s1.molyb;
   s1.Dura:=s2.dura-s1.dura;
   s1.Trit:=s2.trit-s1.trit;
   for i:=1 to 9 do begin
    s1.Torps[i]:=s2.torps[i]-s1.torps[i];
    s1.Minen[i]:=s2.minen[i]-s1.minen[i];
   end;
  end;

  procedure convertp(var p1,p2:t_planet);
  begin
   p1.Creds:=p2.creds-p1.creds;
   p1.Supplies:=p2.supplies-p1.supplies;
   p1.MinedNeutr:=p2.minedneutr-p1.minedneutr;
   p1.MinedMolyb:=p2.minedmolyb-p1.minedmolyb;
   p1.MinedDura:=p2.mineddura-p1.mineddura;
   p1.MinedTrit:=p2.minedtrit-p1.minedtrit;

   p1.Raceanz:=p2.raceanz-p1.raceanz;
   p1.Mines:=p2.mines-p1.mines;
   p1.Facts:=p2.facts-p1.facts;
   p1.Defs:=p2.defs-p1.defs;
   p1.forts:=p2.forts-p1.forts;
  end;

  procedure convertb(var b1,b2:t_starbase);
  var
   i,
   j:byte;
  begin
   b1.Creds:=b2.creds-b1.creds;
   b1.Supplies:=b2.supplies-b1.supplies;
   b1.Neutr:=b2.neutr-b1.neutr;
   b1.Molyb:=b2.molyb-b1.molyb;
   b1.Dura:=b2.dura-b1.dura;
   b1.Trit:=b2.trit-b1.trit;

   b1.crew:=b2.crew-b1.crew;

   b1.fighter:=b2.fighter-b1.fighter;
   b1.defs:=b2.defs-b1.defs;

   for j:=1 to 9 do begin
    for i:=0 to 2
    do b1.storage[i,j]:=b2.storage[i,j]-b1.storage[i,j];
    b1.torps[i]:=b2.torps[i]-b1.torps[i];
    b1.minen[i]:=b2.minen[i]-b1.minen[i];
   end;

   b1.stml:=b2.stml-b1.stml;
   b1.stba:=b2.stba-b1.stba;
  end;

 { proc convertIt }
 var
  i:byte;
  j:word;
 begin
  textattr:=$f;
  writeln('Konvertiere Objekte...');
  {Konvertieren objekte}
  for i:=0 to 31
  do if racesa[i]
  then begin
   for j:=0 to rnrships[i]-1
   do begin
    pg_lock  (rship[i,0,j div 500].h);
    pg_access(rship[i,1,j div 500].h);
    converts(rship[i,0,j div 500].p^[j mod 500],
	     rship[i,1,j div 500].p^[j mod 500]);
    pg_unlock  (rship[i,0,j div 500].h);
   end;
   for j:=0 to rnrplans[i]-1
   do begin
    pg_lock  (rplan[i,0,j div 500].h);
    pg_access(rplan[i,1,j div 500].h);
    convertp(rplan[i,0,j div 500].p^[j mod 500],
	     rplan[i,1,j div 500].p^[j mod 500]);
    pg_unlock  (rplan[i,0,j div 500].h);
   end;
   for j:=0 to rnrbases[i]-1
   do begin
    pg_lock  (rbase[i,0,j div 500].h);
    pg_access(rbase[i,1,j div 500].h);
    convertb(rbase[i,0,j div 500].p^[j mod 500],
	     rbase[i,1,j div 500].p^[j mod 500]);
    pg_unlock  (rbase[i,0,j div 500].h);
   end;
  end;
 end;

 procedure scanplaces;
 var
  i,
  j,
  l:word;

  procedure scanplacesp;
  var
   x,
   y,
   z:integer;
   i,
   j,
   k,
   r:word;

   s,
   p,
   b:word;
   id:longint;
   planets:array[0..1,0..31] of tp_planet;
   ships:array[0..1,0..3499] of tp_schiff;
   basis:array[0..1,0..31] of tp_starbase;

   ccolons:array[0..31] of longint;
   cfighter,
   ccred,
   csupplies,
   cneutr,
   cmolyb,
   cdura,
   ctrit:array[0..31] of longint;

   procedure doships; {unify ship access (needed for lend ships)}
   var
    n:array[0..31] of word;
    rsa,
    r:array[0..31] of byte;
    sa:array[0..1,0..31] of tp_schiff;
    nsa,
    nr,
    a,
    b,
    c,
    owned,
    lendby:word;
    id:longint;

   begin
    if s=0 then exit;
    nr:=0;
    for a:=0 to 31 do if racesa[a] then begin
     r[nr]:=a;
     inc(nr);
    end;
    fillchar(n,sizeof(n),0);
    for a:=0 to s-1 do begin
     pg_access(ship[0,a div 500].h;
     with ship[0,a div 500].p^[a mod 500] do begin
      owned:=$ff;
      lendby:=$ff;
      nsa:=0;
      if nr>0 then begin
       for b:=0 to nr-1 do begin
	pg_access(rship[r[b],1,n[b] div 500].h);
	while (n[b]<rnrships[r[b]])
	and (rship[r[b],1,n[b] div 500].p^[n[b] mod 500].id_nr<id_nr)
	do begin
	 inc(n[b]);
	 if n[b] mod 500=0
	 then pg_access(rship[r[b],1,n[b] div 500].h);
	end;
	if (n[b]<rnrships[r[b]])
	and (rship[r[b],1,n[b] div 500].p^[n[b] mod 500].id_nr=id_nr)
	then begin
	 rsa[nsa]:=r[b];
	 inc(nsa);
	end;
       end;
       if nsa>0 then begin
	if nsa>1 then begin
	 {mods=rship[rsa[0..nsa-1],
		     0..1,
		     n[rsa[0..nsa-1]] div 500].p^[n[rsa[0..nsa-1]]mod 500]}
	 pg_lock(ship[0,a div 500].h);
	 pg_lock(ship[1,a div 500].h);
	 if (byte(sa[1,r[owned]]^.mission1-25)>1)
	 or (byte(sa[0,r[owned]]^.mission2)<>byte(sa[1,r[owned]]^.mission2))
	 then begin
 {	 ignoreship(b,sa[1,r[owned]]);}
 {	 !hier!Anweisungen ausleihende Rasse ignorieren}
	 end else begin
 {	 ignoreship(b,sa[1,r[lendby]]);}
 {	 !hier!Anweisungen besitzende Rasse ignorieren}
	 end;
	end;{nsa>1}
       end;{nsa>0}
      end;
     end;
    end;
   end;

  begin { scanplacesp }
   for i:=0 to nrplans-1 do begin
    fillchar(ccolons,sizeof(ccolons),0);
    fillchar(cfighter,sizeof(cfighter),0);
    fillchar(ccred,sizeof(ccred),0);
    fillchar(csupplies,sizeof(csupplies),0);
    fillchar(cneutr,sizeof(cneutr),0);
    fillchar(cmolyb,sizeof(cmolyb),0);
    fillchar(cdura,sizeof(cdura),0);
    fillchar(ctrit,sizeof(ctrit),0);
    inc(l);
    write(#13,l:4);
    with plan[0,i div 500].p^[i mod 500] do begin
     {local copies}
     x:=posx;
     y:=posy;
     z:=posz;
     id:=id_nr;
    end;
    {$ifdef xDEBUG}
    write('X: ',x,'Y: ',y,'Z: ',z);
    {$endif}
    p:=0;
    s:=0;
    {einlesen Planetenver„nderungen,Schiffe,Basen}
    for r:=0 to 31 do if racesa[r] then begin
     if rnrplans[r]<>0 then begin
      for j:=0 to rnrplans[r]-1 do begin
       if rplan[r,1,j div 500].p^[j mod 500].id_nr=id then begin
	planets[0,p]:=@rplan[r,0,j div 500].p^[j mod 500];
	planets[1,p]:=@rplan[r,1,j div 500].p^[j mod 500];
	inc(p);
	break;
       end;
      end;
     end;
    end;
    if nrships<>0 then begin
     for j:=0 to nrships-1
     do with ship[1,j div 500].p^[j mod 500]
     do if (posx=x)and(posy=y)and(posz=z)
     then begin
      ships[0,s]:=@ship[0,j div 500].p^[j mod 500];
      ships[1,s]:=@ship[1,j div 500].p^[j mod 500];
      inc(s);
     end;
    end;
    if nrbases<>0 then begin
     for j:=0 to nrbases-1
     do with base[1,j div 300].p^[j mod 300]
     do if (posx=x)and(posy=y)and(posz=z)
     then begin
      basis[0,b]:=@base[0,j div 300].p^[j mod 300];
      basis[1,b]:=@base[1,j div 300].p^[j mod 300];
      inc(b);
      break;
     end;
    end;

    doships;

    {!hier!scanplacesp}
   end;
  end;

 begin;
  textattr:=$f;
  writeln('Bearbeite Positionen...');
  textattr:=7;
  l:=0;
  scanplacesp;
 end;

 procedure CopyData;
 var
  i,j,k,kx:word;
 begin
  for i:=0 to (nrplans-1) div 500 do begin
   pg_lock(plan[0,i].h);
   pg_access(plan[1,i].h);
   fillchar(plan[0,i].p^,sizeof(plan[0,i].p^),0);
   if i=(nrplans-1) div 500 then kx:=(nrplans-1) mod 500 else kx:=499;
   for k:=0 to kx do with plan[0,i].p^[k] do begin
    plan[0,i].p^[k].id_nr  :=plan[1,i].p^[k].id_nr;
    plan[0,i].p^[k].knownto:=plan[1,i].p^[k].knownto;
    plan[0,i].p^[k].name   :=plan[1,i].p^[k].name;
   end;
   pg_unlock(plan[0,i].h);
  end;
  for i:=0 to (nrships-1) div 500 do begin
   pg_lock(ship[0,i].h);
   pg_access(ship[1,i].h);
   fillchar(ship[0,i].p^,sizeof(ship[0,i].p^),0);
   if i=(nrships-1) div 500 then kx:=(nrships-1) mod 500 else kx:=499;
   for k:=0 to kx do with ship[0,i].p^[k] do begin
    ship[0,i].p^[k].id_nr	:=ship[1,i].p^[k].id_nr;
    ship[0,i].p^[k].Schiffname	:=ship[1,i].p^[k].Schiffname;
    ship[0,i].p^[k].damage	:=ship[1,i].p^[k].damage;
   end;
   pg_unlock(ship[0,i].h);
  end;
  for i:=0 to (nrbases-1) div 300 do begin
   pg_lock(base[0,i].h);
   pg_access(base[1,i].h);
   fillchar(base[0,i].p^,sizeof(base[0,i].p^),0);
   if i=(nrbases-1) div 500 then kx:=(nrbases-1) mod 500 else kx:=499;
   for k:=0 to kx do with base[0,i].p^[k] do begin
    base[0,i].p^[k].id_nr :=base[1,i].p^[k].id_nr;
    base[0,i].p^[k].name  :=base[1,i].p^[k].name;
    base[0,i].p^[k].damage:=base[1,i].p^[k].damage;
   end;
   pg_unlock(base[0,i].h);
  end;
 end;

 procedure handto;
 var
  rasse:byte;
  j1,j2,jx,
  k1,k2,kx,
  hi,h1,h2,hx:word;

  procedure conflict;
  var
   s10,
   s11,
   s20,
   s21:tp_schiff;
   id:longint;
   other:byte;
   shpbuf:t_schiff;
   k1,k2,kx:word;
   i:byte;

   procedure unmove(rasse:byte;id:longint;x,y,z:word;typ:byte;var d:integer);
   var
    xId:longint;
    Plan,
    planc:tp_planet;
    base:tp_starbase;
    lvar:^longint;

   begin
    if d=0 then exit;
    xid:=planId(x,y,z);
    if xid<>-1 then begin
     plan:=getplanr(rasse,1,xid);
     planc:=getplanr(rasse,0,xid);
     with plan^
     do if (racetyp=rasse)
     and((raceanz<>0)or(planc^.raceanz<>0))
     then begin { own planet?}
      case typ of
       1..5,9:begin
	case typ of
	 1:lvar:=@neutr;
	 2:lvar:=@Supplies;
	 3:lvar:=@Molyb;
	 4:lvar:=@Dura;
	 5:lvar:=@Trit;
	 9:lvar:=@creds;
	end;
	if (d>0) then begin
	 inc(lvar^,d);
	 d:=0;
	 if lvar^>2000000000 then begin
		 d:=lvar^-2000000000;
		 lvar^:=2000000000;
	 end;
	 exit;
	end else if(lvar^+d>=0) then begin
	 inc(lvar^,d);
	 d:=0;
	 exit;
	end else begin
	 inc(d,lvar^);
	 lvar^:=0;
	end;
       end;
      end;{case}
     end;{ own planet? }
    end;{if xid<>-1}

    xid:=baseId(x,y,z);
    if xid<>-1 then begin
     base:=getbaser(rasse,1,xid);
     with base^
     do if (owner=rasse)
     then begin { own base?}
      if (d>0) then begin
       inc(lvar^,d);
       d:=0;
       if lvar^>2000000000 then begin
	d:=lvar^-2000000000;
	lvar^:=2000000000;
       end;
       exit;
      end else if(lvar^+d>=0) then begin
       inc(lvar^,d);
       d:=0;
       exit;
      end else begin
       inc(d,lvar^);
      end;{case}
     end;{ own base? }
    end;{if xid<>-1}

    {!!}

   end;{unmove}

   procedure unmovel(rasse:byte;id:longint;x,y,z:word;typ:byte;var d:longint);
   var
    xId:longint;
    Plan,
    planc:tp_planet;
    base:tp_starbase;
    raceanz:^longint;

   begin
    if d=0 then exit;
    xid:=planId(x,y,z);
    if xid<>-1 then begin
     plan:=getplanr(rasse,1,xid);
     planc:=getplanr(rasse,0,xid);
     with plan^
     do if (racetyp=rasse)
     and((raceanz<>0)or(planc^.raceanz<>0))
     then begin { own planet?}
      if (d>0) then begin
       inc(raceanz,d);
       d:=0;
       if raceanz>2000000000 then begin
	d:=raceanz-2000000000;
	raceanz:=2000000000;
       end;
       exit;
      end else if(raceanz+d>=0) then begin
       inc(raceanz,d);
       d:=0;
       exit;
      end else begin
       inc(d,raceanz);
      end;
     end;{ own planet? }
    end;{if xid<>-1}

    xid:=baseId(x,y,z);
    if xid<>-1 then begin
     base:=getbaser(rasse,1,xid);
     with base^
     do if (owner=rasse)
     then begin { own base?}
      if (d>0) then begin
       inc(crew,d);
       d:=0;
       if crew>2000000000 then begin
	d:=crew-2000000000;
	crew:=2000000000;
       end;
       exit;
      end else if(crew+d>=0) then begin
       inc(crew,d);
       d:=0;
       exit;
      end else begin
       inc(d,crew);
      end;
     end;{ own base? }
    end;{if xid<>-1}

    {!!}

   end;{unmovel}

   procedure solve(typ:byte);
   {typ= 1:Neutronium
	 2:Supplies
	 3:Molybdenium
	 4:Duranium
	 5:Tritanium
	 7:Colonisten
	 9:Credits
	10+i Torpedos
	20+i Minen
    s[12][12]=@ship }
   var
    mx,
    s,
    s2:integer;
    sl,
    sl2:longint;
    s10v,
    s11v,
    s20v,
    s21v:^integer;
    k1,k2,kx:word;

   begin { solve }
    case typ of { typ to solve by data width }
     0..5,9..29:begin { integer types }
      case typ of { typ to solve integer by adress }
       1:begin
	s10v:=@s10^.neutr;	s11v:=@s11^.neutr;
	s20v:=@s20^.neutr;	s21v:=@s21^.neutr;
       end;
       2:begin
	s10v:=@s10^.supplies;	s11v:=@s11^.supplies;
	s20v:=@s20^.supplies;	s21v:=@s21^.supplies;
       end;
       3:begin
	s10v:=@s10^.Molyb;	s11v:=@s11^.Molyb;
	s20v:=@s20^.Molyb;	s21v:=@s21^.Molyb;
       end;
       4:begin
	s10v:=@s10^.Dura;	s11v:=@s11^.Dura;
	s20v:=@s20^.Dura;	s21v:=@s21^.Dura;
       end;
       5:begin
	s10v:=@s10^.trit;	s11v:=@s11^.trit;
	s20v:=@s20^.trit;	s21v:=@s21^.trit;
       end;
       9:begin
	s10v:=@s10^.cred;	s11v:=@s11^.cred;
	s20v:=@s20^.cred;	s21v:=@s21^.cred;
       end;
       10..19:begin
	s10v:=@s10^.torps[typ-10];	s11v:=@s11^.torps[typ-10];
	s20v:=@s20^.torps[typ-10];	s21v:=@s21^.torps[typ-10];
       end;
       20..29:begin
	s10v:=@s10^.minen[typ-20];	s11v:=@s11^.minen[typ-20];
	s20v:=@s20^.minen[typ-20];	s21v:=@s21^.minen[typ-20];
       end;
      end;{case typ inner}
      s:=s11v^;
      s11v^:=0;
      mx:=max(hulls[s11^.typnr].maxmasse-sgewicht(s11),10000);
      if typ=9 then mx:=10000;
      { max. transfer,
      if s11v^+s20v^<0 then begin
       s:=s11v^-s10v^;
       s2:=s div 2;
       dec(s,s2);
       inc(s2,s20v^);{Sn:=Sn0v^+Sn, Sn0v^<(-Sn)< 0 >Sn0v^+Sn}
       with s11^ do unmove(other,id,posx,posy,posz,typ,s2);
       s2:=s2+s-s10v^;
       dec(s10v^,s2);
       with s11^ do unmove(rasse,id,posx,posy,posz,typ,s2);
       inc(s10v^,s2);
       with s11^ do unmove(other,id,posx,posy,posz,typ,s2);
       s11v^:=0;
      end else if s11v^+s20v^>mx then begin
       s:=mx-s11v^+s10v^;
       s2:=s div 2;
       dec(s,s2);
       s2:=s20v^-s2;
       with s11^ do unmove(other,id,posx,posy,posz,typ,s2);
       inc(s2,s10v^-s);
       dec(s10v^,s2);
       with s11^ do unmove(rasse,id,posx,posy,posz,typ,s2);
       inc(s10v^,s2);
       with s11^ do unmove(other,id,posx,posy,posz,typ,s2);
       s11v^:=mx;
      end else begin
       inc(s11v^,s20v^);
      end;
     end;{case typ 0..5,9..29 (integers) }
     7:begin { longint types }
      sl:=s11^.colons;
      s11^.colons:=0;
      mx:=max(hulls[s11^.typnr].maxmasse-sgewicht(s11),1000000);
      if s11^.colons+s20^.colons<0 then begin
       sl:=s11^.colons-s10^.colons;
       sl2:=sl div 2;
       dec(sl,sl2);
       inc(sl2,s20^.colons);{Sn:=Sn0v^+Sn, Sn0v^<(-Sn)< 0 >Sn0v^+Sn}
       with s11^ do unmovel(other,id,posx,posy,posz,typ,sl2);
       sl2:=sl2+sl-s10^.colons;
       dec(s10^.colons,sl2);
       with s11^ do unmovel(rasse,id,posx,posy,posz,typ,sl2);
       inc(s10^.colons,sl2);
       with s11^ do unmovel(other,id,posx,posy,posz,typ,sl2);
       s11^.colons:=0;
      end else if s11^.colons+s20^.colons>mx then begin
       sl:=mx-s11^.colons+s10^.colons;
       sl2:=sl div 2;
       dec(sl,sl2);
       sl2:=s20^.colons-sl2;
       with s11^ do unmovel(other,id,posx,posy,posz,typ,sl2);
       inc(sl2,s10^.colons-sl);
       dec(s10^.colons,sl2);
       with s11^ do unmovel(rasse,id,posx,posy,posz,typ,sl2);
       inc(s10^.colons,sl2);
       with s11^ do unmovel(other,id,posx,posy,posz,typ,sl2);
       s11^.colons:=mx;
      end else begin
       inc(s11^.colons,s20^.colons);
      end;
     end; { case typ 7 (longint) }
    end; { case typ outer }
   end; {solve}

  begin { conflict }
   s11:=@rship[rasse,1,j1].p^[j2];
   other:=s11^.owner;
   if racesa[other] then begin
    pg_lock(rship[rasse,0,j1].h);
    s10:=@rship[rasse,0,j1].p^[j2];
    id:=s11^.id_nr;

    k1:=0;
    k2:=0;
    repeat
     pg_access(rship[other,1,k1].h);
     if k1=(rnrships[other]-1)div 500
     then kx:=(rnrships[other]-1)mod 500
     else kx:=499;
     for k2:=0 to kx
     do with rship[other,1,k1]
     do if id>=p^[k2].id_nr then begin
      if id>p^[k2].id_nr then begin
       pg_unlock(rship[rasse,0,j1].h);
       exit;
      end;
      { id=p^[k2].id_nr }
      pg_lock(h);
      pg_lock(rship[other,0,k1].h);
      s21:=@p^[k2];
      s20:=@rship[other,0,k1].p^[k2];
      break;
     end;
    until id=rship[other,1,k1].p^[k2].id_nr;

    for i:=0 to 29 do solve(i);

    pg_unlock(rship[other,0,k1].h);
    pg_unlock(rship[other,1,k1].h);
    pg_unlock(rship[rasse,0,j1].h);
   end;
  end;

(*var
  rasse:byte;
  j1,j2,jx,
  k1,k2,kx,
  hi,h1,h2,hx:word;*)

 begin { handto }
  if nrships=0 then exit;
  writeln('šbergabe der Schiffe');
  for j1:=0 to (nrships+499) div 500
  do pg_lock(ship[0,j1].h);
  for rasse:=0 to 31 do begin
   hi:=0;h1:=0;h2:=0;
   if nrships<500
   then hx:=nrships
   else hx:=500;
   if racesa[rasse] then begin
    for j1:=0 to integer((rnrships[rasse]-1) div 500) do begin
     pg_acess(rship[rasse,1,j1].h);
     if j1=(rnrships[rasse]-1) div 500
     then jx:=(rnrships[rasse]-1) mod 500
     else jx:=499;

     for j2:=0 to jx
     do with rship[rasse,1,j1].p^[j2]
     do begin

      while ship[0,h1].p^[h2].ID_NR<ID_NR
      do begin
       inc(h2);
       inc(hi);
       if hi>=nr_ships then begin
	writeln('Inkonsistenz Rasse ',rassen[rasse]);
	halt;
       end;
       if h2=hx then begin
	inc(h1);
	if (nrships-hi)<500
	then hx:=nrships
	else hx:=500;
       end;
      end;

      if ship[0,h1].p^[h2].owner=rasse then begin
       if byte(ship[0,h1].p^[h2].mission1-25)<2 then begin
	if byte(mission2-25)<2 then begin
	 { entferne eigene Move-Befehle }
	end else begin
	 { entferne fremde Move-Befehle }
	end;
       {end else begin}
	{nothing}
       end;
      end else begin
       if byte(ship[0,h1].p^[h2].mission1-25)<2 then begin
	{ Zugriff auf geliehenes Schiff }{!!}
       end else begin
	{ Zugriff auf fremdes Schiff }
       end;
      end;

     pg_lock(rship[rasse,1,j1].h);
     pg_access(rship[rasse,0,j1].h);

      if owner=rasse then begin
       if byte(mission3 shr 24)=25 then conflict;
       if byte(mission1)=26 then begin
	pg_lock(rship[rasse,0,j1].h);
	for k1:=0 to integer((rnrships[rasse]-1) div 500) do begin
	if k1=(rnrships[rasse]-1) div 500
	then kx:=(rnrships[rasse]-1) mod 500
	else kx:=499;
	for k2:=0 to kx do with rship[rasse,1,k1].p^[k2] do begin

	end;
	end;
       end;
      end;
     end;
     pg_unlock(rship[rasse,0,j1].h);
     pg_unlock(rship[rasse,1,j1].h);
    end;
   end else begin {racesa[rasse]}
   end;
  end;
  for j1:=0 to (nrships+499) div 500
  do pg_unlock(ship[0,j1].h);
 end;

 procedure fillcrew;
 var
  r,i,j,k:word;
 begin
  ;
 end;

 procedure domissions;
 begin
  handto;
  fillcrew;
  {selffillcrew;}
 end;

begin { compile }
 CopyData;
 removeunused;
 checknames;{+generate RenameMesages}
 convertIt; {r*[1]:=[2]-[1]}
 domissions;
 halt;
 removeunused{2};
 writeln;
 halt;
 scanplaces;
end;

procedure scanlocations;
begin
end;

procedure runturn;
begin
end;

begin
 randomize;
 inithost;
 new_all;
 openhost;
 msg.init;
 checkrace;
 readraces;
 compile;
 scanlocations;
 halt;
 runturn;
 scanlocations;
 msg.done;
end.