Classe VBA - MACRO PW3270
#22
by
ERICK SOUZA
clsLibHllapi.cls
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
'------------------------------------------------------
'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