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