mirror of
https://github.com/stascorp/rdpwrap.git
synced 2024-12-04 12:43:34 +00:00
1075 lines
30 KiB
ObjectPascal
1075 lines
30 KiB
ObjectPascal
{
|
|
Copyright 2014 Stas'M Corp.
|
|
|
|
Licensed under the Apache License, Version 2.0 (the "License");
|
|
you may not use this file except in compliance with the License.
|
|
You may obtain a copy of the License at
|
|
|
|
http://www.apache.org/licenses/LICENSE-2.0
|
|
|
|
Unless required by applicable law or agreed to in writing, software
|
|
distributed under the License is distributed on an "AS IS" BASIS,
|
|
WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
|
|
See the License for the specific language governing permissions and
|
|
limitations under the License.
|
|
}
|
|
|
|
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;
|
|
|
|
function ExtractResText(ResName: String): String;
|
|
var
|
|
ResStream: TResourceStream;
|
|
Str: TStringList;
|
|
begin
|
|
ResStream := TResourceStream.Create(HInstance, ResName, RT_RCDATA);
|
|
Str := TStringList.Create;
|
|
try
|
|
Str.LoadFromStream(ResStream);
|
|
except
|
|
|
|
end;
|
|
ResStream.Free;
|
|
Result := Str.Text;
|
|
Str.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;
|
|
|
|
FreeLibrary(hFile);
|
|
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;
|
|
if (FV.Release = 6002) and (FV.Build = 19214) then
|
|
SuppLvl := 2;
|
|
if (FV.Release = 6002) and (FV.Build = 23521) 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;
|
|
if (FV.Release = 7601) and (FV.Build = 18637) then
|
|
SuppLvl := 2;
|
|
if (FV.Release = 7601) and (FV.Build = 22843) 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;
|
|
if (FV.Release = 9860) 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;
|
|
2: begin
|
|
Writeln('[+] This version of Terminal Services is fully supported.');
|
|
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.4');
|
|
Writeln('Installer v2.2');
|
|
Writeln('Copyright (C) Stas''M Corp. 2014');
|
|
Writeln('');
|
|
|
|
if (ParamCount < 1)
|
|
or (
|
|
(ParamStr(1) <> '-l')
|
|
and (ParamStr(1) <> '-i')
|
|
and (ParamStr(1) <> '-u')
|
|
and (ParamStr(1) <> '-r')
|
|
) then
|
|
begin
|
|
Writeln('USAGE:');
|
|
Writeln('RDPWInst.exe [-l|-i[-s]|-u|-r]');
|
|
Writeln('');
|
|
Writeln('-l display the license agreement');
|
|
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 ParamStr(1) = '-l' then
|
|
begin
|
|
Writeln(ExtractResText('LICENSE'));
|
|
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('[*] Notice to user:');
|
|
Writeln(' - By using all or any portion of this software, you are agreeing');
|
|
Writeln(' to be bound by all the terms and conditions of the license agreement.');
|
|
Writeln(' - To read the license agreement, run the installer with -l parameter.');
|
|
Writeln(' - If you do not agree to any terms of the license agreement,');
|
|
Writeln(' do not use the software.');
|
|
|
|
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.
|