I have found on this site code for VBS to block user input. To simplify, code is:
Sub StopKeyMouse()
Set Def_DLL = DLL.DefineDLL("USER32")
Def_Proc = Def_DLL.DefineProc("BlockInput", vt_b1, vt_b1)
Set Lib = DLL.Load("USER32.DLL", "USER32")
Lib.BlockInput(True)
End Sub
Sub ResumeKeyMouse()
Set Def_DLL = DLL.DefineDLL("USER32")
Def_Proc = Def_DLL.DefineProc("BlockInput", vt_b1, vt_b1)
Set Lib = DLL.Load("USER32.DLL", "USER32")
Lib.BlockInput(False)
End Sub
Sub Test()
StopKeyMouse()
WScript.Sleep 1000
ResumeKeyMouse()
End Sub
Test()
When I run it, I get the error Object required: 'DLL'. Since the post is from 2004, I assume that VBS interaction with User32.dll has been changed.
I am missing a line with CreateObject, something like Set DLL = CreateObject("User32.dll").
Does anybody know what is correct code for script to work?
I have also found that it was possible to use
Set oAutoIt = CreateObject("AutoItX.Control")
oAutoIt.BlockInput "on"
But this is obsolete.
Is it possible to call BlockInput from VBS?
Thank you for any help.
Related
I am trying to send new outlook mail by testcomplete using vb scripting language .In that new mail i want to add new tables and keep default signature at bottom of mail by testcomplete. i am getting VB script run time error when i am using this code..please check the code and suggest me the correct methods i have to use to add new tables and signature
Function SendMail()
Dim objOutLook, NamespaceMAPI,objNewMail, fso, SendReceiveControls
Dim strTo,strCc ,strBcc ,strSubject, AccountName,strAttachmentPath
strSubject="test"
strTo=yyy#yy.com
strCc=XXX#XX.com
strBcc =zzz#zzz.com
strAttachmentPath="c:\text.txt"
Set objOutLook = CreateObject("Outlook.Application")
Set NamespaceMAPI = objOutLook.GetNamespace("MAPI")
Set objNewMail = objOutLook.CreateItem(olMailItem)
objOutLook.DisplayAlerts =True
objNewMail.TO = strTo
objNewMail.CC = strCc
objNewMail.BCC=strBcc
objNewMail.Subject = strSubject
objNewMail.Body = strMsg
If strAttachmentPath <> "" Then
Set fso =CreateObject("Scripting.FileSystemObject")
If fso.FileExists(strAttachmentPath) Then
objNewMail.Attachments.Add(strAttachmentPath)
objNewMail.GetDefaultsignature() 'script run time error occured here
objNewMail.addtable(4,3)
objNewMail.display
Else
msgbox "Attachment File Does not exists"
End If
End If
objOutLook.Quit
''''''' Releasing objects '''''''
Set objOutLook =Nothing
Set objNewMail = Nothing
Set fso = Nothing
End Function
please help me.. thanks in advannce....
See if this or this helps. They are alternative methods to yours.
I prefer to use the 2nd option, the CDO method, you just need to take atention to the fact that usually this email goes to the spam inbox, you need to manually add it to your secure contacts
I'm having some trouble figuring out what's wrong with my VBScript code as it's giving me
Script Engine Error:62:Input past end of file
when i'm trying to run
Function FSORead(ini,Section,Key,defval)
Set FSO = CreateObject("Scripting.FileSystemObject")
Set File = FSO.OpenTextFile("C:\Documents and Settings\ndtm\Application Data\IceChat\Scripts\"+ini)
keysearch = False
Do Until File.AtEndOfStream
if keysearch = False then
if File.ReadLine = "["&Section&"]" then
keysearch = True
end if
else
if Key = Mid(File.ReadLine,1,instr(File.ReadLine,"=")-1) then
FSORead = Mid(File.ReadLine,len(Key)+1)
end if
if Mid(File.ReadLine,1,1) = "[" then
FSORead = defval
end if
end if
Loop
FSORead = defval
End Function
And the File i'm calling does exist and does contain stuff like
[section1]
var1=randomvalue
[section2]
var=someothervalue
I have been trying different things but it's not working so i came here to see if someone could help me find what's wrong and how to fix it
Oh and this is the Sub calling it, it's made for a bot in a IRC network and the "SendCommand" basically allows you to execute non-script commands within the script itself
Sub FSOTest()
SendCommand "/msg #ndtm "&FSORead("http.ini","qtserver","survival","")
End Sub
Your
if Key = Mid(File.ReadLine,1,instr(File.ReadLine,"=")-1) then
tries to read two lines from the file. You need a variable that can be send to Mid and Instr.
Guys
I just wrote a vbs code snippet to automatically post in a forum. That's just for convenience. I encountered a wired problem:
I have several accounts. When I login as some accounts and use the script to automatically post, everything is OK. However, when I login as the other accounts and run the script, I got the error:
Error : Object required "getElementById(...)"
Code : 800a01a8
Source : Microsoft VBScript runtime error
I'm sure the object exists because I get it in the source of the webpage. I feel the error occurred randomly and I cannot get the regularity.
The script is ran in a Windows 8 OS and the browser is IE9. I'm a new learner of vbs and I don't know how to debug it. So I hope someone can help me. You can give me some clue.
Here is my code snippet:
Option Explicit
Dim IEApp
Dim iURL1
Dim iURL2
Dim iURL3
Dim iURL4
Dim iURL5
Set IEApp = CreateObject("InternetExplorer.Application")
iURL1="http://bbs.dealmoon.com/thread-299027-1-1.html"
iURL2="http://bbs.dealmoon.com/thread-299195-1-1.html"
iURL3="http://bbs.dealmoon.com/thread-299018-1-1.html"
iURL4="http://bbs.dealmoon.com/thread-299015-1-1.html"
iURL5="http://bbs.dealmoon.com/thread-299014-1-1.html"
Open iURL1
Open iURL2
Open iURL3
Open iURL4
Open iURL5
WScript.Echo("Done!")
Sub Wait(IE)
Do
WScript.Sleep 500
Loop While IE.ReadyState < 4 And IE.Busy
Do
WScript.Sleep 500
Loop While IE.ReadyState < 4 And IE.Busy
End Sub
Sub Post(IE)
Dim count
For count=0 To 9
With IE.Document
.getElementById("fastpostmessage").innerHTML = "good"
.getElementById("fastpostsubmit").click
Wait IE
WScript.Sleep GetRandom(7,15)
End With
Next
End Sub
Sub Open(PageURL)
IEApp.Visible = False
IEApp.Navigate PageURL
Wait IEApp
Post IEApp
End Sub
Function GetRandom(floor,ceil)
Randomize
GetRandom=Int((ceil - floor + 1) * Rnd + floor)*1000
End Function
You should call your POST routine after all the HTML content is loaded, for example in DOMContentLoaded or window.onload (for IE<9).
You dimmed IEApp, created the object, but you are not using it when trying to get the element ID. Your With block should look like this:
With IEApp.Document
.getElementById("fastpostmessage").innerHTML = "good"
.getElementById("fastpostsubmit").click
Wait IEApp
WScript.Sleep GetRandom(7,15)
End With
There are a few other places you only have IE instead of IEApp. Clear those up and your code should run fine.
I'm trying to run an integration test on my class to make sure an event i expect to be raised is raised:
'integration test not unit test
<TestMethod()>
Public Sub Change_Network_File_Causes_Event_To_Be_Raised()
Dim EventCalled As Boolean
Dim deployChk = New TRSDeploymentCheck("foo")
deployChk._localFile = Path.Combine(AppDomain.CurrentDomain.BaseDirectory, "TestFiles\SameLocalGUIDFile.txt")
AddHandler deployChk.DeploymentNeeded, Sub() EventCalled = True
deployChk.NetworkFileLocation = Path.Combine(AppDomain.CurrentDomain.BaseDirectory, "TestFiles\SameNetGUIDFile.txt")
ChangeNetworkFile(Path.Combine(AppDomain.CurrentDomain.BaseDirectory, "TestFiles\SameNetGUIDFile.txt"))
Assert.IsTrue(EventCalled)
End Sub
Here is how i setup the FileSystemWatcher Object in my class:
Friend Property NetworkFileLocation As String
Set(value As String)
_netFileLoc = value
If File.Exists(value) Then
_watcher = New FileSystemWatcher(value.Replace(Path.GetFileName(value), String.Empty))
_watcher.EnableRaisingEvents = True
AddHandler _watcher.Changed, AddressOf OnNetworkFileChanged
End If
End Set
Get
Return _netFileLoc
End Get
End Property
Private Sub OnNetworkFileChanged(source As Object, e As FileSystemEventArgs)
If IsDeploymentNeeded() Then RaiseEvent DeploymentNeeded()
End Sub
I put a breakpoint in the OneNetworkFileChange sub. The breakpoint is never hit. I have verified the file is actually being changed in ChangeNetworkFile I even copied the code (except for hard coding the path) and copied it into a windows app which i ran during my unit test. It worked in my windows app. What am i missing here?
Finally figured it out after some testing. Well the reason EventCalled is never true above is because the "windows message pump" for the test is blocked. The event will be fired but only after the test completes (which of course is to late). So how do you fix it? Its kind of messy and i don't like it but i referenced System.Windows.Forms.dll & called Application.DoEvents()
'integration test not unit test
<TestMethod()>
Public Sub Change_Network_File_Causes_Event_To_Be_Raised()
Dim EventCalled As Boolean
Dim deployChk = New TRSDeploymentCheck("foo")
deployChk._localFile = Path.Combine(AppDomain.CurrentDomain.BaseDirectory, "TestFiles\SameLocalGUIDFile.txt")
AddHandler deployChk.DeploymentNeeded, Sub() EventCalled = True
deployChk.NetworkFileLocation = Path.Combine(AppDomain.CurrentDomain.BaseDirectory, "TestFiles\SameNetGUIDFile.txt")
ChangeNetworkFile(Path.Combine(AppDomain.CurrentDomain.BaseDirectory, "TestFiles\SameNetGUIDFile.txt"))
Application.DoEvents()
Assert.IsTrue(EventCalled)
End Sub
Until some tells me a better way this appears to be the solution.
Probably its the filter (string.Empty) which apparently only looks at files without an extension (that's an assumption).
Try "*.*" or something like this:
_watcher = New FileSystemWatcher(value.Replace(Path.GetFileName(value), string.Concat("*.", Path.GetExtension(value))))
I'm new to this site. I have searched thoroughly for an answer and cannot seem to locate an answer. I hope one of you fine people will be able to help me....
Thank you
When I try to run my custom form with code show below, I get the following message:
Script Error
Expected statement
Line No:33
Code:
Function Item_Open()
Dim LeaveItem
Dim IO
If not Connection_Open Then
MsgBox("Error connecting to SI")
LeaveItem = True
Item_Open = False
Else
Item_Open = False
End If
End Function
Function Item_Close()
If LeaveItem = True Then
Exit_Function
Else
End If
End Function
Subroutine Connection_Open()
Dim oSI
Set oSI = New ADODB.Connection
Dim ostrSI
oSI.ConnectionString = "Driver={Progress OpenEdge 10.1C Driver};HOST=192.168.1.1;DB=kob;UID=sii;PWD=sisys1;PORT=2501;"
oSI.Open
End Sub
Change
Subroutine Connection_Open()
to
Sub Connection_Open()