?? modbasecode.bas
字號:
Attribute VB_Name = "ModBasecode"
Option Explicit
Public Function cdDate(arg1 As Long) As Date
cdDate = DateAdd("s", arg1, "1/1/70")
End Function
Public Function hex(arg1 As Variant, arg2 As Byte) As String
hex = String(arg2 - Len(VBA.hex$(arg1)), "0") + VBA.hex$(arg1)
End Function
Public Function Dot(arg1 As String, Optional arg2 As Boolean = True, Optional arg3 As String = ".") As String
Dim spot1 As Integer, spot2 As Integer
spot2 = 1
Do
spot1 = InStr(spot2, arg1, arg3)
If spot1 > 0 Then spot2 = spot1 + 1
Loop While spot1 > 0
If spot2 > 1 Then
If arg2 = True Then
Dot = Mid(arg1, spot2)
Else
Dot = Left(arg1, spot2 - 2)
End If
Else
If arg2 = True Then
Dot = arg1
Else
Dot = ""
End If
End If
End Function
Public Sub ValidateDir(arg1 As String)
On Error Resume Next
If Dir(arg1, vbDirectory) = "" Then
If Dot(arg1, False, "\") = arg1 Then
MkDir arg1
Else
ValidateDir Dot(arg1, False, "\")
MkDir arg1
End If
End If
End Sub
Public Function Key(strText As String, Optional aKeySize As Integer = 16) As String
Dim i As Integer, c As Integer, x As Integer
Dim strBuff As String
strBuff = String(aKeySize, 32)
If Len(strText) Then
For i = 1 To Len(strText)
c = Asc(Mid$(strText, i, 1))
c = c + Asc(Mid$(strBuff, (i Mod aKeySize) + 1, 1))
If c > &HFF Then
x = i
Do
Mid$(strBuff, (x Mod aKeySize) + 1, 1) = Chr$(c And &HFF)
x = x + 1
c = (c - &HFF) + Asc(Mid$(strBuff, (x Mod aKeySize) + 1, 1))
Loop Until c <= &HFF
Mid$(strBuff, (x Mod aKeySize) + 1, 1) = Chr$(c And &HFF)
Else
Mid$(strBuff, (i Mod aKeySize) + 1, 1) = Chr$(c And &HFF)
End If
Next i
Else
strBuff = strText
End If
Key = strBuff
End Function
Public Function Str2Hex(strText As String) As String
Dim i As Integer, c As Integer
Dim strBuff As String, strList As String
strList = "0123456789ABCDEF"
If Len(strText) Then
For i = 1 To Len(strText)
c = HiNibb(Asc(Mid$(strText, i, 1)))
strBuff = strBuff & Mid$(strList, c + 1, 1)
c = LoNibb(Asc(Mid$(strText, i, 1)))
strBuff = strBuff & Mid$(strList, c + 1, 1)
Next i
Else
strBuff = strText
End If
Str2Hex = strBuff
End Function
Public Function Hex2Str(strText As String) As String
Dim i As Integer, c As Integer
Dim strBuff As String, strList As String
strList = "123456789ABCDEF"
If Len(strText) Then
For i = 1 To Len(strText) Step 2
c = InStr(1, strList, Mid$(strText, i, 1)) * 16
c = c + InStr(1, strList, Mid$(strText, i + 1, 1))
strBuff = strBuff & Chr$(c)
Next i
Else
strBuff = strText
End If
Hex2Str = strBuff
End Function
Public Function LoNibb(ByVal w As Byte) As Byte
LoNibb = w And &HF
End Function
Public Function HiNibb(ByVal w As Byte) As Byte
HiNibb = (w And &HF0&) \ 16
End Function
Public Function EncryptText(strText As String, Optional ByVal strPwd As String = "
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -