李大仁博客

'VBA Base64 编码/加密函数：
Function Base64Encode(StrA As String) As String                                  'Base64 编码
    On Error GoTo over                                                          '排错
    Dim buf() As Byte, length As Long, mods As Long
    Dim Str() As Byte
    Dim i, kk As Integer
    kk = Len(StrA) - 1
    ReDim Str(kk)
    For i = 0 To kk
        Str(i) = Asc(Mid(StrA, i + 1, 1))
    Next i
    Const B64_CHAR_DICT = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/="
    mods = (UBound(Str) + 1) Mod 3   '除以3的余数
    length = UBound(Str) + 1 - mods
    ReDim buf(length / 3 * 4 + IIf(mods <> 0, 4, 0) - 1)
    For i = 0 To length - 1 Step 3
        buf(i / 3 * 4) = (Str(i) And &HFC) / &H4
        buf(i / 3 * 4 + 1) = (Str(i) And &H3) * &H10 + (Str(i + 1) And &HF0) / &H10
        buf(i / 3 * 4 + 2) = (Str(i + 1) And &HF) * &H4 + (Str(i + 2) And &HC0) / &H40
        buf(i / 3 * 4 + 3) = Str(i + 2) And &H3F
    Next
    If mods = 1 Then
        buf(length / 3 * 4) = (Str(length) And &HFC) / &H4
        buf(length / 3 * 4 + 1) = (Str(length) And &H3) * &H10
        buf(length / 3 * 4 + 2) = 64
        buf(length / 3 * 4 + 3) = 64
    ElseIf mods = 2 Then
        buf(length / 3 * 4) = (Str(length) And &HFC) / &H4
        buf(length / 3 * 4 + 1) = (Str(length) And &H3) * &H10 + (Str(length + 1) And &HF0) / &H10
        buf(length / 3 * 4 + 2) = (Str(length + 1) And &HF) * &H4
        buf(length / 3 * 4 + 3) = 64
    End If
    For i = 0 To UBound(buf)
        Base64Encode = Base64Encode + Mid(B64_CHAR_DICT, buf(i) + 1, 1)
    Next
over:
End Function

=MID(CELL("filename",A1),FIND("]",CELL("filename",A1))+1,255)

Sub Maco1()
For i = 1 To Sheets.Count
Cells(i, 1) = Sheets(i).Name
Next
End Sub

'需要遍历的目录路径
dim strDirPath = "c:\dir"
 
'遍历目录
Private Sub FileTree(strPath)
    Set obFso = CreateObject("Scripting.FileSystemObject")
    If obFso.FolderExists(strPath) Then
        Set obFolder = obFso.GetFolder(strPath)
        '遍历当前目录下的所有目录，递归调用
        Set obSubFolders = obFolder.SubFolders
        For Each obSubFolder In obSubFolders
            Call FileTree(obSubFolder.Path & "")
        Next
        '剔除当前目录
        If strPath = Trim(strDirPath) Then
            Exit Sub
        End If
        '遍历当前目录下的所有文件
        Set obFiles = obFolder.Files
        For Each obFile In obFiles
            Call ExcuteFolderConcentrate(obFile.Path & "")
        Next
    Else
        MsgBox "Invalide Path"
        Exit Sub
    End If
End Sub
 
'文件归集操作
Private Sub ExcuteFolderConcentrate(strPath)
    Set obFso = CreateObject("Scripting.FileSystemObject")
    If obFso.FileExists(strPath) Then
        fullPath = Trim(strDirPath) & “\"
        '按目录层级设置新文件名
        newFileName = Replace(Right(strPath, Len(strPath) - Len(fullPath)), "\", "_”)
        '重复文件重新命名
        If obFso.FileExists(fullPath & newFileName) Then
            Call obFso.copyFile(strPath, fullPath & newFileName & ".duplicate")
        Else
            Call obFso.copyFile(strPath, fullPath & newFileName)
        End If
    End If
End Sub
 
'遍历整个目录，完成文件归集
FileTree (strDirPath)
'重新打开目录文件夹
CreateObject("Shell.Application").Explore strDirPath

@echo off
 
::检测时间间隔，单位：秒
set _interval=5
 
::需要守护的进程名称
set _processName=ProcessName
 
::需要守护的进程启动命令
set _processCmd=C:\xxxx.exe
 
::需要守护的进程预估启动完毕所需时间，单位：秒
set _processTimeout=10
 
::需要守护的进程所监听的端口
set _port=8080
 
::进程用户名，一般是Administrator
set _username=Administrator