远程控制编程

开发平台：
Delphi

Unit1.pas：源码内容
							{
 如果你有意更改代码，请回寄一份给我，大家可以相互交流！
 E-MAIL:xkdh_szb@21cn.net
}
unit Unit1;
interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, Menus, ScktComp, StdCtrls, WinSock, comctrls, JPEG,
  RXSplit, RXCtrls, ShellApi, ImgList, Commctrl, IniFiles;
type
  NetData = record
    Protocol  :set of ( P_SEND, P_REV, P_FILE, P_END, P_LIST,
                        C_SEND, C_REV, C_FILE, C_END, C_REVC,
                        K_SCR, K_MOUSE, K_RUN, K_DEL, K_KEY,
                        P_DRV);
    LInt, RInt:integer;
    Fbuf      :array [0..1024] of char;
    Str       :string[100];
  end;
  TfMain = class(TForm)
    mM: TMainMenu;
    mMenu: TMenuItem;
    mLink: TMenuItem;
    mDo: TMenuItem;
    N4: TMenuItem;
    mExit: TMenuItem;
    PageControl1: TPageControl;
    tscr: TTabSheet;
    tsys: TTabSheet;
    imgShow: TImage;
    cc1: TClientSocket;
    cc2: TClientSocket;
    lview: TListView;
    RxSplitter1: TRxSplitter;
    ldrv: TListBox;
    labpath: TRxLabel;
    ImageList1: TImageList;
    popm: TPopupMenu;
    popup: TMenuItem;
    popdown: TMenuItem;
    z1: TMenuItem;
    poprun: TMenuItem;
    popdel: TMenuItem;
    N1: TMenuItem;
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    stb: TStatusBar;
    msgbox: TComboBox;
    prb: TProgressBar;
    sb1: TScrollBar;
    sb2: TScrollBar;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure cc1Read(Sender: TObject; Socket: TCustomWinSocket);
    procedure cc2Read(Sender: TObject; Socket: TCustomWinSocket);
    procedure mLinkClick(Sender: TObject);
    procedure mDoClick(Sender: TObject);
    procedure mExitClick(Sender: TObject);
    procedure ldrvDblClick(Sender: TObject);
    procedure lviewDblClick(Sender: TObject);
    procedure popupClick(Sender: TObject);
    procedure popdownClick(Sender: TObject);
    procedure cc1Error(Sender: TObject; Socket: TCustomWinSocket;
      ErrorEvent: TErrorEvent; var ErrorCode: Integer);
    procedure poprunClick(Sender: TObject);
    procedure popdelClick(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure sb2Change(Sender: TObject);
    procedure sb1Change(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
CONST
  tport = 9638;
  sport = 9635;
var
  fMain: TfMain;
  MyStream: TMemorystream;{内存流对象}
  MySize  : Longint;
  scF,csF : File;
  jx      : integer;
  jxget   : boolean;
  upfilename: string;
  fi: integer;
implementation
{$R *.dfm}
{$R winxp.res}
procedure smsg(msg: string);
begin
  fmain.msgbox.Items.Add('消息：'+msg);
  fmain.msgbox.ItemIndex := fmain.msgbox.Items.Count -1;
end;
function GetFileSize(Path:string):integer;
var
  Sear:TSearchRec;
begin
  if FindFirst(Path,faArchive,Sear)=0 then
    Result := Sear.Size div 1024
  else
    Result := 0;
end;
procedure TfMain.FormCreate(Sender: TObject);
begin
  cc1.Port := tport;
  cc2.Port := sport;
  MyStream := TMemorystream.Create;
end;
procedure TfMain.FormClose(Sender: TObject; var Action: TCloseAction);
//关闭窗口
begin
  if not mLink.Checked then
    mLink.Checked := true;
  mLinkClick(self);
  MyStream.Free;
end;
procedure TfMain.FormResize(Sender: TObject);
begin
  msgbox.Top := tsys.ClientHeight - stb.Height+3 ;
  msgbox.Left := 353;
  msgbox.Width := tsys.ClientWidth - 353;
  prb.Top := tsys.ClientHeight - stb.Height +4;
  prb.Left := 1;
  prb.Width := 198;
  if imgShow.Width > tscr.ClientWidth then
    sb1.Max := imgShow.Width - tscr.ClientWidth + 17;
  if imgShow.Height > tscr.ClientHeight then
    sb2.Max := imgShow.Height - tscr.ClientHeight + 17;
end;
procedure TfMain.mExitClick(Sender: TObject);
//退出
begin
  close;
end;
procedure TfMain.cc1Read(Sender: TObject; Socket: TCustomWinSocket);
var
  pd: netdata;
  Item: TListItem;
  FileInfo:TShFileInfo;
begin
  if Socket.ReceiveBuf(pd, sizeof(pd))=SOCKET_ERROR then exit;
  Application.ProcessMessages ;
  if P_DRV IN pd.Protocol then
  begin
    if pd.Str = '' then
      smsg('驱动器列表建立完成！')
    else
      ldrv.Items.Add(pd.Str);
  end;
  //S-C SEND FILE
  if P_SEND in pd.Protocol then
  begin
      BlockWrite (csf, pd.Fbuf, pd.RInt);
      pd.Protocol := [P_REV];
      Socket.SendBuf(pd, sizeof(pd));
      prb.Position := prb.Position + 1;
  end;
  if P_END in pd.Protocol then
  begin
    Closefile(csf);
    smsg('S-C模式文件传送完成');
  end;
  // C-S SEND FILE
  if C_REVC in pd.Protocol then
  begin
    pd.Protocol := [C_SEND];
    AssignFile(csF,upfilename);
    FileMode := 0;
    ReSet (csf, 1);
    BlockRead(csf, pd.Fbuf, 1024, pd.RInt);
    if pd.RInt > 0 then
      Socket.SendBuf(pd, sizeof(pd));
  end;
  if C_REV in pd.Protocol then
  begin
    pd.Protocol := [C_SEND];
    BlockRead(csf, pd.Fbuf, SizeOF(pd.Fbuf), pd.RInt);
    if pd.RInt >0 then
      Socket.SendBuf(pd, sizeof(pd))
    else
    begin
      CloseFile(csf);
      pd.Protocol := [C_END];
      Socket.SendBuf(pd,sizeof(pd));
      smsg('C-S 模式文件传送完成');
    end;
    prb.Position := prb.Position + 1;
  end;
  //屏幕控制
  if K_SCR in pd.Protocol then
  begin
    imgShow.Width := pd.RInt ;
    imgShow.Height := pd.RInt * 3 div 4;
    if pd.RInt > tscr.ClientWidth then
      sb1.Max := pd.RInt - tscr.ClientWidth +17;
    if imgShow.Height > tscr.ClientHeight then
      sb2.Max := imgShow.Height - tscr.ClientHeight+17;
    imgshow.Top :=0;
    imgshow.Left :=0 ;
    cc2.Socket.SendText('cap');
  end;
  //获取文件/目录
  if P_LIST in pd.Protocol then
  begin
    if pd.Str <> '' then
    begin
      Item:= lview.Items.Add ;
      Item.Caption := pd.Str ;
      if pd.LInt > -9 then
      begin
        Item.SubItems.Add(IntToStr(pd.LInt div 1024)+ ' KB');
        ShGetFileInfo(pchar(Item.Caption),0,FileInfo,sizeOf(fileinfo),
                      SHGFI_SMALLICON or SHGFI_ICON or SHGFI_USEFILEATTRIBUTES or SHGFI_TYPENAME);
        Item.SubItems.Add(FileInfo.szTypeName);
        Item.ImageIndex := ImageList_AddIcon(ImageList1.Handle,FileInfo.hIcon);
      end
      else begin
        Item.SubItems.Add('<DIR>');
        Item.SubItems.Add('目录');
        Item.ImageIndex := 0;
      end;
      Item.SubItems.Add(DateTimeToStr(FileDateToDateTime(pd.RInt)));
      stb.Panels[1].Text := '共：'+IntToStr(lview.Items.Count)+'个文件';
    end
    else
      smsg('文件列表建立完成！');
  end;
end;
procedure TfMain.cc1Error(Sender: TObject; Socket: TCustomWinSocket;
  ErrorEvent: TErrorEvent; var ErrorCode: Integer);
begin
  ErrorCode:= 0;
end;
procedure TfMain.cc2Read(Sender: TObject; Socket: TCustomWinSocket);
var
  S               : String;
  MyBuffer        : array[0..10000] of byte; {设置接收缓冲区}
  MyReceviceLength: integer;
  MyJpg           : TJpegimage;
begin
  Application.ProcessMessages ;
  if MySize = 0 then
  begin
    S := Socket.ReceiveText;
    MySize := StrToInt(S);
    Socket.SendText('ready');
  end
  else
  begin {以下为图象数据接收部分}
    MyReceviceLength  := socket.ReceiveLength;
    Socket.ReceiveBuf(MyBuffer, MyReceviceLength);
    MyStream.Write(MyBuffer, MyReceviceLength);
    if MyStream.Size >= MySize then
    begin
      MyStream.Position := 0;
      MyJpg := TJpegImage.Create ;
      try
        MyJpg.LoadFromStream(mystream);
        imgShow.Picture.Assign(Myjpg);
      finally {以下为清除工作 }
        Myjpg.Free;
        if jxget then Socket.SendText('cap');
        MyStream.Clear;
        MySize := 0;
      end;
    end;
  end;
end;
procedure TfMain.mLinkClick(Sender: TObject);
//连接
var
  gip : string;
  inif: Tinifile;
begin
  mLink.Checked := not mlink.Checked ;
  ldrv.Clear ;
  lview.Clear ;
  if mlink.Checked then
  begin
    inif:= Tinifile.Create(ExtractFilePath(application.ExeName)+'config.ini');
    gip:= inif.ReadString('IP','LAST','127.0.0.1');
    if InputQuery('Getx II', '输入IP', gip) = false then
    begin
      mlink.Checked := false;
      exit;
    end;
    cc1.Address := gip;
    cc1.Active := true;
    cc2.Address := gip ;
    cc2.Active  :=true;
    inif.WriteString('IP','LAST',gip);
    inif.Free ; 
  end
  else
  begin
    if cc1.Active then cc1.Close ;
    jxget := false;
    if cc2.Active then cc2.Close ;
    mDo.Checked := false;
  end;
end;
procedure TfMain.mDoClick(Sender: TObject);
//屏幕控制
var
  sd : string;
  pp : netdata;
  inif: TiniFile;
begin
  mdo.Checked := not mdo.Checked ;
  if mdo.Checked then
  begin
    inif:= TiniFile.Create(ExtractFilePath(application.ExeName)+'config.ini');
    sd  := inif.ReadString('SRC','HIG', '50');
    if InputQuery('Getx II', '输入颜色深度', sd)= false then
    begin
      mDo.Checked := false;
      exit;
    end;
    inif.WriteString('SRC','HIG',sd);
    inif.Free ; 
    jxget:= True;
    pp.Protocol := [K_SCR];
    PP.RInt     := strtoint(sd);
    cc1.Socket.SendBuf(pp, sizeOf(pp));
  end
  else
  begin
    jxget:= false;
  end;
end;
procedure TfMain.ldrvDblClick(Sender: TObject);
//点击驱动器
var
  str: string;
  dd : netdata;
begin
  lview.Clear ;
  str:= ldrv.Items.Strings[ldrv.ItemIndex];
  str:= copy(str, pos(':', str)+1, length(str))+'*.*';
  dd.Protocol := [P_LIST];
  dd.Str      := str;
  cc1.Socket.SendBuf(dd, sizeof(dd));
  labpath.Caption := copy(str,1, length(str)-3);
end;
procedure TfMain.lviewDblClick(Sender: TObject);
//点击目录/文件
var
  str: string;
  i: integer;
  dd: netdata;
begin
  //mm
  if not assigned(lview.Selected) then exit;
  str:= lview.Selected.SubItems.Strings[0];
  if (str = '<DIR>') and
     (lview.Selected.Caption<>'.') and
     (lview.Selected.Caption<>'..') then
    labpath.Caption := labpath.Caption + lview.Selected.Caption +'';
  if lview.Selected.Caption = '..' then
  begin
    str:='';
    for i:=length(labpath.Caption)-1 downto 1 do
    begin
      str:= copy(labpath.Caption,i ,1)+ str;
      if pos('',str)<>0 then break;
    end;
    labpath.Caption := copy(labpath.Caption,1, length(labpath.Caption)-length(str));
  end;
  if lview.Selected.Caption='.' then
    labpath.Caption := copy(labpath.Caption,1,3);
  dd.Protocol := [P_LIST];
  dd.Str      := labpath.Caption+'*.*';
  cc1.Socket.SendBuf(dd,sizeof(dd));
  lview.Clear ; 
end;
procedure TfMain.popupClick(Sender: TObject);
//上传文件
var
  dd: netdata;
begin
  if not assigned(lview.Selected) then exit;
  if opendialog1.Execute then
  begin
    upFileName:= opendialog1.FileName ;
    dd.Protocol := [C_FILE];
    dd.Str := labpath.Caption + ExtractFileName(upFileName);
    prb.Max := GetFileSize(upFileName);
    prb.Position := 0;
    if prb.Max =0 then prb.Max :=2;
    cc1.Socket.SendBuf(dd,sizeof(dd));
  end;
end;
procedure TfMain.popdownClick(Sender: TObject);
//下载文件
var
  dd: netdata;
begin
  if not assigned(lview.Selected) then exit;
  if lview.Selected.SubItems.Strings[0]='<DIR>' then exit;
  saveDialog1.FileName:= lview.Selected.Caption;
  if saveDialog1.Execute then
  begin
    dd.Protocol := [P_FILE];
    dd.Str      := labpath.Caption + lview.Selected.Caption;
    prb.Max     := StrToInt(copy(lview.Selected.SubItems.Strings[0],1,
                    length(lview.Selected.SubItems.Strings[0])-3));
    if prb.Max =0 then prb.Max :=2;
    prb.Position := 0;
    AssignFile(csF, saveDialog1.FileName);
    ReWrite (csf, 1);
    if IOResult = 0 then
      cc1.Socket.SendBuf(dd,sizeof(dd));
  end;
end;
procedure TfMain.poprunClick(Sender: TObject);
//远程运行
var
  dd: netdata;
begin
  if not assigned(lview.Selected) then exit;
  dd.Protocol := [K_RUN];
  dd.Str      := labpath.Caption + lview.Selected.Caption;
  cc1.Socket.SendBuf(dd,sizeof(dd));
end;
procedure TfMain.popdelClick(Sender: TObject);
//远程删除
var
  dd: netdata;
begin
  if not assigned(lview.Selected) then exit;
  dd.Protocol := [K_DEL];
  dd.Str      := labpath.Caption + lview.Selected.Caption;
  cc1.Socket.SendBuf(dd,sizeof(dd));
end;
procedure TfMain.sb2Change(Sender: TObject);
begin
  imgShow.Top := 0 - sb2.Position;
end;
procedure TfMain.sb1Change(Sender: TObject);
begin
  imgShow.Left := 0 - sb1.Position ;
end;
end.

						