From 96c318fed272bbc6eee9b1d612c0eea8850217f6 Mon Sep 17 00:00:00 2001 From: 502647092 Date: Tue, 27 Oct 2015 10:38:16 +0800 Subject: [PATCH] =?UTF-8?q?=E6=96=B0=E5=A2=9E=E7=BC=96=E7=A0=81=E5=92=8C?= =?UTF-8?q?=E9=85=8D=E7=BD=AE=E6=A8=A1=E5=9D=97...?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: 502647092 --- Base64CodeBas.bas | 66 +++++++++++++++++++++++ Config.bas | 131 ++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 197 insertions(+) create mode 100644 Base64CodeBas.bas create mode 100644 Config.bas diff --git a/Base64CodeBas.bas b/Base64CodeBas.bas new file mode 100644 index 0000000..2727519 --- /dev/null +++ b/Base64CodeBas.bas @@ -0,0 +1,66 @@ +Option Explicit +Private Const cstBase64 = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/" +Private arrBase64() As String + +Public Function Base64Encode(strSource As String) As String'编码 + 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'解码 + 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 \ No newline at end of file diff --git a/Config.bas b/Config.bas new file mode 100644 index 0000000..6164da6 --- /dev/null +++ b/Config.bas @@ -0,0 +1,131 @@ +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配置文件模块=====================================================