home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 3_2004-2005.ISO / Data / Zips / Thermomete1771207182004.psc / io.bas < prev    next >
BASIC Source File  |  2003-06-05  |  4KB  |  170 lines
  1. Attribute VB_Name = "io"
  2. ' This module can be used to implement
  3. ' your own external devices for Emu8086 -
  4. ' 8086 Microprocessor Emulator.
  5. ' Device can be written in Visual Basic
  6. ' (for C/C++/MS Visual C++ use "IO.H" instead).
  7.  
  8. ' Supported input / output addresses:
  9. '                  15 to 65535 (0000Fh - 0FFFFh)
  10.  
  11. ' Version 2.12 of Emu8086 or above is required,
  12. ' check this URL for the latest version:
  13. ' http://www.emu8086.com
  14.  
  15. ' You don't need to understand the code of this
  16. ' module, just add this file ("io.bas") into your
  17. ' project, and use these functions:
  18. '
  19. '    READ_IO_BYTE(lPORT_NUM As Long) As Byte
  20. '    READ_IO_WORD(lPORT_NUM As Long) As Integer
  21. '
  22. ' and subs:
  23. '
  24. '    WRITE_IO_BYTE(lPORT_NUM As Long, uValue As Byte)
  25. '    WRITE_IO_WORD(lPORT_NUM As Long, iValue As Integer)
  26. '
  27. ' Where:
  28. '  lPORT_NUM - is a number in range: from 15 to 65535.
  29. '  uValue    - unsigned byte value to be written to a port.
  30. '  iValue    - signed word value to be written to a port.
  31.  
  32.  
  33.  
  34.  
  35.  
  36. Option Explicit
  37.  
  38. Public Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
  39. Dim sTemp As String * 500
  40. Dim lTSize As Long
  41.  
  42. ' 2.12#611
  43. Const sIO_FILE = "EmuPort.io"
  44.  
  45. Function READ_IO_BYTE(lPORT_NUM As Long) As Byte
  46. On Error GoTo err_rib
  47.  
  48. Dim sFileName As String
  49. Dim tb As Byte
  50. Dim fNum As Integer
  51.  
  52. lTSize = GetTempPath(499, sTemp)
  53. sFileName = Mid(sTemp, 1, lTSize)
  54. sFileName = AddTrailingSlash(sFileName) & sIO_FILE
  55.  
  56. fNum = FreeFile
  57.  
  58. Open sFileName For Random As fNum Len = 1
  59.  
  60. ' File's first byte has Index 1 in VB
  61. ' compatibility for Port 0:
  62. Get fNum, lPORT_NUM + 1, tb
  63.  
  64. Close fNum
  65.  
  66.  
  67. READ_IO_BYTE = tb
  68.  
  69.  
  70. Exit Function
  71. err_rib:
  72. Debug.Print "READ_IO_BYTE: " & Err.Description
  73. Close fNum
  74.  
  75. End Function
  76.  
  77. Sub WRITE_IO_BYTE(lPORT_NUM As Long, uValue As Byte)
  78. On Error GoTo err_wib
  79.  
  80. Dim sFileName As String
  81. Dim fNum As Integer
  82.  
  83. lTSize = GetTempPath(499, sTemp)
  84. sFileName = Mid(sTemp, 1, lTSize)
  85. sFileName = AddTrailingSlash(sFileName) & sIO_FILE
  86.  
  87. fNum = FreeFile
  88.  
  89.  
  90. Open sFileName For Random As fNum Len = 1
  91.  
  92. ' File's first byte has Index 1 in VB
  93. ' compatibility for Port 0:
  94. Put fNum, lPORT_NUM + 1, uValue
  95.  
  96. Close fNum
  97.  
  98. Exit Sub
  99. err_wib:
  100. Debug.Print "WRITE_IO_BYTE: " & Err.Description
  101. Close fNum
  102. End Sub
  103.  
  104.  
  105. Function READ_IO_WORD(lPORT_NUM As Long) As Integer
  106. Dim tb1 As Byte
  107. Dim tb2 As Byte
  108.  
  109.     ' Read lower byte:
  110.     tb1 = READ_IO_BYTE(lPORT_NUM)
  111.     ' Write higher byte:
  112.     tb2 = READ_IO_BYTE(lPORT_NUM + 1)
  113.  
  114.     READ_IO_WORD = make16bit_SIGNED_WORD(tb1, tb2)
  115. End Function
  116.  
  117.  
  118. Sub WRITE_IO_WORD(lPORT_NUM As Long, iValue As Integer)
  119. Dim tb1 As Byte
  120. Dim tb2 As Byte
  121.  
  122.    ' Write lower byte:
  123.    WRITE_IO_BYTE lPORT_NUM, iValue And 255 ' 00FF
  124.    ' Write higher byte:
  125.    WRITE_IO_BYTE lPORT_NUM + 1, (iValue And 65280) / 256 ' FF00 >> 8
  126. End Sub
  127.  
  128. ' This function corrects the file path by adding "\"
  129. ' in the end if required:
  130. Function AddTrailingSlash(sPath As String) As String
  131.   
  132.     If (sPath <> "") Then
  133.         If (Mid(sPath, Len(sPath), 1) <> "\") Then
  134.           AddTrailingSlash = sPath & "\"
  135.           Exit Function
  136.         End If
  137.     End If
  138.   
  139.     AddTrailingSlash = sPath
  140.   
  141. End Function
  142.  
  143. Function make16bit_SIGNED_WORD(ByRef byteL As Byte, ByRef byteH As Byte) As Integer
  144.     Dim temp As Long
  145.     
  146.     ' lower byte - on lower address!
  147.     ' byte1 - lower byte!
  148.     
  149.     temp = byteH
  150.     temp = temp * 256 ' shift left by 8 bit.
  151.     temp = temp + byteL
  152.     
  153.     
  154.     make16bit_SIGNED_WORD = make_signed_int(temp)
  155. End Function
  156.  
  157. ' Makes a Long to be a SIGNED Integer:
  158.  Function make_signed_int(l As Long) As Integer
  159.     If l >= -32768 And l < 65536 Then
  160.         If l <= 32767 Then
  161.             make_signed_int = l
  162.         Else
  163.             make_signed_int = l - 65536
  164.         End If
  165.     Else
  166.         make_signed_int = 0
  167.         MsgBox "Wrong param calling make_signed_int(): " & l
  168.     End If
  169. End Function
  170.