[VBA EXCEL] PW3270 - USANDO A LIBHLLAPI.DLL | PARTE 01

[VBA EXCEL] PW3270 - USANDO A LIBHLLAPI.DLL

"PW3270 é um emulador de terminal 3270 totalmente livre, com recursos avançados e uma interface amigável (elaborada em GTK), comparável às melhores ferramentas do mercado."

Exemplo de classe para automação do terminal PW3270 usando a libhllapi.dll


Option Explicit

Private Declare Function hllapi_init Lib "libhllapi32.dll" (ByVal tp As String) As Long

Private Declare Function hllapi_deinit Lib "libhllapi32.dll" () As Long

Private Declare Function hllapi_get_revision Lib "libhllapi32.dll" () As Long

Private Declare Function hllapi_connect Lib "libhllapi32.dll" (ByVal uri As String, ByVal wait As Integer) As Long

Private Declare Function hllapi_disconnect Lib "libhllapi32.dll" () As Long

Private Declare Function hllapi_wait_for_ready Lib "libhllapi32.dll" (ByVal timeout As Integer) As Long

Private Declare Function hllapi_get_screen_at Lib "libhllapi32.dll" (ByVal row As Integer, ByVal col As Integer, ByVal text As String) As Long

Private Declare Function hllapi_enter Lib "libhllapi32.dll" () As Long

Private Declare Function hllapi_get_message_id Lib "libhllapi32.dll" () As Long

Private Declare Function hllapi_set_text_at Lib "libhllapi32.dll" (ByVal row As Integer, ByVal col As Integer, ByVal text As String) As Long

Private Declare Function hllapi_wait Lib "libhllapi32.dll" (ByVal timeout As Integer) As Long

Private Declare Function hllapi_pfkey Lib "libhllapi32.dll" (ByVal keycode As Integer) As Long

Private Declare Function hllapi_pakey Lib "libhllapi32.dll" (ByVal keycode As Integer) As Long

Private Declare Function hllapi_cmp_text_at Lib "libhllapi32.dll" (ByVal row As Integer, ByVal col As Integer, ByVal text As String) As Long

Private Declare Function hllapi_is_connected Lib "libhllapi32.dll" () As Long

Private Declare Function hllapi_set_unlock_delay Lib "libhllapi32.dll" (ByVal delay As Integer) As Long

Private Declare Function hllapi_get_cursor_address Lib "libhllapi32.dll" () As Long

Private Declare Function hllapi_set_cursor_address Lib "libhllapi32.dll" (ByVal addr As Integer) As Long

Private Declare Function hllapi_action Lib "libhllapi32.dll" (ByVal keyname As String) As Long

Private Declare Function hllapi_find_text Lib "libhllapi32.dll" (ByVal text As String) As Long


Private Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long



Public Sub Connect(Optional host As String)

    Dim hostStr() As Variant
    
    'Carregando a DLL no local indicado
    LoadLibrary ("C:\Program Files\PW3270\libhllapi32.dll")
    
    'Inicializando conexão com o nome do host já aberto
    If host <> "" Then
        If hllapi_init(host) <> 0 Then
            MsgBox ("Erro ao conectar! Verifique se a sessão " & host & " do Terminal está aberto!")
        End If
    Else
        hostStr() = Array("pw3270:A", "pw3270:B", "pw3270:C", "pw3270:D")
        For i = 0 To 3
            If hllapi_init(hostStr(i)) <> 0 Then
                If i >= 3 Then
                    MsgBox ("Tentativas de conexão esgotadas! Verifique se há alguma sessão do Terminal aberta!")
                End If
            Else
                Exit Sub
            End If
        Next
    End If
    
End Sub

Public Sub Disconnect()

    'Desconectando...
    hllapi_deinit

End Sub

Public Sub WaitHost(ByVal tempo As Integer)

    hllapi_wait tempo

End Sub

Public Sub WaitHostOK(ByVal tempo As Integer)

    'Aguardar host ate que esteja ok
    hllapi_wait_for_ready tempo

End Sub

Public Function GetString(ByVal coluna As Integer, ByVal linha As Integer, tamanho As Long)

    'Definindo o tamanho da string
    Dim txt As String

    txt = Space(tamanho)
    hllapi_get_screen_at coluna, linha, txt
    GetString = txt

End Function

Public Sub Enter()

    'Nao precisa explicar... ;)
    hllapi_enter
    While Status <> 0: DoEvents: Wend

End Sub

Public Function PutString(coluna As Integer, linha As Integer, texto As String)

    'Inserir texto na posicao desejada

    hllapi_set_text_at coluna, linha, texto
    While Status <> 0: DoEvents: Wend

End Function

Public Sub SendPFKey(ByVal numero As Integer)

    'Envia tecla de funcao (F1, F8, etc)
    hllapi_pfkey numero
    While Status <> 0: DoEvents: Wend

End Sub

Public Sub SendPAKey(ByVal codigo As Integer)

    'Envia teclas de acordo com a tabela ASCII
    hllapi_pakey codigo
    While Status <> 0: DoEvents: Wend

End Sub

Public Function SendEspKey(keyname As String)

    Dim newKey As String
    'Home = firstfield
    'End = fieldend

    Select Case keyname
        Case "HOME"
            newKey = "firstfield"
        Case "END"
            newKey = "fieldend"
        Case "TAB"
            newKey = "nextfield"
    End Select

    hllapi_action newKey
    While Status <> 0: DoEvents: Wend

End Function

Public Function FindText(txt As String)

    'Localizar um texto na tela. Se encontrar, <> 0
    FindText = hllapi_find_text(txt)

End Function

Public Function SetCursor(col As Integer, linha As Integer)

    'Posicao do cursor:  A  /  B
    '                   008 / 003 -> ((A - 1)*80 + B) -> 563
    Dim addr As Integer

    addr = ((col - 1) * 80) + linha
    hllapi_set_cursor_address addr
    While Status <> 0: DoEvents: Wend

End Function

Public Function SetCursorADDR(addr As Integer)

    'Move o cursor para um endereço específico, como por exemplo, o retorno do GetCursor (925)
    hllapi_set_cursor_address addr
    While Status <> 0: DoEvents: Wend

End Function

Public Function GetCursor()

    GetCursor = hllapi_get_cursor_address

End Function

Public Function WaitForCursor(linha As Integer, coluna As Integer) As Boolean

    'Verifica se o cursor esta em determinada posicao, retornando true
    Dim addr As Integer, cmpAddr As Integer

    addr = hllapi_get_cursor_address

    cmpAddr = ((coluna - 1) * 80) + linha

    If addr = cmpAddr Then
        WaitForCursor = True
    Else
        WaitForCursor = False
    End If

End Function

Public Function Status()

    'Status do Host, "0" se ok
    Status = hllapi_get_message_id()

End Function

Public Function GetScreen(Optional start_row As Integer = 1, Optional end_row As Integer = 24)
    
    'Função para pegar a tela do host com parâmetros opcionais
    
    'Ex.: GetScreen() pega todo o conteúdo da tela
    '     GetScreen(10) pega o conteúdo da tela a partir da linha 10 até a última linha
    '     GetScreen(20,22) pega o conteúdo da tela da linha 20 até a linha 22
    
    'Obs: O HOST SÓ TEM 24 LINHAS... ;)
    
    Dim txt As String
    Dim resTxt As String
    Dim i As Integer
    
    txt = Space(80)
    
    For i = start_row To end_row
        hllapi_get_screen_at i, 1, txt
        resTxt = resTxt & txt & vbCrLf
    Next
    
    GetScreen = resTxt
    While Status <> 0: DoEvents: Wend
    
End Function

*Conteúdo retirado do portal https://softwarepublico.gov.br/

Gostou!? Deixe seu comentário! Convido você a seguir meu blog.【ツ】