home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic 4 Power Pack / Visual_Basic4_Power_Pack.bin / vb4files / pclvbw11 / selfline.bas < prev    next >
Encoding:
BASIC Source File  |  1996-11-20  |  3.1 KB  |  121 lines
  1. Option Explicit
  2.  
  3. Function GetDosMemory (ByVal SizeCode As Integer)
  4.   Dim Size As Long
  5.   Dim Value As Long
  6.   If SizeCode > Size32K Then
  7.     SELFTEST.Print "SizeCode out of range"
  8.     GetDosMemory = 0
  9.     Exit Function
  10.   End If
  11.   Size = 2 ^ (SizeCode + 4)
  12.   Value = GlobalDosAlloc(Size)
  13.   If Value Then
  14.     'return selector
  15.     GetDosMemory = (&HFFFF& And Value)
  16.   Else
  17.     SELFTEST.Print "Cannot allocate Dos memory ("; Size; ")"
  18.     GetDosMemory = 0
  19.   End If
  20.  
  21. End Function
  22.  
  23. Function GoOnline (ByVal ThePort As Integer)
  24.   Dim Selector As Integer
  25.   Dim I As Integer
  26.   Dim Code As Integer
  27.   'allocating RX buffer
  28.   Selector = GetDosMemory(Size1024)
  29.   Code = SioRxBuf(ThePort, Selector, Size1024)
  30.   If Code < 0 Then
  31.     SELFTEST.Print "Cannot allocate RX buffer"
  32.     Exit Function
  33.   End If
  34.   'save selector
  35.   SelectorList(NbrSelectors) = Selector
  36.   NbrSelectors = NbrSelectors + 1
  37.   'allocate TX buffer
  38.   Selector = GetDosMemory(Size1024)
  39.   Code = SioTxBuf(ThePort, Selector, Size1024)
  40.   If Code < 0 Then
  41.     SELFTEST.Print "Cannot allocate TX buffer"
  42.     Exit Function
  43.   End If
  44.   'save selector
  45.   SelectorList(NbrSelectors) = Selector
  46.   NbrSelectors = NbrSelectors + 1
  47.   'reset the port
  48.   Code = SioReset(ThePort, Baud38400)
  49.   If Code < 0 Then
  50.     Call SioError(SELFTEST, Code)
  51.     Exit Function
  52.   End If
  53.   SELFTEST.Print "COM" + LTrim$(Str$(1 + ThePort)) + " reset"
  54.   'set DTR & RTS
  55.   Code = SioDTR(ThePort, Asc("S"))
  56.   Code = SioRTS(ThePort, Asc("S"))
  57.   'turn on hardware flow control
  58.   Code = SioFlow(ThePort, 18)
  59.   SELFTEST.Print "RTS/CTS flow control on"
  60.   'turn on UART FIFO if 16550
  61.   Code = SioFIFO(ThePort, LEVEL_8)
  62.   If Code > 0 Then
  63.     SELFTEST.Print "16550 Detected"
  64.   End If
  65.   ' set parms
  66.   Code = SioParms(ThePort, NoParity, OneStopBit, WordLength8)
  67.   Code = SioRxClear(ThePort)
  68.   Code = SioTxClear(ThePort)
  69.   'are TX interrupts enabled ?
  70.   If SioInfo(Asc("I")) > 0 Then
  71.     SELFTEST.Print "TX interrupts enabled"
  72.   Else
  73.     SELFTEST.Print "TX interrupts not enabled"
  74.   End If
  75.   ' we're online !
  76.   GoOnline = 1
  77. End Function
  78.  
  79. Sub Loopback (ByVal Port As Integer)
  80. SELFTEST.Print "Loopback test: ";
  81. If SioLoopBack(Port) Then
  82.   SELFTEST.Print "FAILS";
  83. Else
  84.   SELFTEST.Print "SUCCESS";
  85. End If
  86.   SELFTEST.Print " for COM"; LTrim$(Str$(1 + Port))
  87. End Sub
  88.  
  89. Sub ShowCaption ()
  90.   Dim A As String
  91.   Dim B As String
  92.   A = "COM" + LTrim$(Str$(1 + The1stPort))
  93.   B = "COM" + LTrim$(Str$(1 + The2ndPort))
  94.   SELFTEST.Caption = "SelfTest: " + A + " ===> " + B
  95. End Sub
  96.  
  97. Sub ShowConfig ()
  98.   Dim Version As Integer
  99.   Version = SioInfo(Asc("V"))
  100.   SELFTEST.Print "*** SELFTEST 1.0"
  101.   SELFTEST.Print "*** PCL4VBW Version ";
  102.   SELFTEST.Print LTrim$(Str$(Version \ 16)) + ".";
  103.   SELFTEST.Print LTrim$(Str$(Version Mod 16))
  104. End Sub
  105.  
  106. Sub ShutDown ()
  107.   Dim I As Integer
  108.   Dim Code As Integer
  109.   Code = SioDone(The1stPort)
  110.   Code = SioDone(The2ndPort)
  111.   If NbrSelectors > 0 Then
  112.   '''SELFTEST.Print "Freeing "; NbrSelectors; " selectors"
  113.    For I = 0 To NbrSelectors - 1
  114.      '''Code = GlobalPageUnlock(SelectorList(I))
  115.      Code = GlobalDosFree(SelectorList(I))
  116.    Next I
  117.    NbrSelectors = 0
  118.   End If
  119. End Sub
  120.  
  121.