|
@@ -0,0 +1,192 @@
|
|
|
|
|
+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
|
|
|
|
|
+
|
|
|
|
|
+
|
|
|
|
|
+End Function
|
|
|
|
|
+
|
|
|
|
|
+
|
|
|
|
|
+Public Function make_sources()
|
|
|
|
|
+'creates the source-code of the app
|
|
|
|
|
+
|
|
|
|
|
+ Debug.Print "Zip the app file"
|
|
|
|
|
+ Call zip_app_file
|
|
|
|
|
+ Debug.Print "> done"
|
|
|
|
|
+
|
|
|
|
|
+ Debug.Print get_include_tables
|
|
|
|
|
+
|
|
|
|
|
+ Debug.Print "Run VCS Export"
|
|
|
|
|
+ Call ExportAllSource
|
|
|
|
|
+ Debug.Print "> done"
|
|
|
|
|
+
|
|
|
|
|
+ MsgBox "Done"
|
|
|
|
|
+
|
|
|
|
|
+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"
|
|
|
|
|
+
|
|
|
|
|
+End Function
|
|
|
|
|
+
|
|
|
|
|
+Public Function config_git_repo()
|
|
|
|
|
+'configure the application GIT repository for VCS use
|
|
|
|
|
+
|
|
|
|
|
+'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
|
|
|
|
|
+
|
|
|
|
|
+' complete the gitignore file
|
|
|
|
|
+Call complete_gitignore
|
|
|
|
|
+
|
|
|
|
|
+
|
|
|
|
|
+End Function
|
|
|
|
|
+
|
|
|
|
|
+Public Function get_include_tables()
|
|
|
|
|
+ get_include_tables = vcs_param("include_tables")
|
|
|
|
|
+End Function
|
|
|
|
|
+
|
|
|
|
|
+Public Function vcs_param(ByVal key As String, Optional ByVal default_value As String = "") As String
|
|
|
|
|
+ vcs_param = default_value
|
|
|
|
|
+ On Error GoTo err_vcs_table
|
|
|
|
|
+ vcs_param = DFirst("val", "ztbl_vcs", "[key]='" & key & "'")
|
|
|
|
|
+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
|
|
|
|
|
+
|
|
|
|
|
+fin:
|
|
|
|
|
+ Exit Function
|
|
|
|
|
+UnknownErr:
|
|
|
|
|
+ MsgBox "Unknown error: unable to ZIP the app file, do it manually"
|
|
|
|
|
+ GoTo fin
|
|
|
|
|
+err:
|
|
|
|
|
+ MsgBox "Error while zipping file app: " & err.Description
|
|
|
|
|
+ GoTo fin
|
|
|
|
|
+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
|
|
|
|
|
+err:
|
|
|
|
|
+ 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 keys() As String
|
|
|
|
|
+keys = Split("*.accdb;*.laccdb;*.mdb;*.ldb", ";")
|
|
|
|
|
+
|
|
|
|
|
+gitignore_path = CurrentProject.Path & "\.gitignore"
|
|
|
|
|
+
|
|
|
|
|
+ Dim fso As Object
|
|
|
|
|
+ Set fso = CreateObject("Scripting.FileSystemObject")
|
|
|
|
|
+
|
|
|
|
|
+ Dim oFile As Object
|
|
|
|
|
+
|
|
|
|
|
+ If Dir(gitignore_path) = "" Then
|
|
|
|
|
+ Set oFile = fso.CreateTextFile(gitignore_path)
|
|
|
|
|
+ Else
|
|
|
|
|
+ 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
|
|
|
|
|
+ Next key
|
|
|
|
|
+ oFile.WriteLine "#]"
|
|
|
|
|
+ oFile.WriteBlankLines (2)
|
|
|
|
|
+
|
|
|
|
|
+ oFile.Close
|
|
|
|
|
+ Set fso = Nothing
|
|
|
|
|
+ Set oFile = Nothing
|
|
|
|
|
+
|
|
|
|
|
+End Function
|