[Back to MISC SWAG index] [Back to Main SWAG index] [Original]

    {Here is the source code to my unit called EASYKEY: }

    { ********************************************************************* }
    { *************       Easy Key version 1.0a        ******************** }
    { *************           Copyrite 1995            ******************** }
    { *************  by Thomas Moore of Stillwater Ok  ******************** }
    { ********************************************************************* }
    { ********************************************************************* }
    { ********  You may freely use this source code without  ************** }
    { ********  fees or royalities, but you may not compile  ************** }
    { ********  this as your REGISTRATION KEY program to be  ************** }
    { ********  sold.  You may however use this unit in your ************** }
    { ********  programs that you sell as registerable.      ************** }
    { ********************************************************************* }
    { ********************************************************************* }

    unit EasyKey;

    Interface
    const registered: boolean = false;
          regfile: string = 'easykey.reg';

    const regcode: array[1..5] of string[40] = ('', '', '', '', '');
    const regkey: string[40] = 'KihILijlipienkhppo98656jj;ajggu88k7899o9';
    type RegStr = string[40];

    procedure CheckRegCode(reg_code: regstr);
    procedure CheckForReg;
    procedure MakeRegFile(filename, sysop_name, bbs_name: string);

    Implementation

    var sysop, bbs: string;

    procedure MakeRegFile(filename, sysop_name, bbs_name: string);
    var rgfil: text;
        i: shortint;
    begin
         assign(rgfil, filename);
         rewrite(rgfil);
         writeln(rgfil, sysop_name);
         writeln(rgfil, bbs_name);
         CheckRegCode(sysop_name);
         for i := 1 to 5 do writeln(rgfil, regcode[i]);
         CheckRegCode(bbs_name);
         for i := 1 to 5 do writeln(rgfil, regcode[i]);
         close(rgfil);
    end;

    procedure CheckForReg;
    var reg: text;
        reginfo: array[1..10] of regstr;
        i: integer;
    begin
         registered := false;
         begin
              registered := false;
              assign(reg, regfile);
              {$I-} reset(reg) {I+};
              registered := false;
              if ioresult <> 0 then exit;
              {$I-} readln(reg, sysop) {I+};
              Registered := false;
              if ioresult <> 0 then exit;
              while length(sysop) < 40 do sysop := sysop + #32;
              {$I-} readln(reg, bbs) {I+};
              Registered := false;
              if ioresult <> 0 then exit;
              while length(bbs) < 40 do bbs := bbs + #32;
              for i := 1 to 10 do
              begin
                   {$I-} readln(reg, reginfo[i]) {I+};
                   Registered := false;
                   if ioresult <> 0 then exit;
              end;
         end;
         CheckRegCode(sysop);
         for i := 1 to 5 do
            if regcode[i] <>  reginfo[i] then exit;
         Registered := false;
         CheckRegCode(bbs);
         for i := 6 to 10 do
            if regcode[i - 5] <> reginfo[i] then exit;
         registered := true;
    end;

    procedure CheckRegCode(reg_code: regstr);
    var i, x: integer;
        tstr: string[4];
    begin
         for i := 1 to 5 do regcode[i] := '';
         while length(reg_code) < 40 do
               Reg_Code := Reg_Code + #32;
         while length(regkey) < 40 do regkey := regkey + regkey;
         for i := 1 to 40 do
         begin
              case i of
                1..8: begin
                          if reg_code[i] < regkey[i] then
                          begin
                             str((ord(regkey[i]) - ord(reg_code[i]))
                                 + 1000, tstr);
                             regcode[1] := regcode[1] + tstr + #32;
                          end
                          else
                          if reg_code[i] > regkey[i] then
                          begin
                             str((ord(reg_code[i]) - ord(regkey[i]))
                                 + 2000, tstr);
                             regcode[1] := regcode[1] + tstr + #32;
                          end
                          else
                          begin
                               str(ord(regkey[i]) + 3000, tstr);
                               regcode[1] := regcode[1] + tstr + #32;
                          end;
                       end;
                9..16: begin
                          if reg_code[i] < regkey[i] then
                          begin
                             str((ord(regkey[i]) - ord(reg_code[i]))
                                 + 1000, tstr);
                             regcode[2] := regcode[2] + tstr + #32;
                          end
                          else
                          if reg_code[i] > regkey[i] then
                          begin
                             str((ord(reg_code[i]) - ord(regkey[i]))
                                 + 2000, tstr);
                             regcode[2] := regcode[2] + tstr + #32;
                          end
                          else
                          begin
                               str(ord(regkey[i]) + 3000, tstr);
                               regcode[2] := regcode[2] + tstr + #32;
                          end;
                        end;
                17..24: begin
                          if reg_code[i] < regkey[i] then
                          begin
                             str((ord(regkey[i]) - ord(reg_code[i]))
                                 + 1000, tstr);
                             regcode[3] := regcode[3] + tstr + #32;
                          end
                          else
                          if reg_code[i] > regkey[i] then
                          begin
                             str((ord(reg_code[i]) - ord(regkey[i]))
                                 + 2000, tstr);
                             regcode[3] := regcode[3] + tstr + #32;
                          end
                          else
                          begin
                               str(ord(regkey[i]) + 3000, tstr);
                               regcode[3] := regcode[3] + tstr + #32;
                          end;
                        end;
                25..32: begin
                          if reg_code[i] < regkey[i] then
                          begin
                             str((ord(regkey[i]) - ord(reg_code[i]))
                                 + 1000, tstr);
                             regcode[4] := regcode[4] + tstr + #32;
                          end
                          else
                          if reg_code[i] > regkey[i] then
                          begin
                             str((ord(reg_code[i]) - ord(regkey[i]))
                                 + 2000, tstr);
                             regcode[4] := regcode[4] + tstr + #32;
                          end
                          else
                          begin
                               str(ord(regkey[i]) + 3000, tstr);
                               regcode[4] := regcode[4] + tstr + #32;
                          end;
                        end;
                33..40: begin
                          if reg_code[i] < regkey[i] then
                          begin
                             str((ord(regkey[i]) - ord(reg_code[i]))
                                 + 1000, tstr);
                             regcode[5] := regcode[5] + tstr + #32;
                          end
                          else
                          if reg_code[i] > regkey[i] then
                          begin
                             str((ord(reg_code[i]) - ord(regkey[i]))
                                 + 2000, tstr);
                             regcode[5] := regcode[5] + tstr + #32;
                          end
                          else
                          begin
                               str(ord(regkey[i]) + 3000, tstr);
                               regcode[5] := regcode[5] + tstr + #32;
                          end;
                        end;
              end;
         end;
    end;

    begin
    end.

    I also have a doc file that comes with it if you would like to FREQ it from
    my system it is in a file called EASYKEY.ZIP.

    SWAG TEAM, if you would like to include this in a swag packett, I would be
    delighted.

    Regards,
    Tom Moore

[Back to MISC SWAG index] [Back to Main SWAG index] [Original]