basdef.bas

气体流动仪控制软件 属于工业控制软件 delphi开发

Attribute VB_Name = "basdef"
Option Explicit
'=========================================================================
'=======================以下为系统底层函数定义============================
'=========================================================================
''ado.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=C:\db1.MDB;Persist Security Info=False"
''ado.RecordSource = "Authors"
''ado.Refresh
''ado.Recordset.MoveLast

Declare Function WritePrivateProfileString Lib "Kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long
'保存参数
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 Long, ByVal lpFileName As String) As Long
'读取参数
Public Const SW_SHOWNORMAL = 1
Public Const SW_RESTORE = 9
Public Const SW_SHOWDEFAULT = 10
'窗体显示常数,用于ShowWindow函数
Declare Function WinExec Lib "Kernel32" (ByVal lpCmdLine As String, ByVal nCmdShow As Long) As Long
'执行程序
Declare Function CloseWindow Lib "user32" (ByVal hwnd As Long) As Long
'关闭窗口
Declare Function AttachThreadInput Lib "user32" (ByVal idAttach As Long, ByVal idAttachTo As Long, ByVal fAttach As Long) As Long
'连接线程
Declare Function GetCurrentThreadId Lib "Kernel32" () As Long
'取自己的线程
Declare Function GetForegroundWindow Lib "user32" () As Long
'取前台句柄
Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
'取前台线程
Declare Function IsWindow Lib "user32" (ByVal hwnd As Long) As Long
'确定窗口是否存在
Declare Function IsChild Lib "user32" (ByVal hWndParent As Long, ByVal hwnd As Long) As Long
'判断是否子窗体
Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
'显示窗体
Declare Function GetLastError Lib "Kernel32" () As Long
'查询错误
Declare Function GetCommandLine Lib "Kernel32" Alias "GetCommandLineA" () As String
'得到命令行参数
Declare Function RegEnumValue Lib "advapi32.dll" Alias "RegEnumValueA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpValueName As String, lpcbValueName As Long, lpReserved As Long, lpType As Long, lpData As Byte, lpcbData As Long) As Long
'读注册表
Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
'打开注册表
Declare Function RegCloseKey Lib "advapi32" (ByVal hKey As Long) As Long
'关闭注册表
Public Const HKEY_LOCAL_MACHINE = &H80000002
Public Const SYNCHRONIZE = &H100000
Public Const READ_CONTROL = &H20000
Public Const STANDARD_RIGHTS_READ = (READ_CONTROL)
Public Const KEY_QUERY_VALUE = &H1
Public Const KEY_NOTIFY = &H10
Public Const KEY_ENUMERATE_SUB_KEYS = &H8
Public Const KEY_READ = ((STANDARD_RIGHTS_READ Or KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY) And (Not SYNCHRONIZE))
Public Const KEY_EXECUTE = (KEY_READ)
Public Const REG_SZ = 1               ' Unicode nul terminated string
Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, ByVal lpData As Any, lpcbData As Long) As Long        ' Note that if you declare the lpData parameter as String, you must pass it By Value.
'以上用于激发邮件程序
Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
'产生键码
Declare Function RegSetValue Lib "advapi32.dll" Alias "RegSetValueA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal dwType As Long, ByVal lpData As String, ByVal cbData As Long) As Long
'设置键值
Public Const HKEY_CLASSES_ROOT = &H80000000
'以上将.re注册为本应用程序文件
Public Const LF_FACESIZE = 32
Type LOGFONT
        lfHeight As Long
        lfWidth As Long
        lfEscapement As Long
        lfOrientation As Long
        lfWeight As Long
        lfItalic As Byte
        lfUnderline As Byte
        lfStrikeOut As Byte
        lfCharSet As Byte
        lfOutPrecision As Byte
        lfClipPrecision As Byte
        lfQuality As Byte
        lfPitchAndFamily As Byte
        lfFaceName(LF_FACESIZE) As Byte
End Type
Declare Function CreateFontIndirect Lib "gdi32" Alias "CreateFontIndirectA" (lpLogFont As LOGFONT) As Long
'产生字体
Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
'选择对象
Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
'删除对象
'以上用于产生旋转字体
Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
'激发文件
Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hwnd As Long) As Long
'用于设置状态栏
'---------------------2000---------------------------------------

Public Declare Function DlPortReadPortUchar Lib "dlportio.dll" (ByVal Port As Long) As Byte
Public Declare Function DlPortReadPortUshort Lib "dlportio.dll" (ByVal Port As Long) As Integer
Public Declare Function DlPortReadPortUlong Lib "dlportio.dll" (ByVal Port As Long) As Long

Public Declare Sub DlPortReadPortBufferUchar Lib "dlportio.dll" (ByVal Port As Long, buffer As Any, ByVal count As Long)
Public Declare Sub DlPortReadPortBufferUshort Lib "dlportio.dll" (ByVal Port As Long, buffer As Any, ByVal count As Long)
Public Declare Sub DlPortReadPortBufferUlong Lib "dlportio.dll" (ByVal Port As Long, buffer As Any, ByVal count As Long)

Public Declare Sub DlPortWritePortUchar Lib "dlportio.dll" (ByVal Port As Long, ByVal Value As Byte)
Public Declare Sub DlPortWritePortUshort Lib "dlportio.dll" (ByVal Port As Long, ByVal Value As Integer)
Public Declare Sub DlPortWritePortUlong Lib "dlportio.dll" (ByVal Port As Long, ByVal Value As Long)

Public Declare Sub DlPortWritePortBufferUchar Lib "dlportio.dll" (ByVal Port As Long, buffer As Any, ByVal count As Long)
Public Declare Sub DlPortWritePortBufferUshort Lib "dlportio.dll" (ByVal Port As Long, buffer As Any, ByVal count As Long)
Public Declare Sub DlPortWritePortBufferUlong Lib "dlportio.dll" (ByVal Port As Long, buffer As Any, ByVal count As Long)


'=========================================================================
'=======================以下为系统公用变量定义============================
'=========================================================================


Public Const Cardbase = 680 '板卡模拟量输入1232
Public Const CardbaseB = 640 '板卡环压泵6210
Public Const CardbaseA = 672 '板卡输出6160

Public QYDQ As String      '取样地区
Public YYJH As String      '岩样井号
Public YPH As String       '样品号
Public YYTX As String      '岩样特性
Public YXZJ As Double      '岩心直径
Public YXCD As Double    '岩心长度
Public KXD As Double      '孔隙度
Public QYZQ As Double      '取样周期

Public SYFF As String '实验方法
Public P0 As Double '大气压
Public YYGZ As Double '岩样干重
Public BHZL As Double '饱和重量
Public BHJZ As String '饱和介质
Public BHND As Double '饱和介质粘度
Public BHMD As Double '饱和介质密度
Public BHKHD As Double '饱和介质矿化度

Public QTJZ As String '驱替介质
Public QTND As Double '驱替介质粘度
Public QTMD As Double '驱替介质密度


Public JKYL As Double      '驱替泵1进口压力
Public JKYL1 As Double     '驱替泵2进口压力
Public CKYL As Double      '出口压力回压
Public HY As Double       '环压
Public HYC As Double     '环压差
Public CY As Double     '差压
Public CY1 As Double    '差压1
Public WD As Double     '温度
Public DZ As Double     '电阻
Public R As Integer ' 环压泵转速
Public Tp As Double '天平采集值


Public Sxc As Double '上限行程
Public Xxc As Double '下限行程
Public DCF(0 To 7) As Integer  '电磁阀


Public SaveCon As ADODB.Connection ''数据库组件
Public SaveRst As ADODB.Recordset '
Public SaveFile As String      '数据文件






Public Function vbInp(ByVal Addrb As Long) As Integer
vbInp = DlPortReadPortUchar(Addrb)
End Function

Public Sub vbOut(ByVal Addrb As Long, ByVal Valuea As Byte)
DlPortWritePortUchar Addrb, Valuea
End Sub