unit nanocore;
{$V-}

interface

uses bbskv,dos,crt,nanostr;

function  exist(filename:dos.pathstr):boolean;
function  d70(year,month,day:word):longint;
procedure makepath(p:string);
procedure cpfiles(fromdir,todir:string);
function  isnum(s:string):boolean;
function  IsNums(s:string):boolean;
function  IsStrNumber(s:string):boolean;
function  IsStrhex(s:string):boolean;
function  hex2dec(s:string):longint;
function  sec70:longint;
function  ds1970:longint; {Returns the current day since Jan 1, 1970}
function  secondstoday:longint; {Returns the number of seconds since 12:00mn}
function  cpfile(fromfile,tofile:string):boolean; {copy file}
procedure killemall(filename:string);
procedure nuke(filename:string);
function  makepath2(p:string):integer;
function  convertdate(daynumber:longint; dtype:integer):string;
function  converttime(secondnumber:longint; ttype:integer):string; {returns the time of day}
function  racrc(pass1:string):longint;
procedure makesem(filename:string);

implementation

var mon:array[1..12] of word;

function  exist(filename:dos.pathstr):boolean;
begin
  Exist:=fSearch(filename,'')<>'';
end;

function d70(year,month,day:word):longint;

procedure setmonthx(year:word);
begin
  mon[1]:=31;  mon[2]:=28;  mon[3]:=31;  mon[4]:=30;
  mon[5]:=31;  mon[6]:=30;  mon[7]:=31;  mon[8]:=31;
  mon[9]:=30; mon[10]:=31; mon[11]:=30; mon[12]:=31;
  if (year mod 4)=0 then mon[2]:=29;
end;

var ds70,m,index:longint;
    ys70:integer;
begin
  if year<70  then year:=year+2000;
  if year<100 then year:=year+1900;
  ds70:=0;
  if
    year>=1970
  then
    begin
      ds70:=0; ys70:=0;
      setmonthx(year);
      index:=1970;
      ys70:=year-index;
      if
        not(year=1970)
      then
        repeat
          begin
            if
              (index mod 4)=0
            then
              ds70:=ds70+366
            else
              ds70:=ds70+365;
            inc(index);
          end;
        until index=year;
      index:=1;
      while index<month do begin ds70:=ds70+mon[index]; inc(index); end;
      ds70:=ds70+day;
    end
  else
    begin
      ds70:=0; ys70:=0;
      setmonthx(year);
      index:=1969;
      ys70:=index-year;
      if
        not(year=1969)
      then
        repeat
          begin
            if
              ((index mod 4)=0)
            then
              ds70:=ds70-366
            else
              ds70:=ds70-365;
            dec(index);
          end;
        until index=year;
      index:=12;
      while index>month do begin ds70:=ds70-mon[index]; dec(index); end;
      ds70:=ds70-(mon[month]+1-day);
    end;
{  setmonth;}
  d70:=ds70-1;
end;

procedure makepath(p:string);
var i:word;
    shit:integer;
    savedir:string;
    curdir:string;
    pp:pathstr;
    n:dos.namestr;
    d:dirstr;
    e:extstr;
begin
{$I-}
  pp:=paramstr(0);
  fsplit(pp,d,n,e);
  pp:=addslash(d);
  getdir(0,savedir);
  chdir(p);
  shit:=ioresult;
  if shit=0 then begin {chdir(pp);} exit; end;
  i:=1;
  p:=addslash(p);
  repeat
    if
      p[i]='\'
    then
      begin
        mkdir(stripslash(copy(p,1,i)));
        shit:=ioresult;
      end;
    inc(i);
  until i>length(p);
  shit:=ioresult;
{$I+}
end;

function makepath2(p:string):integer;
var i:word;
    shit:integer;
    savedir:string;
    curdir:string;
    pp:pathstr;
    n:dos.namestr;
    d:dirstr;
    e:extstr;
begin
  makepath2:=0;
{$I-}
(*  pp:=paramstr(0);
  fsplit(pp,d,n,e);
  pp:=addslash(d);
  getdir(0,savedir);
  chdir(stripslash(p));
  shit:=ioresult; makepath2:=shit;
  if shit=0 then begin {chdir(pp);} exit; end;
  *)
  i:=1;
  p:=addslash(p);
  repeat
    if
      p[i]='\'
    then
      begin
        mkdir(stripslash(copy(p,1,i)));
        shit:=ioresult;
        makepath2:=shit;
      end;
    inc(i);
  until i>length(p);
  shit:=ioresult;
{$I+}
end;

function cpfile(fromfile,tofile:string):boolean; {copy file}
type bbuf=array[1..32768] of char;
var infile,outfile:file;
    numread,numwritten:word;
    buf:^bbuf;
begin
  cpfile:=false;
  if not exist(fromfile) then exit;
  new(buf);
  fromfile:=fexpand(upcasestr(fromfile));
  tofile:=fexpand(upcasestr(tofile));
  if (fromfile=tofile) then exit;
  assign(infile,fromfile);
  assign(outfile,tofile);
  reset(infile,1);
  rewrite(outfile,1);
  repeat
    blockread(infile,buf^,sizeof(buf^),numread);
    blockwrite(outfile,buf^,numread,numwritten);
  until (numread=0) or (numwritten<>numread);
  close(infile);
  close(outfile);
  dispose(buf);
  cpfile:=true;
end;

procedure cpfiles(fromdir,todir:string);
var dirinfo:searchrec;
    p:dos.pathstr;
    dd,
    d:dos.dirstr;
    n:dos.namestr;
    e:dos.extstr;
    ta:byte;
begin
  ta:=textattr;
  makepath(todir);
  findfirst(fromdir,archive,dirinfo);
  p:=todir; fsplit(p,dd,n,e);
  p:=fromdir; fsplit(p,d,n,e);
  while doserror=0 do
  begin
    textcolor(cyan);
    write('Copying ',dirinfo.name,' ... ');
    if
      cpfile(d+dirinfo.name,dd+dirinfo.name)
    then
      begin
        textcolor(yellow);
        writeln('Done!')
      end
    else
      begin
        textattr:=blink+lightred+(textattr and $F0);
        writeln('Failed!');
      end;
    findnext(dirinfo);
  end;
  textattr:=ta;
end;

function IsStrNumber(s:string):boolean;
const nums=['0'..'9','-'];
var tmp:boolean;
    index:integer;
    x:char;
begin
  s:=qualify(s); 
  if s='' then begin isstrnumber:=false; exit; end;
  tmp:=true;
  for index:=1 to length(s) do
    begin
      x:=s[index];
      if not (x in nums) then tmp:=false;
    end;
  IsStrNumber:=tmp;
end;

function Isnums(s:string):boolean;
begin
  isnums:=isstrnumber(s);
end;

function IsStrhex(s:string):boolean;
const nums=['0'..'9','$','A'..'F','a'..'f'];
var tmp:boolean;
    index:integer;
    x:char;
begin
  s:=qualify(s);
  if (s[2]='$') or (s[1]<>'$') then begin isstrhex:=false; exit; end;
  if s='' then begin isstrhex:=false; exit; end;
  tmp:=true;
  for index:=1 to length(s) do
    begin
      x:=s[index];
      if not (x in nums) then tmp:=false;
    end;
  IsStrhex:=tmp;
end;

function isnum(s:string):boolean;
begin
  isnum:=isstrnumber(s);
end;

function hex2dec(s:string):longint;
var i,tmp,acc,mul:longint;
    ss:string[16];
begin
  ss:='0123456789ABCDEF';
  if not (isstrhex(s)) then begin hex2dec:=0; exit; end;
  s:=qualify(s);
  while pos('$',s)>0 do delete(s,pos('$',s),1); {kill the '$'}
  if s='' then begin hex2dec:=0; exit; end;
  if s[0]>#8 then begin hex2dec:=0; exit; end;
  i:=length(s); mul:=1; acc:=0;
  repeat
    tmp:=pos(s[i],ss)-1;
    acc:=longint(acc+(mul*tmp));
    dec(i);
  until i=0;
  hex2dec:=acc;
end;

function sec70:longint;
begin
  sec70:=(ds1970*86400)+secondstoday;
  {Seconds since January 1, 1970 12:00 midnight}
end;

function ds1970:longint; {Returns the current day since Jan 1, 1970}
var year,month,day,dotw:word;
    ds70,m:longint; ys70:integer;
    index:longint;
begin
  getdate(year,month,day,dotw);
  ds1970:=d70(year,month,day);
end;

function secondstoday:longint; {Returns the number of seconds since 12:00mn}
var h,m,s,o:word;
    h1,m1,s1:longint;
    tmpix:longint;
begin
  tmpix:=0;
  gettime(h,m,s,o);
  h1:=h; m1:=m; s1:=s;
  tmpix:=s1+(m1*60)+(h1*3600);
  secondstoday:=tmpix;
end;

procedure nuke(filename:string);
var c:text;
    x:integer;
begin
  if
    exist(filename)
  then
    begin
      assign(c,filename);
{$I-}
      erase(c);
      x:=ioresult;
{$I+}
    end;
end;

procedure killemall(filename:string);
var dirinfo:searchrec;
    p:pathstr;
    n:namestr;
    d:dirstr;
    e:extstr;
begin
  p:=filename; fsplit(p,d,n,e);
  if (d='\') or (d='') or (d='C:\') or (d='C:') then exit;
  findfirst(filename,$20,dirinfo);
  while doserror=0 do
  begin
    nuke(d+dirinfo.name);
    findnext(dirinfo);
  end;
end;

procedure strmove(var s:string; d:string);
begin
  s:=d;
end;

procedure setmonth;
var crap,year:word;
begin
  getdate(year,crap,crap,crap);
  mon[1]:=31;  mon[2]:=28;  mon[3]:=31;  mon[4]:=30;
  mon[5]:=31;  mon[6]:=30;  mon[7]:=31;  mon[8]:=31;
  mon[9]:=30; mon[10]:=31; mon[11]:=30; mon[12]:=31;
  if (year mod 4)=0 then mon[2]:=29;
end;

function converttime(secondnumber:longint; ttype:integer):string; {returns the time of day}
var hour,minute,second,sec100:longint;
    junk:longint;
    meridian:string[2];
    tmp:string[40];
    hours,minutes,seconds,sec100s,hour12s:string[20];
    min2:longint;
    mins2:string[20];
begin
  {Auto-detect for sec70}
{  if (secondnumber>1000000) then secondnumber:=longint(secondnumber div 86400);}
  if (secondnumber>1000000) then secondnumber:=longint(secondnumber mod 86400);
  hour:=0; minute:=0; second:=0;
  hour:=longint(secondnumber div 3600);
  minute:=longint((secondnumber mod 3600) div 60);
  min2:=longint(secondnumber div 60); {Calculate total integer minutes}
  mins2:=int2str(min2);
  second:=longint(secondnumber mod 60);
  str(hour,hours);
  hour12s:=hours;
  str(hour mod 12,hour12s);
  meridian:='pm';
  if
    hour12s=hours
  then
    meridian:='am';
  if (hour=0) or (hour=12) then hour12s:='12';
  if (hour<10) then hours:='0'+hours;
  str(minute,minutes);
  if
    (minute<10)
  then
    minutes:='0'+minutes;
  str(second,seconds);
  if
    (second<10)
  then
    seconds:='0'+seconds;
  str(sec100,sec100s);
  if
    sec100<10
  then
    sec100s:='0'+seconds;
  tmp:=hour12s+':'+minutes;
  case ttype of
    1: strmove(tmp,hour12s+':'+minutes);               {12 hour, no secs   }
    2: strmove(tmp,hour12s+':'+minutes+':'+seconds);   {12 hour, with secs }
    3: strmove(tmp,hours+':'+minutes);                 {24 hour, no secs   }
    4: strmove(tmp,hours+':'+minutes+':'+seconds);     {24 hour, with secs }
    5: tmp:=meridian;                                  {AM or PM as apropos}
    6: strmove(tmp,hours);                             {The hour, in 24h   }
    7: strmove(tmp,hour12s);                           {The hour, in 12h   }
    8: strmove(tmp,minutes);                           {The minute         }
    9: strmove(tmp,seconds);                           {The second         }
   10: begin        {Seconds since midnight}
         junk:=0;
         junk:=secondstoday;
         str(junk,tmp);
       end;
   11: strmove(tmp,int2str(sec70)); {Seconds since midnight Jan. 1, 1970}
   12: tmp:=int2str(secondnumber div 3600); {Hours user has been online}
   13: tmp:=int2str(secondnumber div 60); {Minutes user has been online}
   14: tmp:=int2str(secondnumber); {Total seconds user has been online}
   15: tmp:=int2str((secondnumber mod 3600) div 60); {Minute component of}
                                                       {users time online}
   16: tmp:=int2str(secondnumber mod 60); {Second component of users time online}
   17: tmp:=hours+':'+minutes+':'+seconds;
   18: strmove(tmp,mins2+':'+seconds);                 {Mins/secs only     }
  end; {case}
  converttime:=tmp;
end; {function converttime}

function cmonths(i:integer):string;
begin
  cmonths:='Never';
  case i of
    0:cmonths:='January';
    1:cmonths:='February';
    2:cmonths:='March';
    3:cmonths:='April';
    4:cmonths:='May';
    5:cmonths:='June';
    6:cmonths:='July';
    7:cmonths:='August';
    8:cmonths:='September';
    9:cmonths:='October';
   10:cmonths:='November';
   11:cmonths:='December';
  end;
end;

function cdays(i:integer):string;
begin
  cdays:='Never';
  case i of
    0:cdays:='Sunday';
    1:cdays:='Monday';
    2:cdays:='Tuesday';
    3:cdays:='Wednesday';
    4:cdays:='Thursday';
    5:cdays:='Friday';
    6:cdays:='Saturday';
  end;
end;

function convertdate(daynumber:longint; dtype:integer):string;
var thisyear,thismonth,thisdate,thisday:word;
    thistmp:word;
    tmp:string[40]; csis,index:integer; test:boolean;
begin
  if (daynumber>60000) then daynumber:=daynumber div 86400; {Auto-detect for sec70}
  {A longint can hold about 24000 days worth of seconds}
  inc(daynumber);
  setmonth;
  thisyear:=1970+((daynumber*100)-26) div 36525;
  thistmp:=(((daynumber*100)-26) mod 36525) div 100;
  csis:=thistmp; test:=false;
  index:=0;
  repeat
    begin
      inc(index);
      if
        csis<mon[index]
      then
        test:=true
      else
        csis:=csis-mon[index];
    end;
  until test;
  thisdate:=csis;
  thismonth:=index;
  if
    thisdate=0
  then
    begin
      dec(thismonth); if thismonth=0 then begin thismonth:=12; dec(thisyear); end;
      thisdate:=mon[thismonth];
    end;
  thisday:=(daynumber+3) mod 7;

  case DTYPE of
  1:  begin  { CENTURY }
        strmove(tmp,'20');
        if
          (thisyear<2000)
        then
          strmove(tmp,'19');
      end;
  2:  begin  { YEAR }
        str(thisyear,tmp);
        tmp:=copy(tmp,3,2);
      end;
  3:  begin { MONTH with zero padding }
        str(thismonth,tmp);
        if
          thismonth<10
        then
          strmove(tmp,'0'+tmp);
      end;
  4:  str(thismonth,tmp); { MONTH without zero padding }
  5:  tmp:=cmonths(thismonth); { Longhand MONTH }
  6:  tmp:=copy(cmonths(thismonth),1,3); { Shorthand MONTH }
  7:  begin { DATE with zero padding }
        str(thisdate,tmp);
        if
          thisdate<10
        then
          strmove(tmp,'0'+tmp);
      end;
  8:  str(thisdate,tmp); { DATE without zero padding }
  9:  begin { DATE ORDINAL SUFFIX }
        tmp:='th';
        case THISDATE of
        1,21,31: tmp:='st';
        2,22   : tmp:='nd';
        3,23   : tmp:='rd';
        end; {case thisdate}
      end;
  11: tmp:=cdays(thisday); { DAY OF THE WEEK }
  12: tmp:=copy(cdays(thisday),1,3); {Shorthand DAY OF THE WEEK}
  20: tmp:=convertdate(daynumber,2)+'-'+convertdate(daynumber,3)+'-'+convertdate(daynumber,7);
  end; {major case}
  convertdate:=tmp;
end;

{ CRC calc stuff from the SWAG }

var
    crc32table : array [byte] of longint;
    crcval : longint;
    j      : integer;

procedure makeCRC32table;
var crc : longint;
    i,n : byte;
begin
 for i := 0 to 255 do
   begin
     crc := i;
     for n := 1 to 8 do
       if odd(crc) then
         crc := (crc shr 1) xor $EDB88320
       else
         crc := crc shr 1;
     crc32table[i] := crc;
   end;
end;

function updateCRC32(c : byte; crc : longint) : longint;
begin
 updateCRC32 := crc32table[lo(crc) xor c] xor (crc shr 8);
end;

function racrc(pass1:string):longint;
begin
  pass1:=upcasestr(pass1);
  makecrc32table;
  crcval := $FFFFFFFF;
  for j := 1 to length(pass1) do
    begin
      crcval := updateCRC32(ord(pass1[j]),crcval);
    end;
    racrc := crcval;
end;

procedure makesem(filename:string); {Makes a semaphore}
var f:text; c:integer;
begin
  if exist(filename) then exit;
  assign(f,filename);
{$I-}
  rewrite(f); c:=ioresult;
  close(f); c:=ioresult;
{$I+}
end;

begin
end.

