server_main.~pas

以前用delphi+kol写的监视工具

{ KOL MCK } // Do not remove this line!
{$DEFINE KOL_MCK}
{ KOL MCK }// Do not remove this line!
{$DEFINE KOL_MCK}
unit server_main;

interface

{$IFDEF KOL_MCK}
uses Windows, Messages, ShellAPI, KOL, ListEdit, kolTCPSocket {$IFNDEF KOL_MCK}, mirror, Classes,
  mckObjs, mckTCPSocket, mckCtrls, mckListEdit, Controls {$ENDIF};
{$ELSE}
{$I uses.inc}
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs;
{$ENDIF}

type
{$IFDEF KOL_MCK}
{$I MCKfakeClasses.inc}
  PclassPolicySrv = ^TclassPolicySrv;
  TclassPolicySrv = object(TObj)
    Form: PControl;
  {$ELSE not_KOL_MCK}
  TclassPolicySrv = class(TForm)
  {$ENDIF KOL_MCK}
    Project: TKOLProject;
    Main: TKOLForm;
    Server: TKOLTCPServer;
    Client: TKOLTCPClient;
    p_client: TKOLPanel;
    Panel1: TKOLPanel;
    Panel2: TKOLPanel;
    conns: TKOLListView;
    Memo1: TKOLMemo;
    Panel3: TKOLPanel;
    Button1: TKOLButton;
    Button2: TKOLButton;
    Splitter2: TKOLSplitter;
    PopupMenu1: TKOLPopupMenu;
    TrayIcon1: TKOLTrayIcon;
    Button3: TKOLButton;
    Button4: TKOLButton;
    open1: TKOLOpenSaveDialog;
    Splitter1: TKOLSplitter;
    packages: TKOLListEdit;
    PopupMenu2: TKOLPopupMenu;
    PopupMenu3: TKOLPopupMenu;
    Button5: TKOLButton;
    procedure MainFormCreate(Sender: PObj);
    function ServerAccept(sender: PTCPServer; const ip: string;
      const port: Smallint): Boolean;
    procedure ServerClientDisconnect(sender: PTCPClient);
    procedure ServerClientError(sender: PObj; const error: Integer);
    procedure ServerError(sender: PObj; const error: Integer);
    procedure ServerClientReceive(sender: PTCPClient; var buf: array of Byte;
      const count: Integer);
    procedure ServerClientStreamReceive(Sender: PTCPClient);
    procedure ClientConnect(Sender: PTCPClient);
    procedure Button1Click(Sender: PObj);
    procedure Button2Click(Sender: PObj);
    procedure PopupMenu1N1Menu(Sender: PMenu; Item: Integer);
    procedure PopupMenu1N2Menu(Sender: PMenu; Item: Integer);
    procedure TrayIcon1Mouse(Sender: TObject; Message: Word);
    procedure MainClose(Sender: PObj; var Accept: Boolean);
    procedure Button3Click(Sender: PObj);
    procedure Button4Click(Sender: PObj);
    procedure packagesKeyDown(Sender: PControl; var Key: Integer;
      Shift: Cardinal);
    procedure PopupMenu2N5Menu(Sender: PMenu; Item: Integer);
    procedure PopupMenu2N3Menu(Sender: PMenu; Item: Integer);
    procedure PopupMenu3N4Menu(Sender: PMenu; Item: Integer);
    procedure Button5Click(Sender: PObj);
  private
    procedure updateUserList;
    { Private declarations }
  public
    procedure LoadG_policy(filename: string);
    procedure Addlog(log: string);
    procedure showsplash;
    procedure UpdateList;
    { Public declarations }
  end;

var
  classPolicySrv{$IFDEF KOL_MCK}: PclassPolicySrv{$ELSE}: TclassPolicySrv{$ENDIF};
  downloadsize: integer;
  downloadname: string;
  downloadstream: pstream;


{$IFDEF KOL_MCK}
procedure NewclassPolicySrv( var Result: PclassPolicySrv; AParent: PControl );
{$ENDIF}


implementation
uses uglobal, uglobal_srv;

{$IFDEF KOL_MCK}
{$I server_main_1.inc}
{$ENDIF}
{$IFNDEF KOL_MCK} {$R *.DFM} {$ENDIF}

var disList: pDisList;

procedure TclassPolicySrv.showsplash;
begin
  Addlog('/' + RepeatStr('-', 85) + '\');
  AddLog(RepeatStr(' ', 8) + self.Form.Caption);
  Addlog(RepeatStr(' ', 10) + RepeatStr('=', 30));
  Addlog(RepeatStr(' ', 10) + 'Bug report: [e-mail]');
  //Addlog(RepeatStr(' ', 10) + 'Home Page : http://');
  Addlog('\' + RepeatStr('-', 85) + '/');
end;

procedure TclassPolicySrv.LoadG_policy(filename: string);
var l_str: PStrList;
begin
  l_str := NewStrList;
  try
    l_str.LoadFromFile(filename);
    G_policy.Size := 0;
    l_str.SaveToStream(G_policy);
    listLoadFromBuf(G_policy,disList);
    UpdateList ;
  finally
    l_str.free;
  end;
end;

procedure TclassPolicySrv.MainFormCreate(Sender: PObj);
begin
  G_USERLIST := NewStrListEx;
  G_policy := NewMemoryStream;
  Memo1.Text := '';
  getSysparm;
  showsplash;
  packages.LVColAdd( 'Execute File', taLeft, 50);
  packages.LVColAdd( 'Effective Time', taLeft, 80);
  packages.LVColAdd( 'End Time', taLeft, 80);
  Self.Form.Visible := not C_SYSParm.Hide;
  TrayIcon1.Active := not C_SYSParm.Hide;
  disList := newDisList;
  LoadG_policy('list.wpc');
  try
    if C_SYSParm.list <> '' then
      LoadG_policy(C_SYSParm.list);
    if C_SYSParm.lPort <> 0 then begin
      server.Port := C_SYSParm.lPort;
      try
        Button5.Click ;
      except
      end;
    end;
  finally
  end;
end;


function TclassPolicySrv.ServerAccept(sender: PTCPServer; const ip: string;
  const port: Smallint): Boolean;
begin
 // addlog('Client '+ip+':'+int2str(port)+' connected.');
  conns.LVAdd(IP, 0, [], 0, 0, 0);
  result := true;
end;

procedure TclassPolicySrv.ServerClientDisconnect(sender: PTCPClient);
var t: TsrvUserInfo;
begin
  if G_USERLIST.IndexOf(sender.Host) <> -1 then begin
    t := psrvUserinfo(G_USERLIST.OBJECTS[G_USERLIST.IndexOf(sender.Host)])^;
    with ptcpserverclient(sender)^ do
    begin
      addlog('Client ' + t.userName + '@' + t.host + ' disconnected');
    end;
  end;
  t.IP := sender.Host;
  DelUser(t);
  updateUserList;
end;

procedure TclassPolicySrv.ServerClientError(sender: PObj; const error: Integer);
begin
//  addlog('Client '+ptcpserverclient(sender).ip+' error: '+err2str(error));
end;

procedure TclassPolicySrv.ServerError(sender: PObj; const error: Integer);
begin
 // addlog('Error: '+err2str(error));
end;

procedure TclassPolicySrv.ServerClientReceive(sender: PTCPClient;
  var buf: array of Byte; const count: Integer);
var
  s, t: string;
  userinfo: TsrvUserInfo;
  dt: Tdatetime;
begin
  setlength(s, count);
  move(buf, s[1], count);
  if copy(s, 1, 3) = #2'@@' then begin //update user info
    delete(s, 1, 3);
    move(s[1], userinfo, sizeof(userinfo));
    userinfo.userName := int2str(sender.Index) + ':' + userinfo.userName;
    userinfo.IP := sender.Host;
    userinfo.stTime := Time2StrFmt('hh:mm:ss', Now);
    addlog('Client ' + userinfo.userName + '@' + userinfo.host + ' connected.');
    AddUser(userInfo);
    updateUserList;
  end;
  if Parse(s, ',') = 'down' then begin //down something command
    if s = 'policy' then begin //down policy
      sender.SendString(s);
      sender.SendInteger(G_policy.Size);
      G_policy.Position := 0;
      sender.SendStream(G_policy, false);
    end;
  end;
  t := uppercase(s);
  //addlog(sender.Host + t);
  {
  if parse(t,#13)='FILE' then
  begin
    parse(s,#13);
    downloadsize:=str2int(parse(s,#13));
    downloadname:=parse(s,#13);
    if downloadstream<>nil then downloadstream.free;
    downloadstream:=newwritefilestream(downloadname);
    sender.setreceivestream(downloadstream,true,downloadsize);
    additem(sender.host+' uploads file (size: '+int2str(downloadsize)+'): '+downloadname);
    progress.progress:=0;
    progress.show;
    sender.sendstring('UPLOADING');
  end else additem(sender.host+' >> '+s);
  }
end;

procedure TclassPolicySrv.ServerClientStreamReceive(Sender: PTCPClient);
begin
{  if not sender.streamreceiving then
  begin
    sender.setreceivestream(nil,false,0);
    downloadstream:=nil;
    additem('File received: '+downloadname);
    progress.hide;
    shellexecute(0,'open',pchar(downloadname),nil,nil,SW_SHOWNORMAL);
  end else
  with downloadstream^ do progress.progress:=round(size/downloadsize*100);}
end;

procedure TclassPolicySrv.ClientConnect(Sender: PTCPClient);
begin
//
end;

procedure TclassPolicySrv.Button1Click(Sender: PObj);
begin
  self.Form.Hide;

end;

procedure TclassPolicySrv.Button2Click(Sender: PObj);
begin
  self.form.close;
end;

procedure TclassPolicySrv.PopupMenu1N1Menu(Sender: PMenu; Item: Integer);
begin
  if Self.Form.Visible then
    Self.Form.Hide
  else
    Self.Form.Show;

end;

procedure TclassPolicySrv.PopupMenu1N2Menu(Sender: PMenu; Item: Integer);
begin
  self.Form.Close;
end;

procedure TclassPolicySrv.TrayIcon1Mouse(Sender: TObject; Message: Word);
var winpos: Tpoint;
begin
  GetCursorPos(winpos);
  case Message of
    516: begin
        PopupMenu1.Popup(winpos.X, winpos.Y);
      end;
  end;
end;

procedure TclassPolicySrv.Addlog(log: string);
begin
  if memo1.Count > 200 then begin
    memo1.Clear;
    showsplash;
  end;
  memo1.add(DateTime2StrShort(now) + '  ' + log + #13#10);
  memo1.Perform(LB_SETTOPINDEX, pred(memo1.count), 0);
end;

procedure TclassPolicySrv.updateUserList();
var I: integer;
  P: psrvUserInfo;
begin
  conns.Clear;
  for i := 0 to G_USERLIST.Count - 1 do begin
    p := psrvUserInfo(G_USERLIST.Objects[i]);
    conns.LVAdd(p^.userName, 0, [], 0, 0, G_USERLIST.Objects[i]);
    conns.LVItems[i, 1] := p^.host;
    conns.LVItems[i, 2] := p^.IP + ':' + trim(p^.lport);
    conns.LVItems[i, 3] := p^.stTime;
  end;
end;


procedure TclassPolicySrv.MainClose(Sender: PObj; var Accept: Boolean);
begin
  ClearUsers;
  G_USERLIST.free;
  G_policy.Free;
end;

procedure TclassPolicySrv.UpdateList;
var i: integer;
  Item: pDisableInfo;
begin
  packages.Clear;
  for i := 0 to disList.Count - 1 do begin
    Item := disList.Items[i];
    packages.LVAdd(Item.ExeName, 0, [], 0, 0, 0);
    packages.LVItems[i, 1] := DateTime2StrShort(item.Effdatetime);
    packages.LVItems[i, 2] := DateTime2StrShort(item.EffdateTimeTo);
  end;
end;

procedure TclassPolicySrv.Button3Click(Sender: PObj);
begin
  if open1.Execute then begin
    LoadG_policy(open1.Filename );
  end;
end;

procedure TclassPolicySrv.Button4Click(Sender: PObj);
begin
  if open1.Execute then
    listSaveToFileName(disList, open1.Filename);
end;

procedure TclassPolicySrv.packagesKeyDown(Sender: PControl;
  var Key: Integer; Shift: Cardinal);
begin
  case key of
    45: begin //add
      end;
    46: begin //delete
      end;
    13: begin //edit
      end;
  end;
end;

procedure TclassPolicySrv.PopupMenu2N5Menu(Sender: PMenu; Item: Integer);
begin
  packages.LVAdd('', 0, [], 0, 0, 0);
end;

procedure TclassPolicySrv.PopupMenu2N3Menu(Sender: PMenu; Item: Integer);
var i: integer;
    l_s:String;
begin
  disList.ClearItems;
  l_s:='';
  for i := 0 to packages.Count - 1 do begin
    if packages.LVItems[i, 0]='' then continue;
    disList.AddItem(packages.LVItems[i, 0], Str2DateTimeShort(packages.LVItems[i, 1]),
      Str2DateTimeShort(packages.LVItems[i, 2]));
    l_s:=l_s+#13#10+Format('%s,%s,%s',[packages.LVItems[i, 0], Str2DateTimeShort(packages.LVItems[i, 1]),
      Str2DateTimeShort(packages.LVItems[i, 2])]);
  end;
  if l_s<>'' then delete(l_s,1,2);
  G_policy.Size :=0;
  G_policy.Write(l_s[1],length(l_s)); 
  UpdateList;

end;

procedure TclassPolicySrv.PopupMenu3N4Menu(Sender: PMenu; Item: Integer);
var i: integer;
begin
  for i := 0 to Server.Count - 1 do begin
    Server.Connection[i].SendString('reload');
  end;
end;

procedure TclassPolicySrv.Button5Click(Sender: PObj);
begin
  if Server.Active  then begin
    Server.Disconnect;
    Button5.Caption :='Start>>';
  end
  else begin
    Server.Listen ;
    Button5.Caption :='Stop>>';
  end;
end;

end.
{implementation
  G_USERLIST:=Tstrlistex.create;
finalization
  ClearUsers;
  G_USERLIST.free;
  }