When I resize "Terminal server", I want that the "RDP session" follow the resizing without grey borders appear
Anybody can help me?
Thanks
I have the following code:
$host = "" ;<<<<<<< enter here the host name or ip address
$hGUI = GUICreate("Terminal server", 900, 700, -1, -1, BitOR($GUI_SS_DEFAULT_GUI,$WS_SIZEBOX,$WS_THICKFRAME))
$oRDP = ObjCreate("MsTscAx.MsTscAx.2")
$oRDP_Ctrl = GUICtrlCreateObj($oRDP, 0, 0, 900, 700)
GUICtrlSetResizing(-1,GUI_DOCKLEFT+$GUI_DOCKRIGHT+$GUI_DOCKTOP+$GUI_DOCKBOTTOM+$GUI_DOCKWID TH+$GUI_DOCKHEIGHT) GUICtrlSetStyle($oRDP_Ctrl , $WS_VISIBLE)
$oRDP.DesktopWidth = 900
$oRDP.DesktopHeight = 700
$oRDP.Fullscreen = False
$oRDP.ColorDepth = 16
$oRDP.AdvancedSettings3.SmartSizing = True
$oRDP.Server = $host
$oRDP.UserName = "" ;<<<<<<< enter here the user name
$oRDP.Domain = ""
$oRDP.AdvancedSettings2.ClearTextPassword = ""
$oRDP.ConnectingText = "Connecting to " & $host
$oRDP.DisconnectedText = "Disconnected from " & $host
$oRDP.StartConnected = True
$oRDP.Connect()
GUISetState(#SW_SHOW, $hGUI)
$oShel = ObjCreate("shell.application")
$oShel_Ctrl = GUICtrlCreateObj($oShel, 0, 0, 900, 700)
GUICtrlSetStyle($oShel_Ctrl , $WS_VISIBLE)
Send("#r")
Send ("C:\Program Files (x86)\scripts\PSTools\******.bat")
Send("{ENTER}")
While 1
$nMsg = GUIGetMsg()
Switch $nMsg
Case $GUI_EVENT_CLOSE
$oRDP.Disconnect()
Exit
EndSwitch
WEnd
You really only need:
$hGUI = GUICreate("Terminal server", 900, 700, -1, -1, $WS_POPUP)
If you are trying to make it so there is absolutely NO borders, then the $WS_POPUP is what you want to use, exactly as above. It's very hard to understand your broken english, my apologies.
Related
We have 4 Html pages that we are joining together into 1 file.
For the first page, we are reading a blank PDF file (letter head) to add as the background and then add the further 3 pages.
However, all seemed ok in version 8, but now the second page will not show.
thedoc reads the blank pdf and then the html page which overlays the text no issue here.
thedoc1 is the second page which will not load
thedoc1a and thedoc2 load ok.
If I remove the adding of the letter head from thedoc, then all 4 pages load ok, but as soon as I try and use the letter head, the second page doesnt load.
Ive added my script below. What I am doing wrong please
Sub page_load()
Dim rs
Dim strSQLQuery As String
Dim theDoc As Doc = New Doc()
Dim theDoc1 As Doc = New Doc()
Dim theDoc1a As Doc = New Doc()
Dim theDoc2 As Doc = New Doc()
Dim theDoccontents As Doc = New Doc()
theDoc.MediaBox.String = "A4"
theDoc1.MediaBox.String = "A4"
theDoc1a.MediaBox.String = "A4"
theDoc2.MediaBox.String = "A4
theDoc.HtmlOptions.PageCacheEnabled = False
theDoc.HtmlOptions.PageCacheClear()
theDoc.HtmlOptions.ImageQuality = 33
theDoc1.HtmlOptions.ImageQuality = 33
theDoc1a.HtmlOptions.ImageQuality = 33
theDoc2.HtmlOptions.ImageQuality = 33
theDoc.HtmlOptions.AddLinks = True
theDoc1.HtmlOptions.AddLinks = True
theDoc1a.HtmlOptions.AddLinks = True
theDoc2.HtmlOptions.AddLinks = True
theDoc.HtmlOptions.Timeout = 10000000
theDoc1.HtmlOptions.Timeout = 10000000
theDoc1a.HtmlOptions.Timeout = 10000000
theDoc2.HtmlOptions.Timeout = 10000000
Dim rbrandchosen As String
Dim quotenumber As String
Dim rnum As String
Dim cover as string
dim pagex as integer
quotenumber=request("quotenumber")
rbrandchosen=request("rbrandchosen")
response.write(quotenumber)
Dim theURL As String
Dim theID As Integer
Dim strsql as string
Dim theSection as string
Dim theCountDoc1a As Integer
Randomize()
rnum = (CInt(Math.Floor(90 * Rnd())) + 10).ToString
' add covering letter
cover = "c:\\inetpub\\wwwroot\\icopalukintranet\\pnf\\letterhead.pdf"
theDoc.Read(cover)
'theID = theDoc.AddObject("<< >>")
theDoc.HtmlOptions.UseScript = True
theDoc.HtmlOptions.Engine = EngineType.Chrome86
' Render after 2 seconds
theDoc.Rect.SetRect(20, 110, 600, 620)
theDoc.HtmlOptions.OnLoadScript = "(function(){ window.ABCpdf_go = false; setTimeout(function(){ window.ABCpdf_go = true; }, 3000); })();"
theURL = "http://localhost/icopalukintranet/pnf/rooflights/rooflightquotepdfletter.asp?quotenumber="+ quotenumber + "&stridrnd="+rnum
'theDoc.AddImageUrl(theURL)
theID = theDoc.AddImageUrl(theURL)
While True
If Not theDoc.Chainable(theID) Then
Exit While
End If
theDoc.Page = theDoc.AddPage()
theID = theDoc.AddImageToChain(theID)
End While
' add quote
theDoc1.HtmlOptions.Engine = EngineType.Chrome86
theDoc1.HtmlOptions.UseScript = True
theDoc1.Rect.SetRect(0, 0, 600, 820)
' Render after 2 seconds
theDoc1.HtmlOptions.OnLoadScript = "(function(){ window.ABCpdf_go = false; setTimeout(function(){ window.ABCpdf_go = true; }, 2000); })();"
theURL = "http://localhost/icopalukintranet/pnf/rooflights/rooflightquotepdfquote.asp?quotenumber="+ quotenumber + "&stridrnd="+rnum
theDoc1.Page = theDoc1.AddPage()
theID = theDoc1.AddImageUrl(theURL)
While True
If Not theDoc1.Chainable(theID) Then
Exit While
End If
theSection = "Quote"
theDoc1.Page = theDoc1.AddPage()
theID = theDoc1.AddImageToChain(theID)
theDoc1.AddBookmark(theSection, True)
End While
' add notes
theDoc1a.HtmlOptions.Engine = EngineType.Chrome86
theDoc1a.HtmlOptions.UseScript = True
theDoc1a.Rect.SetRect(0, 0, 600, 820)
' Render after 3 seconds
theDoc1a.HtmlOptions.OnLoadScript = "(function(){ window.ABCpdf_go = false; setTimeout(function(){ window.ABCpdf_go = true; }, 1000); })();"
theURL = "http://localhost/icopalukintranet/pnf/rooflights/rooflightquotepdfnotes.asp?quotenumber="+ quotenumber + "&stridrnd="+rnum
theDoc1a.Page = theDoc1a.AddPage()
theID = theDoc1a.AddImageUrl(theURL)
While True
If Not theDoc1a.Chainable(theID) Then
Exit While
End If
theDoc1a.Page = theDoc1a.AddPage()
theID = theDoc1a.AddImageToChain(theID)
End While
' add terms details
theDoc2.HtmlOptions.Engine = EngineType.Chrome86
theDoc2.HtmlOptions.UseScript = True
theDoc2.Rect.SetRect(20, 80, 560, 710)
theDoc2.Transform.Magnify(0.93 ,0.93, 0, 690)
' Render after 1 seconds
theDoc2.HtmlOptions.OnLoadScript = "(function(){ window.ABCpdf_go = false; setTimeout(function(){ window.ABCpdf_go = true; }, 2000); })();"
theURL = "http://localhost/icopalukintranet/pnf/rooflights/rooflightquotepdfterms.asp?quotenumber="+ quotenumber + "&stridrnd="+rnum
theDoc2.Page = theDoc2.AddPage()
theID = theDoc2.AddImageUrl(theURL)
While True
If Not theDoc2.Chainable(theID) Then
Exit While
End If
theSection = "Terms"
theDoc2.Page = theDoc2.AddPage()
theID = theDoc2.AddImageToChain(theID)
theDoc2.AddBookmark(theSection, True)
End While
Dim cst = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & Server.MapPath("rooflightquotes.mdb")
Dim conn = CreateObject("ADODB.Connection")
conn.open(cst)
Session("myConn") = conn
dim rsAddquestion = Server.CreateObject("ADODB.Recordset")
strsql ="select * from pdfs where id=" & quotenumber & " "
rsAddquestion.Open(strsql, conn, 3, 3)
dim n as string
n=rsAddquestion.recordcount
rsAddquestion.AddNew
n=n+1
rsAddquestion("id")=quotenumber
rsAddquestion("pdfname") =quotenumber +"-rev"+n+".pdf"
rsAddquestion("printdate")=now()
rsAddquestion("status")="Printed"
rsAddquestion.update
rsAddquestion = Server.CreateObject("ADODB.Recordset")
strsql ="select * from header where id=" & quotenumber & " "
rsAddquestion.Open(strsql, conn, 3, 3)
rsAddquestion("status")="Printed"
rsAddquestion.update
conn.close
' add the pdf together in selected order
theDoc.Append(theDoc1)
theDoc.Append(theDoc1a)
theDoc.Append(theDoc2)
Dim theCount = theDoc.PageCount
' left bottom width heght
theDoc.Rect.String = "10 10 580 25"
theDoc.HPos = 1.0
theDoc.VPos = 0.5
theDoc.Color.String = "255 255 255"
theDoc.Font = theDoc.AddFont("Arial")
theDoc.FontSize = 10
For i = 1 To theCount
theDoc.PageNumber = i
If i <> 1 Then
theDoc.AddHtml(" Page " + i.ToString() + " of " + theCount.ToString() + "")
theDoc.FrameRect()
End If
Next
dim pdffilenamec = "pdf/"+quotenumber+"-rev"+n+".pdf"
theDoc.Save(Server.MapPath(pdffilenamec))
'response.redirect("rooflightquotepdfmenu.asp?quotenumber="+quotenumber)
End Sub
This used to work find in version 8, but not now using version 12
I have a label that the caption property does not change when written to.
The label caption stays with the text condition on program start.
The BackColor changes properly.
txtBlower.LinkTopic = strTopic 'get F/A Blower Status
txtBlower.LinkItem = "N7:12"
txtBlower.LinkMode = 1
If txtBlower.Text = "1" Then
lblBlower.BackColor = vbGreen
lblBlower.Caption = "BLOWER ON"
End If
If txtBlower.Text = "0" Then
lblBlower.BackColor = vbRed
lblBlower.Caption = "BLOWER OFF"
End If
The following is also in the program and works just fine.
txtWinter.LinkTopic = strTopic 'get Winter bit
txtWinter.LinkItem = "N7:19"
txtWinter.LinkMode = 1
If txtWinter.Text = "1" Then
lblWinter.BackColor = vbBlue
lblWinter.Caption = " WINTER"
Else:
lblWinter.BackColor = vbYellow
lblWinter.Caption = " SUMMER"
End If
I can't find any differences in the properties of the text boxes or the labels.
2
I went through the forums and other related question, but did not get much help.
My question is related to sending Message to controls using AutoIt. In the following code I am trying to find the index of Text that I intended to search("L20"). The application is written in VB and the same SendMessage through VB works. I believe the below SendMessage has some issue. Please help me finding the issue.
$WindowName = "Form1"
$WindowText = ""
WinWait("[CLASS:ThunderRT6FormDC]")
Local $hListBox1 = ControlGetHandle("[CLASS:ThunderRT6FormDC]", "", "ThunderRT6ListBox1")
Local $hListBox2 = ControlGetHandle("[CLASS:ThunderRT6FormDC]", "", "ThunderRT6ListBox2")
WinActivate( $WindowName, $WindowText )
ControlClick("[CLASS:ThunderRT6FormDC]", "", "ThunderRT6ListBox2")
MsgBox(0, "ControlGetHandle Example", $hListBox1 & " - " & $LB_FINDSTRING & " - " & -1 & " - " & "L20")
MsgBox(0, "ControlGetHandle Example", $hListBox2 & " - " & $LB_FINDSTRING & " - " & -1 & " - " & "L20")
Local $sText = "L20"
Local $obj1 = DllCall("user32.dll", "int", "SendMessageA", "hwnd", $hListBox1, "UINT", $LB_FINDSTRING, "WPARAM", -1, "wstr", $sText)
Local $obj2 = DllCall("user32.dll", "int", "SendMessageA", "hwnd", $hListBox2, "UINT", $LB_FINDSTRING, "WPARAM", -1, "wstr", $sText)
;Local $obj1 = _SendMessageA($hListBox1, $LB_FINDSTRING, -1, "L20")
;Local $obj2 = _SendMessageA($hListBox2, $LB_FINDSTRING, -1, "L20")
MsgBox(0, "ControlGetHandle Example", "The control handle of ThunderRT6ListBox1 is: " & $obj1 & $obj2)
The following vb6 version works in VB6 application
If FindExactMatch Then
GetListBoxIndex = SendMessage(hWnd, LB_FINDSTRINGEXACT, StartIndex, SearchKey)
Else
GetListBoxIndex = SendMessage(hWnd, LB_FINDSTRING, StartIndex, SearchKey)
End If
I am calling java code from VB script using WShell.Run. It returns a code 143. What does it mean? Where can i get the list of error codes that run method can return?
Here is the reference to System Error Codes.
ERROR_SAME_DRIVE 143 (0x8F) The system cannot join or substitute a
drive to or for a directory on the same drive.
P.S. I think that the next notes are out of the question, but just in case...
Just to note that Err object has "dummy" Description (Unknown runtime error) for most codes. If you like to get filtered list with all sensible descriptions, you can do something like this:
With CreateObject("InternetExplorer.Application")
Const DUMMY = "Unknown runtime error"
ReDim aryLines(15999)
Dim cnt, i, w, h
cnt = -1
.Navigate "about:blank"
.Document.Title = "Error Codes " & String(100, Chr(1))
.ToolBar = False
.Resizable = True
.StatusBar = False
.Width = 420
.Height = 380
With .Document.ParentWindow.Screen
w = .AvailWidth
h = .AvailHeight
End With
.Left = (w - .Width ) \ 2
.Top = (h - .Height) \ 2
Do While .Busy : WScript.Sleep 200 : Loop
On Error Resume Next
With Err
For i = 1 To 15999
.Raise i
If .Description <> DUMMY Then
cnt = cnt + 1
aryLines(cnt) = AddZero(i) & .Description
End If
.Clear
Next
End With
On Error GoTo 0
ReDim Preserve aryLines(cnt)
.Document.Body.InnerHTML = "<pre id=x>" & Join(aryLines, vbNewLine)
.Document.Body.Style.overflow = "auto"
.Document.All.X.Style.fontFamily = "Verdana, sans-serif"
.Visible = True
End With
Function AddZero(nVar)
AddZero = "<b>" & Right("00000" & nVar, 5) & "</b> "
End Function
this code returned by your java application. From MSDN
The following VBScript code does the same thing, except it specifies the window type, waits for Notepad to be shut down by the user, and saves the error code returned from Notepad when it is shut down.
Set WshShell = WScript.CreateObject("WScript.Shell")
Return = WshShell.Run("notepad " & WScript.ScriptFullName, 1, true)
So far I have:
Set objShell = WScript.CreateObject("WScript.Shell")
objShell.Run("""C:\Server01.rdp""")
But when I run it, nothing happens. Is it even possible to run an RDP file with VBScript? If so, then what am I doing wrong?
try calling mstsc.exe with the .rdp file name passed in:
objShell.Run(""mstsc C:\server01.rdp"")
I think you need to run mstsc.exe and pass the rdp file in as an argument.
http://technet.microsoft.com/en-us/library/cc753907%28WS.10%29.aspx
This will work: (In PHP with VBSCRIPT):
<script type="text/vbscript" language="vbscript">
<!--
const L_FullScreenWarn1_Text = "Your current security settings do not allow automatically switching to fullscreen mode."
const L_FullScreenWarn2_Text = "You can use ctrl-alt-pause to toggle your remote desktop session to fullscreen mode"
const L_FullScreenTitle_Text = "Remote Desktop Web Connection "
const L_ErrMsg_Text = "Error connecting to remote computer: "
const L_ClientNotSupportedWarning_Text = "Remote Desktop 6.0 does not support CredSSP over TSWeb."
const L_RemoteDesktopCaption_ErrorMessage = "Remote Desktop Connection"
const L_InvalidServerName_ErrorMessage = "An invalid server name was specified."
sub window_onload()
if not autoConnect() then
msgbox("VB")
end if
end sub
function autoConnect()
Dim sServer
Dim iFS, iAutoConnect
sServer = getQS ("Server")
iAutoConnect = getQS ("AutoConnect")
iFS = getQS ("FS")
if NOT IsNumeric ( iFS ) then
iFS = 0
else
iFS = CInt ( iFS )
end if
if iAutoConnect <> 1 then
autoConnect = false
exit function
else
if IsNull ( sServer ) or sServer = "" then
sServer = window.location.hostname
end if
btnConnect ()
autoConnect = true
end if
end function
function getQS ( sKey )
Dim iKeyPos, iDelimPos, iEndPos
Dim sURL, sRetVal
iKeyPos = iDelimPos = iEndPos = 0
sURL = window.location.href
if sKey = "" Or Len(sKey) < 1 then
getQS = ""
exit function
end if
iKeyPos = InStr ( 1, sURL, sKey )
if iKeyPos = 0 then
sRetVal = ""
exit function
end if
iDelimPos = InStr ( iKeyPos, sURL, "=" )
iEndPos = InStr ( iDelimPos, sURL, "&" )
if iEndPos = 0 then
sRetVal = Mid ( sURL, iDelimPos + 1 )
else
sRetVal = Mid ( sURL, iDelimPos + 1, iEndPos - iDelimPos - 1 )
end if
getQS = sRetVal
end function
sub OnControlLoadError
Msgbox("You wont be able to connect trough Remote Desktop")
end sub
sub OnControlLoad
set Control = Document.getElementById("MsRdpClient")
if Not Control is Nothing then
if Control.readyState = 4 then
BtnConnect()
else
Msgbox("You wont be able to connect trough Remote Desktop")
end if
else
Msgbox("You wont be able to connect trough Remote Desktop")
end if
end sub
sub BtnConnect
Dim serverName
serverName = "<?=$_POST["RDserver"]?>"
serverName = trim(serverName)
On Error Resume Next
MsRdpClient.server = serverName
If Err then
msgbox
L_InvalidServerName_ErrorMessage,0,L_RemoteDesktopCaption_ErrorMessage
Err.Clear
exit sub
end if
On Error Goto 0
Dim ClientUserName
ClientUserName = "<?=trim($_POST["RDuser"])?>"
MsRdpClient.UserName = ClientUserName
MsRdpClient.AdvancedSettings.ClearTextPassword = "<?=trim($_POST["RDpass"])?>"
MsRdpClient.FullScreen = TRUE
resWidth = screen.width
resHeight = screen.height
MsRdpClient.DesktopWidth = resWidth
MsRdpClient.DesktopHeight = resHeight
MsRdpClient.Width = resWidth
MsRdpClient.Height = resHeight
MsRdpClient.AdvancedSettings2.RedirectDrives = FALSE
MsRdpClient.AdvancedSettings2.RedirectPrinters = FALSE
MsRdpClient.AdvancedSettings2.RedirectPorts = FALSE
MsRdpClient.AdvancedSettings2.RedirectSmartCards = FALSE
MsRdpClient.FullScreenTitle = L_FullScreenTitle_Text & "-" & serverName & "-"
MsRdpClient.Connect
end sub
-->
</script>
<object id="MsRdpClient" language="vbscript" onreadystatechange="OnControlLoad" onerror="OnControlLoadError" classid="CLSID:4eb89ff4-7f78-4a0f-8b8d-2bf02e94e4b2" width="800" height="600"></object>
<script language="VBScript">
<!--
sub ReturnToConnectPage()
me.close
end sub
sub MsRdpClient_OnConnected()
end sub
sub MsRdpClient_OnDisconnected(disconnectCode)
extendedDiscReason = MsRdpClient.ExtendedDisconnectReason
majorDiscReason = disconnectCode And &hFF
if (disconnectCode = &hB08 or majorDiscReason = 2 or majorDiscReason = 1) and not (extendedDiscReason = 5) then
ReturnToConnectPage
exit sub
end if
errMsgText = MsRdpClient.GetErrorDescription(disconnectCode, extendedDiscReason)
if not errMsgText = "" then
msgbox errMsgText,0,L_RemoteDesktopCaption_ErrorMessage
end if
ReturnToConnectPage
end sub
-->
</script>
The problem is, that only works in IE, still looking for Firefox / Safari... any luck??