OpenOffice.org Forum at OOoForum.orgThe OpenOffice.org Forum
 
 [Home]   [FAQ]   [Search]   [Memberlist]   [Usergroups]   [Register
 [Profile]   [Log in to check your private messages]   [Log in

DDE IBM PComm functions in Basic

 
Post new topic   Reply to topic    OOoForum.org Forum Index -> OpenOffice.org Code Snippets
View previous topic :: View next topic  
Author Message
minami
Newbie
Newbie


Joined: 12 Sep 2011
Posts: 2

PostPosted: Fri Sep 16, 2011 9:03 am    Post subject: DDE IBM PComm functions in Basic Reply with quote

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
View user's profile Send private message
minami
Newbie
Newbie


Joined: 12 Sep 2011
Posts: 2

PostPosted: Sat Sep 17, 2011 9:00 pm    Post subject: Reply with quote

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
View user's profile Send private message
Display posts from previous:   
Post new topic   Reply to topic    OOoForum.org Forum Index -> OpenOffice.org Code Snippets All times are GMT - 8 Hours
Page 1 of 1

 
Jump to:  
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