Информатика и выч. техника \ Программирование на языках высокого уровня

Програмне забезпеченння для адміністрування комп'ютерного клубу, страница 9

unit MainUnit;

interface

uses

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

ImgList, ToolWin, ComCtrls, ShellAPI, ExtCtrls, inifiles, StdCtrls, Menus, Datagram,

ZShellExplorerOff, TLHelp32;

type

txt=text;

TForm1 = class(TForm)

ToolBar: TToolBar;

ImageList1: TImageList;

Timer: TTimer;

MainMenu1: TMainMenu;

N1: TMenuItem;

nReset: TMenuItem;

nTurnOff: TMenuItem;

miTime: TMenuItem;

miNet: TMenuItem;

tmSockets: TTimer;

NAdminMenu: TMenuItem;

N2: TMenuItem;

N3: TMenuItem;

N4: TMenuItem;

N5: TMenuItem;

procedure FormCreate(Sender: TObject);

procedure AppOnDeactivate(Sender: TObject);

procedure TBClick(Sender: TObject);

procedure TimerTimer(Sender: TObject);

procedure nResetClick(Sender: TObject);

procedure nTurnOffClick(Sender: TObject);

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

procedure tmSocketsTimer(Sender: TObject);

procedure N2Click(Sender: TObject);

procedure N3Click(Sender: TObject);

procedure N4Click(Sender: TObject);

private

procedure WMDisplayChange(var Message: TMessage); message WM_DISPLAYCHANGE;

public

{ Public declarations }

end;

var

Form1: TForm1;

//Net options

net:record

connected:boolean;

timeto:tdatetime;

forevertime:boolean

end;

implementation

{$R *.DFM}

uses Common, PasswordUnit, CopyFilesUnit, DoplatiteUnit, SnapshotUnit;

const

BNUMINROW=6;

ROWPIXELS=38;

TIME_TO_DELAY=6000;

WAITTIME=500;

MAXNUMPROCESSES=MAXIMUM_WAIT_OBJECTS;

type

copiedfiles=record

filename:array [1..MAXCOPIED] of string;

num:word

end;

pcopiedfiles=^copiedfiles;

savetime=record

timeto:tdatetime;

forevertime:boolean

end;

var

buttons:array [1..MAXBUTTNUM] of ttoolbutton;

copyreference:string;

pcs:array [1..MAXNUMPROCESSES] of record

handle:THandle;

processId:DWORD;

pcopfiles:pcopiedfiles

end;

numpcs:word;

cancloseform:boolean;

quiting:boolean;

timetodelay:dword;

cs:tsocket;

echocame:boolean;




 


procedure MessageDoplatite;

begin

if password.visible then begin

password.modalresult:=mrOk;

password.hide

end;

doplatite.left:=form1.left+((form1.width - doplatite.width) div 2);

doplatite.top:=form1.top+((form1.height - doplatite.height) div 2);

if (not doplatite.visible) then doplatite.showmodal

end;

//Posts a WM_QUIT message to all windows

//of new processes

function SendQuits:boolean;

var hwndnow:HWND;

procid:dword;

totalwins:word;

i:word;

wins:array [1..300] of dword;

begin

result:=false;

totalwins:=0;

hwndnow:=getforegroundwindow;

hwndnow:=getwindow(hwndnow,GW_HWNDFIRST);

while hwndnow<>0 do begin

getwindowthreadprocessid(hwndnow,@procid);

if not itssavedprocess(procid) then begin

inc(totalwins);

wins[totalwins]:=hwndnow;

result:=true

end;

hwndnow:=getnextwindow(hwndnow,GW_HWNDNEXT)

end;

for i:=1 to totalwins do

postmessage(wins[i],WM_QUIT,0,0)

end;

procedure CheckClosedProcesses(closeallmanually:boolean);

var quitthis:boolean;

res:dword;

i:word;

temppcs:array [0..MAXNUMPROCESSES] of THandle;

begin

//repeat ... until  - means

//that there can be several ended processes

//so work on all of them

//if closeallmanually set to true then

//this function just closes all handles to

//processes and deletes configs

quitthis:=false;

if numpcs>0 then repeat

for i:=1 to numpcs do

temppcs[i-1]:=pcs[i].handle;

if not closeallmanually then

//Real close

res:=waitformultipleobjects(numpcs,@temppcs,false,WAITTIME)

else

//Emulate close

res:=WAIT_OBJECT_0;

if (numpcs>0)and(res<=WAIT_OBJECT_0+numpcs-1) then begin

res:=res-WAIT_OBJECT_0+1;

deleteconfigs(res);

closehandle(pcs[res].handle);

pcs[res].handle:=0;

pcs[res].processid:=0;

if res<>numpcs then

for i:=res to numpcs-1 do begin

pcs[i].handle:=pcs[i+1].handle;

pcs[i].pcopfiles:=pcs[i+1].pcopfiles

end;

pcs[numpcs].processid:=0;

pcs[numpcs].handle:=0;

pcs[numpcs].pcopfiles:=nil;

dec(numpcs)

end

else quitthis:=true

until (quitthis)or(numpcs=0)

end;

Скачать файл