Program DjForce241;
uses crt;
Var
Serial,i:integer;
serialValid:boolean;
s1,s2,serialstr:string;
c:char;
NumBack,NumBack2:integer;
const
acer=4+4;
bcer=5+3+2;
ccer=10+12+8+3;
Procedure GUI;
var n,n2,n3,n4:integer;
Procedure GetCashFromSerial(var a,b,c,d:integer;s:string);
begin
a:=0;
b:=0;
c:=0;
d:=0;
for i:=1 to 28 do
begin
if i mod 3 = 0 then a:=a+ord(s[i]) mod 10;
if i mod 4 = 0 then d:=d+ord(s[i]) mod 10;
if i mod 7 = 0 then b:=b+ord(s[i]) mod 10;
if i mod 9 = 0 then c:=c+ord(s[i]) mod 10;
end;
end;
Procedure Input(n,n2:integer);
var a,b,c,u,u2:integer;
begin
numBack:=0;
numback2:=0;
u:=random(100);
u2:=random(100);
n:=n+u+(2+2+2+2){8}+(5+3+2+15+5+3) div 10{33}+(8+6+3+4+10+8) div 10{39};
n2:=n2+u2+(2+4+2+2){10}+(5+3+2+18+2+2+1) mod 10{33}+(8+6+3+4+10+8) mod 10{39};
numBack:=25+u;
NumBack2:=14+u2;
str(n,s1);
str(n2,s2)
end;
Procedure Output(s:string);
var n,n2,code:integer;
a,b,c,d:integer;
begin
val(s1,n3,code);
val(s2,n4,code);
GetCashFromSerial(a,b,c,d,serialstr);
n3:=n3-(numBack-25)-b-(a div 10)-d div 10;
n4:=n4-(numback2-14)-c-(a mod 10)- d mod 10;
writeln('Otvet=',n3+n4);
readln;
gui;
end;
Procedure ProverkaSerial;
begin
if serialVALID=false then begin
textcolor(4);
writeln('Don"t available in Shareware ');
readln;
textcolor(2);
clrscr;
gui;
end else begin
input(n,n2);
Output(serialstr);
end;
end;
Procedure Calc;
var s:string;
begin
clrscr;
if serialvalid=true then s:='' else s:='(Don"t Available in Shareware)';
writeln('Vvedite 2 chisla');
write('>');readln(n,n2);
writeln;
writeln('[1] -');
writeln('[2] *');
writeln('[3] + '+s);
c:=readkey;
case c of
'1':begin writeln('Otvet=',n-n2);readln;gui;end;
'2':begin writeln('Otvet=',n*n2);readln;gui;end;
'3':ProverkaSerial;
end;
end;
Procedure WElcom;
begin
Writeln('Welcome to Crackme from ID');
writeln('Version DjForce 2.41');
writeln('- this is ShareWare Program which doing with numbers what do you want');
writeln('- if you registered the program you can adding numbers');
writeln('- choice that are you want');
writeln;
end;
{---------------------------------------------------------------------------------------}
procedure WrBox(x,y,z:byte;s:string);
var i:byte;
begin
gotoxy(x,y);
write(chr(218));
for i:=1 to z do
write(chr(196));
write(chr(191));
gotoxy(x,y+1);
write(chr(195));
gotoxy(x,y+2);
write(chr(192));
gotoxy(x+z+1,y+1);
write(chr(197));
gotoxy(x+1,y+2);
for i:=1 to z do
write(chr(196));
write(chr(217));
writeln;
gotoxy(x+2,y+1);
write(s);
gotoxy(x,y+4);
end;
{-------------------------------------------------------------------------------}
Function Confirm:boolean;
var s:string;
begin
Gotoxy(1,20);
writeln('Are You Confirm This serial');
writeln('y/n');
repeat
readln(s);
until (s='y') or (s='n') or (s='Y') or(s='N');
if (s='y') or (s='Y') then Confirm:=true
else Confirm:=false;
end;
function CheckSerial(s:string):boolean;
var a,b,c:integer;
begin
a:=0;
b:=0;
c:=0;
for i:=1 to 28 do
begin
if i mod 3 = 0 then a:=a+ord(s[i]) mod 10;
if i mod 7 = 0 then b:=b+ord(s[i]) mod 10;
if i mod 9 = 0 then c:=c+ord(s[i]) mod 10;
end;
if (a=ccer) and(b=acer) and (c=bcer) then CheckSerial:=true;
end;
Procedure Register;
var i,n,x,y:integer;
s:string;
a,b:boolean;
Procedure Brash;
begin
clrscr;
Writeln('You mast enter the Serial Number');
WrBox(1,3,7,'');
WrBox(10,3,7,'');
WrBox(19,3,7,'');
WrBox(28,3,7,'');
WrBox(1,9,15,'[Esc] - Reset');
WrBox(19,9,16,'[Enter] - Exit');
x:=2;
y:=4;
gotoxy(x,y);
i:=0;
n:=0;
s:='';
b:=false
end;
{--------------------}
begin
n:=0;
Brash;
repeat
if n=4 then begin
n:=0;
a:=Confirm;
if a=false then brash;
if a=true then b:=CheckSerial(serialstr);
if b=true then begin
GOTOXY(1,24);
WRITELN('Serial is Valid');
serialvalid:=true;
end else begin
gotoxy(1,24);
textcolor(4);
writeln('Wrong Serial');
textcolor(2);
readln;
brash;
end;
end;
c:=readkey;
write(c);
serialstr:=serialstr+c;
inc(i);
if i=7 then begin
i:=0;
inc(n);
inc(x,9);
gotoxy(x,y)
end;
if c=#13 then continue;
if c=#27 then begin
Brash;
end;
until c=#13;
clrscr;
Gui;
end;
Procedure About;
begin
clrscr;
writeln('This Program Protected By DjForce v2.41');
Writeln('Created By Igor Djugostran');
writeln('Nothing Right Reserved');
readln;
gui;
end;
begin
clrscr;
welcom;
WrBox(2,6,24,'[1] Doing calculation');
WrBox(2,9,24,'[2] Register Program');
WrBox(2,12,24,'[3] About');
WrBox(2,15,24,'[4] Exit');
repeat
c:=readkey;
case c of
'1':Calc;
'2':Register;
'3':about;
'4':halt;
end;
until c='4'
end;
Procedure ClearCash;
begin
serialValid:=false;
end;
begin
CLEARCASH;
randomize;
clrscr;
textcolor(2);
Gui;
textcolor(7);
end.