SourceSafe Auto Backup

最新推荐文章于 2025-04-24 14:53:15 发布

EricQLiu

最新推荐文章于 2025-04-24 14:53:15 发布

阅读量1k

点赞数

分类专栏： VB专题文章标签： string function shell command vss delete

本文链接：https://blog.youkuaiyun.com/EricQLiu/article/details/889494

版权

VB专题专栏收录该内容

5 篇文章

订阅专栏

本文介绍了一个使用VSS数据库进行文件操作的过程，并通过WinZip实现文件压缩的脚本示例。该脚本从指定的VSS路径下载文件到本地临时目录，使用WinZip压缩这些文件，然后将压缩后的文件上传回另一个VSS路径。

摘要生成于 C知道，由 DeepSeek-R1 满血版支持，前往体验 >

Option Explicit

Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long

Private Const SYNCHRONIZE = &H100000 '进程同步

Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long

Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long

Private Const INFINITE = &HFFFFFFFF

Public Sub Main()

    Dim objVSSDatabase As VSSDatabase
    Dim objVSSProject   As VSSItem
    Dim strErrorDescription As String

    Dim wzipexe As String    ' winzip 执行文件的位置
    Dim wcmd As String        ' Shell 指令
    Dim retval As Double

    Dim strFileName As String
    Dim arr() As String

    Dim strPara() As String
    Dim strSrcServer As String
    Dim strSrcPath As String
    Dim strSrcUser As String
    Dim strSrcPwd As String
    Dim strDstServer As String
    Dim strDstPath As String
    Dim strDstUser As String
    Dim strDstPwd As String

On Error GoTo Error_Handler

'    strPara = Split(Command, "|")
'    strSrcServer = strPara(0)
'    strSrcPath = strPara(1)
'    strSrcUser = strPara(2)
'    strSrcPwd = strPara(3)
'    strDstServer = strPara(4)
'    strDstPath = strPara(5)
'    strDstUser = strPara(6)
'    strDstPwd = strPara(7)

    strSrcServer = "//hi1-bowork/bo3vss$/srcsafe.ini"
    strSrcPath = "$/BMS-BACH"
    strSrcUser = "***"
    strSrcPwd = "***"
    strDstServer = "//scopsource/hi1softsafe$/srcsafe.ini"
    strDstPath = "$/BMS/Backup Files"
    strDstUser = "*****"
    strDstPwd = "****"

    Dim fs As FileSystemObject
    Set fs = New FileSystemObject
    Set objVSSDatabase = New VSSDatabase
    objVSSDatabase.Open strSrcServer, strSrcUser, strSrcPwd

Set objVSSProject = objVSSDatabase.VSSItem(strSrcPath, False)
objVSSProject.Get Local:="D:/LocalTemp", iFlags:=VSSFLAG_TIMENOW + VSSFLAG_REPREPLACE + VSSFLAG_RECURSYES + VSSFLAG_FORCEDIRNO + VSSFLAG_EOLCRLF

Set objVSSDatabase = Nothing

    'Delete
    fs.DeleteFolder "D:/LocalTemp/S0(Requirment)", True
    fs.DeleteFile "D:/LocalTemp/S1(Exteneral Spec)/Meeting Minutes/FIN_20060414(CEA,CEG,BTP,INV920).MP3", True

    arr = Split(strSrcPath, "/")
    strFileName = arr(UBound(arr)) & "-" & Format(Now, "yyyyMMdd") & ".zip"
    wzipexe = "D:/program files/winzip/WINzip32" ' winzip 执行文件的位置
    wcmd = wzipexe & " -a -r " & "D:/" & strFileName & " " & "D:/LocalTemp/*.*"
    'retval = Shell(wcmd, 6)
    OpenFileWait wcmd

    Set objVSSDatabase = New VSSDatabase
    objVSSDatabase.Open strDstServer, strDstUser, strDstPwd
    Set objVSSProject = objVSSDatabase.VSSItem(strDstPath, False)
    objVSSProject.Add "D:/" & strFileName
    Set objVSSProject = Nothing
    Set objVSSDatabase = Nothing

    fs.DeleteFile "D:/" & strFileName, True
    fs.DeleteFolder "D:/LocalTemp", True

'    MsgBox "OK"

    Exit Sub
Error_Handler:
    Set objVSSProject = Nothing
    Set objVSSDatabase = Nothing
    strErrorDescription = "[(" & 1051 + vbObjectError & ")(" & App.Title & ")(cmdGet_Click)]" & Err.Description
    MsgBox Err.Description
    Screen.MousePointer = 0
End Sub

Private Sub OpenFileWait(tkFileName As String)
Dim wndID As Long
Dim wnd As Long
wndID = Shell(tkFileName, 6)

wnd = OpenProcess(SYNCHRONIZE, 0, wndID)

WaitForSingleObject wnd, INFINITE

CloseHandle wnd

End Sub