resitry.bas

来自「本公司开发得大请油田人事管理系统c/s结构」· BAS 代码 · 共 80 行

Attribute VB_Name = "Resitry"
Option Explicit

Public 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 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
Public Const C_DATABASE_SECTION = "Database"
Public Const C_INI_FILE = "CQBureau.ini"
Public Const C_FAIL_DEAFULT = "not found"
Public Const C_BUFFER_MAX_LENGTH = 255
Public Const C_DATABASE_SERVER = "ServerName"
Public Const C_DATABASE_PASSWORD = "Password"
Public Const C_ADMIN_PASSWORD = "AdminPass"

Public g_str4DatabaseServerName As String * 255
Public g_str4DatabasePassword As String * 255
Public g_str4InitAdminPassword As String * 255

Public g_str4ServerName As String
Public g_str4Password As String
Public g_strOprrolePassword As String

Public g_saEncry As New FTACUTILLib.ODes

Public Function WriteConfigMsg() As Long
    Dim lResult As Long
    WriteConfigMsg = -1
    lResult = WritePrivateProfileString(C_DATABASE_SECTION, C_DATABASE_SERVER, g_str4ServerName, App.Path & "\" & C_INI_FILE)
    If lResult = 0 Then
        WriteConfigMsg = -1
        Exit Function
    Else
        WriteConfigMsg = 0
    End If
    lResult = WritePrivateProfileString(C_DATABASE_SECTION, C_DATABASE_PASSWORD, g_str4Password, App.Path & "\" & C_INI_FILE)
    If lResult = 0 Then
        WriteConfigMsg = -1
        Exit Function
    Else
        WriteConfigMsg = 0
    End If
    lResult = WritePrivateProfileString(C_DATABASE_SECTION, C_ADMIN_PASSWORD, g_strOprrolePassword, App.Path & "\" & C_INI_FILE)
    If lResult = 0 Then
        WriteConfigMsg = -1
        Exit Function
    Else
        WriteConfigMsg = 0
    End If
End Function
Public Function GetConfigMsg() As Long
    Dim lError As Long
    GetConfigMsg = -1
    lError = GetPrivateProfileString(C_DATABASE_SECTION, C_DATABASE_SERVER, C_FAIL_DEAFULT, g_str4DatabaseServerName, C_BUFFER_MAX_LENGTH, App.Path & "\" & C_INI_FILE)
    If lError >= C_BUFFER_MAX_LENGTH - 2 Or left(g_str4DatabaseServerName, 9) = C_FAIL_DEAFULT Then
        GetConfigMsg = -1
        Exit Function
    Else
        GetConfigMsg = 0
    End If
    lError = GetPrivateProfileString(C_DATABASE_SECTION, C_DATABASE_PASSWORD, C_FAIL_DEAFULT, g_str4DatabasePassword, C_BUFFER_MAX_LENGTH, App.Path & "\" & C_INI_FILE)
    If lError >= C_BUFFER_MAX_LENGTH - 2 Then
        GetConfigMsg = -1
        Exit Function
    Else
        GetConfigMsg = 0
    End If
    lError = GetPrivateProfileString(C_DATABASE_SECTION, C_ADMIN_PASSWORD, C_FAIL_DEAFULT, g_str4InitAdminPassword, C_BUFFER_MAX_LENGTH, App.Path & "\" & C_INI_FILE)
    If lError >= C_BUFFER_MAX_LENGTH - 2 Then
        GetConfigMsg = -1
        Exit Function
    Else
        GetConfigMsg = 0
    End If
    g_str4ServerName = left(g_str4DatabaseServerName, InStr(g_str4DatabaseServerName, Chr(0)) - 1)
    g_str4Password = left(g_str4DatabasePassword, InStr(g_str4DatabasePassword, Chr(0)) - 1)
    g_strOprrolePassword = left(g_str4InitAdminPassword, InStr(g_str4InitAdminPassword, Chr(0)) - 1)
    g_str4Password = g_saEncry.Decrypt(g_str4Password)
    g_strOprrolePassword = g_saEncry.Decrypt(g_strOprrolePassword)
End Function