502647092/VBFunctionBas
1
0
Fork 0
mirror of https://e.coding.net/circlecloud/VBFunctionBas.git synced 2025-11-24 21:26:26 +00:00
Code Releases Activity

新增编码和配置模块...

Browse Source 
Signed-off-by: 502647092 <jtb1@163.com>
This commit is contained in:
502647092
2015-10-27 10:38:16 +08:00
parent db463fa993
commit 96c318fed2
2 changed files with 197 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

66
Base64CodeBas.bas Normal file
View File

@@ -0,0 +1,66 @@
Option Explicit
Private Const cstBase64 = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
Private arrBase64() As String
Public Function Base64Encode(strSource As String) As String'<27><><EFBFBD><EFBFBD>
On Error Resume Next
If UBound(arrBase64) = -1 Then
arrBase64 = Split(StrConv(cstBase64, vbUnicode), vbNullChar)
End If
Dim arrB() As Byte, bTmp(2) As Byte, bT As Byte
Dim I As Long, J As Long
arrB = StrConv(strSource, vbFromUnicode)
J = UBound(arrB)
For I = 0 To J Step 3
Erase bTmp
bTmp(0) = arrB(I + 0)
bTmp(1) = arrB(I + 1)
bTmp(2) = arrB(I + 2)
bT = (bTmp(0) And 252) / 4
Base64Encode = Base64Encode & arrBase64(bT)
bT = (bTmp(0) And 3) * 16
bT = bT + bTmp(1) \ 16
Base64Encode = Base64Encode & arrBase64(bT)
bT = (bTmp(1) And 15) * 4
bT = bT + bTmp(2) \ 64
If I + 1 <= J Then
Base64Encode = Base64Encode & arrBase64(bT)
Else
Base64Encode = Base64Encode & "="
End If
bT = bTmp(2) And 63
If I + 2 <= J Then
Base64Encode = Base64Encode & arrBase64(bT)
Else
Base64Encode = Base64Encode & "="
End If
Next
End Function
Public Function Base64Decode(strEncoded As String) As String'<27><><EFBFBD><EFBFBD>
On Error Resume Next
Dim arrB() As Byte, bTmp(3) As Byte, bT As Long, bRet() As Byte
Dim I As Long, J As Long
arrB = StrConv(strEncoded, vbFromUnicode)
J = InStr(strEncoded & "=", "=") - 2
ReDim bRet(J - J \ 4 - 1)
For I = 0 To J Step 4
Erase bTmp
bTmp(0) = (InStr(cstBase64, Chr(arrB(I))) - 1) And 63
bTmp(1) = (InStr(cstBase64, Chr(arrB(I + 1))) - 1) And 63
bTmp(2) = (InStr(cstBase64, Chr(arrB(I + 2))) - 1) And 63
bTmp(3) = (InStr(cstBase64, Chr(arrB(I + 3))) - 1) And 63
bT = bTmp(0) * 2 ^ 18 + bTmp(1) * 2 ^ 12 + bTmp(2) * 2 ^ 6 + bTmp(3)
bRet((I \ 4) * 3) = bT \ 65536
bRet((I \ 4) * 3 + 1) = (bT And 65280) \ 256
bRet((I \ 4) * 3 + 2) = bT And 255
Next
Base64Decode = StrConv(bRet, vbUnicode)
End Function

131
Config.bas Normal file
View File

@@ -0,0 +1,131 @@
Attribute VB_Name = "Config"
'#######################################<23>û<EFBFBD><C3BB>ؼ<EFBFBD>˵<EFBFBD><CBB5>#########################################
'<27><><EFBFBD><EFBFBD>:<3A><><EFBFBD><EFBFBD><EFBFBD>ļ<EFBFBD>ģ<EFBFBD><C4A3>
'<27><><EFBFBD><EFBFBD>:<3A><>ȡд<C8A1><D0B4>INI<4E><49><EFBFBD><EFBFBD><EFBFBD>ļ<EFBFBD>
'<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>:2014<31><34>5<EFBFBD><35>7<EFBFBD><37>
'<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>:<3A><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
'<27><>λ:<3A>Ϻ<EFBFBD><CFBA>ж<EFBFBD><D0B6><EFBFBD>ˮ<EFBFBD>繤<EFBFBD>̰<EFBFBD>װ<EFBFBD><D7B0><EFBFBD>޹<EFBFBD>˾
''====================================<3D>ؼ<EFBFBD>ʹ<EFBFBD><CAB9>˵<EFBFBD><CBB5>=======================================
'<27>÷<EFBFBD>: <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD>iniFileName="<22>ļ<EFBFBD><C4BC><EFBFBD>" <20><><EFBFBD><EFBFBD>Ҫ <20><>ini<6E><69>׺
'<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>˵<EFBFBD><CBB5><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>Ը<EFBFBD>ֵ<EFBFBD><D6B5>iniFileName<6D>Ϳ<EFBFBD><CDBF><EFBFBD>д<EFBFBD><D0B4><EFBFBD><EFBFBD>¼<EFBFBD><C2BC><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ʱд<CAB1>벻ͬ<EBB2BB><CDAC>ini<6E>ļ<EFBFBD>(<28><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ļ<EFBFBD><C4BC>Ƿ<EFBFBD><C7B7>Ѵ<EFBFBD><D1B4>ڣ<EFBFBD><DAA3><EFBFBD>ͨ<EFBFBD><CDA8><EFBFBD>޸<EFBFBD><DEB8><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ñ<EFBFBD><C3B1><EFBFBD><EFBFBD><EFBFBD>
'<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>DelInikey (<28><><EFBFBD><EFBFBD>,<2C><><EFBFBD><EFBFBD>)
'<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>DelIniSec (<28><><EFBFBD><EFBFBD>)
'д<><D0B4><EFBFBD><EFBFBD><EFBFBD><EFBFBD>SetIniN (<28><><EFBFBD><EFBFBD>,<2C><><EFBFBD><EFBFBD>, д<><D0B4>ֵ)
'<27><>ȡ<EFBFBD><C8A1><EFBFBD><EFBFBD>GetIniN (<28><><EFBFBD><EFBFBD>,<2C><><EFBFBD><EFBFBD>, Ĭ<><C4AC>ֵ)
'д<><D0B4><EFBFBD>ַ<EFBFBD><D6B7><EFBFBD>SetIniS (<28><><EFBFBD><EFBFBD>,<2C><><EFBFBD><EFBFBD>, д<><D0B4>ֵ)
'<27><>ȡ<EFBFBD>ַ<EFBFBD><D6B7><EFBFBD>GetIniS (<28><><EFBFBD><EFBFBD>,<2C><><EFBFBD><EFBFBD>, Ĭ<><C4AC>ֵ)
'#######################################ģ<><C4A3>˵<EFBFBD><CBB5>#########################################
Option Explicit
''================================INI<4E>ļ<EFBFBD><C4BC><EFBFBD><EFBFBD><EFBFBD>=========================================
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<4E><49><EFBFBD><EFBFBD><EFBFBD>ļ<EFBFBD>ģ<EFBFBD><C4A3>=====================================================
'****************************************<2A><>ȡIni<6E>ַ<EFBFBD><D6B7><EFBFBD>ֵ(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))
'<27><><EFBFBD><EFBFBD><EFBFBD>ؼ<EFBFBD><D8BC>ʵ<EFBFBD>ֵ
If Temp% > 0 Then '<27>ؼ<EFBFBD><D8BC>ʵ<EFBFBD>ֵ<EFBFBD><D6B5>Ϊ<EFBFBD><CEAA>
' 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))
'<27><>ȱʡֵд<D6B5><D0B4>INI<4E>ļ<EFBFBD>
S = DefString
Else
S = ""
End If
End If
GetIniS = S
End Function
'**************************************<2A><>ȡIni<6E><69>ֵ(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
'***************************************д<><D0B4><EFBFBD>ַ<EFBFBD><D6B7><EFBFBD>ֵ(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
'****************************************д<><D0B4><EFBFBD><EFBFBD>ֵ(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
'***************************************<2A><><EFBFBD><EFBFBD>KeyWord"<22><>"(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
'**************************************<2A><><EFBFBD><EFBFBD> Section"<22><>"(Sub)***********************************************
Public Sub DelIniSec(ByVal SectionName As String) '<27><><EFBFBD><EFBFBD>section
Dim retval As Integer
retval = WritePrivateProfileString(SectionName, 0&, "", AppProFileName(iniFileName))
End Sub
'*************************************<2A><><EFBFBD><EFBFBD>Ini<6E>ļ<EFBFBD><C4BC><EFBFBD>(Function)***************************************************
'<27><><EFBFBD><EFBFBD>ini<6E>ļ<EFBFBD><C4BC><EFBFBD>
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<4E><49><EFBFBD><EFBFBD><EFBFBD>ļ<EFBFBD>ģ<EFBFBD><C4A3>=====================================================