1
0
mirror of https://e.coding.net/circlecloud/VBFunctionBas.git synced 2024-10-31 22:38:50 +00:00
VBFunctionBas/Config.bas
502647092 96c318fed2 新增编码和配置模块...
Signed-off-by: 502647092 <jtb1@163.com>
2015-10-27 10:38:16 +08:00

132 lines
5.8 KiB
QBasic
Raw Permalink Blame History

This file contains ambiguous Unicode characters

This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

Attribute VB_Name = "Config"
'#######################################用户控件说明#########################################
'名称:配置文件模块
'功能:读取写入INI配置文件
'最后更新日期:2014年5月7日
'创建人:蒋天蓓
'单位:上海市定海水电工程安装有限公司
''====================================控件使用说明=======================================
'用法: 首先 定义iniFileName="文件名" 不需要 加ini后缀
'这就是说你可以赋值给iniFileName就可以写入记录而且你可以随时写入不同的ini文件(不管这个文件是否已存在),通过修改这个公用变量。
'清除键DelInikey (部名,键名)
'清除部DelIniSec (键名)
'写入数SetIniN (部名,键名, 写入值)
'读取数GetIniN (部名,键名, 默认值)
'写入字符SetIniS (部名,键名, 写入值)
'读取字符GetIniS (部名,键名, 默认值)
'#######################################模块说明#########################################
Option Explicit
''================================INI文件函数=========================================
Public iniFileName As String
Public DirMode As Boolean
Public DirPath As String
Public ALLDirPath As String
Public ReSetDirPath As Boolean
Private FileDir As String
Private Declare Function GetPrivateProfileInt Lib "kernel32" Alias "GetPrivateProfileIntA" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal nDefault As Long, ByVal lpFileName As String) As Long
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 Long, ByVal lpFileName As String) As Long
Private 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
'========================================INI配置文件模块=====================================================
'****************************************获取Ini字符串值(Function)******************************************
Public Function GetIniS(ByVal SectionName As String, ByVal KeyWord As String, Optional ByVal DefString As String) As String
Dim ResultString As String * 144, Temp As Integer
Dim S As String, i As Integer
Temp% = GetPrivateProfileString(SectionName, KeyWord, "", ResultString, 144, AppProFileName(iniFileName))
'检索关键词的值
If Temp% > 0 Then '关键词的值不为空
' s = Mid$(ResultString, 1, Temp%)
For i = 1 To 144
If Asc(Mid$(ResultString, i, 1)) = 0 Then
Exit For
Else
S = S & Mid$(ResultString, i, 1)
End If
Next
Else
If DefString <> vbNullString Then
Temp% = WritePrivateProfileString(SectionName, KeyWord, DefString, AppProFileName(iniFileName))
'将缺省值写入INI文件
S = DefString
Else
S = ""
End If
End If
GetIniS = S
End Function
'**************************************获取Ini数值(Function)***************************************************
Public Function GetIniN(ByVal SectionName As String, ByVal KeyWord As String, ByVal DefValue As Long) As Integer
Dim D As Long, S As String
D = DefValue
GetIniN = GetPrivateProfileInt(SectionName, KeyWord, DefValue, AppProFileName(iniFileName))
If D <> DefValue Then
S = "" & D
D = WritePrivateProfileString(SectionName, KeyWord, S, AppProFileName(iniFileName))
End If
End Function
'***************************************写入字符串值(Sub)**************************************************
Public Sub SetIniS(ByVal SectionName As String, ByVal KeyWord As String, ByVal ValStr As String)
Dim res%
res% = WritePrivateProfileString(SectionName, KeyWord, ValStr, AppProFileName(iniFileName))
End Sub
'****************************************写入数值(Sub)******************************************************
Public Sub SetIniN(ByVal SectionName As String, ByVal KeyWord As String, ByVal ValInt As Long)
Dim res%, S$
S$ = Str$(ValInt)
res% = WritePrivateProfileString(SectionName, KeyWord, S$, AppProFileName(iniFileName))
End Sub
'***************************************清除KeyWord"键"(Sub)*************************************************
Public Sub DelIniKey(ByVal SectionName As String, ByVal KeyWord As String)
Dim retval As Integer
retval = WritePrivateProfileString(SectionName, KeyWord, 0&, AppProFileName(iniFileName))
End Sub
'**************************************清除 Section"段"(Sub)***********************************************
Public Sub DelIniSec(ByVal SectionName As String) '清除section
Dim retval As Integer
retval = WritePrivateProfileString(SectionName, 0&, "", AppProFileName(iniFileName))
End Sub
'*************************************定义Ini文件名(Function)***************************************************
'定义ini文件名
Public Function AppProFileName(iniFileName)
If InStr(1, iniFileName, ":") <> 0 Then
AppProFileName = iniFileName
Else
If Right(App.Path, 1) <> "\" Then AppProFileName = App.Path & "\"
ALLDirPath = AppProFileName
If DirMode Then
AppProFileName = AppProFileName & DirPath & "\"
ALLDirPath = AppProFileName
If ReSetDirPath Then
FileDir = Dir(ALLDirPath & "\*")
While FileDir <> ""
Kill ALLDirPath & "\" & FileDir
FileDir = Dir(ALLDirPath & "\*")
Wend
ReSetDirPath = False
End If
If Dir(AppProFileName, vbDirectory Or vbHidden Or vbNormal Or vbReadOnly) = "" Then
MkDir AppProFileName
End If
End If
AppProFileName = AppProFileName & iniFileName & ".ini"
End If
End Function
'========================================INI配置文件模块=====================================================