Archive

Posts Tagged ‘VBscript’

[VBA]Base64编码和Base64解码

March 26th, 2019 No comments

VBA实现Base64编码和Base64解码,用于处理加密的URL非常方便。

VBA Base64 编码/加密函数:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
'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

Read more…

Categories: 零敲碎打 Tags: , ,

[VBS]Excel获取所有Sheet的名称

November 9th, 2018 No comments

1.在当前Sheet里面获取当前Sheet名
选取任意单元格,编辑公式

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

2.在当前Sheet里面获取Workbook下所有的Sheet名
使用alt+f11组合快捷键进入vbe编辑器,插入一个新的模块,并在模块中输入以下代码:

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

然后运行指定宏既可以在当前sheet里面获取到了

Categories: 零敲碎打 Tags: ,

VBS实现目录下所有文件归集

August 25th, 2017 No comments

一个简单的需求:
Windows 环境下用VBS/VBA来实现抽取某一个特定目录下的全部所有文件,要求遍历当前目录下所有的子目录。
注意各子目录下文件的文件名可能会重复,各子目录下存在空目录的情况。

实现VBS代码

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
'需要遍历的目录路径
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
Categories: 语言编程, 零敲碎打 Tags: ,

Windows下实现Deamon守护脚本

June 28th, 2016 No comments

最近需要在Windows服务器上保持程序长期允许,因为程序比较老,无法用srvany.exe 改写成windows服务,只能自己手动编写守护脚本实现,网上找了短比较靠谱的守护脚本,在此mark一下。支持监视进程、端口。

守护脚本定义部分

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
@echo off
 
::检测时间间隔,单位:秒
set _interval=5
 
::需要守护的进程名称
set _processName=ProcessName
 
::需要守护的进程启动命令
set _processCmd=C:\xxxx.exe
 
::需要守护的进程预估启动完毕所需时间,单位:秒
set _processTimeout=10
 
::需要守护的进程所监听的端口
set _port=8080
 
::进程用户名,一般是Administrator
set _username=Administrator

Read more…

Categories: 零敲碎打 Tags: , ,

[VBS]文件批量转编码

January 12th, 2016 No comments

工作中需要将大量GB2312编码的文件转换为UTF-8编码,Baidu找了一段很实用的VBS可以有效解决问题。
使用方法也很简单,添加到工程调用ConvertFile即可。需要注意的是Adodb.Stream方式生成的UTF-8文件的头部会抱憾3个字节的BOM,处理PHP之类的无BOM要求的文件时需要注意一下。

Read more…

Categories: 零敲碎打 Tags: ,

基于EXTJS+ASP的WEB桌面应用程序

November 29th, 2009 2 comments

CG在IBM-ETP的培训已经进入了第二阶段了,今天要发布的就是CG在前几天做的一个基于EXTJS的小应用,学生的问题问答提问系统,目的是为了方便学生在授课和作业过程中能够相互之间交流和问题解答,同时为了即时交流,又增加了一个简单的即时通信的聊天工具。
系统设计也很简单,主要包括:A问题和发布系统,这个类似于一个简单的放百度知道的系统,B在线即时聊天系统,类似于QQ的群聊功能。
其中用户界面使用了Extjs来实现,因为时间紧张,为了减少JS的调试时间,使用了Iframe方式来实习页面的显示,CG在EXTJS方面也是初学者,欢迎高手指教。

Read more…

发布本地美容工作室ASP网站整站源代码

November 11th, 2009 5 comments

继续上篇日志发布新整站代码,这次发布是最近刚完成的一个本地美容造型工作室的展示网站的整站源代码,技术上还是基于ASP+Access,另外由于工作室的展示要求实现弹窗显示效果,所以使用了Jquery的相关技术,CG本人一直对Jquery偏爱有加,当然做出来的效果也是很满意的,另外首页下边的滚动效果也是使用的Jquery实现的,效果大家测试的时候可以看到。
最后,本次发布的工作室展示的整站代码还是对大家自由开放,欢迎大家免费下载和使用,也欢迎留言。
补充一点,本次发布CG删除了部分来自该造型工作室的版权图片,使用了来自网络相关图片,并不影响显示和运行效果,呵呵。

Read more…

Categories: 开源共享 Tags: , , ,