VB SourceSafe Auto Backup

最新推荐文章于 2023-01-12 17:46:00 发布

原创最新推荐文章于 2023-01-12 17:46:00 发布 · 1.1k 阅读

0 ·

CC 4.0 BY-SA版权

文章标签：

#vb #string #function #shell #command #vss

VB专题专栏收录该内容

5 篇文章

订阅专栏

本文介绍了一种使用VSS数据库进行源代码同步与备份的方法。通过调用VSS API，实现从源服务器到本地的文件下载，并进一步压缩打包，最后上传到目标服务器。文章涉及了进程同步、文件操作等技术细节。

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 = "//Source/bo3vss$/srcsafe.ini"
    strSrcPath = "$/BMS-BACH"
    strSrcUser = "*******"
    strSrcPwd = "*******"
    strDstServer = "//Dest$/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