Ajout de Shell and wait, fonction sync, quelques corrections

source/modules/Shell.bas

@@ -66,7 +66,7 @@ Public Sub ShellWait(Pathname As String, Optional WindowStyle As Long)
     ret& = CloseHandle(proc.hProcess)
 End Sub
 
-Public Function cmd(ByVal command As String, Optional dir As String = "", Optional WindowStyle As Long = vbHide)
+Public Function cmd(ByVal command As String, Optional WindowStyle As Long = vbHide, Optional dir As String = "")
 
     If Len(dir) = 0 Then dir = CurrentProject.Path
 

source/modules/vcs.bas

@@ -2,7 +2,7 @@ Option Compare Database
 
 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 & _
@@ -18,14 +18,17 @@ Public Function vcsprompt()
         Case "makesources"
         
             Call make_sources
-        
+            MsgBox "Done"
+            
         Case "update"
         
             Call update_from_sources
+            MsgBox "Done"
         
         Case "sync"
         
             Call sync
+            MsgBox "Done"
         
         
         Case vbNullString
@@ -49,6 +52,12 @@ End Function
 Public Function make_sources()
 'creates the source-code of the app
 
+    If CodeProject.Path = CurrentProject.Path Then
+        MsgBox "ERROR: you should not run VSC for VCS from here, VCS modules would not be exported" & vbNewLine & _
+                "Use VCS - AddIn instead"
+        Exit Function
+    End If
+
     Debug.Print "Zip the app file"
     Call zip_app_file
     Debug.Print "> done"
@@ -59,29 +68,37 @@ Public Function make_sources()
     Call ExportAllSource
     Debug.Print "> done"
 
-    MsgBox "Done"
-
 End Function
 
 
 Public Function update_from_sources()
 'updates the application from the sources
+Dim backup As Boolean
 
-        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
+    If CodeProject.Path = CurrentProject.Path Then
+        MsgBox "ERROR: you should not run VSC for VCS from here, VCS modules would not be exported" & vbNewLine & _
+                "Use VCS - AddIn instead"
+        Exit Function
+    End If
+
+    Debug.Print "Creates a backup of the app file"
+    backup = make_backup()
     
-        Debug.Print "Run VCS Import"
-        Call ImportAllSource
+    If backup Then
         Debug.Print "> done"
-    
-        MsgBox "Done"
+    Else
+        MsgBox "Error: unable to backup the app file, do it manually, then click OK"
+    End If
+
+    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"
     
 End Function
 
@@ -108,21 +125,21 @@ Public Function sync()
         Exit Function
     End If
 
-    Call make_sources
+    'Call make_sources
 
-    Call cmd("git add *" & "& pause", vbNormalFocus)
+    Call cmd("echo --ADD FILES-- & git add *" & "& timeout 2", 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("echo --COMMIT-- & git commit -a -m " & Chr(34) & msg & Chr(34) & "& timeout 2", vbNormalFocus)
     
-    Call cmd("git pull origin master & pause", vbNormalFocus)
+    Call cmd("echo --PULL-- & git pull origin master & pause", vbNormalFocus)
     
     Call update_from_sources
     
-    Call cmd("push origin master" & "& pause", vbNormalFocus)
+    Call cmd("echo --PUSH-- & git push origin master" & "& timeout 2", vbNormalFocus)
 
 Exit Function
 err_msg:
@@ -181,17 +198,20 @@ End Function
 Public Function make_backup() As Boolean
     On Error GoTo err
     
-    make_backup = True
+    make_backup = False
     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"
+
+    'FileCopy CurrentProject.Path & "\" & CurrentProject.name, CurrentProject.Path & "\" & CurrentProject.name & ".old"
+    Call cmd("copy " & Chr(34) & CurrentProject.Path & "\" & CurrentProject.name & Chr(34) & _
+             " " & Chr(34) & CurrentProject.Path & "\" & CurrentProject.name & ".old" & Chr(34))
     
     make_backup = True
     Exit Function
 err:
-        MsgBox "Error during backup:" & err.Description
+        MsgBox "Error during backup: " & err.Description
 End Function
 
 Public Function complete_gitignore()