M626
Programmer
- Mar 13, 2002
- 299
I am trying to do a screen scrape of a specific length off a Pcomm Session, Anyone have any ideas of examples how to do this?
Follow along with the video below to see how to install our site as a web app on your home screen.
Note: This feature may not be available in some browsers.
'HACLmod was the brainchild of Scott Farren
'All code included with this application is the product of Scott Farren unless otherwise noted
'If you wish to use this code in any other project it must be noted with this information as a condition of use
'Thank you
Option Explicit
Global psA As Object
Global psB As Object
Global psC As Object
Global psD As Object
Global psE As Object
Global psF As Object
Global OIAA As Object
Global OIAB As Object
Global OIAC As Object
Global OIAD As Object
Global OIAE As Object
Global OIAF As Object
Global E As String
Global C As String
Public Sub StartUp()
On Error GoTo Error_Trap
E = "[enter]"
C = "[clear]"
Set psA = CreateObject("PCOMM.autECLPS")
Set psB = CreateObject("PCOMM.autECLPS")
Set psC = CreateObject("PCOMM.autECLPS")
Set psD = CreateObject("PCOMM.autECLPS")
Set psE = CreateObject("PCOMM.autECLPS")
Set psF = CreateObject("PCOMM.autECLPS")
Set OIAA = CreateObject("PCOMM.autECLOIA")
Set OIAB = CreateObject("PCOMM.autECLOIA")
Set OIAC = CreateObject("PCOMM.autECLOIA")
Set OIAD = CreateObject("PCOMM.autECLOIA")
Set OIAE = CreateObject("PCOMM.autECLOIA")
Set OIAF = CreateObject("PCOMM.autECLOIA")
Connect
Exit Sub
Error_Trap:
MsgBox Err.Number & "-" & Err.Description
End Sub
Public Sub Connect()
Dim ErrCounter As Integer
On Error GoTo Error_Trap
psA.SetConnectionByName ("A")
psB.SetConnectionByName ("B")
psC.SetConnectionByName ("C")
psC.SetConnectionByName ("E")
psD.SetConnectionByName ("D")
psE.SetConnectionByName ("E")
psF.SetConnectionByName ("F")
OIAA.SetConnectionByName ("A")
OIAB.SetConnectionByName ("B")
OIAC.SetConnectionByName ("C")
OIAD.SetConnectionByName ("D")
OIAE.SetConnectionByName ("E")
OIAF.SetConnectionByName ("F")
Exit Sub
Error_Trap:
If Err.Number = -2147352567 Then
'this is the pcomm bloat problem
MsgBox "Please do a shutdown restart. This is a CMMouse issue and is being addressed. Thank you.", vbOKOnly
End If
MsgBox Err.Number & "-" & Err.Description
End Sub
Public Function GetIt(PS As Object, Optional R As Long, Optional C As Long, Optional L As Long) As String
On Error GoTo Error_Trap
If R = 0 Then 'Get whole scree
GetIt = PS.GetText()
Else: 'Get selected area
GetIt = PS.GetText(R, C, L)
End If
Exit Function
Error_Trap:
If Err.Number = 91 Then 'you did not run the startup sub this will do it for you
StartUp
Resume
End If
WhereAmI = WhereAmI & " " & "GetIt"
MsgBox Err.Number & "-" & Err.Description
Resume
End Function
Public Sub SendIt(PS As Object, Info As String, Optional R As Long, Optional C As Long)
If frmMain.Visible = False Then QuitIt: Exit Sub
Dim WaitTime
Dim ErrorCount As Single
TryAgain:
Err().Number = 0
On Error GoTo Error_Trap
If R = 0 Then
DoEvents
R = PS.CursorPosRow
DoEvents
C = PS.CursorPosCol
DoEvents
End If
PS.SendKeys Info, R, C
'set WaitTime to 25sec
WaitTime = Timer + 25
'wait
Select Case PS.Name
Case "A"
Do Until OIAA.InputInhibited = 0
DoEvents
If Timer > WaitTime Then
Select Case MsgBox("The '" & PS.Name & "' Emulator appears to be clocking" & Chr(13) & _
"Do you wish to continue waiting?" & "If you select No this program will end", vbYesNo, "Wait?")
Case vbYes
WaitTime = Timer + 25
Case vbNo
Set psA = Nothing
Set psB = Nothing
Set psC = Nothing
Set psD = Nothing
Set psE = Nothing
Set psF = Nothing
Set OIAA = Nothing
Set OIAB = Nothing
Set OIAC = Nothing
Set OIAD = Nothing
Set OIAE = Nothing
Set OIAF = Nothing
End
End Select
End If
Loop
Case "B"
Do Until OIAB.InputInhibited = 0
DoEvents
If Timer > WaitTime Then
Select Case MsgBox("The '" & PS.Name & "' Emulator appears to be clocking" & Chr(13) & _
"Do you wish to continue waiting?" & "If you select No this program will end", vbYesNo, "Wait?")
Case vbYes
WaitTime = Timer + 25
Case vbNo
Set psA = Nothing
Set psB = Nothing
Set psC = Nothing
Set psD = Nothing
Set psE = Nothing
Set psF = Nothing
Set OIAA = Nothing
Set OIAB = Nothing
Set OIAC = Nothing
Set OIAD = Nothing
Set OIAE = Nothing
Set OIAF = Nothing
End
End Select
End If
Loop
Case "C"
Do Until OIAC.InputInhibited = 0
DoEvents
If Timer > WaitTime Then
NotStayOnTop frmMain
Select Case MsgBox("The '" & PS.Name & "' Emulator appears to be clocking" & Chr(13) & _
"Do you wish to continue waiting?" & "If you select No this program will end", vbYesNo, "Wait?")
Case vbYes
WaitTime = Timer + 25
Case vbNo
Set psA = Nothing
Set psB = Nothing
Set psC = Nothing
Set psD = Nothing
Set psE = Nothing
Set psF = Nothing
Set OIAA = Nothing
Set OIAB = Nothing
Set OIAC = Nothing
Set OIAD = Nothing
Set OIAE = Nothing
Set OIAF = Nothing
End
End Select
End If
Loop
Case "D"
Do Until OIAD.InputInhibited = 0
DoEvents
If Timer > WaitTime Then
NotStayOnTop frmMain
Select Case MsgBox("The '" & PS.Name & "' Emulator appears to be clocking" & Chr(13) & _
"Do you wish to continue waiting?" & "If you select No this program will end", vbYesNo, "Wait?")
Case vbYes
WaitTime = Timer + 25
Case vbNo
Set psA = Nothing
Set psB = Nothing
Set psC = Nothing
Set psD = Nothing
Set psE = Nothing
Set psF = Nothing
Set OIAA = Nothing
Set OIAB = Nothing
Set OIAC = Nothing
Set OIAD = Nothing
Set OIAE = Nothing
Set OIAF = Nothing
End
End Select
End If
Loop
Case "E"
Do Until OIAE.InputInhibited = 0
DoEvents
If Timer > WaitTime Then
NotStayOnTop frmMain
Select Case MsgBox("The '" & PS.Name & "' Emulator appears to be clocking" & Chr(13) & _
"Do you wish to continue waiting?" & "If you select No this program will end", vbYesNo, "Wait?")
Case vbYes
WaitTime = Timer + 25
Case vbNo
Set psA = Nothing
Set psB = Nothing
Set psC = Nothing
Set psD = Nothing
Set psE = Nothing
Set psF = Nothing
Set OIAA = Nothing
Set OIAB = Nothing
Set OIAC = Nothing
Set OIAD = Nothing
Set OIAE = Nothing
Set OIAF = Nothing
End
End Select
End If
Loop
Case "F"
Do Until OIAE.InputInhibited = 0
DoEvents
If Timer > WaitTime Then
NotStayOnTop frmMain
Select Case MsgBox("The '" & PS.Name & "' Emulator appears to be clocking" & Chr(13) & _
"Do you wish to continue waiting?" & "If you select No this program will end", vbYesNo, "Wait?")
Case vbYes
WaitTime = Timer + 25
Case vbNo
Set psA = Nothing
Set psB = Nothing
Set psC = Nothing
Set psD = Nothing
Set psE = Nothing
Set psF = Nothing
Set OIAA = Nothing
Set OIAB = Nothing
Set OIAC = Nothing
Set OIAD = Nothing
Set OIAE = Nothing
Set OIAF = Nothing
End
End Select
End If
Loop
End Select
Exit Sub
Error_Trap:
If Err().Number = -2147352567 Then
PS.SendKeys "[reset]", 1, 1
Resume TryAgain
Else:
If Err.Number = 91 Then 'you did not run the startup sub this will do it for you
StartUp
Resume
Else:
MsgBox Err.Number & "-" & Err.Description
Resume
End If
End If
End Sub
Public Sub Enter(PS As Object)
On Error GoTo Error_Trap
Dim lsUnTarget As String
lsUnTarget = GetIt(PS)
SendIt PS, E
PagesCount = PagesCount + 1
Do Until GetIt(PS) <> lsUnTarget
DoEvents
Loop
Exit Sub
Error_Trap:
MsgBox Err.Number & "-" & Err.Description
End Sub
Public Sub Clear(PS As Object)
On Error GoTo Error_Trap
TryAgain:
SendIt PS, C & C
Loop Until Trim(GetIt(PS)) = ""
DoEvents
Loop
Exit Sub
Error_Trap:
MsgBox Err.Number & "-" & Err.Description
End Sub