| View previous topic :: View next topic |
| Author |
Message |
minami
Newbie
Joined: 12 Sep 2011
Posts: 2
|
 Posted: Fri Sep 16, 2011 9:03 am Post subject: DDE IBM PComm functions in Basic |
 |
|
Hello!
This is my first post. I have to automate Personal Communications with Star Basic and the code below is what I got. I tried to declare HLLAPI dlls but OOo crashes when I call any function to get strings from presentation screen, so I implemented it using DDE. The DDEPoke function from OOo is defective, luckly we can send the string one character per time.
To connect to a PCOMM session:
0. Save the code in a OOo library
1. Load the library
BasicLibraries.LoadLibrary(name_of_library)
2. Declare the connection
Dim Connection As Boolean
3. Connect
Connection = pcConnect("A")
4. Test the connection before use it
If Connection = FALSE Then Exit Sub
5. Automate
Now you can read the Presentation Screen, send keystrokes, wait for a string etc
6. Disconnect
If someone knows how to call HLLAPI from OpenOffice, please let me know.
This code works only in Windows.
| Code: |
' ******************************************************************************
' DDE IBM PComm functions for OpenOffice.org (Screen scraping)
' Copyright (C) 2011 Fabio Minami
'
' ******************************************************************************
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY; without even the implied warranty of
' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
' GNU General Public License for more details.
'
' You should have received a copy of the GNU General Public License
' along with this program. If not, see <http://www.gnu.org/licenses/>.
'
' ******************************************************************************
' REFERENCES
' Using DDE Functions with a DDE Client Application:
' http://publib.boulder.ibm.com/infocenter/pcomhelp/v5r9/topic/
' com.ibm.pcomm.doc/books/html/emulator_programming12.htm#HDRCHAP8
'
' DDE Functions in a 32-bit Environment:
' http://publib.boulder.ibm.com/infocenter/pcomhelp/v5r9/topic/
' com.ibm.pcomm.doc/books/html/emulator_programming11.htm#HDRCHAP7O
'
' ******************************************************************************
Option Explicit
Const iTimeout = 10 ' seconds
Const iPause = 5 ' miliseconds
Dim iSystemChannel As Integer
Dim iSessionChannel As Integer
Public Function ConvPosition(iRow As Integer, iColumn As Integer) As Integer
ConvPosition = ((iRow - 1) * 80) + (iColumn - 1)
End Function
Public Function pcConnect(sSession as String) As Boolean
' Connect to a PCOMM system / session
' Wait iPause
iSystemChannel = DDEInitiate ("IBM327032", "SYSTEM")
iSessionChannel = DDEInitiate ("IBM327032", "Session" + sSession)
If iSystemChannel = 0 Then
pcConnect = FALSE
msgbox ("PCOMM is not running!", 48, "Sorry!")
Exit Function
ElseIf iSessionChannel = 0 Then
pcConnect = FALSE
msgbox ("PCOMM is not connected!", 48, "Sorry!")
' print "Error"
Exit Function
Else
pcConnect = TRUE
End If
Wait iPause
End Function
Public Function pcDisconnect() As Integer
' Disconnect
' DDETerminate (iSystemChannel)
' DDETerminate (iSessionChannel)
Wait iPause
pcDisconnect = DDETerminateAll
End Function
' DDEPOKE
' Bug 39574 - ddepoke only transmits first character
' http://openoffice.org/bugzilla/show_bug.cgi?id=39574
Public Function pcSetCursor (iRow As Integer, iColumn As Integer) As Integer
' it doesnt work! openoffice sends only the first char
Wait iPause
pcSetCursor = DDEPoke(iSessionChannel, "SETCURSOR", ConvPosition(iRow, iColumn))
End Function
Public Function pcInsert(iRow As Integer, iColumn As Integer, sText As String)
' Insert strings into the Presentation Screen
' It should not work... luckly it doesnt matter to PCOMM if DDEPoke sends only the first char.
' An error will raise if the string to be inserted is wider than the field.
Dim iTextLength As Integer
Dim iPos As Integer
Dim n As Integer
Dim sChar As String
n = 1
iTextLength = Len(sText) + 1
iPos = ConvPosition(iRow, iColumn)
Wait iPause
' Loop to send one character per time
Do Until n = iTextLength
sChar = Mid(sText, n, 1)
'DDEPoke(iSessionChannel, "EPS(" + iPos + ", 1)", sChar)
DDEPoke(iSessionChannel, "EPS(" + iPos + ", 0)", sChar)
'Wait 5
n = n + 1
iPos = iPos + 1
Loop
End Function
' DDEREQUEST
Public Function pcExtract (iRow As Integer, iColumn As Integer, iLength As Integer) As String
Dim iEnd As Integer
iEnd = iColumn + iLength - 1
pcExtract = DDERequest (iSessionChannel, "TRIMRECT(" + iRow + "," + iColumn + "," + iRow + "," + iEnd + ")")
Wait iPause
End Function
Public Function pcExtractRectangle (iRow1 As Integer, iColumn1 As Integer, iRow2 As Integer, iColumn2 As Integer) As String
' Extract strings from Presentation Space, multi lines
' UpperLeftCorner = (iRow1, iColumn1) ; BottonRightCorner = (iRow2, iColumn2)
Wait iPause
pcExtractRectangle = DDERequest (iSessionChannel, "TRIMRECT(" + iRow1 + "," + iColumn1 + "," + iRow2 + "," + iColumn2 + ")")
End Function
Public Function pcExtractPS () As String
' Extract Presentation Screen (full screen)
Wait iPause
pcExtractPS = pcExtractRectangle(1, 1, 24, 80)
End Function
Public Function pcGetOIA () As String
'Get Operator Information Area
Wait iPause
pcGetOIA = DDERequest (iSessionChannel, "OIA")
End Function
Public Function pcReadyState () As String
' PCOMM readystate
Dim iPSstate As Integer
Wait iPause
iPSstate = CInt(Mid(DDERequest (iSessionChannel, "SSTAT"), 60, 1))
If iPSstate = 0 Then
pcReadyState = "unlocked"
Elseif iPSstate = 4 Then
pcReadyState = "busy"
Elseif iPSstate = 5 Then
pcReadyState = "locked"
Else
pcReadyState = "unknow"
End If
End Function
Public Function pcWaitForTerminalReady()
Dim sPSstate As String
Dim sOIAstate As String
Dim bContinue As Boolean
Do
' Query PS and OIA state
sPSstate = pcReadyState
sOIAstate = Mid(pcGetOIA, 9, 10)
'Wait until PS is unlocked and OIA is clean
If sPSstate <> "unlocked" Or Instr(sOIAstate, "X") > 0 Then
bContinue = TRUE
Else
bContinue = FALSE
End If
Wait 250
Loop Until bContinue = FALSE
End Function
' DDEEXECUTE
Public Function pcPressKey (sKey As String) As Integer
' Send keys to PCOMM
pcWaitForTerminalReady
pcPressKey = DDEExecute(iSessionChannel, "[SENDKEY(" + sKey + ")]")
pcWaitForTerminalReady
End Function
Public Function pcUnlockKeyboard() As Integer
' Unlock keyboard
Wait iPause
pcUnlockKeyboard = DDEExecute(iSessionChannel, "[KEYBOARD(UNLOCK)]")
End Function
Public Function pcLockKeyboard() As Integer
' Lock keyboard
Wait iPause
pcLockKeyboard = DDEExecute(iSessionChannel, "[KEYBOARD(LOCK)]")
End Function
Public Function pcWait (iRow As Integer, iColumn As Integer, sText As String) As Integer
' Wait predefined time until a string appears on the Presentation Space
Wait iPause
pcWait = DDEExecute (iSessionChannel, "[WAIT(""" + iTimeout + " seconds until " + chr(34) + chr(34) + sText + chr(34) + chr(34) + " at (" + iRow + "," +iColumn + ")"")]")
End Function
|
Fabio Minami |
|
| Back to top |
|
 |
minami
Newbie
Joined: 12 Sep 2011
Posts: 2
|
| Posted: Sat Sep 17, 2011 9:00 pm Post subject: |
|
|
Another way to use StarBasic to screen scrape the Personal Communications TN3270 Terminal Emulator, now using HACL (Host Access Class Library Automation Objects).
Reference:
http://publib.boulder.ibm.com/infocenter/pcomhelp/v5r9/index.jsp?topic=/com.ibm.pcomm.doc/books/html/host_access08.htm
| Code: |
Sub Test
Dim xECLPS as Object
Dim sText As String
Set xECLPS = CreateObject("PCOMM.autECLPS")
xECLPS.SetConnectionByName("A")
xECLPS.WaitForString("Mainframe", 1 , 2, 10000, TRUE)
sText = xECLPS.getText("1", "1", "80")
msgbox sText
sText = xECLPS.getTextRect(1, 1, 24, 80)
msgbox sText
xECLPS.Sendkeys("netview", "21", "22")
xECLPS.Sendkeys("[enter]")
xECLPS.WaitForString("NetView", 13 , 40, 10000, TRUE)
xECLPS.Sendkeys("operator", "15", "29")
xECLPS.Sendkeys("password", "16", "29")
xECLPS.Sendkeys("[enter]")
End Sub
|
Some functions:
| Code: |
Const iTimeout = 10000
Dim xECLSession As Object
Dim xECLPS as Object
Dim xECLOIA As Object
Public Function Connect(sSession As String)
'Set xECLPS = CreateObject("PCOMM.autECLPS")
Set xECLSession = CreateObject("PCOMM.autECLSession")
' Initialize the connection
' xECLPS.SetConnectionByName("" + sSession + "")
xECLSession.SetConnectionByName("" + sSession + "")
xECLPS = xECLSession.autECLPS
xECLOIA = xECLSession.autECLOIA
'Wait methods dont work in Star Basic :-(
' xECLOIA.WaitForAppAvailable(iTimeout)
' xECLOIA.WaitForInputReady(iTimeout)
End Function
Public Function Paste(iRow As Integer, iColumn As Integer, sText As String)
' xECLPS.Sendkeys("" + sText + "", "" + iRow + "", "" + iColumn + "")
xECLPS.SetText("" + sText + "", "" + iRow + "", "" + iColumn + "")
End Function
Public Function PressKey(sKey As String)
xECLPS.Sendkeys("" + sKey + "")
End Function
Public Function Copy(iRow As Integer, iColumn As Integer, vSizeOrString As Variant) As Variant
If IsNull(vSizeOrString) = TRUE Then
Copy = FALSE
Elseif IsNumeric(vSizeOrString) Then
Copy = xECLPS.getTextRect(iRow, iColumn, iRow, iColumn + vSizeOrString - 1)
Else
Dim iSize As Integer
iSize = Len(vSizeOrString)
If xECLPS.getTextRect(iRow, iColumn, iRow, iColumn + iSize - 1) = vSizeOrString Then
Copy = TRUE
Else
Copy = FALSE
End If
End If
End Function
'WaiForString method doesnt work in StarBasic
'Public Function WaitString(iRow As String, iColumn As String, sText As String)
' xECLPS.WaitForString("" + sText + "", iRow , iColumn, 10000, TRUE)
'End Function
Public Function WaitString(iRow As Integer, iColumn As Integer, sText As String)
Dim iSize As Integer
iSize = Len(sText)
Do
wait 5
Loop Until xECLPS.getText("" + iRow + "", "" + iColumn + "", "" + iSize + "") = sText
End Function
Public Function SetCursor(iRow As Integer, iColumn As Integer)
SetCursor = xECLPS.SetCursorPos(iRow, iColumn)
End Function
|
Fabio Minami |
|
| Back to top |
|
|
|
|
You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum
You cannot vote in polls in this forum
|
Powered by phpBB © 2001, 2005 phpBB Group
|
