MEMBER !Interface class for Terminal Services Functions. !***************************************************************************************************************** !Copyright (C) 2013 Upper Park Solutions, Rick Martin, rick.martin@upperparksolutions.com !This software is provided 'as-is', without any express or implied warranty. In no event will the authors !be held liable for any damages arising from the use of this software. !Permission is granted to anyone to use this software for any purpose, !including commercial applications, subject to the following restrictions: !1. The origin of this software must not be misrepresented; you must not claim that you wrote the original software. ! If you use this software in a product, an acknowledgment in the product documentation would be appreciated ! but is not required. !2. You may not use this software in a commerical product whose primary purpose is a terminal server/services utility. !3. This notice may not be removed or altered from any source distribution. !***************************************************************************************************************** INCLUDE('UP_System_TS.INC'),ONCE fpWTSQuerySessionInformation LONG, NAME('upapi_WTSQuerySessionInformation') fpWTSFreeMemory LONG, NAME('upapi_WTSFreeMemory') MAP MODULE('WINAPI') OutputDebugString(*CString),RAW,PASCAL,NAME('OutputDebugStringA') upapi_GetEnvironmentVar(*CSTRING,*CSTRING,UNSIGNED),UNSIGNED,PASCAL,RAW,NAME('GetEnvironmentVariableA') END module('CWRTL') memcpy(LONG destination, LONG source, LONG bytes), LONG, NAME('_memcpy'),PROC end module('WTS32API_LL') upapi_WTSQuerySessionInformation( LONG hServer, | ULONG SessionId, | BYTE WTSInfoClass, | *LONG ppBuffer, | *ULONG pBytesReturned), SIGNED, PASCAL, RAW, DLL(1) !, NAME('WTSQuerySessionInformationA') upapi_WTSFreeMemory( LONG pMemory), PASCAL, DLL(1), RAW !, NAME('WTSFreeMemory') end END ! ! UP_System_TS.Construct PROCEDURE() code self.LoadLibrary &= new(LoadLibClass) fpWTSQuerySessionInformation = 0 fpWTSFreeMemory = 0 If (not self.LoadLibrary &= NULL) and self.LoadLibrary.LlcLoadLibrary('WTSAPI32.DLL') = 0 !success fpWTSQuerySessionInformation = self.LoadLibrary.LlcGetProcAddress('WTSQuerySessionInformationA') fpWTSFreeMemory = self.LoadLibrary.LlcGetProcAddress('WTSFreeMemory') End UP_System_TS.Destruct PROCEDURE() code If not self.LoadLibrary &= NULL self.LoadLibrary.LlcFreeLibrary() end dispose(self.LoadLibrary) UP_System_TS.GetEnvironmentVar PROCEDURE(string argEnvironmentString) !,STRING loc:EnvironmentString cstring(len(argEnvironmentString)+1) loc:Size long loc:CstrResult &cstring loc:Results UP_StringClass code loc:EnvironmentString = argEnvironmentString loc:Size = upapi_GetEnvironmentVar(loc:EnvironmentString,loc:CstrResult,0) if loc:Size loc:CstrResult &= new(cstring(loc:Size)) loc:Size = upapi_GetEnvironmentVar(loc:EnvironmentString,loc:CstrResult,loc:Size) if loc:Size loc:Results.Assign(loc:CstrResult) end dispose(loc:CstrResult) end return loc:Results.Get() UP_System_TS.GetClientName PROCEDURE() !,STRING ClientName UP_StringClass BufferPtr long BufferLength ULONG BufferRef &CSTRING code if fpWTSQuerySessionInformation if upapi_WTSQuerySessionInformation(upapi_WTS_CURRENT_SERVER_HANDLE,upapi_WTS_CURRENT_SESSION,upapi_WTSClientName,BufferPtr,BufferLength) BufferRef &= new(cstring(BufferLength+1)) memcpy(address(BufferRef), BufferPtr, BufferLength) ClientName.Assign(BufferRef) dispose(BufferRef) upapi_WTSFreeMemory(BufferPtr) end end return ClientName.Get() UP_System_TS.DebugString PROCEDURE (STRING pDebugString) ! Declare Procedure 3 lDebugString &CSTRING code lDebugString &= NEW CSTRING(LEN(CLIP(pDebugString)) + 3) lDebugString = CLIP(pDebugString) & '<13,10,0>' OutPutDebugString(lDebugString) DISPOSE(lDebugString)