modconfig.bas

1、以DLL形式提供医生工作站 2、 根据【检查项目】

Attribute VB_Name = "modConfig"
Option Explicit
Public Const CONFIG_FILE_NAME = "htpacs.ini"
Public Const LOGIN_USERINFO = "login.ini"
Const SECTION_WORKSTATION = "WORKSTATION"
Const KEY_HOSPITAL_NAME = "HOSPITAL_NAME"
Const C_HOSPITAL_NAME = "翰佳科技"



'医院名称
Public HOSPITAL_NAME As String

'工作站名称
Public STATION_NAME As String

'服务器IP地址/名称
Public SERVER_IP As String

'本地IP地址/名称
Public DCM_LOCAL_ROOT As String

'DICOM 文件根目录
Public Const ROOT_DIRECTORY = "DICOM"

'工作站类型
Public STATION_TYPE As String


'TRUE 为以FTP 方式下载，FALSE 为以共享方式打开图片
'Public FASHION_OF_FTP As String


'读取配置文件中配置
'strConfigName为要读取的配置参数
'strConfigFileName为要读取的配置文件
'返回值ConfigResult为根据配置参数取得的配置
Public Function GetConfig(ByVal strConfigFileName As String, ByVal strConfigName As String) As String
    If Len(Trim(strConfigName)) <= 0 Or Len(Trim(strConfigFileName)) <= 0 Then
        GetConfig = ""
    End If
    
    strConfigName = Trim(strConfigName)
    Dim fs
    Dim hFile
    
    Dim strLine As String       '一行数据
    Dim strConfigResult As String   '存放配置结果
    Dim strConfigTmp   As String    '从一行数据中截取的与目标配置长度相同的字符串
    
    On Error GoTo ErrHandler
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set hFile = fs.OpenTextFile(strConfigFileName, 1, True)
    'If hFile = Nothing Then
    '    GetConfig = ""
    '    Exit Function
    'End If
    
    
    strLine = Trim(hFile.ReadLine)
    '读取的行中必须有=号存在，且=号的位置刚好为Len(strConfigName)+  1
    Do While Len(strLine) > 0
        If Len(strLine) >= (Len(strConfigName) + 2) And _
            InStr(strLine, "=") = (Len(strConfigName) + 1) Then
            
            strConfigTmp = left(strLine, Len(strConfigName))
            If StrComp(strConfigTmp, strConfigName) = 0 Then
                
                Dim nConfigResultCount As Integer
                nConfigResultCount = Len(strLine) - (Len(strConfigName) + 1)
                GetConfig = Right(strLine, nConfigResultCount)
                
                Exit Function
            End If
            
        End If
        
        strLine = Trim(hFile.ReadLine)
    Loop
    
    hFile.Close
    Exit Function
ErrHandler:
    
    GetConfig = ""
        
    
End Function


'从配置文件获取医院名称
'作者：冷家锋
'时间：2009-2-12 14：51
Public Function GetHospitalNameFromConfig() As String
    On Error GoTo ErrHandler
    Dim strErr As String
    GetHospitalNameFromConfig = GetValueByKeyName(SECTION_WORKSTATION, _
        KEY_HOSPITAL_NAME, App.Path + "\" + CONFIG_FILE_NAME, strErr)
    Exit Function
ErrHandler:
    GetHospitalNameFromConfig = C_HOSPITAL_NAME

End Function



'根据给定键信息获取其值
'p_strSection<IN>:节名
'p_strKey<IN>:要获取的键
'p_strConfigFilePath<IN>:配置文件的路径
'p_strErr<OUT>:函数执行过程的错误信息
Public Function GetValueByKeyName(ByVal p_strSection As String, _
    ByVal p_strKey As String, ByVal p_strConfigFilePath As String, _
    ByRef p_strErr As String) As String
On Error GoTo ErrHandler
    'Const IN_MONITOR_NAME_PREFIX = "\\.\Display"

    Dim nRet As Long
    Dim strMonitorName As String
    strMonitorName = Space(256)
  
    nRet = GetPrivateProfileString(p_strSection, p_strKey, "", _
        strMonitorName, 256, p_strConfigFilePath)
    
   
    strMonitorName = left$(Trim(strMonitorName), nRet)
    
    strMonitorName = DelInvaildChr(strMonitorName)
    'strMonitorName = IN_MONITOR_NAME_PREFIX + strMonitorName

    GetValueByKeyName = strMonitorName
    Exit Function
ErrHandler:
    p_strErr = Err.Description
    GetValueByKeyName = ""
End Function