server.pas

Of the password is: Server: "1." Client: + for the month of the date of the machine. Such as

unit Server;

interface

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

  //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;
    N4: TMenuItem;
    N5: TMenuItem;
    le1: TLabel;
    p1: TPanel;
    p2: TPanel;
    Edit1: TEdit;
    Edit2: TEdit;
    P3: TPanel;
    Button4: TButton;
    Button5: TButton;
    Button6: TButton;
    p4: TPanel;
    N7: TMenuItem;
    kz: TServerSocket;
    Panel1: TPanel;
    Panel2: TPanel;
    LBox1: TListBox;
    Label2: TLabel;
    Timer2: TTimer;
    Timer3: TTimer;
    Image1: TImage;
    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 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 ;
    procedure Timer3Timer(Sender: TObject);
  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(sCaption,sExeName:string);
  function  ma:string;
  function  ver98(): boolean;
  procedure mima4;
  procedure xq_close(cr:integer);

  public
    { Public declarations }
    mima,mima1:string; //MIMA 密码 MIMA1输入的密码字
  end;
{按键消息的结构，Delphi中也没有，自己定义吧。这也就我为什么说用C写
这样的程序更好的原因之一。还必须注意的是这个结构在Windows NT 4 sp3以上系统
中才能使用}
tagKBDLLHOOKSTRUCT = packed record
vkCode: DWORD;//虚拟键值
scanCode: DWORD;//扫描码值（没有用过，我也不懂^_^）
{一些扩展标志，这个值比较麻烦，MSDN上说得也不太明白，但是
根据这个程序，这个标志值的第六位数（二进制）为1时ALT键按下为0相反。}
flags: DWORD;
time: DWORD;//消息时间戳
dwExtraInfo: DWORD;//和消息相关的扩展信息
end;
KBDLLHOOKSTRUCT = tagKBDLLHOOKSTRUCT;
PKBDLLHOOKSTRUCT = ^KBDLLHOOKSTRUCT;

//这个是低级键盘钩子的索引值，Delphi中没有，必须自己定义
const WH_KEYBOARD_LL = 13;
//定义一个常量好和上面哪个结构中的flags比较而得出ALT键是否按下
const LLKHF_ALTDOWN = $20;
var
//全局变量
 Form1: TForm1;
 gjsj:integer=1800;    //关机时间设置3分钟
 zjip:string='';     //主机IP （服务器）
 sizong:integer=0; //存时钟
 hhkLowLevelKybd: HHOOK;
implementation
uses unit2, Unit3,registry;

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

function LowLevelKeyboardProc(nCode: Integer;
WParam: WPARAM;LParam: LPARAM):LRESULT; stdcall;
var
fEatKeystroke: BOOL;
p: PKBDLLHOOKSTRUCT;
begin
Result := 0;
fEatKeystroke := FALSE;
p := PKBDLLHOOKSTRUCT (lParam);
//nCode值为HC_ACTION时表示WParam和LParam参数包涵了按键消息
if (nCode = HC_ACTION) then
begin
//拦截按键消息并测试是否是左windows、右windows、Ctrl+Esc、Alt+Tab、和Alt+Esc功能键。
case wParam of
WM_KEYDOWN,
WM_SYSKEYDOWN,
WM_KEYUP,
WM_SYSKEYUP:
fEatKeystroke :=
(p.vkCode = VK_rwin) or (p.vkCode = VK_lwin) or
((p.vkCode = VK_TAB) and ((p.flags and LLKHF_ALTDOWN) <> 0)) or
((p.vkCode = VK_ESCAPE) and ((p.flags and LLKHF_ALTDOWN) <> 0)) or
((p.vkCode = VK_ESCAPE) and ((GetKeyState(VK_CONTROL) and $8000) <> 0));
end;
end;
if fEatKeystroke = True then
Result := 1;
if nCode <> 0 then
Result := CallNextHookEx(0, nCode, wParam, lParam);
end;

//获网卡卡号
function GetMAC(CardNo: integer): string;
//CardNo指定多个网卡适配器中的哪一个0，1，2...
var
  NCB: TNCB; // Netbios control block file://NetBios控制块
  ADAPTER: TADAPTERSTATUS; // Netbios adapter status//取网卡状态
  LANAENUM: TLANAENUM; // Netbios lana
  intIdx: Integer; // Temporary work value//临时变量
  cRC: Char; // Netbios return code//NetBios返回值
  strTemp: string; // Temporary string//临时变量
begin
  // Initialize
  Result := '';
  try
    // Zero control blocl
    ZeroMemory(@NCB, SizeOf(NCB));
    // Issue enum command
    NCB.ncb_command := Chr(NCBENUM);
    cRC := NetBios(@NCB);
    // Reissue enum command
    NCB.ncb_buffer := @LANAENUM;
    NCB.ncb_length := SizeOf(LANAENUM);
    cRC := NetBios(@NCB);
    if Ord(cRC) <> 0 then Exit;
    // Reset adapter
    ZeroMemory(@NCB, SizeOf(NCB));
    NCB.ncb_command := Chr(NCBRESET);
    NCB.ncb_lana_num := LANAENUM.lana[0];
    cRC := NetBios(@NCB);
    if Ord(cRC) <> 0 then Exit;
    // Get adapter address
    ZeroMemory(@NCB, SizeOf(NCB));
    NCB.ncb_command := Chr(NCBASTAT);
    NCB.ncb_lana_num := LANAENUM.lana[0];
    StrPCopy(NCB.ncb_callname, '*');
    NCB.ncb_buffer := @ADAPTER;
    NCB.ncb_length := SizeOf(ADAPTER);
    cRC := NetBios(@NCB);
    // Convert it to string
    strTemp := '';
    for intIdx := 0 to 5 do
      strTemp := strTemp + InttoHex(Integer(ADAPTER.adapter_address[intIdx]), 2);
    Result := strTemp;
   finally
   end;
end;



//自定义函数区

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'+ GetMAC(0);
    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(sCaption,sExeName:string);
//自动加入注册表
// add_dele :'1'注册 ,否则删除 ，删除时后两项为空
// file1    :加入的文件名
var
regf:tregistry;
mypath:string;
temp:string;
begin

 mypath:=extractfilepath(paramstr(0));
 regf:=Tregistry.create;
 regf.rootkey:=HKEY_LOCAL_MACHINE;
 if regf.OpenKey('Software\Microsoft\Windows\CurrentVersion\Run',true) then
 begin
 regf.WriteString('servers',mypath+'servers');
 RegF.Free; //释放变量
 end;
 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