unit1.pas

限制客户机运行程序 (有关机等功能)

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, ToolWin, ExtCtrls, ScktComp, Spin, Menus,
  ImgList, Buttons, bsSkinData, BusinessSkinForm, bsSkinCtrls,
  bsSkinBoxCtrls, Registry, bsMessages, bsSkinMenus, bsSkinShellCtrls,
  bsDialogs,Winsock;
const
    CMax=1000;  //客户端最大连接数
type
  client_record=record
     CHandle: integer;          //客户端套接字句柄
     CSocket:TCustomWinSocket;    //客户端套接字
     CName:string;                //客户端计算机名称
     CAddress:string;             //客户端计算机IP地址
     CUsed: boolean;               //客户端联机标志
     RemotePort:integer;           //客户端口
  end;
type
  TForm1 = class(TForm)
    ServerSocket: TServerSocket;
    StatusBar: TStatusBar;
    Timer1: TTimer;
    bsBusinessSkinForm1: TbsBusinessSkinForm;
    bsSkinData1: TbsSkinData;
    bsCompressedStoredSkin1: TbsCompressedStoredSkin;
    bsSkinMainMenuBar1: TbsSkinMainMenuBar;
    bsSkinMainMenu1: TbsSkinMainMenu;
    N2: TMenuItem;
    N3: TMenuItem;
    N4: TMenuItem;
    N5: TMenuItem;
    bsSkinMessage1: TbsSkinMessage;
    bsSkinTextDialog1: TbsSkinTextDialog;
    bsSkinPopupMenu2: TbsSkinPopupMenu;
    N10: TMenuItem;
    N11: TMenuItem;
    N12: TMenuItem;
    N1: TMenuItem;
    ListBox1: TListBox;
    OnlineUserlist: TListView;
    bsSkinInputDialog1: TbsSkinInputDialog;
    ListBox2: TListBox;
    N7: TMenuItem;
    N8: TMenuItem;
    N9: TMenuItem;
    N13: TMenuItem;
    N14: TMenuItem;
    N15: TMenuItem;
    N16: TMenuItem;
    N17: TMenuItem;
    N18: TMenuItem;
    bsSkinPopupMenu1: TbsSkinPopupMenu;
    N19: TMenuItem;
    N20: TMenuItem;
    N6: TMenuItem;
    N21: TMenuItem;
    N22: TMenuItem;
    N23: TMenuItem;
    N24: TMenuItem;
    N25: TMenuItem;
    N26: TMenuItem;
    N27: TMenuItem;
    N28: TMenuItem;
    procedure ServerSocketClientRead(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ServerSocketListen(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ServerSocketClientDisconnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure ServerSocketGetSocket(Sender: TObject; Socket: Integer;
      var ClientSocket: TServerClientWinSocket);
    procedure ServerSocketClientError(Sender: TObject;
      Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
      var ErrorCode: Integer);
    procedure N3Click(Sender: TObject);
    procedure N4Click(Sender: TObject);
    procedure N5Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure N11Click(Sender: TObject);
    procedure N12Click(Sender: TObject);
    procedure N1Click(Sender: TObject);
    procedure ServerSocketAccept(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ListBox2DblClick(Sender: TObject);
    procedure N7Click(Sender: TObject);
    procedure N8Click(Sender: TObject);
    procedure N9Click(Sender: TObject);
    procedure N13Click(Sender: TObject);
    procedure N14Click(Sender: TObject);
    procedure N15Click(Sender: TObject);
    procedure N19Click(Sender: TObject);
    procedure N20Click(Sender: TObject);
    procedure N21Click(Sender: TObject);
    procedure N22Click(Sender: TObject);
    procedure N23Click(Sender: TObject);
    procedure OnlineUserlistDblClick(Sender: TObject);
    procedure N24Click(Sender: TObject);
    procedure N26Click(Sender: TObject);
    procedure N27Click(Sender: TObject);
    procedure N28Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    session: array[0..CMax] of client_record;      //客户端连接数组
    Sessions: integer;                             //客户端连接数
  end;

var
  Form1: TForm1;
  MaxClient:Integer=1000;
  _jjj:String;
  Listtem: TListItem;

implementation
{$R *.dfm}

function GetPCName():string;
var
  CNameBuffer : PChar;
  fl_loaded : Boolean;
  CLen : ^DWord;
  computerName:string;
begin
    GetMem(CNameBuffer,255);
    New(CLen);
    CLen^:= 255;
    fl_loaded := GetComputerName(CNameBuffer,CLen^);
    if fl_loaded then
     ComputerName:= StrPas(CNameBuffer)
    else
      ComputerName := 'Unkown';
    Result:=ComputerName;
    FreeMem(CNameBuffer,255);
    Dispose(CLen);
end;

function LocalIP : string;
type
    TaPInAddr = array [0..10] of PInAddr;
    PaPInAddr = ^TaPInAddr;
var
    phe  : PHostEnt;
    pptr : PaPInAddr;
    Buffer : array [0..63] of char;
    I    : Integer;
    GInitData      : TWSADATA;
begin
    WSAStartup($101, GInitData);
    Result := '';
    GetHostName(Buffer, SizeOf(Buffer));
    phe :=GetHostByName(buffer);
    if phe = nil then Exit;
    pptr := PaPInAddr(Phe^.h_addr_list);
    I := 0;
    while pptr^[I] <> nil do begin
      result:=StrPas(inet_ntoa(pptr^[I]^));
      Inc(I);
    end;
    WSACleanup;
end;

procedure TForm1.ServerSocketClientRead(Sender: TObject;
  Socket: TCustomWinSocket);
procedure AddUserInfo(UserName:String;Control:String;Userip:String;_n3:String;_qx:String;_sj:String);   //记录登录主机信息
var
i,ii:Integer;
begin
       if OnlineUserlist.Items.Count >= MaxClient then
        begin
for i:=0 to sessions do
    begin
        //取得匹配的客户端
if session[i].CHandle = Socket.SocketHandle then
        begin
session[i].CSocket.SendText('$Z$MaxClient');
session[i].CSocket.Close;
    end;
    end;
            Exit;
        end;
for i:=0 to OnlineUserlist.Items.Count-1 do
    begin

    if (OnlineUserlist.Items[i].SubItems[0]=UserName) and (StrToInt(_qx)>0) then
//   if (ListBox2.Items.Strings[i]=UserName) and (StrToInt(_qx)>0) then
    begin
    for ii:=0 to sessions do
    begin
    if  session[ii].CHandle=Socket.SocketHandle then
    begin
//session[ii].CSocket.SendText('用户已登陆');
//StrToInt(ListBox2.Items.Strings[i])] ;
session[ii].CSocket.SendText('$Z$LogonNo');
session[ii].CSocket.Close;
exit;
    end;
    end;
    end;
end;
    Listtem:= OnlineUserlist.Items.Add;
    Listtem.Caption:= Control; //向在线用户列表加入用户
    Listtem.SubItems.Add(UserName);
    Listtem.SubItems.Add(Userip);
    Listtem.SubItems.Add(_qx);
    Listtem.SubItems.Add(_n3);
    Listtem.SubItems.Add(_sj);
end;
procedure DelUser(User:String);   //删除登录主机信息
var
i:integer;
begin
for i:=0 to Form1.OnlineUserlist.Items.Count-1 do
    begin
//    if Form1.ListBox1.Items.Strings[i]=User then
if OnlineUserlist.Items[i].subitems[0]=User then
    begin
//    RichEdit1.Lines.Add('用户'+Form1.listbox2.Items.Strings[i]+'退出 '+DateTimeToStr(Now));
    OnlineUserlist.Items[i].Delete;
    Break;
     end;
    end;
end;
var
    Data:WideString;
    i:integer;
begin
    //将从客户端读取的信息添加到Memo1中
   Data:=Socket.ReceiveText;
  if pos('$Name$',Data)=1 then  //服务器数据
    begin
    delete(Data,1,6);
for i:=0 to  OnlineUserlist.Items.Count-1 do
if OnlineUserlist.Items[i].Caption=inttostr(Socket.SocketHandle) then
   begin
    OnlineUserlist.Items[i].SubItems[0]:=data;
    exit;
    Break;
    end;
   end;
    if pos('$C$Userlist',Data)=1 then  //服务器数据
    begin
    delete(Data,1,11);
ListBox2.Items.Text:=Data;
   end;
end;

procedure TForm1.ServerSocketListen(Sender: TObject;
  Socket: TCustomWinSocket);
begin
    StatusBar.Panels[0].Text :='服务器已启动...';
end;

procedure DelUserInfo(UserID:String);   //删除登录主机信息
var
i:integer;
begin
for i:=0 to Form1.OnlineUserlist.Items.Count-1 do
    begin
    if Form1.OnlineUserlist.Items[i].Caption=UserID then
    begin
    Form1.OnlineUserlist.Items[i].Delete;
    Break;
     end;
    end;
end;


procedure TForm1.ServerSocketClientDisconnect(Sender: TObject;
  Socket: TCustomWinSocket);
var
    i:integer;
begin
    for i:=0 to sessions do
    begin
        if session[i].CHandle =Socket.SocketHandle then
        begin
            session[i].CHandle :=0;
            session[i].CUsed := False;
            Break;
        end;
    end;
 DelUserInfo(inttostr(Socket.SocketHandle));
 ListBox2.Clear;
 end;

procedure TForm1.FormCreate(Sender: TObject);
var
  tempreg:TRegistry;
  exeroute:string;
begin
    Form1.Caption:='限制运行程序服务器'+DateToStr(now)+' '+timeToStr(now);
    ListBox1.Items.LoadFromFile(ExtractFilePath(Paramstr(0))+'kill.txt');
    sessions := 0;
    ServerSocket.Open;
    exeroute:=extractfiledir(application.ExeName );
    tempreg:=TRegistry.Create;
    tempreg.RootKey:=HKEY_LOCAL_MACHINE;
    tempreg.OpenKey('SOFTWARE\Microsoft\Windows\CurrentVersion\Run',True);
    tempreg.WriteString('CRMS_Server','"'+exeroute+'\killserver.exe"');
    tempreg.Closekey;
    tempreg.Free;
    StatusBar.Panels[2].Text :='主机名'+GetPCName();
    StatusBar.Panels[3].Text :='主机IP'+LocalIP;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
   ServerSocket.Close ;
end;

procedure TForm1.ServerSocketGetSocket(Sender: TObject; Socket: Integer;
  var ClientSocket: TServerClientWinSocket);
begin
    StatusBar.Panels[0].Text :='客户端正在连接...';
end;

procedure TForm1.ServerSocketClientError(Sender: TObject;
  Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
  var ErrorCode: Integer);
begin
//    RichEdit1.Lines.Add('客户端'+Socket.RemoteAddress+'发生错误！');
    DelUserInfo(inttostr(Socket.SocketHandle));
    ListBox2.Clear;
    ErrorCode := 0;
end;


procedure TForm1.N3Click(Sender: TObject);
begin
ServerSocket.Close;
StatusBar.Panels[0].Text :='服务器套接字连接已经关闭，无法接受客户端的连接请求.';
end;

procedure TForm1.N4Click(Sender: TObject);
begin
    Close;
end;

procedure TForm1.N5Click(Sender: TObject);
begin
ServerSocket.Open;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
 StatusBar.Panels[1].Text :='已有'+inttostr(OnlineUserlist.Items.Count)+'个连接';
 Form1.Caption:='限制运行程序服务器'+DateToStr(now)+' '+timeToStr(now);
end;

procedure TForm1.N11Click(Sender: TObject);
var
  i:integer;
begin
  for i:=0 to sessions do
    begin
if session[i].CUsed then
        begin
session[i].CSocket.SendText('$Z$GetKILL'+ListBox1.Items.Text);
    end;
    end;
end;

procedure TForm1.N12Click(Sender: TObject);
var
     i:integer;
begin
if  OnlineUserlist.ItemIndex=-1 then