SRL Archive - Other Scripts

Lol, Copied the Idea of Sdcit. But mines Different. It get's the First and Last name of a website, So there's alot of variety, there.

If the persons age is below 19 they will never have been married. It also follows the Month rules (30 days has september, ect..) and will randomly pick if it's a leap year for february.

Examples:

First      : Satchel
Last       : Gino
Age        : 79
Born On    : 3 Jun, 1888
Died On    : 27 Jul, 1967
Marriages  : 1
Brothers   : Yes, 3
Sisters    : No.

First      : Demetrio
Last       : Manoel
Age        : 31
Born On    : 11 Aug, 1907
Married    : Yes, 2 Time(s).
Brothers   : Yes, 3
Sisters    : Yes, 4

First      : Irene
Last       : Agapios
Age        : 4
Born On    : 12 Feb, 1975
Married    : Never
Brothers   : Yes, 4
Sisters    : Yes, 1

hehe. :)

type ID = Record
  First, Last, Month: string;
  Age, Brothers, Sisters, Born, Date, Death, Married: integer;
end;

function Ryes: boolean;
begin
  if (Random(2) = 0) then
    result:= true;
end;

function LoadSite: string;
begin
  result:= GetPage('http://www.behindthename.com/random/random.php?number=2&gender=both&surname=&all=yes');
end;

function IsInTextDob(a, b, w: string): boolean;
begin
 if (pos(w, a) > 0) or (pos(w, b) > 0) then
   result:= true;
end;

function Name: ID;
var g: string;
begin
 repeat
  g:= Between('Your random name is:', '</div>', LoadSite);
   result.First:= Between('class="plain">', '</a>', g);
   result.Last:= Between(result.first, '</font>', g);
   result.Last:= Between('class="plain">', '</a>', result.last);
 until(not(IsInTextDob(result.First, result.Last, '&')));
end;

function PosIn(a, w: string): integer;
var i: integer;
begin
  for i:= 1 to length(a) do
    begin
      if (copy(a, i, 1) = w) then
        begin
          result:= i;
          exit;
        end;
    end;
end;

function Age(nF, nL: string): integer;
var fP, lP, add, m: integer;
var alph: string;
begin
 alph:= 'abcdefghijklmnopqrstuvwxyz';
 fP:= PosIn(alph, lowercase(copy(nF, 1, 1)));
 lP:= PosIn(alph, lowercase(copy(nL, 1, 1)));
  if (fP + lP > 100) then
    begin
      while(fP + lP > 100) do
        begin
          fP:= fP - Random(5);
          lP:= lP - Random(5);
        end;
    end;
 if (fP >= (length(alph)/2)) then
   begin
     add:= 30;
   end else
   begin
     add:= 10;
   end;
 if (lP >= (length(alph)/2)) then
   begin
     add:= add + 40;
   end else
   begin
     add:= add + 20;
   end;
 m:= 100-add;
 result:= (add + Random(m) - Random(m));
  if (result < 1) then
    begin
      m:= result + 100;
     result:= result + (m + (Random(m/2)));
    end;
  if (result > 99) then
    begin
      m:= result - 100;
     result:= result - (m + random(m/2));
    end;
 if (Ryes) then
   begin
     result:= result + Random(10);
   end;
end;

function PickFR: integer;
begin
  if (Ryes) then
    begin
      result:= 1 + Random(4);
     if (Ryes) then
       begin
         result:= result + Random(3);
       end;
    end;
 if (result > 2) then
   result:= result - random(3);
end;

function Family: ID;
begin
  result.Brothers:= PickFR;
  result.Sisters:= PickFR;
  result.Married:= (PickFR/2)+1;
end;

function BornIn(thisyear, age: integer): integer;
begin
  result:= thisyear-age;
end;

function PickString(Options: array of string): string;
begin
  result:= Options[random(getarraylength(Options))];
end;

function RandomMonth: string;
begin
  result:= PickString(['Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun', 'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec']);
end;

function FindManyIn(find: array of string; s: string): boolean;
var i: integer;
begin
 for i:= 0 to getarraylength(find)-1 do
   begin
     if (pos(find[i], s) > 0) then
       begin
         result:= true;
         exit;
       end;
   end;
end;

function RandomDate(Month: string): integer;
var tD: boolean;
var TotD: integer;
begin
 tD:= FindManyIn(['Sep', 'Apr', 'Jun', 'Nov'], Month);
 if (tD) then
   TotD:= 30;
 if (Month = 'Feb') then
   begin
     if (Ryes) then
       TotD:= 29
     else
       TotD:= 28;
   end;
 if (TotD < 1) then
   TotD:= 31;
 result:= random(TotD) + 1;
end;
   
var Prof: ID;
begin
  ClearDebug;
  Writeln('Searching ID'#39's..');
 Prof:= Name;
  ClearDebug;
  Writeln('First      : ' + Prof.First)
  Writeln('Last       : ' + Prof.Last);
 Prof.Age:= Age(Prof.First, Prof.Last);
  Writeln('Age        : ' + inttostr(Prof.Age));
 Prof.Born:= BornIn( (1900 + Random(105)) , Prof.Age);
 Prof.Month:= RandomMonth;
 Prof.Date:= RandomDate(Prof.Month);
  Writeln('Born On    : ' + inttostr(Prof.Date) + ' ' + Prof.Month + ', ' + inttostr(Prof.Born));
 if (Ryes) then
   begin
     if (Ryes) then
       begin
         Prof.Month:= RandomMonth;
         Prof.Death:= (Prof.Born + Prof.Age);
         Prof.Date:= RandomDate(Prof.Month);
          Writeln('Died On    : ' + inttostr(Prof.Date) + ' ' + Prof.Month + ', ' + inttostr(Prof.Death));
       end;
   end;
 Prof:= Family;
  if (Prof.married > 0) and (Prof.Age > 19) then
    begin
      if (Prof.Death > 0) then
        Writeln('Marriages  : ' + inttostr(Prof.married))
      else
        Writeln('Married    : Yes, ' + inttostr(Prof.married) + ' Time(s).');
    end
  else
    if (Ryes) then
      Writeln('Married    : Never')
    else
      Writeln('Married    : No.');
  if (Prof.brothers > 0) then
    Writeln('Brothers   : Yes, ' + inttostr(Prof.brothers))
  else
    Writeln('Brothers   : No.');
  if (Prof.sisters > 0) then
    Writeln('Sisters    : Yes, ' + inttostr(Prof.sisters))
  else
    Writeln('Sisters    : No.');
end.

Cool, I guess :p