[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]