'------------------------------------------------------ 'Classe para automação do terminal PW3270 usando a libhllapi.dll 'Dúvidas/Sugestões: Erick Lopes de Souza - sodapraia@hotmail.com '------------------------------------------------------ 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