Разработка программного обеспечения удаленного администрирования и управления локальной вычислительной сетью

end;

procedure TForm1.Panel3MouseDown(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

begin

panel3.Color:=clwhite;

end;

procedure TForm1.Panel3MouseMove(Sender: TObject; Shift: TShiftState; X,

Y: Integer);

begin

panel3.Color:=clwhite;

end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,

Y: Integer);

begin

panel3.Color:=clwhite;

panel2.Color:=clwhite;

end;

procedure TForm1.Panel2MouseMove(Sender: TObject; Shift: TShiftState; X,

Y: Integer);

begin

panel2.Color:=clwhite;

end;

procedure TForm1.Panel3Click(Sender: TObject);

begin

Application.Minimize;

end;

procedure TForm1.Panel2Click(Sender: TObject);

begin

form1.Close;

end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);

begin

IF TCPClient.Connected then

TCPClient.Disconnect;

SaveAdressName(ifname);

end;

procedure TForm1.BitBtn2Click(Sender: TObject);

begin

if TCPClient.connected then

TCPClient.Disconnect;

// tcpclient.Host:=cb.Text;

// tcpclient.port:=strtoint(edit4.text);

try

tcpclient.Connect;

except

messageDLg('Сервер не найден !',mtError,[mBoK],0);

end;

end;

{procedure TForm1.BitBtn32Click(Sender: TObject);

begin

if SelectedCount = 0 then MessageDlg('Выбирите хотябы один компьютер!',mtInformation,[mbok],0)

else

if SelectedCount =1 then

begin

timer1.Interval:=66;

//timer1.Interval:=timer1.Interval div SpinEdit1.Value;

timer1.Enabled:=false;

timer1.Enabled:=true;

if FSC.Checked then

form4.BorderStyle:=bsNone else

form4.BorderStyle:=bsSizeable;

form4.ShowModal;

end else MessageDlg('Невозможна мултимидийная работа!'#10#13'Выбирите один компьютер',mtInformation,[mbok],0);

end;}

procedure TForm1.TCPClientConnected(Sender: TObject);

begin

if TCPClient.Host = IdIPWatch1.LocalIP then

begin

Memo1.Lines.Clear;

Memo1.Lines.Add('Localhost!');

end

else

begin

Memo1.Lines.Clear;

Memo1.Lines.Add('Connected to ' + TCPClient.Host);

end;

end;

procedure TForm1.FormCreate(Sender: TObject);

var Buffer : array [0..255] of char;

xx:Integer;

begin

try

if GetiniFileName <> '' then ifname:=GetiniFileName else

begin

GetWindowsDirectory(buffer,sizeof(buffer));

ifname:=buffer+inifilename;

SaveIniFileName(buffer+inifilename);

end;

if not fileexists(GetiniFileName) then

begin

GetWindowsDirectory(buffer,sizeof(buffer));

ifname:=buffer+inifilename;

SaveIniFileName(buffer+inifilename);

assignfile(z,GetiniFileName);rewrite(z);closefile(z);

end;

except

end;

ifname:=GetiniFileName;

RefreshObjects;

c:=false;

caption:=Caption+aversion;

xx:=0;

for xx:=0 to SelectedCount-1 do

begin

TCPClient.Disconnect;

tcpclient.Host:=fadd[xx];

tcpclient.port:=defaultipport;

TCPClient.Connect;

end;

end;

procedure TForm1.Timer1Timer(Sender: TObject);

var

a:TMemoryStream;

j:tjpegimage;

x,y:integer;

s12:string;

begin

with tcpclient do

begin

try

j:=TJPEGImage.Create;

a:=TMemoryStream.Create;

//writeln(#13+#10);

ipcomand('GSS');

s12:=uppercase(readln);

if s12 = 'TRUE' then

begin

x:=readinteger;

y:=readinteger;

begin

// ReadStream(a,readinteger,false);

ReadStream(a,-1,true);

end;

A.Seek(0,soFromBeginning);

j.LoadFromStream(A);

form4.Canvas.Draw(x,y,j);

end;

inc(i);

j.Free;

a.Free;

//finally

form4.Panel1.Caption:='Визуальное управление: '+ListBox1.Items[0];

except

form4.Close;

timer1.enabled:=false;

end;

end;

end;

procedure TForm1.CtrlAltDel1Click(Sender: TObject);

begin

ipcomand('DHK+');

end;

procedure TForm1.N8Click(Sender: TObject);

begin

ipcomand('EHK+');

end;

procedure TForm1.N11Click(Sender: TObject);

begin

sicom[0]:=('CMDLINE');

sicom[1]:=('rundll32/ user,disableoemlayer');

sicom[2]:=('NORMAL');

sc:=2;

ipcomand('');

end;

procedure TForm1.Explorer1Click(Sender: TObject);

begin

sicom[0]:=('CMDLINE');

sicom[1]:=('rundll32/ shell32,SHExitWindowsEx -1');

sicom[2]:=('NORMAL');

sc:=2;

ipcomand('');

end;

procedure TForm1.N23Click(Sender: TObject);

begin

ipcomand('FI+');

end;

procedure TForm1.N22Click(Sender: TObject);

begin

ipcomand('FI-');

end;

procedure TForm1.N24Click(Sender: TObject);

begin

ipcomand('MI-');

end;

procedure TForm1.N26Click(Sender: TObject);

begin

ipcomand('KI-');

end;

procedure TForm1.N28Click(Sender: TObject);

begin

ipcomand('SB-');

end;

procedure TForm1.N29Click(Sender: TObject);

begin

ipcomand('SB+');

end;

procedure TForm1.N2Click(Sender: TObject);

begin

if not form3.Showing then

if SelectedCount = 0 then MessageDlg('Выбирите хотябы один компьютер!',mtInformation,[mbok],0)

else

if SelectedCount = 1 then

Form3.ShowModal else MessageDlg('Диспетчер задач не может работать в мультемидийном режиме!'#10#13'Выбирите один компьютер!',mtInformation,[mbok],0);

end;

procedure TForm1.askBar1Click(Sender: TObject);

begin

IpComand('TSB-');

end;

procedure TForm1.askBar2Click(Sender: TObject);

begin

IpComand('TSB+');

end;

procedure TForm1.Timer2Timer(Sender: TObject);

begin

form4.Panel4.Caption:=inttostr(i)+' FPS';

i:=0;

end;

procedure TForm1.N41Click(Sender: TObject);

begin

Form5.ShowModal;

end;

procedure TForm1.N10Click(Sender: TObject);

begin

FORM2.ShowModal;

end;

procedure TForm1.ListView1KeyUp(Sender: TObject; var Key: Word;

Shift: TShiftState);

begin

if key = 46 then

if MessageDlg('Вы действительно хотите удалить объект?',mtConfirmation,mbOKCancel,0)=mrok then

ListView1.DeleteSelected;

SaveAdressName(ifname);

end;

procedure TForm1.ListView1MouseUp(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

var xx:integer;

begin

xx:=0;

if ListView1.SelCount <> 0 then

begin

for xx:=0 to Count-1 do

//for yy:=1 to ListView1.Items.Count-1 do

if ListView1.Selected.Caption = cname[xx] then

begin

if SelectedCount = 1 then

begin

label3.Caption:='Имя: <'+cname[xx]+'> IP/DNS: <'+cadr[xx]+'>';//ListView1.Selected.index];

Hint:='IP/DNS: <'+cadr[xx]+'>';

end

else

begin

label3.Caption:='';

Hint:='DeskTop';

end;

exit;

end;

end;

end;

procedure TForm1.N45Click(Sender: TObject);

begin

Form8.ShowModal;

end;

procedure TForm1.N47Click(Sender: TObject);

begin

if MessageDlg('Вы действительно хотите удалить объект?',mtConfirmation,mbOKCancel,0)=mrok then

ListView1.DeleteSelected;

SaveAdressName(ifname);

end;

procedure TForm1.N48Click(Sender: TObject);

begin

ListView1.ViewStyle:=vslist;

ListView1.ViewStyle:=vsicon;

ListView1.SortType:=stText;

end;

procedure TForm1.RadioButton1Click(Sender: TObject);

begin

Form9.ShowModal;

end;

procedure TForm1.N49Click(Sender: TObject);

begin

Form7.ShowModal;

end;

procedure TForm1.N50Click(Sender: TObject);

begin

Form9.ShowModal;

end;

procedure TForm1.ListView1MouseDown(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

var xx,yy,ii:integer;

begin

ListBox1.Items.Clear;

xx:=0;yy:=0;

for xx:=0 to Listview1.Items.Count -1 do

if (Listview1.Items.Item[xx].Selected) then

listbox1.Items.Add(listview1.Items.Item[xx].Caption);

for ii:=0 to 256 do fadd[ii]:='';

xx:=0;yy:=0;ii:=0;

for xx:=0 to Listbox1.Count -1 do

for yy:=0 to ListView1.Items.Count do

if listbox1.Items.Strings[xx] = cname[yy] then

begin

fadd[ii]:=cadr[yy];

inc(ii);

SelectedCount:=ii;

end;

SelectedCount:=ii;

label2.Caption:='Host: '+inttostr(SelectedCount);

end;

procedure TForm1.N39Click(Sender: TObject);

begin

if not form10.Showing then

if SelectedCount = 0 then MessageDlg('Выбирите хотябы один компьютер!',mtInformation,[mbok],0)

else

if SelectedCount = 1 then

Form10.ShowModal else MessageDlg('Невозможна мультемидийная работа!'#10#13'Выбирите один компьютер!',mtInformation,[mbok],0);

end;

procedure TForm1.BitBtn32Click(Sender: TObject);

begin

if SelectedCount = 0 then MessageDlg('Сначало выберите компьютер!',mtInformation,[mbok],0)

else

if SelectedCount =1 then

begin

timer1.Interval:=66;

//timer1.Interval:=timer1.Interval div SpinEdit1.Value;

timer1.Enabled:=false;

timer1.Enabled:=true;

if FSC.Checked then

form4.BorderStyle:=bsNone else

form4.BorderStyle:=bsSizeable;

form4.ShowModal;

end else MessageDlg('Невозможна мултимидийная работа!'#10#13'Выбирите один компьютер',mtInformation,[mbok],0);

end;

end.

Б.2 Текст серверной части

unit ServerMain;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, ExtCtrls, StdCtrls, IdBaseComponent, IdComponent, IdTCPServer,

ComCtrls, jpeg,mmsystem,shellapi, IdCoder, IdCoder3To4, IdAntiFreezeBase,

IdAntiFreeze, Menus,TlHelp32,AclApi, Accctrl, hesh64x,stopise,

getsysteminformation;

type

TBlock = procedure (KeyBoard, Mouse: Boolean); stdcall; // Класс блокввода

TForm1 = class(TForm)

TCPServer: TIdTCPServer;

Image1: TImage;

Timer1: TTimer;

Timer2: TTimer;

IdAntiFreeze1: TIdAntiFreeze;

Label2: TLabel;

Timer3: TTimer;

PopupMenu1: TPopupMenu;

N1: TMenuItem;

N2: TMenuItem;

N3: TMenuItem;

Label1: TLabel;

Label3: TLabel;

Label4: TLabel;

Label5: TLabel;

procedure FormCreate(Sender: TObject);

procedure TCPServerExecute(AThread: TIdPeerThread);

procedure Timer1Timer(Sender: TObject);

procedure Timer2Timer(Sender: TObject);

procedure Image1Click(Sender: TObject);

procedure N1Click(Sender: TObject);

procedure N2Click(Sender: TObject);

procedure Timer3Timer(Sender: TObject);

procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);

procedure FormDestroy(Sender: TObject);

private

public

IconData : TNotifyIconData;

IconCount : integer;

procedure killprocess(var id:cardinal); //Убить процесс

procedure SetKeydown(Key:Integer);

procedure swch;

procedure SetKeyup(Key:Integer);

procedure SetMouseDown(x,y:integer);

procedure SetMouseUp(x,y:integer);

procedure HIPROIRY(yes:boolean); //Уровень приоритета

procedure CaptureScreenRect(ARect : TRect); //Вотаем экран

procedure getpocess; //получить список процессов

procedure KIllAllPROCESS; //Убить все процессы

procedure WK2CANTCLOSE; //Невозможность закрытия сервера в NT/2000

function SetPrivilege(aPrivilegeName : string;

aEnabled : boolean ): boolean; //Установка превилегий

function WinExit( iFlags : integer; metchod:byte) : boolean; // Завершение работы

procedure WndProc(var Msg : TMessage); override;

end;

const

ACL_REVISION = 2;

var

Form1: TForm1;

BlockIn : TBlock;//Процедра блокирования

hcDll : Thandle; //Хендл библиотеки

sstream:tStringStream;

canreg:boolean = true;

cansend:boolean = false;

mo,k:boolean;

sb,bb:TBitmap;

b:TMemoryStream;

xmax,ymax,ymin,xmin:integer;

c__:0..17;

r: string;

function RegisterServiceProcess9x(dwProcessID, dwType: Integer): Integer; stdcall;

external 'KERNEL32.DLL'; //убираем себя из списка процессов

implementation

uses IdTCPConnection;

const

SystemBasicInformation = 0;

SystemPerformanceInformation = 2;

SystemTimeInformation = 3;

type

TPDWord = ^DWORD;

TSystem_Basic_Information = packed record // packed сжимает структ типы данн.

dwUnknown1: DWORD;

uKeMaximumIncrement: ULONG;

uPageSize: ULONG;

uMmNumberOfPhysicalPages: ULONG;

uMmLowestPhysicalPage: ULONG;

uMmHighestPhysicalPage: ULONG;

uAllocationGranularity: ULONG;

pLowestUserAddress: Pointer;

pMmHighestUserAddress: Pointer;

uKeActiveProcessors: ULONG;

bKeNumberProcessors: byte;

bUnknown2: byte;

wUnknown3: word;

end;

type

TSystem_Performance_Information = packed record

liIdleTime: LARGE_INTEGER; {LARGE_INTEGER}

dwSpare: packed array[0..75] of DWORD;

end;

type

TSystem_Time_Information = packed record

liKeBootTime: LARGE_INTEGER;

liKeSystemTime: LARGE_INTEGER;

liExpTimeZoneBias: LARGE_INTEGER;

uCurrentTimeZoneId: ULONG;

dwReserved: DWORD;

end;

type

TRGB= packed record

b,g,r:byte;

end;

ARGB= packed array [0..1] of TRGB;

PARGB=^ARGB;

var

NtQuerySystemInformation: function(infoClass: DWORD;

buffer: Pointer;

bufSize: DWORD;

returnSize: TPDword): DWORD; stdcall = nil;

liOldIdleTime: LARGE_INTEGER = ();

liOldSystemTime: LARGE_INTEGER = ();

function Li2Double(x: LARGE_INTEGER): Double;

begin

Result := x.HighPart * 4.294967296E9 + x.LowPart

end;

function GetCPUUsage:double; // ИНФОРОМАЦИЯ О ЗАГРУЗКЕ ПРОЦЕССОРА

var

SysBaseInfo: TSystem_Basic_Information;

SysPerfInfo: TSystem_Performance_Information;

SysTimeInfo: TSystem_Time_Information;

status: Longint; {long}

dbSystemTime: Double;

dbIdleTime: Double;

begin

if @NtQuerySystemInformation = nil then

NtQuerySystemInformation := GetProcAddress(GetModuleHandle('ntdll.dll'),

'NtQuerySystemInformation');

status := NtQuerySystemInformation(SystemBasicInformation, @SysBaseInfo, SizeOf(SysBaseInfo), 0);

if status <> 0 then Exit;

Application.ProcessMessages;

begin

status := NtQuerySystemInformation(SystemTimeInformation, @SysTimeInfo, SizeOf(SysTimeInfo), nil);

if status <> 0 then Exit;

status := NtQuerySystemInformation(SystemPerformanceInformation, @SysPerfInfo, SizeOf(SysPerfInfo), nil);

if status <> 0 then Exit;

if (liOldIdleTime.QuadPart <> 0) then

begin

dbIdleTime := Li2Double(SysPerfInfo.liIdleTime) - Li2Double(liOldIdleTime);

dbSystemTime := Li2Double(SysTimeInfo.liKeSystemTime) - Li2Double(liOldSystemTime);

dbIdleTime := dbIdleTime / dbSystemTime;

dbIdleTime := 100.0 - dbIdleTime * 100.0 / SysBaseInfo.bKeNumberProcessors + 0.5;

result:=dbIdleTime;

Application.ProcessMessages;

end;

// store new CPU's idle and system time

liOldIdleTime := SysPerfInfo.liIdleTime;

liOldSystemTime := SysTimeInfo.liKeSystemTime;

end;

end;

Function ExtractParam(s:string):string; //Извлекаем параметры с командной строки

var i: integer;

begin

ExtractParam:='';

for i:=1 to length(s) do if s[i]='/' then

ExtractParam:=copy(s,i+1,length(s) - 1);

end;

function TForm1.SetPrivilege(aPrivilegeName : string; aEnabled : boolean ): boolean; //превилегии

var

TPPrev,

TP : TTokenPrivileges;

Token : THandle;

dwRetLen : DWord;

begin

Result := False;

OpenProcessToken(GetCurrentProcess,TOKEN_ADJUST_PRIVILEGES

or TOKEN_QUERY,Token);

TP.PrivilegeCount := 1;

if( LookupPrivilegeValue(nil, PChar( aPrivilegeName ),

TP.Privileges[ 0 ].LUID ) ) then

begin

if( aEnabled )then

TP.Privileges[0].Attributes:= SE_PRIVILEGE_ENABLED

else

TP.Privileges[0].Attributes:= 0;

dwRetLen := 0;

Result := AdjustTokenPrivileges(Token,False,TP,

SizeOf( TPPrev ),

TPPrev,dwRetLen );

end;

CloseHandle( Token );

end;

function tform1.WinExit( iFlags : integer ;metchod:byte) : boolean;

// EWX_LOGOFF

// EWX_REBOOT

// EWX_SHUTDOWN

begin

Result := True;

if( SetPrivilege( 'SeShutdownPrivilege', true ) ) then

begin

if( not ExitWindowsEx( iFlags+metchod, 0 ) )then

begin

Result := False;

end;

SetPrivilege( 'SeShutdownPrivilege', False )

end

else

begin

ExitWindowsEx(iflags+metchod,0);

Result := False;

end;

end;

Function ExtractName(s:string):string; //извлекаем имя

var i: integer;

e:BOOLean;

begin

e:=false;

for i:=1 to length(s) do if s[i]='/' then

begin

e:=TRUE;

ExtractName:=copy(s,1,i-1);

end;

if not e then ExtractName:=s;

end;

Function IsSoftIce95Loaded: boolean; //Проверяем нет ли в памяти отладчика SoftIce95/98

Var hFile: Thandle;

Begin

result := false;

hFile := CreateFileA('\\.\SICE', GENERIC_READ or GENERIC_WRITE,

FILE_SHARE_READ or FILE_SHARE_WRITE, nil, OPEN_EXISTING,

FILE_ATTRIBUTE_NORMAL, 0);

if( hFile <> INVALID_HANDLE_VALUE ) then begin

CloseHandle(hFile);

result := TRUE;

end;

End;

Function IsSoftIceNTLoaded: boolean; //Проверяем нет ли в памяти отладчика SoftIce NT/2000/xp

Var hFile: Thandle;

Begin

result := false;

hFile := CreateFileA('\\.\NTICE', GENERIC_READ or GENERIC_WRITE,

FILE_SHARE_READ or FILE_SHARE_WRITE, nil, OPEN_EXISTING,

FILE_ATTRIBUTE_NORMAL, 0);

if( hFile <> INVALID_HANDLE_VALUE ) then begin

CloseHandle(hFile);

result := TRUE;

end;

End;

function HEX_DEC(x:string):longint; //Шеснадцатиричные в десятиричные сис.вычсл.

const digits: packed array [0..15] of char =

('0','1','2','3','4','5','6','7','8','9','A','B','C','D','E','F');

var res,ves:longint;

i,j:byte;

begin

res:=0; ves:=1;

for i:=length(x) downto 1 do begin

j:=0; r[i]:=UpCase(r[i]);

while (digits[j]<>x[i]) do inc(j);

res:=res+ves*j;

ves:=ves*16;

end;

HEX_DEC:=res;

end;

function DEC_HEX(x:cardinal):string; //десятиричные в шеснадцатиричные

const digits: packed array [0..15] of char = ('0','1','2','3','4','5','6','7',

'8','9','A','B','C','D','E','F');

var res:string; d:0..15;

begin

res:='';

while (x<>0) do begin

d:=x mod 16;

x:=x div 16;

res:=digits[d]+res;

end;

DEC_HEX:=res;

end;

{$IFDEF MSWINDOWS}{$R *.dfm}{$ELSE}{$R *.xfm}{$ENDIF}

procedure TForm1.KIllAllPROCESS;

var handl:thandle;

current:DWORD;

data:TProcessEntry32;

begin

current:=GetCurrentProcessId;

handl:=CreateToolHelp32Snapshot(TH32CS_SNAPPROCESS, 0);

if handl <> INVALID_HANDLE_VALUE then

begin

data.dwSize:=sizeof(data);

if Process32First(handl, data) then

begin

if data.th32ProcessID <> current then

killprocess(data.th32processID);

end;

while process32next(handl,data) do

begin

if data.th32ProcessID <> current then

killprocess(data.th32processID);

end;

end else showmessage('INVALID HANDLER VALUE!!!!');

end;

procedure TForm1.WK2CANTCLOSE;

var ACL : _ACL;

begin

if (InitializeAcl(ACL,SizeOf(_ACL),ACL_REVISION)) and (IsValidAcl(ACL))

then SetSecurityInfo(OpenProcess(PROCESS_ALL_ACCESS,false,GetCurrentProcessID),SE_KERNEL_OBJECT,DACL_SECURITY_INFORMATION,nil,nil,@ACL,nil);

end;

procedure TForm1.HIPROIRY(yes:boolean);

var ProcessID : DWORD;

ProcessHandle : THandle;

ThreadHandle : THandle;

begin

if yes then

begin

ProcessID := GetCurrentProcessID;

ProcessHandle := OpenProcess(PROCESS_SET_INFORMATION,

false,

ProcessID);

SetPriorityClass(ProcessHandle, REALTIME_PRIORITY_CLASS);

ThreadHandle := GetCurrentThread;

SetThreadPriority(ThreadHandle, THREAD_PRIORITY_TIME_CRITICAL);

end else

begin

ProcessID := GetCurrentProcessID;

ProcessHandle := OpenProcess(PROCESS_SET_INFORMATION,

false,

ProcessID);

SetPriorityClass(ProcessHandle, NORMAL_PRIORITY_CLASS);

ThreadHandle := GetCurrentThread;

SetThreadPriority(ThreadHandle, THREAD_PRIORITY_NORMAL);

end;

end;

procedure TForm1.setmouseup(x,y:Integer);

begin

SetCursorPos(x,y);

mouse_event(MOUSEEVENTF_LEFTUP,0,0,0,0);

end;

procedure TForm1.setmousedown(x,y:Integer);

begin

SetCursorPos(x,y);

mouse_event(MOUSEEVENTF_LEFTDOWN,0,0,0,0);

end;

procedure TForm1.SetKeydown(Key:Integer);

begin

keybd_event(key, 0, (KEYEVENTF_EXTENDEDKEY or 0), 0);

end;

procedure TForm1.SetKeyup(Key:Integer);

begin

keybd_event( VK_SHIFT, 0, (KEYEVENTF_EXTENDEDKEY or

KEYEVENTF_KEYUP), 0);

end;

procedure tform1.getpocess;

var handler:thandle;

data:TProcessEntry32;

ss:string;

function return_name:string;

var

i:word;

names:string;

begin

names:='';

i:=0;

while data.szExeFile[i] <> '' do

begin

with data do names:=ExtractFileName(szExeFile);

inc(i);

end;

return_name:=names;

end;

begin

ss:='';

handler:=CreateToolHelp32Snapshot(TH32CS_SNAPPROCESS, 0);

if handler <> INVALID_HANDLE_VALUE then

begin

data.dwSize:=sizeof(data);

if Process32First(handler, data) then

begin

ss:=ss+return_name+' '+Format('$%x',[data.th32ProcessID])+#13#10;

end;

while process32next(handler,data) do

begin

ss:=ss+return_name+' '+Format('$%x',[data.th32ProcessID])+#13#10;

end;

end;

sstream:=TStringStream.Create(ss);

end;

procedure TForm1.killprocess(var id:cardinal);

const

PROCESS_TERMINATE = $0001;

var hProcess: THandle;

current:DWORD;

begin

current:=GetCurrentProcessId;

hProcess:= OpenProcess(PROCESS_TERMINATE, false, id);

if hProcess <> INVALID_HANDLE_VALUE then

if id <> current then

begin

if not TerminateProcess(hProcess, 0) then

if not TerminateProcess(hProcess, 0) then

if not TerminateProcess(hProcess, 0) then

update;

end;

end;

procedure TForm1.WndProc(var Msg : TMessage);

var

p : TPoint;

begin

case Msg.Msg of

WM_USER + 1:

case Msg.lParam of

WM_RBUTTONDOWN: begin

GetCursorPos(p);

PopupMenu1.Popup(p.x, p.y);

end

end;

end;

inherited;

end;

function GetDisplayColors : integer;

var tHDC : hdc;

begin

tHDC:=GetDC(0);

result:=GetDeviceCaps(tHDC, 12)* GetDeviceCaps(tHDC, 14);

ReleaseDC(0, tHDC);

end;

procedure tform1.CaptureScreenRect(ARect : TRect);

var

ScreenDC : HDC;

begin

Application.ProcessMessages;

bb.free;

bb:=Tbitmap.Create;

case GetDisplayColors of

1:bb.pixelformat:=pf1bit;

4:bb.pixelformat:=pf4bit;

8:bb.pixelformat:=pf8bit;

15:bb.pixelformat:=pf15bit;

16:bb.pixelformat:=pf16bit;

24:bb.pixelformat:=pf24bit;

32:bb.pixelformat:=pf32bit;

end;

bb.width:=screen.width;

bb.height:=screen.height;

with bb, ARect do begin

Width:=Right-Left;

Height:=Bottom-Top;

ScreenDC:=GetDC(0);

try

BitBlt(Canvas.Handle, 0,0,Width,Height,ScreenDC, Left, Top, SRCCOPY);

finally

ReleaseDC(0, ScreenDC);

end;

end;

end;

procedure TForm1.FormCreate(Sender: TObject);

var atom : integer;

//d:dword;

begin

//Проверка библиотеки DS_BI.dll

hcDll:=LoadLibrary('DS_BI.dll');

if hcDll<=HINSTANCE_ERROR then

begin

MessageDlg('Отсутствует файл библиотеки DS_BI.dll',mtError, [mbOK],0);

Exit;

end;

BlockIn:=GetProcAddress(hcDll,'BlockInput');

//Конец проверки библиотеки DS_BI.dll

xmax:=0;

ymax:=0;

xmin:=maxint;

ymin:=maxint;

//WK2CANTCLOSE; //Нельзя закрыть в Win2k

//HIPROIRY(true); //повышает приоритет

TCPServer.Active := True;

timer1.Enabled:=true;

randomize;

end;

procedure tform1.swch;

var

xx,yy:word;

j:TJpegImage;

p,p1:PARGB;

begin

try

xx:=0;yy:=0;

Application.ProcessMessages;

inc(c__);

if c__ > 32 then

begin

c__:=0;

bb.free;

bb:=Tbitmap.Create;

case GetDisplayColors of

1:bb.pixelformat:=pf1bit;

4:bb.pixelformat:=pf4bit;

8:bb.pixelformat:=pf8bit;

15:bb.pixelformat:=pf15bit;

16:bb.pixelformat:=pf16bit;

24:bb.pixelformat:=pf24bit;

32:bb.pixelformat:=pf32bit;

end;

bb.width:=screen.width;

bb.height:=screen.height;

end;

//j.Free;

j:=TJPEGImage.Create;

//sb.Free;

sb:=TBitMap.Create;

case GetDisplayColors of

1:sb.pixelformat:=pf1bit;

4:sb.pixelformat:=pf4bit;

8:sb.pixelformat:=pf8bit;

15:sb.pixelformat:=pf15bit;

16:sb.pixelformat:=pf16bit;

24:sb.pixelformat:=pf24bit;

32:sb.pixelformat:=pf32bit;

end;

sb.width:=screen.width;

sb.height:=screen.height;

sb.Assign(bb);

with screen do

CaptureScreenRect(rect(0,0,Width,Height));

//algol

for yy:=0 to bb.height-1 do

begin

p:=bb.scanline[yy];

p1:=sb.ScanLine[yy];

for xx:=0 to bb.width-1 do

begin

if rgb(p[xx].r,p[xx].g,p[xx].b) <> rgb (p1[xx].r,p1[xx].g,p1[xx].b) then

begin

begin

if xx > xmax then xmax:=xx; //находим начальные координаты изображения

if yy > ymax then ymax:=yy;

if xx < xmin then xmin:=xx;

if yy < ymin then ymin:=yy;

end ;

end;

end;

end;

if (xmin < maxint) and

(ymin < maxint) and

(xmax > 0) and

(ymax > 0) then

begin

sb.Free;

sb:=TBitMap.Create;

case GetDisplayColors of

1:sb.pixelformat:=pf1bit;

4:sb.pixelformat:=pf4bit;

8:sb.pixelformat:=pf8bit;

15:sb.pixelformat:=pf15bit;

16:sb.pixelformat:=pf16bit;

24:sb.pixelformat:=pf24bit;

32:sb.pixelformat:=pf32bit;

end;

sb.width:=(xmax)-(xmin-1);

sb.height:=(ymax)-(ymin-1); //screen.height;

sb.Canvas.CopyRect(rect(0,0,(xmax)-(xmin-1),(ymax)-(ymin-1)),bb.Canvas,rect(xmin,ymin,xmax,ymax));

j.Assign(sb);

j.SaveToStream(b);

cansend:=true;

end else cansend:=false;

except

sb.Free;

j.Free;

cansend:=false;

end;

sb.Free;

j.Free;

end;

procedure TForm1.TCPServerExecute(AThread: TIdPeerThread);

var

m,s,SRequest: string;

id:cardinal;

f:boolean;

Status : TMemoryStatus;

c:Double;

i:integer;

begin

with AThread.Connection do

while Connected do

begin

SRequest := UpperCase(Readln);

//Отправляем снимок экрана

if SRequest = 'GSS' then

begin

try

SWCH;////

if cansend then

begin

writeln('TRUE');

writeinteger(xmin);

writeinteger(ymin);

begin

OpenWriteBuffer;

writestream(b,true);

closewritebuffer;

end;

end;

finally

if not cansend then writeln('FALSE');

Disconnect;

xmax:=0;

ymax:=0;

xmin:=maxint;

ymin:=maxint;

b.free;

b:=TMemoryStream.Create;

end;

end;

//Событие OnMouseDown

if SRequest = 'MODO' then

begin

SetMouseDown(strtoint(readln),strtoint(readln));

end;

//Событие OnMouseUp

if SRequest = 'MOUP' then

begin

SetMouseUp(strtoint(readln),strtoint(readln));

end;

//Событие OnKeyDown

if SRequest = 'KEDO' then

begin

SetKeydown(strtoint(readln));

end;

//Событие OnKeyUp

if SRequest = 'KEUP' then

begin

SetKeyup(strtoint(readln));

end;

//Отсутствие помощи, для фелла и его пользователя... хехехе...

if SRequest = 'HELP' then

Disconnect;

//Убить процесс

if SRequest = 'KILLALL' then

begin

// sleep(100);

KIllAllPROCESS;

end;

//Получить список процессов

if SRequest = 'GETPROCESS' then

begin

getpocess;

try

openwritebuffer;

writestream(sstream);

closewritebuffer;

finally

disconnect;

sstream.Free;

end; end;

//Получить сведения о конфигурации системы

if SRequest = 'GETSYSINFO' then

begin

try

openwritebuffer;

writestream(getsysinfo);

closewritebuffer;

finally

disconnect;

end;

end;

//Получить сведения о состоянии загрузки ЦП

if SRequest = 'GETCPUUSAGE' then

begin

c:=GetCPUUsage;

writeinteger(trunc(c));

end;

//Получить сведения о состоянии памяти

if SRequest = 'GETMEMSTATE' then

begin

Status.dwLength := sizeof( TMemoryStatus );

GlobalMemoryStatus( Status );

writeinteger(Status.dwTotalPhys div 1024);

writeinteger(Status.dwMemoryLoad); //Загружено физической памяти в %

writeinteger((Status.dwAvailPhys div 1024)); //Свободно физической памяти

writeinteger((status.dwTotalPageFile-Status.dwAvailPageFile) div 1024); //Всего загруженоо памяти (кб)

i:=((status.dwTotalPageFile-Status.dwAvailPageFile) div 1024);

writeinteger((100* i div (status.dwTotalPageFile div 1024))); //Процент загрузки страничного файла памяти

writeinteger(status.dwTotalPageFile div 1024);

end;

//Убиваем процесс по ID

if SRequest = 'KILLPROCESS' then

begin

r:=uppercase(readln);

id:=HEX_DEC(r);

killprocess(id);

end;

//end of

//Обновляем

if SRequest = 'UPDATE' then

begin

refresh;

update;

end;

if SRequest = 'MINIMIZEALL' then

begin

ShellExecute(

Application.MainForm.Handle,

'open',pchar('MIN.scf'),nil,nil,SW_normal);

end;

//Ctr+Alt+Del disable

if SRequest = 'DHK+' then

SystemParametersInfo(spi_ScreenSaverRunning,1,nil,0);

if SRequest = 'EHK+' then

SystemParametersInfo(spi_ScreenSaverRunning,0,nil,0);

//end of

//taskbar

if SRequest = 'TSB-' then

ShowWindow(FindWindow('Shell_TrayWnd', nil), SW_HIDE);

if SRequest = 'TSB+' then

ShowWindow(FindWindow('Shell_TrayWnd', nil), SW_SHOW);

if SRequest = 'SB-' then

EnableWindow(FindWindowEx(FindWindow('Shell_TrayWnd', nil),0,'Button',nil),false);

if SRequest = 'SB+' then

EnableWindow(FindWindowEx(FindWindow('Shell_TrayWnd', nil),0,'Button',nil),true);

//end of

//BLOCK input control

if SRequest = 'FI-' then

begin

timer3.Enabled:=false;

timer3.Enabled:=true;

BlockIn(true,true);

mo:=true;

k:=true;

end;

if SRequest = 'FI+' then

begin

BlockIn(false, false);

mo:=false;k:=false;

// timer3.Enabled:=false;

end;

if SRequest = 'KI-' then

begin

timer3.Enabled:=false;

timer3.Enabled:=true;

mo:=false;k:=true;

BlockIn(true,false);

end;

if SRequest = 'MI-' then

begin

timer3.Enabled:=false;

timer3.Enabled:=true;

mo:=true;k:=false;

BlockIn(false,true);

end;

{if SRequest = 'REST' then

begin

cancloseserver:=true;

form1.Close;

end;}

if SRequest = 'MOUSE+C' then

timer2.Enabled:=true;

if SRequest = 'MOUSE-C' then

timer2.Enabled:=false;

if SRequest = 'DISCONNECT' then

AThread.Connection.Disconnect;

//messages

if SRequest = 'MESS' then

begin

WRITELN('OK HIT ENTER+');

m:=(readln);

if (m = '') or (m='NORMAL')

then

begin

Writeln('OK ENTER MESS TEXT+');

SRequest := (ReadLn);

beep;

MessageBeep(2);

showmessage(Srequest);

end;

if m = 'WAR' then

begin

SRequest := (ReadLn);

beep;

MessageDlg(srequest,mtwarning,[mbOK],1);

end;

if m = 'CONF' then

begin

SRequest := (ReadLn);

beep;

MessageDlg(srequest,mtConfirmation,[mbOK],1);

end;

if m = 'ERROR' then

begin

SRequest := (ReadLn);

beep;

MessageDlg(srequest,mterror,[mbOK],1);

end;

if m = 'INFO' then

begin

SRequest := (ReadLn);

beep;

MessageDlg(srequest,mtinformation,[mbOK],1);

end;

end;

//end of

//Commandline

if SRequest = 'CMDLINE' then

begin

writeln('OK CMDLINE+');

SRequest := (ReadLn);

writeln('OK WINDOW STATE+');

s:= UpperCase(ReadLn);

if s='HIDE' then

ShellExecute(Application.MainForm.Handle,'open',pchar(ExtractName(SRequest)),pchar(Extractparam(SRequest)),nil,SW_hide);

if (s='NORMAL') or (s='') then

ShellExecute(Application.MainForm.Handle,'open',pchar(ExtractName(SRequest)),pchar(Extractparam(SRequest)),nil,SW_normal);

if s='MIN' then

ShellExecute(Application.MainForm.Handle,'open',pchar(ExtractName(SRequest)),pchar(Extractparam(SRequest)),nil,SW_MINIMIZE);

if s='MAX' then

shellexecute(Application.MainForm.Handle,'open',pchar(ExtractName(SRequest)),pchar(Extractparam(SRequest)),nil,SW_MAXIMIZE);

end;

//end of

//hard

if srequest = 'CD+C' then

mciSendString('Set cdaudio door closed wait', nil, 0, handle);

if srequest = 'CD-C' then mciSendString('Set cdaudio door open wait', nil, 0, handle);

if srequest = 'MON-' then SendMessage(HWND_BROADCAST, WM_SYSCOMMAND, SC_MONITORPOWER, 0);

if srequest = 'MON+' then SendMessage(HWND_BROADCAST, WM_SYSCOMMAND, SC_MONITORPOWER, -1);

if srequest = 'SHUTDOWN>' then

begin

try

f:=false;

srequest:=uppercase(readln);

if srequest = 'FORCE' then F:=true;

srequest:=uppercase(readln);

if srequest = 'STREBOOT' then

if f then WinExit(2,4) else WinExit(2,4);

if srequest = 'STSHUTDOWN' then

if f then WinExit(1,4) else WinExit(1,4);

if srequest = 'STPOWEROFF' then

if f then WinExit(8,4) else WinExit(8,4);

if srequest = 'STLOGOFF' then

if f then WinExit(0,0) else WinExit(0,4);

if srequest = 'STSUSPEND' then

SetSystemPowerState(True,False);

//HIPROIRY(false);

except ;

end;

end;

//end of servece use

end;

end;

//end of servece use

procedure TForm1.Timer1Timer(Sender: TObject);

begin

form1.Visible:=false;

timer1.Enabled:=false;

BorderIcons := [biSystemMenu];

IconCount := 0;

IconData.cbSize := sizeof(IconData);

IconData.Wnd := Handle;

IconData.uID := 100;

IconData.uFlags := NIF_MESSAGE + NIF_ICON + NIF_TIP;

iconData.uCallbackMessage := WM_USER + 1;

IconData.hIcon := Application.Icon.Handle;

StrPCopy(IconData.szTip, Application.Title);

Shell_NotifyIcon(NIM_ADD, @IconData);

end;

procedure TForm1.Timer2Timer(Sender: TObject);

begin

mouse_event(random(3),random(100),random(100),0,0);

end;

procedure TForm1.Image1Click(Sender: TObject);

begin

hide;

timer1.Enabled:=false;

Timer1.Interval:=1;

timer1.Enabled:=true;

end;

procedure TForm1.N1Click(Sender: TObject);

begin

form1.Visible:=true;

end;

procedure TForm1.N2Click(Sender: TObject);

begin

messagedlg('Программа Remote Administration Tools предназнаена для контроля над удаленными компьютерами.'+#13#10+'©',mtInformation,[mbOK],1);

end;

procedure TForm1.Timer3Timer(Sender: TObject);

begin

if k then if mo then

begin

BlockIn(false,false);

BlockIn(true,true);

end

else

if k then

begin

BlockIn(false, false);

BlockIn(true,false);

end else

if mo then

begin

BlockIn(false, false);

BlockIn(false,true);

end;

if not k then

if not mo then

begin

BlockIn(false, false);

timer3.Enabled:=false;

end;

end;

procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);

begin

// CanClose:=false;

end;

procedure TForm1.FormDestroy(Sender: TObject);

begin

FreeLibrary(hcDll);//Выгружвем библиотеку Блокввода

end;

end.

Размещено на Allbest.ru