rdpwrap/src-installer/RDPWInst.dpr

1013 lines
28 KiB
ObjectPascal
Raw Normal View History

2014-10-22 23:47:44 +00:00
program RDPWInst;
{$APPTYPE CONSOLE}
{$R resource.res}
uses
SysUtils,
Windows,
Classes,
WinSvc,
Registry;
function EnumServicesStatusEx(
hSCManager: SC_HANDLE;
InfoLevel,
dwServiceType,
dwServiceState: DWORD;
lpServices: PByte;
cbBufSize: DWORD;
var pcbBytesNeeded,
lpServicesReturned,
lpResumeHandle: DWORD;
pszGroupName: PWideChar): BOOL; stdcall;
external advapi32 name 'EnumServicesStatusExW';
type
FILE_VERSION = record
Version: record case Boolean of
True: (dw: DWORD);
False: (w: record
Minor, Major: Word;
end;)
end;
Release, Build: Word;
bDebug, bPrerelease, bPrivate, bSpecial: Boolean;
end;
SERVICE_STATUS_PROCESS = packed record
dwServiceType,
dwCurrentState,
dwControlsAccepted,
dwWin32ExitCode,
dwServiceSpecificExitCode,
dwCheckPoint,
dwWaitHint,
dwProcessId,
dwServiceFlags: DWORD;
end;
PSERVICE_STATUS_PROCESS = ^SERVICE_STATUS_PROCESS;
ENUM_SERVICE_STATUS_PROCESS = packed record
lpServiceName,
lpDisplayName: PWideChar;
ServiceStatusProcess: SERVICE_STATUS_PROCESS;
end;
PENUM_SERVICE_STATUS_PROCESS = ^ENUM_SERVICE_STATUS_PROCESS;
const
SC_ENUM_PROCESS_INFO = 0;
TermService = 'TermService';
var
Installed: Boolean;
WrapPath: String;
Arch: Byte;
OldWow64RedirectionValue: LongBool;
TermServicePath: String;
FV: FILE_VERSION;
TermServicePID: DWORD;
ShareSvc: Array of String;
sShareSvc: String;
function SupportedArchitecture: Boolean;
var
SI: TSystemInfo;
begin
GetNativeSystemInfo(SI);
case SI.wProcessorArchitecture of
0:
begin
Arch := 32;
Result := True; // Intel x86
end;
6: Result := False; // Itanium-based x64
9: begin
Arch := 64;
Result := True; // Intel/AMD x64
end;
else Result := False;
end;
end;
function DisableWowRedirection: Boolean;
type
TFunc = function(var Wow64FsEnableRedirection: LongBool): LongBool; stdcall;
var
hModule: THandle;
Wow64DisableWow64FsRedirection: TFunc;
begin
Result := False;
hModule := GetModuleHandle(kernel32);
if hModule <> 0 then
Wow64DisableWow64FsRedirection := GetProcAddress(hModule, 'Wow64DisableWow64FsRedirection')
else
Exit;
if @Wow64DisableWow64FsRedirection <> nil then
Result := Wow64DisableWow64FsRedirection(OldWow64RedirectionValue);
end;
function RevertWowRedirection: Boolean;
type
TFunc = function(var Wow64RevertWow64FsRedirection: LongBool): LongBool; stdcall;
var
hModule: THandle;
Wow64RevertWow64FsRedirection: TFunc;
begin
Result := False;
hModule := GetModuleHandle(kernel32);
if hModule <> 0 then
Wow64RevertWow64FsRedirection := GetProcAddress(hModule, 'Wow64RevertWow64FsRedirection')
else
Exit;
if @Wow64RevertWow64FsRedirection <> nil then
Result := Wow64RevertWow64FsRedirection(OldWow64RedirectionValue);
end;
procedure CheckInstall;
var
Code: DWORD;
TermServiceHost: String;
Reg: TRegistry;
begin
if Arch = 64 then
Reg := TRegistry.Create(KEY_WOW64_64KEY)
else
Reg := TRegistry.Create;
Reg.RootKey := HKEY_LOCAL_MACHINE;
if not Reg.OpenKeyReadOnly('\SYSTEM\CurrentControlSet\Services\TermService') then
begin
Reg.Free;
Code := GetLastError;
Writeln('[-] OpenKeyReadOnly error (code ', Code, ').');
Halt(Code);
end;
TermServiceHost := Reg.ReadString('ImagePath');
Reg.CloseKey;
if Pos('svchost.exe', LowerCase(TermServiceHost)) = 0 then
begin
Reg.Free;
Writeln('[-] TermService is hosted in a custom application (BeTwin, etc.) - unsupported.');
Writeln('[*] ImagePath: "', TermServiceHost, '".');
Halt(ERROR_NOT_SUPPORTED);
end;
if not Reg.OpenKeyReadOnly('\SYSTEM\CurrentControlSet\Services\TermService\Parameters') then
begin
Reg.Free;
Code := GetLastError;
Writeln('[-] OpenKeyReadOnly error (code ', Code, ').');
Halt(Code);
end;
TermServicePath := Reg.ReadString('ServiceDll');
Reg.CloseKey;
if (Pos('termsrv.dll', LowerCase(TermServicePath)) = 0)
and (Pos('rdpwrap.dll', LowerCase(TermServicePath)) = 0) then
begin
Reg.Free;
Writeln('[-] Another third-party TermService library is installed.');
Writeln('[*] ServiceDll: "', TermServicePath, '".');
Halt(ERROR_NOT_SUPPORTED);
end;
Reg.Free;
Installed := Pos('rdpwrap.dll', LowerCase(TermServicePath)) > 0;
end;
function SvcGetStart(SvcName: String): Integer;
var
hSC: SC_HANDLE;
hSvc: THandle;
Code: DWORD;
lpServiceConfig: PQueryServiceConfig;
Buf: Pointer;
cbBufSize, pcbBytesNeeded: Cardinal;
begin
Result := -1;
Writeln('[*] Checking ', SvcName, '...');
hSC := OpenSCManager(nil, SERVICES_ACTIVE_DATABASE, SC_MANAGER_CONNECT);
if hSC = 0 then
begin
Code := GetLastError;
Writeln('[-] OpenSCManager error (code ', Code, ').');
Exit;
end;
hSvc := OpenService(hSC, PWideChar(SvcName), SERVICE_QUERY_CONFIG);
if hSvc = 0 then
begin
CloseServiceHandle(hSC);
Code := GetLastError;
Writeln('[-] OpenService error (code ', Code, ').');
Exit;
end;
if QueryServiceConfig(hSvc, nil, 0, pcbBytesNeeded) then begin
Writeln('[-] QueryServiceConfig failed.');
Exit;
end;
cbBufSize := pcbBytesNeeded;
GetMem(Buf, cbBufSize);
if not QueryServiceConfig(hSvc, Buf, cbBufSize, pcbBytesNeeded) then begin
FreeMem(Buf, cbBufSize);
CloseServiceHandle(hSvc);
CloseServiceHandle(hSC);
Code := GetLastError;
Writeln('[-] QueryServiceConfig error (code ', Code, ').');
Exit;
end else begin
lpServiceConfig := Buf;
Result := Integer(lpServiceConfig^.dwStartType);
end;
FreeMem(Buf, cbBufSize);
CloseServiceHandle(hSvc);
CloseServiceHandle(hSC);
end;
procedure SvcConfigStart(SvcName: String; dwStartType: Cardinal);
var
hSC: SC_HANDLE;
hSvc: THandle;
Code: DWORD;
begin
Writeln('[*] Configuring ', SvcName, '...');
hSC := OpenSCManager(nil, SERVICES_ACTIVE_DATABASE, SC_MANAGER_CONNECT);
if hSC = 0 then
begin
Code := GetLastError;
Writeln('[-] OpenSCManager error (code ', Code, ').');
Exit;
end;
hSvc := OpenService(hSC, PWideChar(SvcName), SERVICE_CHANGE_CONFIG);
if hSvc = 0 then
begin
CloseServiceHandle(hSC);
Code := GetLastError;
Writeln('[-] OpenService error (code ', Code, ').');
Exit;
end;
if not ChangeServiceConfig(hSvc, SERVICE_NO_CHANGE, dwStartType,
SERVICE_NO_CHANGE, nil, nil, nil, nil, nil, nil, nil) then begin
CloseServiceHandle(hSvc);
CloseServiceHandle(hSC);
Code := GetLastError;
Writeln('[-] ChangeServiceConfig error (code ', Code, ').');
Exit;
end;
CloseServiceHandle(hSvc);
CloseServiceHandle(hSC);
end;
procedure SvcStart(SvcName: String);
var
hSC: SC_HANDLE;
hSvc: THandle;
Code: DWORD;
pch: PWideChar;
begin
Writeln('[*] Starting ', SvcName, '...');
hSC := OpenSCManager(nil, SERVICES_ACTIVE_DATABASE, SC_MANAGER_CONNECT);
if hSC = 0 then
begin
Code := GetLastError;
Writeln('[-] OpenSCManager error (code ', Code, ').');
Exit;
end;
hSvc := OpenService(hSC, PWideChar(SvcName), SERVICE_START);
if hSvc = 0 then
begin
CloseServiceHandle(hSC);
Code := GetLastError;
Writeln('[-] OpenService error (code ', Code, ').');
Exit;
end;
pch := nil;
if not StartService(hSvc, 0, pch) then begin
CloseServiceHandle(hSvc);
CloseServiceHandle(hSC);
Code := GetLastError;
Writeln('[-] StartService error (code ', Code, ').');
Exit;
end;
CloseServiceHandle(hSvc);
CloseServiceHandle(hSC);
end;
procedure CheckTermsrvProcess;
label
back;
var
hSC: SC_HANDLE;
dwNeedBytes, dwReturnBytes, dwResumeHandle, Code: DWORD;
Svc: Array of ENUM_SERVICE_STATUS_PROCESS;
I: Integer;
Found, Started: Boolean;
TermServiceName: String;
begin
Started := False;
back:
hSC := OpenSCManager(nil, SERVICES_ACTIVE_DATABASE, SC_MANAGER_CONNECT or SC_MANAGER_ENUMERATE_SERVICE);
if hSC = 0 then
begin
Code := GetLastError;
Writeln('[-] OpenSCManager error (code ', Code, ').');
Halt(Code);
end;
SetLength(Svc, 1489);
FillChar(Svc[0], sizeof(Svc[0])*Length(Svc), 0);
if not EnumServicesStatusEx(hSC, SC_ENUM_PROCESS_INFO, SERVICE_WIN32, SERVICE_STATE_ALL,
@Svc[0], sizeof(Svc[0])*Length(Svc), dwNeedBytes, dwReturnBytes, dwResumeHandle, nil) then begin
Code := GetLastError;
if Code <> ERROR_MORE_DATA then
begin
CloseServiceHandle(hSC);
Writeln('[-] EnumServicesStatusEx error (code ', Code, ').');
Halt(Code);
end
else
begin
SetLength(Svc, 5957);
FillChar(Svc[0], sizeof(Svc[0])*Length(Svc), 0);
if not EnumServicesStatusEx(hSC, SC_ENUM_PROCESS_INFO, SERVICE_WIN32, SERVICE_STATE_ALL,
@Svc[0], sizeof(Svc[0])*Length(Svc), dwNeedBytes, dwReturnBytes, dwResumeHandle, nil) then begin
CloseServiceHandle(hSC);
Code := GetLastError;
Writeln('[-] EnumServicesStatusEx error (code ', Code, ').');
Halt(Code);
end;
end;
end;
CloseServiceHandle(hSC);
Found := False;
for I := 0 to Length(Svc) - 1 do
begin
if Svc[I].lpServiceName = nil then
Break;
if LowerCase(Svc[I].lpServiceName) = LowerCase(TermService) then
begin
Found := True;
TermServiceName := Svc[I].lpServiceName;
TermServicePID := Svc[I].ServiceStatusProcess.dwProcessId;
Break;
end;
end;
if not Found then
begin
Writeln('[-] TermService not found.');
Halt(ERROR_SERVICE_DOES_NOT_EXIST);
end;
if TermServicePID = 0 then
begin
if Started then begin
Writeln('[-] Failed to set up TermService. Unknown error.');
Halt(ERROR_SERVICE_NOT_ACTIVE);
end;
SvcConfigStart(TermService, SERVICE_AUTO_START);
SvcStart(TermService);
Started := True;
goto back;
end
else
Writeln('[+] TermService found (pid ', TermServicePID, ').');
SetLength(ShareSvc, 0);
for I := 0 to Length(Svc) - 1 do
begin
if Svc[I].lpServiceName = nil then
Break;
if Svc[I].ServiceStatusProcess.dwProcessId = TermServicePID then
if Svc[I].lpServiceName <> TermServiceName then
begin
SetLength(ShareSvc, Length(ShareSvc)+1);
ShareSvc[Length(ShareSvc)-1] := Svc[I].lpServiceName;
end;
end;
sShareSvc := '';
for I := 0 to Length(ShareSvc) - 1 do
if sShareSvc = '' then
sShareSvc := ShareSvc[I]
else
sShareSvc := sShareSvc + ', ' + ShareSvc[I];
if sShareSvc <> '' then
Writeln('[*] Shared services found: ', sShareSvc)
else
Writeln('[*] No shared services found.');
end;
function AddPrivilege(SePriv: String): Boolean;
var
hToken: THandle;
SeNameValue: Int64;
tkp: TOKEN_PRIVILEGES;
ReturnLength: Cardinal;
ErrorCode: Cardinal;
begin
Result := False;
if not OpenProcessToken(GetCurrentProcess(), TOKEN_ADJUST_PRIVILEGES
or TOKEN_QUERY, hToken) then begin
ErrorCode := GetLastError;
Writeln('[-] OpenProcessToken error (code ' + IntToStr(ErrorCode) + ').');
Exit;
end;
if not LookupPrivilegeValue(nil, PWideChar(SePriv), SeNameValue) then begin
ErrorCode := GetLastError;
Writeln('[-] LookupPrivilegeValue error (code ' + IntToStr(ErrorCode) + ').');
Exit;
end;
tkp.PrivilegeCount := 1;
tkp.Privileges[0].Luid := SeNameValue;
tkp.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;
if not AdjustTokenPrivileges(hToken, False, tkp, SizeOf(tkp), tkp, ReturnLength) then begin
ErrorCode := GetLastError;
Writeln('[-] AdjustTokenPrivileges error (code ' + IntToStr(ErrorCode) + ').');
Exit;
end;
Result := True;
end;
procedure KillProcess(PID: DWORD);
var
hProc: THandle;
Code: DWORD;
begin
hProc := OpenProcess(PROCESS_TERMINATE, False, PID);
if hProc = 0 then
begin
Code := GetLastError;
Writeln('[-] OpenProcess error (code ', Code, ').');
Halt(Code);
end;
if not TerminateProcess(hProc, 0) then
begin
CloseHandle(hProc);
Code := GetLastError;
Writeln('[-] TerminateProcess error (code ', Code, ').');
Halt(Code);
end;
CloseHandle(hProc);
end;
function ExecWait(Cmdline: String): Boolean;
var
si: STARTUPINFO;
pi: PROCESS_INFORMATION;
begin
Result := False;
ZeroMemory(@si, sizeof(si));
si.cb := sizeof(si);
UniqueString(Cmdline);
if not CreateProcess(nil, PWideChar(Cmdline), nil, nil, True, 0, nil, nil, si, pi) then begin
Writeln('[-] CreateProcess error (code: ', GetLastError, ').');
Exit;
end;
CloseHandle(pi.hThread);
WaitForSingleObject(pi.hProcess, INFINITE);
CloseHandle(pi.hProcess);
Result := True;
end;
function ExpandPath(Path: String): String;
var
Str: Array[0..511] of Char;
begin
Result := '';
FillChar(Str, 512, 0);
if Arch = 64 then
Path := StringReplace(Path, '%ProgramFiles%', '%ProgramW6432%', [rfReplaceAll, rfIgnoreCase]);
if ExpandEnvironmentStrings(PWideChar(Path), Str, 512) > 0 then
Result := Str;
end;
procedure SetWrapperDll;
var
Reg: TRegistry;
Code: DWORD;
begin
if Arch = 64 then
Reg := TRegistry.Create(KEY_WRITE or KEY_WOW64_64KEY)
else
Reg := TRegistry.Create;
Reg.RootKey := HKEY_LOCAL_MACHINE;
if not Reg.OpenKey('\SYSTEM\CurrentControlSet\Services\TermService\Parameters', True) then
begin
Code := GetLastError;
Writeln('[-] OpenKey error (code ', Code, ').');
Halt(Code);
end;
try
Reg.WriteExpandString('ServiceDll', WrapPath);
if (Arch = 64) and (FV.Version.w.Major = 6) and (FV.Version.w.Minor = 0) then
ExecWait('"'+ExpandPath('%SystemRoot%')+'\system32\reg.exe" add HKLM\SYSTEM\CurrentControlSet\Services\TermService\Parameters /v ServiceDll /t REG_EXPAND_SZ /d "'+WrapPath+'" /f');
except
Writeln('[-] WriteExpandString error.');
Halt(ERROR_ACCESS_DENIED);
end;
Reg.CloseKey;
Reg.Free;
end;
procedure ResetServiceDll;
var
Reg: TRegistry;
Code: DWORD;
begin
if Arch = 64 then
Reg := TRegistry.Create(KEY_WRITE or KEY_WOW64_64KEY)
else
Reg := TRegistry.Create;
Reg.RootKey := HKEY_LOCAL_MACHINE;
if not Reg.OpenKey('\SYSTEM\CurrentControlSet\Services\TermService\Parameters', True) then
begin
Code := GetLastError;
Writeln('[-] OpenKey error (code ', Code, ').');
Halt(Code);
end;
try
Reg.WriteExpandString('ServiceDll', '%SystemRoot%\System32\termsrv.dll');
except
Writeln('[-] WriteExpandString error.');
Halt(ERROR_ACCESS_DENIED);
end;
Reg.CloseKey;
Reg.Free;
end;
procedure ExtractRes(ResName, Path: String);
var
ResStream: TResourceStream;
begin
ResStream := TResourceStream.Create(HInstance, ResName, RT_RCDATA);
try
ResStream.SaveToFile(Path);
except
Writeln('[-] Failed to extract file.');
Writeln('[*] Resource name: ' + ResName);
Writeln('[*] Destination path: ' + Path);
ResStream.Free;
Exit;
end;
Writeln('[+] Extracted ', ResName, ' -> ', Path);
ResStream.Free;
end;
procedure ExtractFiles;
begin
if not DirectoryExists(ExtractFilePath(ExpandPath(WrapPath))) then
if ForceDirectories(ExtractFilePath(ExpandPath(WrapPath))) then
Writeln('[+] Folder created: ', ExtractFilePath(ExpandPath(WrapPath)))
else begin
Writeln('[-] ForceDirectories error.');
Writeln('[*] Path: ', ExtractFilePath(ExpandPath(WrapPath)));
Halt(0);
end;
case Arch of
32: begin
ExtractRes('rdpw32', ExpandPath(WrapPath));
if not FileExists(ExpandPath('%SystemRoot%\System32\rdpclip.exe')) then
ExtractRes('rdpclip32', ExpandPath('%SystemRoot%\System32\rdpclip.exe'));
end;
64: begin
ExtractRes('rdpw64', ExpandPath(WrapPath));
if not FileExists(ExpandPath('%SystemRoot%\System32\rdpclip.exe')) then
ExtractRes('rdpclip64', ExpandPath('%SystemRoot%\System32\rdpclip.exe'));
end;
end;
end;
procedure DeleteFiles;
var
Code: DWORD;
begin
if not DeleteFile(PWideChar(ExpandPath(TermServicePath))) then
begin
Code := GetLastError;
Writeln('[-] DeleteFile error (code ', Code, ').');
Exit;
end;
Writeln('[+] Removed file: ', ExpandPath(TermServicePath));
if not RemoveDirectory(PWideChar(ExtractFilePath(ExpandPath(TermServicePath)))) then
begin
Code := GetLastError;
Writeln('[-] RemoveDirectory error (code ', Code, ').');
Exit;
end;
Writeln('[+] Removed folder: ', ExtractFilePath(ExpandPath(TermServicePath)));
end;
function GetFileVersion(const FileName: TFileName; var FileVersion: FILE_VERSION): Boolean;
type
VS_VERSIONINFO = record
wLength, wValueLength, wType: Word;
szKey: Array[1..16] of WideChar;
Padding1: Word;
Value: VS_FIXEDFILEINFO;
Padding2, Children: Word;
end;
PVS_VERSIONINFO = ^VS_VERSIONINFO;
const
VFF_DEBUG = 1;
VFF_PRERELEASE = 2;
VFF_PRIVATE = 8;
VFF_SPECIAL = 32;
var
hFile: HMODULE;
hResourceInfo: HRSRC;
VersionInfo: PVS_VERSIONINFO;
begin
Result := False;
hFile := LoadLibraryEx(PWideChar(FileName), 0, LOAD_LIBRARY_AS_DATAFILE);
if hFile = 0 then
Exit;
hResourceInfo := FindResource(hFile, PWideChar(1), PWideChar($10));
if hResourceInfo = 0 then
Exit;
VersionInfo := Pointer(LoadResource(hFile, hResourceInfo));
if VersionInfo = nil then
Exit;
FileVersion.Version.dw := VersionInfo.Value.dwFileVersionMS;
FileVersion.Release := Word(VersionInfo.Value.dwFileVersionLS shr 16);
FileVersion.Build := Word(VersionInfo.Value.dwFileVersionLS);
FileVersion.bDebug := (VersionInfo.Value.dwFileFlags and VFF_DEBUG) = VFF_DEBUG;
FileVersion.bPrerelease := (VersionInfo.Value.dwFileFlags and VFF_PRERELEASE) = VFF_PRERELEASE;
FileVersion.bPrivate := (VersionInfo.Value.dwFileFlags and VFF_PRIVATE) = VFF_PRIVATE;
FileVersion.bSpecial := (VersionInfo.Value.dwFileFlags and VFF_SPECIAL) = VFF_SPECIAL;
Result := True;
end;
procedure CheckTermsrvVersion;
var
SuppLvl: Byte;
begin
GetFileVersion(ExpandPath(TermServicePath), FV);
Writeln('[*] Terminal Services version: ',
Format('%d.%d.%d.%d',
[FV.Version.w.Major, FV.Version.w.Minor, FV.Release, FV.Build]));
if (FV.Version.w.Major = 5) and (FV.Version.w.Minor = 1) then
begin
if Arch = 32 then
begin
Writeln('[!] Windows XP is not supported.');
Writeln('You may take a look at RDP Realtime Patch by Stas''M for Windows XP');
Writeln('Link: http://stascorp.com/load/1-1-0-62');
end;
if Arch = 64 then
Writeln('[!] Windows XP 64-bit Edition is not supported.');
Exit;
end;
if (FV.Version.w.Major = 5) and (FV.Version.w.Minor = 2) then
begin
if Arch = 32 then
Writeln('[!] Windows Server 2003 is not supported.');
if Arch = 64 then
Writeln('[!] Windows Server 2003 or XP 64-bit Edition is not supported.');
Exit;
end;
SuppLvl := 0;
if (FV.Version.w.Major = 6) and (FV.Version.w.Minor = 0) then begin
SuppLvl := 1;
if (Arch = 32) and (FV.Release = 6000) and (FV.Build = 16386) then begin
Writeln('[!] This version of Terminal Services may crash on logon attempt.');
Writeln('It''s recommended to upgrade to Service Pack 1 or higher.');
end;
if (FV.Release = 6000) and (FV.Build = 16386) then
SuppLvl := 2;
if (FV.Release = 6001) and (FV.Build = 18000) then
SuppLvl := 2;
if (FV.Release = 6002) and (FV.Build = 18005) then
SuppLvl := 2;
end;
if (FV.Version.w.Major = 6) and (FV.Version.w.Minor = 1) then begin
SuppLvl := 1;
if (FV.Release = 7600) and (FV.Build = 16385) then
SuppLvl := 2;
if (FV.Release = 7601) and (FV.Build = 17514) then
SuppLvl := 2;
if (FV.Release = 7601) and (FV.Build = 18540) then
SuppLvl := 2;
if (FV.Release = 7601) and (FV.Build = 22750) then
SuppLvl := 2;
end;
if (FV.Version.w.Major = 6) and (FV.Version.w.Minor = 2) then begin
if (FV.Release = 8102) and (FV.Build = 0) then
SuppLvl := 2;
if (FV.Release = 8250) and (FV.Build = 0) then
SuppLvl := 2;
if (FV.Release = 8400) and (FV.Build = 0) then
SuppLvl := 2;
if (FV.Release = 9200) and (FV.Build = 16384) then
SuppLvl := 2;
if (FV.Release = 9200) and (FV.Build = 17048) then
SuppLvl := 2;
if (FV.Release = 9200) and (FV.Build = 21166) then
SuppLvl := 2;
end;
if (FV.Version.w.Major = 6) and (FV.Version.w.Minor = 3) then begin
if (FV.Release = 9431) and (FV.Build = 0) then
SuppLvl := 2;
if (FV.Release = 9600) and (FV.Build = 16384) then
SuppLvl := 2;
if (FV.Release = 9600) and (FV.Build = 17095) then
SuppLvl := 2;
end;
if (FV.Version.w.Major = 6) and (FV.Version.w.Minor = 4) then begin
if (FV.Release = 9841) and (FV.Build = 0) then
SuppLvl := 2;
end;
case SuppLvl of
0: begin
Writeln('[!] This version of Terminal Services is not supported.');
Writeln('Send your termsrv.dll to project developer for support.');
end;
1: begin
Writeln('[!] This version of Terminal Services is supported partially.');
Writeln('It means you may have some limitations such as only 2 concurrent sessions.');
Writeln('Send your termsrv.dll to project developer for adding full support.');
end;
end;
end;
procedure CheckTermsrvDependencies;
const
CertPropSvc = 'CertPropSvc';
SessionEnv = 'SessionEnv';
begin
if SvcGetStart(CertPropSvc) = SERVICE_DISABLED then
SvcConfigStart(CertPropSvc, SERVICE_DEMAND_START);
if SvcGetStart(SessionEnv) = SERVICE_DISABLED then
SvcConfigStart(SessionEnv, SERVICE_DEMAND_START);
end;
procedure TSConfigRegistry(Enable: Boolean);
var
Reg: TRegistry;
Code: DWORD;
begin
if Arch = 64 then
Reg := TRegistry.Create(KEY_WRITE or KEY_WOW64_64KEY)
else
Reg := TRegistry.Create;
Reg.RootKey := HKEY_LOCAL_MACHINE;
if not Reg.OpenKey('\SYSTEM\CurrentControlSet\Control\Terminal Server', True) then
begin
Code := GetLastError;
Writeln('[-] OpenKey error (code ', Code, ').');
Halt(Code);
end;
try
Reg.WriteBool('fDenyTSConnections', not Enable);
except
Writeln('[-] WriteBool error.');
Halt(ERROR_ACCESS_DENIED);
end;
Reg.CloseKey;
if Enable then
begin
if not Reg.OpenKey('\SYSTEM\CurrentControlSet\Control\Terminal Server\Licensing Core', True) then
begin
Code := GetLastError;
Writeln('[-] OpenKey error (code ', Code, ').');
Halt(Code);
end;
try
Reg.WriteBool('EnableConcurrentSessions', True);
except
Writeln('[-] WriteBool error.');
Halt(ERROR_ACCESS_DENIED);
end;
Reg.CloseKey;
if not Reg.OpenKey('\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon', True) then
begin
Code := GetLastError;
Writeln('[-] OpenKey error (code ', Code, ').');
Halt(Code);
end;
try
Reg.WriteBool('AllowMultipleTSSessions', True);
except
Writeln('[-] WriteBool error.');
Halt(ERROR_ACCESS_DENIED);
end;
Reg.CloseKey;
if not Reg.KeyExists('\SYSTEM\CurrentControlSet\Control\Terminal Server\AddIns') then begin
if not Reg.OpenKey('\SYSTEM\CurrentControlSet\Control\Terminal Server\AddIns', True) then
begin
Code := GetLastError;
Writeln('[-] OpenKey error (code ', Code, ').');
Halt(Code);
end;
Reg.CloseKey;
if not Reg.OpenKey('\SYSTEM\CurrentControlSet\Control\Terminal Server\AddIns\Clip Redirector', True) then
begin
Code := GetLastError;
Writeln('[-] OpenKey error (code ', Code, ').');
Halt(Code);
end;
try
Reg.WriteString('Name', 'RDPClip');
Reg.WriteInteger('Type', 3);
except
Writeln('[-] WriteInteger error.');
Halt(ERROR_ACCESS_DENIED);
end;
Reg.CloseKey;
if not Reg.OpenKey('\SYSTEM\CurrentControlSet\Control\Terminal Server\AddIns\DND Redirector', True) then
begin
Code := GetLastError;
Writeln('[-] OpenKey error (code ', Code, ').');
Halt(Code);
end;
try
Reg.WriteString('Name', 'RDPDND');
Reg.WriteInteger('Type', 3);
except
Writeln('[-] WriteInteger error.');
Halt(ERROR_ACCESS_DENIED);
end;
Reg.CloseKey;
if not Reg.OpenKey('\SYSTEM\CurrentControlSet\Control\Terminal Server\AddIns\Dynamic VC', True) then
begin
Code := GetLastError;
Writeln('[-] OpenKey error (code ', Code, ').');
Halt(Code);
end;
try
Reg.WriteInteger('Type', -1);
except
Writeln('[-] WriteInteger error.');
Halt(ERROR_ACCESS_DENIED);
end;
Reg.CloseKey;
end;
end;
Reg.Free;
end;
procedure TSConfigFirewall(Enable: Boolean);
begin
if Enable then
ExecWait('netsh advfirewall firewall add rule name="Remote Desktop" dir=in protocol=tcp localport=3389 profile=any action=allow')
else
ExecWait('netsh advfirewall firewall delete rule name="Remote Desktop"');
end;
var
I: Integer;
begin
Writeln('RDP Wrapper Library v1.3');
Writeln('Installer v2.2');
Writeln('Copyright (C) Stas''M Corp. 2014');
Writeln('');
if (ParamCount < 1)
or (
(ParamStr(1) <> '-i')
and (ParamStr(1) <> '-u')
and (ParamStr(1) <> '-r')
) then
begin
Writeln('USAGE:');
Writeln('RDPWInst.exe [-i[-s]|-u|-r]');
Writeln('');
Writeln('-i install wrapper to Program Files folder (default)');
Writeln('-i -s install wrapper to System32 folder');
Writeln('-u uninstall wrapper');
Writeln('-r force restart Terminal Services');
Exit;
end;
if not SupportedArchitecture then
begin
Writeln('[-] Unsupported processor architecture.');
Exit;
end;
CheckInstall;
if ParamStr(1) = '-i' then
begin
if Installed then
begin
Writeln('[*] RDP Wrapper Library is already installed.');
Halt(ERROR_INVALID_FUNCTION);
end;
Writeln('[*] Installing...');
if ParamStr(2) = '-s' then
WrapPath := '%SystemRoot%\system32\rdpwrap.dll'
else
WrapPath := '%ProgramFiles%\RDP Wrapper\rdpwrap.dll';
if Arch = 64 then
DisableWowRedirection;
CheckTermsrvVersion;
CheckTermsrvProcess;
Writeln('[*] Extracting files...');
ExtractFiles;
Writeln('[*] Configuring service library...');
SetWrapperDll;
Writeln('[*] Checking dependencies...');
CheckTermsrvDependencies;
Writeln('[*] Terminating service...');
AddPrivilege('SeDebugPrivilege');
KillProcess(TermServicePID);
Sleep(1000);
if Length(ShareSvc) > 0 then
for I := 0 to Length(ShareSvc) - 1 do
SvcStart(ShareSvc[I]);
Sleep(500);
SvcStart(TermService);
Sleep(500);
Writeln('[*] Configuring registry...');
TSConfigRegistry(True);
Writeln('[*] Configuring firewall...');
TSConfigFirewall(True);
Writeln('[+] Successfully installed.');
if Arch = 64 then
RevertWowRedirection;
end;
if ParamStr(1) = '-u' then
begin
if not Installed then
begin
Writeln('[*] RDP Wrapper Library is not installed.');
Halt(ERROR_INVALID_FUNCTION);
end;
Writeln('[*] Uninstalling...');
if Arch = 64 then
DisableWowRedirection;
CheckTermsrvProcess;
Writeln('[*] Resetting service library...');
ResetServiceDll;
Writeln('[*] Terminating service...');
AddPrivilege('SeDebugPrivilege');
KillProcess(TermServicePID);
Sleep(1000);
Writeln('[*] Removing files...');
DeleteFiles;
if Length(ShareSvc) > 0 then
for I := 0 to Length(ShareSvc) - 1 do
SvcStart(ShareSvc[I]);
Sleep(500);
SvcStart(TermService);
Sleep(500);
Writeln('[*] Configuring registry...');
TSConfigRegistry(False);
Writeln('[*] Configuring firewall...');
TSConfigFirewall(False);
if Arch = 64 then
RevertWowRedirection;
Writeln('[+] Successfully uninstalled.');
end;
if ParamStr(1) = '-r' then
begin
Writeln('[*] Restarting...');
CheckTermsrvProcess;
Writeln('[*] Terminating service...');
AddPrivilege('SeDebugPrivilege');
KillProcess(TermServicePID);
Sleep(1000);
if Length(ShareSvc) > 0 then
for I := 0 to Length(ShareSvc) - 1 do
SvcStart(ShareSvc[I]);
Sleep(500);
SvcStart(TermService);
Writeln('[+] Done.');
end;
end.