module1.bas

目前只支持 s51

Attribute VB_Name = "Comm"
Option Explicit

Declare Function GetPortVal Lib "WinIo.dll" (ByVal PortAddrr As Integer, ByRef Portval As Long, ByVal bSize As Byte) As Boolean
Declare Function SetPortVal Lib "WinIo.dll" (ByVal PortAddrr 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

Private Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Integer, ByVal lpFileName As String) As Integer
Private Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal Appname As String, ByVal KeyName As Any, ByVal NewString As Any, ByVal Filename As String) As Integer

'利用计算机频率作定时器
Private Type LARGE_INTEGER
    lowpart As Long
    highpart As Long
End Type

Private Declare Function QueryPerformanceCounter Lib "kernel32" (lpPerformanceCount As LARGE_INTEGER) As Long
Private Declare Function QueryPerformanceFrequency Lib "kernel32" (lpFrequency As LARGE_INTEGER) As Long


Public PTRDataPort As Long  '并口地址
Public PTRStatPort As Long
Public PTRCtrlPort As Long
Public RST As Integer         '对应并口引脚
Public SCK As Integer
Public MOSI As Integer
Public MISO As Integer
Public OE As Integer
Public LE As Integer
Public OEE As Boolean
Public LEE As Boolean
Public OED As Boolean
Public LED As Boolean

Public OutBuf(0 To 255) As Byte, InBuf(0 To 255) As Byte
Public CtrlCode As Byte, DataCode As Byte, StatCode As Byte
Public SignString As String
Public HexFileNameStr As String
Public DelayTime As Long
Public SysIniFileName As String
Public ChipTypeFileName As String
Public FileCodeLen As Long
Public ChipRom As Integer
Public ChipPID As Integer
Public ChipRSign As String '读代码特征字
Public ChipWSign As String '写代码特征字
Public ChipRRsign As String '读特征字的特征字
Public ChipEsign As String '擦除的特征字
Public MaxLen As Long


Type ChipType
     PID As Integer
     Rom As Integer
     Sign As String
     RRsign As String
     RSign As String
     WSign As String
     ESign As String
End Type

Sub InitPort()
 PTRDataPort = GetSysIni(SysIniFileName, "并口地址", "PTRADD", &H378) '并口地址
 PTRStatPort = PTRDataPort + 1
 PTRCtrlPort = PTRDataPort + 2
 RST = GetSysIni(SysIniFileName, "引脚控制", "RST", 16) '对应并口引脚
 SCK = GetSysIni(SysIniFileName, "引脚控制", "SCK", 1)
 MOSI = GetSysIni(SysIniFileName, "引脚控制", "MOSI", 14)
 MISO = GetSysIni(SysIniFileName, "引脚控制", "MISO", 15)
 OE = GetSysIni(SysIniFileName, "引脚控制", "OE", 2)
 LE = GetSysIni(SysIniFileName, "引脚控制", "LE", 17)
 OEE = GetSysIni(SysIniFileName, "输出控制(OE)", "Enable", 0)
 LEE = GetSysIni(SysIniFileName, "锁存控制(LE)", "Enable", 1)
 OED = GetSysIni(SysIniFileName, "输出控制(OE)", "Disable", 1)
 LED = GetSysIni(SysIniFileName, "锁存控制(LE)", "Disable", 1)
 
End Sub

Public Function GetSysIni(ByVal IniFile$, ByVal Key$, ByVal KeyName$, ByVal lpDefault As String) As String
On Error Resume Next
Dim retval As Integer
Dim T As String * 255
   retval = GetPrivateProfileString(Key$, KeyName$, lpDefault, T, Len(T), IniFile)
   If retval > 0 Then
      GetSysIni = Left$(T, retval)
   Else
      GetSysIni = lpDefault
   End If
End Function

Public Function SaveSysIni(ByVal IniFile$, ByVal Key$, ByVal KeyName$, ByVal Value$)
  On Error Resume Next
  SaveSysIni = WritePrivateProfileString(Key$, KeyName$, Value$, IniFile)
End Function

Sub DelayUS(N_us As Long)   '*******************   延时,N_us 个1uS
   On Error Resume Next
    Dim lim As LARGE_INTEGER
    Dim limA As LARGE_INTEGER
    Dim limB As LARGE_INTEGER
    Dim iCount As Long
    QueryPerformanceFrequency lim
    QueryPerformanceCounter limB
  Do
    QueryPerformanceCounter limA
    'If YunX = False Then Exit Sub
    iCount = (limA.lowpart - limB.lowpart) / lim.lowpart * 1000 * 1000 * 10
  Loop Until iCount >= N_us
End Sub

Sub ShowMsg(msg As String)
 If Form1.List1.ListCount > 500 Then Form1.List1.Clear
 Form1.List1.AddItem msg, 0
End Sub


Public Function ReAddrata() As Byte
  Dim Val As Long
  GetPortVal PTRDataPort, Val, 1
  ReAddrata = CByte(Val)
End Function


Public Sub WriteData(Dat As Byte)
   SetPortVal PTRDataPort, CLng(Dat), 1
End Sub


Public Function ReadState() As Byte
  Dim Val As Long
  GetPortVal PTRStatPort, Val, 1
  ReadState = CByte(Val)
End Function

Public Function ReadCtrl() As Byte
  Dim Val As Long
  GetPortVal PTRCtrlPort, Val, 1
  ReadCtrl = CByte(Val)
End Function

Public Sub WriteCtrl(Ctrl As Byte)
   SetPortVal PTRCtrlPort, CLng(Ctrl), 1
End Sub



Public Function SetPinH(nPin As Integer) As Boolean

   If (nPin = 0) Then SetPinH = False
    
   Select Case nPin
     
    Case 1
        CtrlCode = CtrlCode And &HFE
        WriteCtrl CtrlCode
        SetPinH = True
    Case 2
        DataCode = DataCode And &H1
        WriteData DataCode
        SetPinH = True
    Case 3
        DataCode = DataCode And &H2
        WriteData DataCode
        SetPinH = True
    Case 4
        DataCode = DataCode And &H4
        WriteData DataCode
        SetPinH = True
    Case 5
        DataCode = DataCode And &H8
        WriteData DataCode
        SetPinH = True
    Case 6
        DataCode = DataCode And &H10
        WriteData DataCode
        SetPinH = True
    Case 7
        DataCode = DataCode And &H20
        WriteData DataCode
        SetPinH = True
    Case 8
        DataCode = DataCode And &H40
        WriteData DataCode
        SetPinH = True
    Case 9
        DataCode = DataCode And &H80
        WriteData DataCode
        SetPinH = True
    Case 14
        CtrlCode = CtrlCode And &HFD
        WriteCtrl CtrlCode
        SetPinH = True
    Case 16
        CtrlCode = CtrlCode Or &H4
        WriteCtrl CtrlCode
        SetPinH = True
    Case 17
        CtrlCode = CtrlCode And &HF7
        WriteCtrl CtrlCode
        SetPinH = True
    Case Else
        SetPinH = False
    End Select
End Function

Public Function SetPinL(nPin As Integer) As Boolean
   
   If (nPin = 0) Then SetPinL = False
   
   Select Case nPin
    Case 1
        CtrlCode = CtrlCode Or &H1
        WriteCtrl CtrlCode
        SetPinL = True
    Case 2
        DataCode = DataCode And &HFE
        WriteData DataCode
        SetPinL = True
    Case 3
        DataCode = DataCode And &HFD
        WriteData DataCode
        SetPinL = True
    Case 4
        DataCode = DataCode And &HFB
        WriteData DataCode
        SetPinL = True
    Case 5
        DataCode = DataCode And &HF7
        WriteData DataCode
        SetPinL = True
    Case 6
        DataCode = DataCode And &HEF
        WriteData DataCode
        SetPinL = True
    Case 7
        DataCode = DataCode And &HDF
        WriteData DataCode
        SetPinL = True
    Case 8
        DataCode = DataCode And &HBF
        WriteData DataCode
        SetPinL = True
    Case 9
        DataCode = DataCode And &H7F
        WriteData DataCode
        SetPinL = True
    Case 14
        CtrlCode = CtrlCode Or &H2
        WriteCtrl CtrlCode
        SetPinL = True
    Case 16
        CtrlCode = CtrlCode And &HFB
        WriteCtrl CtrlCode
        SetPinL = True
    Case 17
        CtrlCode = CtrlCode Or &H8
        WriteCtrl CtrlCode
        SetPinL = True
    Case Else
        SetPinL = False
    End Select
End Function

Public Function SetPinLogic(nPin As Integer, bLogic As Boolean) As Boolean

   
If (bLogic) Then
    If (nPin = 0) Then SetPinLogic = False
    Select Case nPin
    Case 1
        CtrlCode = CtrlCode And &HFE
        WriteCtrl CtrlCode
        SetPinLogic = True
    Case 2
        DataCode = DataCode Or &H1
        WriteData DataCode
        SetPinLogic = True
    Case 3
        DataCode = DataCode Or &H2
        WriteData DataCode
        SetPinLogic = True
    Case 4
        DataCode = DataCode Or &H4
        WriteData DataCode
        SetPinLogic = True
    Case 5
        DataCode = DataCode Or &H8
        WriteData DataCode
        SetPinLogic = True
    Case 6
        DataCode = DataCode Or &H10
        WriteData DataCode
        SetPinLogic = True
    Case 7
        DataCode = DataCode Or &H20
        WriteData DataCode
        SetPinLogic = True
    Case 8
        DataCode = DataCode Or &H40
        WriteData DataCode
        SetPinLogic = True
    Case 9
        DataCode = DataCode Or &H80
        WriteData DataCode