test

.gitignore

@@ -0,0 +1,5 @@
+*.komodoproject
+
+*.accdb
+*.laccdb
+*.accda

source/modules/Shell.bas

@@ -0,0 +1,75 @@
+Option Compare Database
+
+Private Const STARTF_USESHOWWINDOW& = &H1
+Private Const NORMAL_PRIORITY_CLASS = &H20&
+Private Const INFINITE = -1&
+
+Private Type STARTUPINFO
+    cb As Long
+    lpReserved As String
+    lpDesktop As String
+    lpTitle As String
+    dwX As Long
+    dwY As Long
+    dwXSize As Long
+    dwYSize As Long
+    dwXCountChars As Long
+    dwYCountChars As Long
+    dwFillAttribute As Long
+    dwFlags As Long
+    wShowWindow As Integer
+    cbReserved2 As Integer
+    lpReserved2 As Long
+    hStdInput As Long
+    hStdOutput As Long
+    hStdError As Long
+End Type
+
+Private Type PROCESS_INFORMATION
+    hProcess As Long
+    hThread As Long
+    dwProcessID As Long
+    dwThreadID As Long
+End Type
+
+Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal _
+    hHandle As Long, ByVal dwMilliseconds As Long) As Long
+    
+Private Declare Function CreateProcessA Lib "kernel32" (ByVal _
+    lpApplicationName As Long, ByVal lpCommandLine As String, ByVal _
+    lpProcessAttributes As Long, ByVal lpThreadAttributes As Long, _
+    ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, _
+    ByVal lpEnvironment As Long, ByVal lpCurrentDirectory As Long, _
+    lpStartupInfo As STARTUPINFO, lpProcessInformation As _
+    PROCESS_INFORMATION) As Long
+    
+Private Declare Function CloseHandle Lib "kernel32" (ByVal _
+    hObject As Long) As Long
+    
+Public Sub ShellWait(Pathname As String, Optional WindowStyle As Long)
+    Dim proc As PROCESS_INFORMATION
+    Dim start As STARTUPINFO
+    Dim ret As Long
+    ' Initialize the STARTUPINFO structure:
+    With start
+        .cb = Len(start)
+        If Not IsMissing(WindowStyle) Then
+            .dwFlags = STARTF_USESHOWWINDOW
+            .wShowWindow = WindowStyle
+        End If
+    End With
+    ' Start the shelled application:
+    ret& = CreateProcessA(0&, Pathname, 0&, 0&, 1&, _
+            NORMAL_PRIORITY_CLASS, 0&, 0&, start, proc)
+    ' Wait for the shelled application to finish:
+    ret& = WaitForSingleObject(proc.hProcess, INFINITE)
+    ret& = CloseHandle(proc.hProcess)
+End Sub
+
+Public Function cmd(ByVal command As String, Optional dir As String = "", Optional WindowStyle As Long = vbHide)
+
+    If Len(dir) = 0 Then dir = CurrentProject.Path
+
+    Call ShellWait("cmd.exe /r cd " & dir & " & " & command, WindowStyle)
+
+End Function

source/modules/vcs.bas

@@ -1,33 +1,47 @@
 Option Compare Database
-Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal Milliseconds As LongPtr)
 
 Public Function vcsprompt()
-Dim prompt, prompttext, warning As String
-
-prompttext = "Write your command here:" & vbNewLine & _
-             "> 'makesources' to create or update the source files" & vbNewLine & _
-             "> 'update' to update the current application within the source files" & vbNewLine & _
-             "(see docs for more commands)"
-prompt = InputBox(prompttext, "VCS")
-
-Select Case prompt
-
-Case "makesources"
-
-    Call make_sources
-
-Case "update"
-
-    Call update_from_sources
-
-Case ""
-    MsgBox "Operation cancelled"
-
-Case Else
-    MsgBox "Unknown command"
-
-End Select
+    Dim prompt, prompttext, warning As String
+    
+    prompttext = "Write your command here:" & vbNewLine & _
+                 "> 'makesources' to create or update the source files" & vbNewLine & _
+                 "> 'update' to update the current application within the source files" & vbNewLine & _
+                 "> 'ok' to close this input box" & vbNewLine & _
+                 "(see docs for more commands)"
+    prompt = ""
+    
+    While prompt <> "ok"
+        prompt = InputBox(prompttext, "VCS", "")
+        
+        Select Case prompt
+        
+        Case "makesources"
+        
+            Call make_sources
+        
+        Case "update"
+        
+            Call update_from_sources
+        
+        Case "sync"
+        
+            Call sync
+        
+        
+        Case vbNullString
+            MsgBox "Operation cancelled"
+            prompt = "ok"
+            
+        Case "ok"
+        
+        Case Else
+            MsgBox "Unknown command"
+        
+        End Select
+whil:
+    Wend
 
+Exit Function
 
 End Function
 
@@ -53,37 +67,70 @@ End Function
 Public Function update_from_sources()
 'updates the application from the sources
 
-    Debug.Print "Creates a backup of the app file"
-    Call make_backup
-    Debug.Print "> done"
-
-    If MsgBox("WARNING: the current application is going to be updated " & _
-                "with the source files. " & _
-                "Any non committed work would be lost, " & _
-                "are you sure you want to continue?" & _
-                "", vbOKCancel) = vbCancel Then Exit Function
-
-    Debug.Print "Run VCS Import"
-    Call ImportAllSource
-    Debug.Print "> done"
-
-    MsgBox "Done"
+        Debug.Print "Creates a backup of the app file"
+        Call make_backup
+        Debug.Print "> done"
+    
+        If MsgBox("WARNING: the current application is going to be updated " & _
+                    "with the source files. " & _
+                    "Any non committed work would be lost, " & _
+                    "are you sure you want to continue?" & _
+                    "", vbOKCancel) = vbCancel Then Exit Function
+    
+        Debug.Print "Run VCS Import"
+        Call ImportAllSource
+        Debug.Print "> done"
+    
+        MsgBox "Done"
     
 End Function
 
 Public Function config_git_repo()
 'configure the application GIT repository for VCS use
+    
+    'verify that it is a git repository
+    If Not is_git_repo() Then
+        MsgBox "Not a git repository, please use 'git init on this directory first"
+        Exit Function
+    End If
+    
+    ' complete the gitignore file
+    Call complete_gitignore
 
-'verify that it is a git repository
-If Dir(CurrentProject.Path & "\.git") = "" Then
-    MsgBox "Not a git repository, please use 'git init on this directory first"
-    Exit Function
-End If
+End Function
+
+Public Function sync()
+'complete command to synchronize this app with the distant master branch
+
+    'verify that it is a git repository
+    If Not is_git_repo() Then
+        MsgBox "Not a git repository, please use 'git init on this directory first"
+        Exit Function
+    End If
 
-' complete the gitignore file
-Call complete_gitignore
+    Call make_sources
 
+    Call cmd("git add *" & "& pause", vbNormalFocus)
+    
+    Dim msg As String
+    msg = InputBox("Commit message:", "VCS")
+    If Not Len(msg) > 0 Then GoTo err_msg
+    
+    Call cmd("git commit -a -m " & Chr(34) & msg & Chr(34) & "& pause", vbNormalFocus)
+    
+    Call cmd("git pull origin master & pause", vbNormalFocus)
+    
+    Call update_from_sources
+    
+    Call cmd("push origin master" & "& pause", vbNormalFocus)
 
+Exit Function
+err_msg:
+    MsgBox "Invalid value", vbExclamation
+End Function
+
+Public Function is_git_repo() As Boolean
+    is_git_repo = (dir(CurrentProject.Path & "\.git\", vbDirectory) <> "")
 End Function
 
 Public Function get_include_tables()
@@ -98,38 +145,28 @@ err_vcs_table:
 End Function
 
 Public Function zip_app_file() As Boolean
-On Error GoTo err
-Dim command As String
-
-zip_app_file = False
-
-'run the shell comand
-command = "cmd.exe  /k cd " & CurrentProject.Path & " & " & _
-      "zip tmp_" & CurrentProject.name & ".zip " & CurrentProject.name & _
-      " & exit"
-Shell command, vbHide
-      
-' waits for the compression ends
-Dim count As Integer
-count = 0
-Do Until Dir(CurrentProject.Path & "\tmp_" & CurrentProject.name & ".zip") <> ""
-    Sleep (0.01)
-    count = count + 1
-    If count > 5000 Then GoTo UnknownErr
-Loop
-
-'remove the old zip file
-If Dir(CurrentProject.Path & "\" & CurrentProject.name & ".zip") <> "" Then
-    Kill CurrentProject.Path & "\" & CurrentProject.name & ".zip"
-End If
-
-'rename the temporary zip
-command = "cmd.exe  /k cd " & CurrentProject.Path & " & " & _
-      "ren tmp_" & CurrentProject.name & ".zip" & " " & CurrentProject.name & ".zip" & _
-      " & exit"
-Shell command, vbHide
-
-zip_app_file = True
+    On Error GoTo err
+    Dim command As String
+    
+    zip_app_file = False
+    
+    'run the shell comand
+    Call cmd("cd " & CurrentProject.Path & " & " & _
+             "zip tmp_" & CurrentProject.name & ".zip " & CurrentProject.name & _
+             " & exit")
+    
+    'remove the old zip file
+    If dir(CurrentProject.Path & "\" & CurrentProject.name & ".zip") <> "" Then
+        Kill CurrentProject.Path & "\" & CurrentProject.name & ".zip"
+    End If
+    
+    'rename the temporary zip
+    Call cmd("cd " & CurrentProject.Path & " & " & _
+            "ren tmp_" & CurrentProject.name & ".zip" & " " & CurrentProject.name & ".zip" & _
+            " & exit")
+    
+    
+    zip_app_file = True
 
 fin:
     Exit Function
@@ -142,27 +179,27 @@ err:
 End Function
 
 Public Function make_backup() As Boolean
-On Error GoTo err
-
-make_backup = True
-If Dir(CurrentProject.Path & "\" & CurrentProject.name & ".old") <> "" Then
-    Kill CurrentProject.Path & "\" & CurrentProject.name & ".old"
-End If
-
-FileCopy CurrentProject.Path & "\" & CurrentProject.name, CurrentProject.Path & "\" & CurrentProject.name & ".old"
-
-make_backup = True
-Exit Function
+    On Error GoTo err
+    
+    make_backup = True
+    If dir(CurrentProject.Path & "\" & CurrentProject.name & ".old") <> "" Then
+        Kill CurrentProject.Path & "\" & CurrentProject.name & ".old"
+    End If
+    
+    FileCopy CurrentProject.Path & "\" & CurrentProject.name, CurrentProject.Path & "\" & CurrentProject.name & ".old"
+    
+    make_backup = True
+    Exit Function
 err:
-    MsgBox "Error during backup:" & err.Description
+        MsgBox "Error during backup:" & err.Description
 End Function
 
 Public Function complete_gitignore()
 ' creates or complete the .gitignore file of the repo
-Dim gitignore_path As String
+Dim gitignore_path, str_existing_keys, str As String
 
 Dim keys() As String
-keys = Split("*.accdb;*.laccdb;*.mdb;*.ldb", ";")
+keys = Split("*.accdb;*.laccdb;*.mdb;*.ldb;*.accde;*.mde;*.accda", ";")
 
 gitignore_path = CurrentProject.Path & "\.gitignore"
 
@@ -170,17 +207,34 @@ gitignore_path = CurrentProject.Path & "\.gitignore"
     Set fso = CreateObject("Scripting.FileSystemObject")
     
     Dim oFile As Object
-    
-    If Dir(gitignore_path) = "" Then
+    If Not fso.FileExists(gitignore_path) Then
         Set oFile = fso.CreateTextFile(gitignore_path)
     Else
+        Set oFile = fso.OpenTextFile(gitignore_path, ForReading)
+        str_existing_keys = ""
+        
+        While Not oFile.AtEndOfStream
+            str = oFile.readline
+            If Len(str_existing_keys) = 0 Then
+                str_existing_keys = str
+            Else
+                str_existing_keys = str_existing_keys & ";" & str
+            End If
+        Wend
+        oFile.Close
+        
+        Dim existing_keys() As String
+        existing_keys = Split(str_existing_keys, ";")
+        
         Set oFile = fso.OpenTextFile(gitignore_path, ForAppending)
     End If
     
     oFile.WriteBlankLines (2)
     oFile.WriteLine ("#[ automatically added by VCS")
     For Each key In keys
-        oFile.WriteLine key
+        If Not IsInArray(key, existing_keys) Then
+            oFile.WriteLine key
+        End If
     Next key
     oFile.WriteLine "#]"
     oFile.WriteBlankLines (2)
@@ -189,4 +243,8 @@ gitignore_path = CurrentProject.Path & "\.gitignore"
     Set fso = Nothing
     Set oFile = Nothing
 
+End Function
+
+Private Function IsInArray(ByVal stringToBeFound As String, ByRef arr As Variant) As Boolean
+    IsInArray = (UBound(Filter(arr, stringToBeFound)) > -1)
 End Function