QUANTIDADE DE PORTAS SERIAIS?
Olá, pessoal.
Alguém sabe me dizer se tem como saber a quantidade de portas seriais tem em cada micro através do VB?
E alguém teria algum exemplo de como fazer isto?
Alguém sabe me dizer se tem como saber a quantidade de portas seriais tem em cada micro através do VB?
E alguém teria algum exemplo de como fazer isto?
Tente assim: Em um módulo:
Option Explicit
Private Declare Function ConfigurePort Lib "winspool.drv" Alias "ConfigurePortA" (ByVal pName As String, ByVal hwnd As Long, ByVal pPortName As String) As Long
Private Type PORTA
pPortName As String
pMonitorName As String
pDescription As String
fPortType As Long
Reserved As Long
End Type
Private Type BUFFER_PORTA
pPortName As Long
pMonitorName As Long
pDescription As Long
fPortType As Long
Reserved As Long
End Type
Private Declare Function EnumPorts Lib "winspool.drv" Alias "EnumPortsA" (ByVal pName As String, ByVal Level As Long, ByVal lpbPorts As Long, ByVal cbBuf As Long, pcbNeeded As Long, pcReturned As Long) As Long
Private Declare Function lstrlenW Lib "kernel32" (ByVal lpString As Long) As Long
Private Declare Sub CopyMem Lib "kernel32" Alias "RtlMoveMemory" (pTo As Any, uFrom As Any, ByVal lSize As Long)
Private Declare Function HeapAlloc Lib "kernel32" (ByVal hHeap As Long, ByVal dwFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function GetProcessHeap Lib "kernel32" () As Long
Private Declare Function HeapFree Lib "kernel32" (ByVal hHeap As Long, ByVal dwFlags As Long, lpMem As Any) As Long
Private Ports(0 To 100) As PORTA
Private Function TrimStr(strName As String) As String
Dim x As Integer
x = InStr(strName, vbNullChar)
If x 0 Then TrimStr = Left(strName, x - 1) Else TrimStr = strName
x = Empty
End Function
Private Function LPSTRtoSTRING(ByVal lngPointer As Long) As String
Dim lngLength As Long
lngLength = lstrlenW(lngPointer) * 2
LPSTRtoSTRING = String(lngLength, 0)
CopyMem ByVal StrPtr(LPSTRtoSTRING), ByVal lngPointer, lngLength
LPSTRtoSTRING = TrimStr(StrConv(LPSTRtoSTRING, vbUnicode))
End Function
Private Function GetAvailablePorts(ServerName As String) As Long
Dim ret As Long
Dim PortsStruct(0 To 100) As BUFFER_PORTA
Dim pcbNeeded As Long
Dim pcReturned As Long
Dim TempBuff As Long
Dim i As Integer
ret = EnumPorts(ServerName, 2, TempBuff, 0, pcbNeeded, pcReturned)
TempBuff = HeapAlloc(GetProcessHeap(), 0, pcbNeeded)
ret = EnumPorts(ServerName, 2, TempBuff, pcbNeeded, pcbNeeded, pcReturned)
If ret Then
CopyMem PortsStruct(0), ByVal TempBuff, pcbNeeded
For i = 0 To pcReturned - 1
Ports(i).pDescription = LPSTRtoSTRING(PortsStruct(i).pDescription)
Ports(i).pPortName = LPSTRtoSTRING(PortsStruct(i).pPortName)
Ports(i).pMonitorName = LPSTRtoSTRING(PortsStruct(i).pMonitorName)
Ports(i).fPortType = PortsStruct(i).fPortType
Next
End If
GetAvailablePorts = pcReturned
If TempBuff Then HeapFree GetProcessHeap(), 0, TempBuff
End Function
Public Function ChecaPortas(Ponteiro As Long) As String()
Dim NumPorts As Long
Dim i As Integer
Dim sMAT() As String
NumPorts = GetAvailablePorts("")
For i = 0 To NumPorts - 1
ReDim Preserve sMAT(i + 1)
If ConfigurePort(vbNullChar, Ponteiro, Ports(i).pPortName) 0 Then
sMAT(i) = Ports(i).pPortName & " OK"
Else
sMAT(i) = Ports(i).pPortName & " FALHA"
End If
Next i
ChecaPortas = sMAT
NumPorts = Empty
i = Empty
Erase sMAT
End Function
No Form, com um listbox (List1):
Option Explicit
Private Sub Command1_Click()
Dim a() As String
Dim T As Long
List1.Clear
a = ChecaPortas(Me.hwnd)
For T = LBound(a) To UBound(a)
List1.AddItem a(T)
Next
T = Empty
Erase a
End Sub
Option Explicit
Private Declare Function ConfigurePort Lib "winspool.drv" Alias "ConfigurePortA" (ByVal pName As String, ByVal hwnd As Long, ByVal pPortName As String) As Long
Private Type PORTA
pPortName As String
pMonitorName As String
pDescription As String
fPortType As Long
Reserved As Long
End Type
Private Type BUFFER_PORTA
pPortName As Long
pMonitorName As Long
pDescription As Long
fPortType As Long
Reserved As Long
End Type
Private Declare Function EnumPorts Lib "winspool.drv" Alias "EnumPortsA" (ByVal pName As String, ByVal Level As Long, ByVal lpbPorts As Long, ByVal cbBuf As Long, pcbNeeded As Long, pcReturned As Long) As Long
Private Declare Function lstrlenW Lib "kernel32" (ByVal lpString As Long) As Long
Private Declare Sub CopyMem Lib "kernel32" Alias "RtlMoveMemory" (pTo As Any, uFrom As Any, ByVal lSize As Long)
Private Declare Function HeapAlloc Lib "kernel32" (ByVal hHeap As Long, ByVal dwFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function GetProcessHeap Lib "kernel32" () As Long
Private Declare Function HeapFree Lib "kernel32" (ByVal hHeap As Long, ByVal dwFlags As Long, lpMem As Any) As Long
Private Ports(0 To 100) As PORTA
Private Function TrimStr(strName As String) As String
Dim x As Integer
x = InStr(strName, vbNullChar)
If x 0 Then TrimStr = Left(strName, x - 1) Else TrimStr = strName
x = Empty
End Function
Private Function LPSTRtoSTRING(ByVal lngPointer As Long) As String
Dim lngLength As Long
lngLength = lstrlenW(lngPointer) * 2
LPSTRtoSTRING = String(lngLength, 0)
CopyMem ByVal StrPtr(LPSTRtoSTRING), ByVal lngPointer, lngLength
LPSTRtoSTRING = TrimStr(StrConv(LPSTRtoSTRING, vbUnicode))
End Function
Private Function GetAvailablePorts(ServerName As String) As Long
Dim ret As Long
Dim PortsStruct(0 To 100) As BUFFER_PORTA
Dim pcbNeeded As Long
Dim pcReturned As Long
Dim TempBuff As Long
Dim i As Integer
ret = EnumPorts(ServerName, 2, TempBuff, 0, pcbNeeded, pcReturned)
TempBuff = HeapAlloc(GetProcessHeap(), 0, pcbNeeded)
ret = EnumPorts(ServerName, 2, TempBuff, pcbNeeded, pcbNeeded, pcReturned)
If ret Then
CopyMem PortsStruct(0), ByVal TempBuff, pcbNeeded
For i = 0 To pcReturned - 1
Ports(i).pDescription = LPSTRtoSTRING(PortsStruct(i).pDescription)
Ports(i).pPortName = LPSTRtoSTRING(PortsStruct(i).pPortName)
Ports(i).pMonitorName = LPSTRtoSTRING(PortsStruct(i).pMonitorName)
Ports(i).fPortType = PortsStruct(i).fPortType
Next
End If
GetAvailablePorts = pcReturned
If TempBuff Then HeapFree GetProcessHeap(), 0, TempBuff
End Function
Public Function ChecaPortas(Ponteiro As Long) As String()
Dim NumPorts As Long
Dim i As Integer
Dim sMAT() As String
NumPorts = GetAvailablePorts("")
For i = 0 To NumPorts - 1
ReDim Preserve sMAT(i + 1)
If ConfigurePort(vbNullChar, Ponteiro, Ports(i).pPortName) 0 Then
sMAT(i) = Ports(i).pPortName & " OK"
Else
sMAT(i) = Ports(i).pPortName & " FALHA"
End If
Next i
ChecaPortas = sMAT
NumPorts = Empty
i = Empty
Erase sMAT
End Function
No Form, com um listbox (List1):
Option Explicit
Private Sub Command1_Click()
Dim a() As String
Dim T As Long
List1.Clear
a = ChecaPortas(Me.hwnd)
For T = LBound(a) To UBound(a)
List1.AddItem a(T)
Next
T = Empty
Erase a
End Sub
BRUNOSALDANHA:
A Multi-I/O é usada e vista pelo sistema como uma porta serial e/ou paralela também. Espetou na máquina, a PCI detecta as extensões da placa e o S.O. (dependendo da versão) reconhece e instala os drivers necessários.
MARCELO:
Se estiver usando o MS-Comm (deve estar, eu esqueci), essa rotina aqui é BEM mais adequada. A rotina anterior retorna TODAS as portar, seriais e/ou paralelas e virtuais e o retorno dos testes não é muito preciso.
Option Explicit
Private Sub Command1_Click()
On Error Resume Next
Dim t As Long
For t = 1 To 16
Err.Clear
Comm.CommPort = t
If Not Comm.PortOpen = False Then Comm.PortOpen = False
Err.Clear
Comm.PortOpen = True
If Err.Number = 0 Then
List1.AddItem "Porta " & Str(t) & " ok"
Else
List1.AddItem "Porta " & Str(t) & " inválida (" & Err.Description & ")"
End If
Comm.PortOpen = False
Err.Clear
Next t
End Sub
A Multi-I/O é usada e vista pelo sistema como uma porta serial e/ou paralela também. Espetou na máquina, a PCI detecta as extensões da placa e o S.O. (dependendo da versão) reconhece e instala os drivers necessários.
MARCELO:
Se estiver usando o MS-Comm (deve estar, eu esqueci), essa rotina aqui é BEM mais adequada. A rotina anterior retorna TODAS as portar, seriais e/ou paralelas e virtuais e o retorno dos testes não é muito preciso.
Option Explicit
Private Sub Command1_Click()
On Error Resume Next
Dim t As Long
For t = 1 To 16
Err.Clear
Comm.CommPort = t
If Not Comm.PortOpen = False Then Comm.PortOpen = False
Err.Clear
Comm.PortOpen = True
If Err.Number = 0 Then
List1.AddItem "Porta " & Str(t) & " ok"
Else
List1.AddItem "Porta " & Str(t) & " inválida (" & Err.Description & ")"
End If
Comm.PortOpen = False
Err.Clear
Next t
End Sub
Marcelo, mesmo que você só tenha uma porta serial conectável, por exemplo a do mouse, quase sempre haverão outras, internas ou virtuais. No mÃnimo, serão duas e no máximo, 16 (seriais comuns).
Agora ainda, com o USB, essa capacidade passa á não ter um limite lógico.
Agora ainda, com o USB, essa capacidade passa á não ter um limite lógico.
Me.hWnd é o ponteiro da janela onde está o Command1. Esse ponteiro só está disponÃvel depois do form se desenhar, portanto não funcionaria no evento Form_load, por exemplo. Porisso o coloquei em um Command.
Quanto á matriz de texto, você pode substituir
a( ) = ChecaPortas(Me.hwnd)
por
a = ChecaPortas(SeuForm.hwnd) , onde SeuForm é o formulário de onde parte a chamada ás funções.
Quanto ao sMat, pode ser que não haja um retorno e nesse caso, a matriz não pode ser preenchida. Você pode fazer assim:
...
If Not UBound(sMat) (maior que) 0 Then
ReDim sMat(1)
sMAT(0) = Empty
End If
ChecaPortas = sMAT
...
Lembrando que a função ChecaPortas deve ter um retorno em forma de matriz de strings ( Ex.: Public Function.... .... As String() )
Quanto á matriz de texto, você pode substituir
a( ) = ChecaPortas(Me.hwnd)
por
a = ChecaPortas(SeuForm.hwnd) , onde SeuForm é o formulário de onde parte a chamada ás funções.
Quanto ao sMat, pode ser que não haja um retorno e nesse caso, a matriz não pode ser preenchida. Você pode fazer assim:
...
If Not UBound(sMat) (maior que) 0 Then
ReDim sMat(1)
sMAT(0) = Empty
End If
ChecaPortas = sMAT
...
Lembrando que a função ChecaPortas deve ter um retorno em forma de matriz de strings ( Ex.: Public Function.... .... As String() )
Verifique:
1- Se a função ChecaPortas está realmente retornando uma matriz de string, como eu havia citado. Para tanto, a declaração dela deve estar mais ou menos como:
Public Function ChecaPortas(parà ¢metros) As String()
2 - Se a variável matriz "a" não foi dimensionada com um valor fixo para suas dimensões. Deve ser dimensionada com suas dimensões em aberto, ex.:
Dim a() as String
1- Se a função ChecaPortas está realmente retornando uma matriz de string, como eu havia citado. Para tanto, a declaração dela deve estar mais ou menos como:
Public Function ChecaPortas(parà ¢metros) As String()
2 - Se a variável matriz "a" não foi dimensionada com um valor fixo para suas dimensões. Deve ser dimensionada com suas dimensões em aberto, ex.:
Dim a() as String
Public Function ChecaPortas(Ponteiro As Long) As String()
(Não deve haver espaços entre os parênteses após o String final)
(Não deve haver espaços entre os parênteses após o String final)
Me passe a função, como tem aà no sistema, por e-mail, ok?
Tópico encerrado , respostas não são mais permitidas