[THIN] Re: Querying TSProfilePath, TSHomeDrive via Script?

From: RICHARD.CHAPMAN@xxxxxxxxxxxxxxxxxx
To: thin@xxxxxxxxxxxxx
Date: Wed, 9 Jul 2003 16:31:16 +0100
Hi Jeff

The code below is pretty rough as it was just a bit of experimentation
before I went on to write the final application.  It has everything you need
though to pretty much cut and paste and build your COM component.
Obviously, you'll need to replace domain names etc as appropriate to suite
your environment

The crux of it is in the WTSQueryUserConfig function from the wtsapi32 dll
which you'll find in the form module at the bottom.

Regards
Rich
Richard Chapman 
Technical Support 
richard.chapman@xxxxxxxxxxxxxxxxxx 
Ph +44 207 587 2205 
This email is confidential to the addressee only. If you do not believe that
you are the intended addressee, do not use, pass on or copy it in any way.
If you have received it in error, please delete it immediately and telephone
the number given, reversing the charges if necessary.

-------------------------------------------------------------

Attribute VB_Name = "modAPIDeclarations"
Option Explicit

Public Enum WTS_CONFIG_CLASS
    WTSUserConfigInitialProgram
    WTSUserConfigWorkingDirectory
    WTSUserConfigfInheritInitialProgram
    WTSUserConfigfAllowLogonTerminalServer
    WTSUserConfigTimeoutSettingsConnections
    WTSUserConfigTimeoutSettingsDisconnections
    WTSUserConfigTimeoutSettingsIdle
    WTSUserConfigfDeviceClientDrives
    WTSUserConfigfDeviceClientPrinters
    WTSUserConfigfDeviceClientDefaultPrinter
    WTSUserConfigBrokenTimeoutSettings
    WTSUserConfigReconnectSettings
    WTSUserConfigModemCallbackSettings
    WTSUserConfigModemCallbackPhoneNumber
    WTSUserConfigShadowingSettings
    WTSUserConfigTerminalServerProfilePath
    WTSUserConfigTerminalServerHomeDir
    WTSUserConfigTerminalServerHomeDirDrive
    WTSUserConfigfTerminalServerRemoteHomeDir
End Enum

Public Declare Function WTSQueryUserConfig Lib "wtsapi32" Alias _
                        "WTSQueryUserConfigA" _
                        (ByVal pServerName As String, _
                         ByVal pUserName As String, _
                         ByVal WTSConfigClass As WTS_CONFIG_CLASS, _
                         ByRef ppBuffer As Long, _
                         ByRef pBytesReturned As Long) As Long

Public Declare Function WTSSetUserConfig Lib "wtsapi32" Alias _
                        "WTSSetUserConfigA" _
                        (ByVal pServerName As String, _
                         ByVal pUserName As String, _
                         ByVal WTSConfigClass As WTS_CONFIG_CLASS, _
                         ByVal pBuffer As String, _
                         ByVal DataLength As Long) As Long

Public Declare Sub CopyMemory Lib "kernel32" Alias _
                   "RtlMoveMemory" _
                   (Destination As Any, _
                    Source As Any, _
                    ByVal Length As Long)
                  
Public Declare Sub WTSFreeMemory Lib "wtsapi32.dll" _
                   (ByVal pMemory As Long)
                   
Public Declare Function GetLastError Lib "kernel32" () As Long

Public Declare Function NetGetDCName Lib "netapi32.dll" _
                        (ServerName As Long, _
                         DomainName As Byte, _
                         BufPtr As Long) As Long
                         
Public Declare Sub lstrcpyW Lib "kernel32" _
                   (dest As Any, _
                    ByVal src As Any)
                    
Public Declare Function NetApiBufferFree& Lib "netapi32" _
                        (ByVal Buffer As Long)

-----------------------------------------------------------------


Attribute VB_Name = "modDomainControllers"
Option Explicit

Public Function GetPrimaryDCName(ByVal DomainName As String, _
                                 ByRef PDCName As String) As Boolean
    Dim sDCName As String
    Dim lDCNPtr As Long
    Dim bytDNArray() As Byte
    Dim bytDCNArray(100) As Byte
    Dim lResult As Long
    
    bytDNArray = DomainName & vbNullChar
    
    '-- Lookup the Primary Domain Controller
    lResult = NetGetDCName(0&, bytDNArray(0), lDCNPtr)
    
    If lResult <> 0 Then
        MsgBox "Unable to locate the Primary Domain Controller" & _
               "The program will terminate." & _
               vbCrLf & vbCrLf & "Error: " & lResult
        GetPrimaryDCName = False
        Exit Function
    End If
           
    lstrcpyW bytDCNArray(0), lDCNPtr
    
    lResult = NetApiBufferFree(lDCNPtr)
    sDCName = bytDCNArray()
    PDCName = Left(sDCName, InStr(sDCName, Chr(0)) - 1)
    GetPrimaryDCName = True
End Function


-----------------------------------------------------------------

Attribute VB_Name = "modStringFunctions"
Option Explicit

Public Function GetStringFromLP(ByVal StrPtr As Long) As String

Dim b As Byte
Dim sTempStr As String
Dim sBufferStr As String
Dim bDone As Boolean

bDone = False

Do
    '-- Get the byte/character that StrPtr is pointing to.
    Call CopyMemory(b, ByVal StrPtr, 1)
    '-- If you find a null character, then you're done.
    If b = 0 Then
        bDone = True
    Else
        '-- Get the character for the byte's value
        sTempStr = Chr$(b)
        '-- Add it to the string
        sBufferStr = sBufferStr & sTempStr
        ' Increment the pointer to next byte/char
        StrPtr = StrPtr + 1
    End If
Loop Until bDone

GetStringFromLP = sBufferStr

End Function

-----------------------------------------------------------------

VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   4695
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   7815
   LinkTopic       =   "Form1"
   ScaleHeight     =   4695
   ScaleWidth      =   7815
   StartUpPosition =   3  'Windows Default
   Begin VB.CommandButton Command3 
      Caption         =   "Get PDC"
      Height          =   375
      Left            =   2880
      TabIndex        =   7
      Top             =   4200
      Width           =   1335
   End
   Begin VB.CommandButton Command2 
      Caption         =   "Set TSE Home Dir"
      Height          =   375
      Left            =   4500
      TabIndex        =   4
      Top             =   4260
      Width           =   1575
   End
   Begin VB.TextBox Text3 
      Height          =   285
      Left            =   1020
      TabIndex        =   3
      Text            =   "\\admin01\users\homedirs\chapmanr"
      Top             =   2820
      Width           =   4575
   End
   Begin VB.TextBox Text2 
      Height          =   285
      Left            =   1020
      TabIndex        =   2
      Text            =   "chapmanr"
      Top             =   2400
      Width           =   4575
   End
   Begin VB.CommandButton Command1 
      Caption         =   "Get TSE Home Dir"
      Height          =   375
      Left            =   6180
      TabIndex        =   1
      Top             =   4260
      Width           =   1575
   End
   Begin VB.TextBox Text1 
      Height          =   2235
      Left            =   60
      MultiLine       =   -1  'True
      TabIndex        =   0
      Text            =   "frmMain.frx":0000
      Top             =   60
      Width           =   7695
   End
   Begin VB.Label Label2 
      Caption         =   "Home Dir"
      Height          =   255
      Left            =   60
      TabIndex        =   6
      Top             =   2880
      Width           =   915
   End
   Begin VB.Label Label1 
      Caption         =   "Username:"
      Height          =   255
      Left            =   60
      TabIndex        =   5
      Top             =   2460
      Width           =   915
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Sub Command1_Click()
    
Dim sServer As String
Dim sUserName As String
Dim lpBuffer As Long
Dim sBuffer As String
Dim lBytesReturned As Long

Dim lResult As Long

sServer = "\\ADMIN02"
sUserName = Text2.Text
lpBuffer = 0
lBytesReturned = 0

lResult = WTSQueryUserConfig _
          (sServer, _
           sUserName, _
           WTS_CONFIG_CLASS.WTSUserConfigTerminalServerHomeDir, _
           lpBuffer, _
           lBytesReturned)
            
If lResult > 0 Then
    '-- Call to WTSQueryUserConfig was successful
    sBuffer = GetStringFromLP(lpBuffer)
    UpdateTextBox ("TSE Home Drive: " & vbCrLf & sBuffer & _
                    vbCrLf & "LBytes.." & lBytesReturned)
Else
    '-- Call to WTSQueryUserConfig failed
    UpdateTextBox ("Invalid username...")
End If
    
End Sub

Private Sub UpdateTextBox(Message As String)
    Text1.Text = Message
End Sub

Private Sub Command2_Click()
Dim sServer As String
Dim sUserName As String
Dim sBuffer As String
Dim lBufferLen As Long
Dim lResult As Long

sServer = "\\ADMIN02"
sUserName = Text2.Text
sBuffer = Text3.Text & Chr(0)

lBufferLen = Len(sBuffer)

lResult = WTSSetUserConfig _
          (sServer, _
           sUserName, _
           WTS_CONFIG_CLASS.WTSUserConfigTerminalServerHomeDir, _
           sBuffer, _
           lBufferLen)
           
If lResult > 0 Then
    '-- Call to WTSSetUserConfig was successful
    UpdateTextBox ("TSE Home Drive Updated Successfully.")
Else
    '-- Call to WTSQueryUserConfig failed
    UpdateTextBox ("TSE Home Drive Update Failed")
End If

End Sub

Private Sub Command3_Click()
    Dim bResult As Boolean
    Dim sPDCName As String
    
    bResult = GetPrimaryDCName("Insert Domain Here", sPDCName)
    
    Text1.Text = sPDCName
End Sub


-----Original Message-----
From: Durbin, Jeff [mailto:jdurbin@xxxxxxxxxxxxxxxxxxx] 
Sent: 09 July 2003 15:52
To: thin@xxxxxxxxxxxxx
Subject: [THIN] Re: Querying TSProfilePath, TSHomeDrive via Script?


Thanks. I hadn't looked at TSCMD closely enough. I have VBScripts that I use
to query a domain for every user and gather username, homedrive, profile
path, etc., so I'd still like to have a COM object if anyone has one. Thanks
again.
-----Original Message-----
From: Angus Macdonald [mailto:Angus.Macdonald@xxxxxxxxxxxxxxxxxxx] 
Sent: Wednesday, July 09, 2003 2:14 AM
To: thin@xxxxxxxxxxxxx
Subject: [THIN] Re: Querying TSProfilePath, TSHomeDrive via Script?


tscmd will return the current value of a variable if you don't specify a new
value.
ie 
tscmd.exe nwwyg1 angus timeoutidle

would return my current idle timeout value.
-----Original Message-----
From: Durbin, Jeff [mailto:jdurbin@xxxxxxxxxxxxxxxxxxx]
Sent: 08 July 2003 23:14
To: thin@xxxxxxxxxxxxx
Subject: [THIN] Querying TSProfilePath, TSHomeDrive via Script?


 Does anyone have any code for getting TSProfilePath and TSHomeDrive via VB
or VBScript? I have Thomas Eck's COM object - it only allows you to *set*
TSProfile path and TS Home Drive. I also know about TSCMD, which has the
same limitation. Has anyone created a COM object to query this information
from Win2K? I keep meaning to write one, but it keeps getting pushed down
the priority list. Thanks in advance.
Jeff Durbin 


****************************************************************************


SMOKE ALARMS SAVE LIVES

Go to London Fire at www.london-fire.gov.uk/firesafety 

This email is confidential to the addressee only. If you do not believe that
you are the intended addressee, do not use, pass on or copy it in any way.
If you have received it in error, please delete it immediately and telephone
the number given, reversing the charges if necessary.
********************************************************
This weeks sponsor - RTOSoft TScale 
Complaints about applications response time - DO SOMETHING ABOUT IT!
TScale 2.0 improves applications response time and increases terminal
server capacity. Really get MORE from your existing servers! Free eval:
http://www.rtosoft.com/enter.asp?id=130
**********************************************************
Useful Thin Client Computing Links are available at:
http://thethin.net/links.cfm

For Archives, to Unsubscribe, Subscribe or 
set Digest or Vacation mode use the below link:
http://thethin.net/citrixlist.cfm
[THIN] Re: Querying TSProfilePath, TSHomeDrive via Script?

Other related posts:
