Estou com problemas em uma Rotina que Funciona no Windows 98 e ME, mas não funciona nos Windows NT/XP/2000/2003.

Pensei que era problema do Windows, mas Vi um Exemplo feito em VB 6 e funciona Certinho.

Já estou trabalhando nisto ha varios dias. Sem resultado. Esta WinIO, pode ser baixada em http://www.internals.com

Este código é para Acessar um Display de 44 Teclas do Teclado Keytec. O suporte diz que não pode fazer nada, ja que em VB6 funciona, é sinal que o problema esta no VFP.

Alguem já se deparou com um problema como este, e poderia me ajudar ?


Segue primeiro o Código em VFP :
No Intit do form vai este codigo :

Thisform.txtEnd.Value   = [60]  && valor em HexaDecimal do Endereço do Teclado no Computador.
Thisform.txtTempo.Value = 500

Declare  MapPhysToLin        IN  "WinIo.dll" Long PhysAddr,Long PhysSize,LONG @PhysMemHandle 
Declare  UnmapPhysicalMemory IN  "WinIo.dll" LONG PhysMemHandle, long  LinAddr
Declare  GetPhysLong         IN  "WinIo.dll" LONG PhysAddr,LONG @PhysVal 
Declare  SetPhysLong         IN  "WinIo.dll" LONG PhysAddr,LONG  PhysVal 
Declare  GetPortVal          IN  "WinIo.dll" INTEGER PortAddr , LONG  @PortVal ,INTEGER bSize 
Declare  SetPortVal          IN  "WinIo.dll" INTEGER PortAddr , LONG  PortVal  ,INTEGER bSize 
Declare  InitializeWinIo     IN  "WinIo.dll" 
Declare  ShutdownWinIo       IN  "WinIo.dll" 
NUMLOCK(.f.)
ON KEY LABEL F10 KEYBOARD CHR(255) PLAIN
nResult = InitializeWinIo()

Codigo de um commandButton para enviar dados para o display :

LOCAL lcString,i

lcString = [ENVIANDO DADOS PARA O DISPLAY]
Thisform.envia([08])
FOR I=1 TO LEN(lcString)
	Thisform.envia( SUBSTR(lcString,i,1) )
ENDFOR

Thisform.envia([09])

FUNCTION Envia
LPARAMETERS lcString

	lnEnd  = Thisform.hex2dec( Thisform.txtEnd.Value )
	lnDado = ASC(lcString)
	result = SetPortVal( lnEnd,lnDado,1 )
		
	FOR i = 1 TO thisform.txtTempo.Value 
	ENDFOR
	
RETURN .T.	

Agora o Código em VB6 :

Attribute VB_Name = "Module1"
Option Explicit

Global XDelay As Integer

Declare Function MapPhysToLin Lib "WinIo.dll" (ByVal PhysAddr As Long, ByVal PhysSize As Long, ByRef PhysMemHandle) As Long
Declare Function UnmapPhysicalMemory Lib "WinIo.dll" (ByVal PhysMemHandle, ByVal LinAddr) As Boolean
Declare Function GetPhysLong Lib "WinIo.dll" (ByVal PhysAddr As Long, ByRef PhysVal As Long) As Boolean
Declare Function SetPhysLong Lib "WinIo.dll" (ByVal PhysAddr As Long, ByVal PhysVal As Long) As Boolean
Declare Function GetPortVal Lib "WinIo.dll" (ByVal PortAddr As Integer, ByRef PortVal As Long, ByVal bSize As Byte) As Boolean
Declare Function SetPortVal Lib "WinIo.dll" (ByVal PortAddr As Integer, ByVal PortVal As Long, ByVal bSize As Byte) As Boolean
Declare Function InitializeWinIo Lib "WinIo.dll" () As Boolean
Declare Function ShutdownWinIo Lib "WinIo.dll" () As Boolean



Function ENVIA(ENDERECO As String, CARACTER As String)
    Dim Result As Boolean
    Dim ENDER As Integer
    Dim DADO As Byte
    Dim SDADO As Integer
    Dim I As Double
    Dim Tempo As Double
  
    ENDER = Val("&H" & ENDERECO)
    DADO = Val("&H" & CARACTER)
    SDADO = Len(DADO)
    Result = SetPortVal(ENDER, DADO, SDADO)
    Tempo = 500
    If Val(XDelay) < 10 Then
        Tempo = Tempo * 10
    Else
        Tempo = Tempo * Val(XDelay)
    End If

    I = 0
    Do
        I = I + 1
        If I = Tempo Then Exit Do
    Loop
  
End Function

Private Sub UserControl_Initialize()
    If InitializeWinIo = False Then
        Err.Raise "50000", "OCX Keytec WinIO", "Erro ao Tentar Inicializar o WinIO"
    End If
End Sub


Public Function Envia_Mensagem(ByVal Mensagem As Variant)
    Dim o As Integer
    On Error GoTo Envia_Mensagem_Erro
    ENVIA "60", "08"
    For o = 1 To Len(Mensagem)
        ENVIA "60", Hex(Asc(Mid(Mensagem, o, 1)))
    Next o
    ENVIA "60", "09"
    Exit Function
Envia_Mensagem_Erro:
    Err.Raise "50000", "OCX Keytec WinIO", "Erro ao Tentar Enviar Mensagem para o WinIO"
End Function

Public Function Envia_Comando(ByVal Comando As Variant)
    Dim o As Integer
    Dim XDado As String
    On Error GoTo Envia_Comando_Erro
    XDado = Comando
    ENVIA "60", "A0"
    ENVIA "60", XDado
    Exit Function
Envia_Comando_Erro:
    Err.Raise "50000", "OCX Keytec WinIO", "Erro ao Tentar Enviar Comando para o WinIO"
End Function

Public Property Get Delay_Envio() As Variant
    Delay_Envio = XDelay
End Property

Public Property Let Delay_Envio(ByVal Novo_Delay As Variant)
    XDelay = Novo_Delay
    PropertyChanged "Delay_Envio"
End Property

Private Sub UserControl_InitProperties()
    XDelay = 10
End Sub

Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
    XDelay = PropBag.ReadProperty("Delay_Envio", "10")
End Sub

Private Sub UserControl_Terminate()
    On Error GoTo UserControl_Terminate_Erro
    Call ShutdownWinIo
    Exit Sub
UserControl_Terminate_Erro:
    Err.Raise "50001", "OCX Keytec WinIO", "Erro ao Tentar Finalizar o WinIO"
End Sub

Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
    Call PropBag.WriteProperty("Delay_Envio", XDelay, "10")
End Sub