diff --git a/src/app/FakeLib/EnvironmentHelper.fs b/src/app/FakeLib/EnvironmentHelper.fs
index d52ee3def69..a92de04427a 100644
--- a/src/app/FakeLib/EnvironmentHelper.fs
+++ b/src/app/FakeLib/EnvironmentHelper.fs
@@ -119,6 +119,19 @@ let mutable TargetPlatformPrefix =
else Some @"C:\Windows\Microsoft.NET\Framework"
|> Option.get
+/// Base path for getting tools from windows SDKs
+let sdkBasePath = ProgramFilesX86 @@ "Microsoft SDKs\Windows"
+
+/// Helper function to help find framework or sdk tools from the
+/// newest toolkit available
+let getNewestTool possibleToolPaths =
+ possibleToolPaths
+ |> Seq.sortBy (fun p -> p)
+ |> Array.ofSeq
+ |> Array.rev
+ |> Seq.ofArray
+ |> Seq.head
+
/// Gets the local directory for the given target platform
let getTargetPlatformDir platformVersion =
if Directory.Exists(TargetPlatformPrefix + "64") then (TargetPlatformPrefix + "64") @@ platformVersion
diff --git a/src/app/FakeLib/FakeLib.fsproj b/src/app/FakeLib/FakeLib.fsproj
index 972fe715826..db0fb2ae682 100644
--- a/src/app/FakeLib/FakeLib.fsproj
+++ b/src/app/FakeLib/FakeLib.fsproj
@@ -151,6 +151,8 @@
+
+
diff --git a/src/app/FakeLib/RegAsmHelper.fs b/src/app/FakeLib/RegAsmHelper.fs
index 48c76be11a1..b4243c5fd65 100644
--- a/src/app/FakeLib/RegAsmHelper.fs
+++ b/src/app/FakeLib/RegAsmHelper.fs
@@ -3,6 +3,11 @@
module Fake.RegAsmHelper
open System
+open System.IO
+
+/// Path to newest `regasm.exe`
+let regAsmToolPath = !! (TargetPlatformPrefix + "/**/RegAsm.exe")
+ |> getNewestTool
/// RegAsm parameter type
type RegAsmParams =
@@ -13,7 +18,7 @@ type RegAsmParams =
/// RegAsm default params
let RegAsmDefaults =
- { ToolPath = @"C:\Windows\Microsoft.NET\Framework\v2.0.50727\regasm.exe"
+ { ToolPath = regAsmToolPath
WorkingDir = "."
TimeOut = TimeSpan.FromMinutes 5.
ExportTypeLibrary = true }
@@ -36,3 +41,51 @@ let RegAsm setParams lib =
info.Arguments <- args) parameters.TimeOut
then failwithf "RegAsm %s failed." args
traceEndTask "RegAsm" lib
+
+/// Executes `RegAsm.exe` with the `/codebase` `/tlb` option
+///
+/// Used to temporarily register any .net dependencies before running
+/// a VB6 build
+let public RegisterAssembliesWithCodebase workingDir (assemblies:string seq) =
+ traceStartTask "Regasm with codebase" "Registering assemblies with codebase, expect warnings"
+ let registerAssemblyWithCodebase assembly =
+ async {
+ let! regAsmResult =
+ asyncShellExec {defaultParams with
+ Program = regAsmToolPath
+ WorkingDirectory = workingDir
+ CommandLine = (sprintf "\"%s\" /tlb:%s /codebase" assembly ((Path.GetFileName assembly) + ".tlb"))
+ }
+ if regAsmResult <> 0 then failwith (sprintf "Register %s with codebase failed" assembly)
+ return ()
+ }
+ assemblies
+ |> Seq.map registerAssemblyWithCodebase
+ |> Async.Parallel
+ |> Async.RunSynchronously
+ |> ignore
+ traceEndTask "Regasm with codebase" "Registering assemblies with codebase, expect warnings"
+
+/// Executes `Regasm.exe` with the `/codebase /tlb /unregister` options
+///
+/// Used to unregegister any temporarily registerd .net dependencies
+/// _after_ running a VB6 build
+let public UnregisterAssemblies workingDir (assemblies:string seq) =
+ traceStartTask "Regasm /unregister with codebase" "Registering assemblies with codebase, expect warnings"
+ let registerAssemblyWithCodebase assembly =
+ async {
+ let! regAsmResult =
+ asyncShellExec {defaultParams with
+ Program = regAsmToolPath
+ WorkingDirectory = workingDir
+ CommandLine = (sprintf "\"%s\" /tlb:%s /codebase /unregister" assembly ((Path.GetFileName assembly) + ".tlb"))
+ }
+ if regAsmResult <> 0 then failwith (sprintf "Unregister %s with codebase failed" assembly)
+ return ()
+ }
+ assemblies
+ |> Seq.map registerAssemblyWithCodebase
+ |> Async.Parallel
+ |> Async.RunSynchronously
+ |> ignore
+ traceEndTask "Regasm /unregister with codebase" "Registering assemblies with codebase, expect warnings"
\ No newline at end of file
diff --git a/src/app/FakeLib/Sxshelper.fs b/src/app/FakeLib/Sxshelper.fs
new file mode 100644
index 00000000000..84b72ef7c71
--- /dev/null
+++ b/src/app/FakeLib/Sxshelper.fs
@@ -0,0 +1,339 @@
+/// Module that enables creating and embedding Side-by-Side interop
+/// manifests for registration free deployment of Com-.net interop projects
+module Fake.SxsHelper
+
+open Fake
+open System
+open System.IO
+open System.Linq
+open System.Xml.Linq
+
+/// Represents a `.NET` assembly that may be used in COM interop projects
+type InteropAssemblyData =
+ {
+ /// Assembly name
+ Name:string
+
+ /// Path to the assembly file
+ Path:string
+
+ /// Assembly version
+ Version:string
+
+ /// Guid from the `System.Runtime.Interopservice.GuidAttribute` of the assembly
+ Guid:System.Guid
+ }
+
+/// Represents an executable to create an _application manifest_ for
+type InteropApplicationData =
+ {
+ /// Path of the executable binary file
+ ExecutablePath:string
+
+ /// Version of the executable
+ Version:String
+
+ /// Dependent `.NET` assemblies of the executable
+ Dependencies:InteropAssemblyData seq
+ }
+
+/// Represents status of attempted parsing
+/// of IL file created from executing `ildasm.exe`
+/// on a binary
+type private ILparsingResult =
+ /// Found all required data
+ /// Includes structured assembly data
+ | Success of InteropAssemblyData
+ /// Failed to find all reguired data
+ /// Includes an error message
+ | Failed of string
+
+/// Path to `mt.exe`
+/// ref: https://msdn.microsoft.com/en-us/library/aa375649(v=vs.85).aspx
+let private mtToolPath = !! (sdkBasePath + "/**/mt.exe") -- (sdkBasePath + "/**/x64/*.*")
+ |> getNewestTool
+
+/// Path to `ildasm.exe
+/// .net fx dissasembly tool
+/// ref: https://msdn.microsoft.com/en-us/library/f7dy01k1(v=vs.110).aspx
+let private ildasmPath = !! (sdkBasePath + "/**/ildasm.exe") -- (sdkBasePath + "/**/x64/*.*")
+ |> getNewestTool
+
+/// XLM namespace of manifest files
+let private manifestNamespace = "urn:schemas-microsoft-com:asm.v1"
+
+/// create XName from string with manifest namepace
+let private nsXn s = XName.Get(s, manifestNamespace)
+/// create XName from string __without__ manifest namespace
+let private xn s = XName.Get(s)
+
+let private setAssemblyIdAttributeValue attributeName attributeValue (manifest:XContainer) =
+ manifest.Descendants(nsXn "assemblyIdentity")
+ .Single()
+ .Attribute(xn attributeName)
+ .SetValue(attributeValue)
+
+let private getAssemblyIdAttributeValue attributeName (manifest:XContainer) =
+ manifest.Descendants(nsXn "assemblyIdentity")
+ .Single()
+ .Attribute(xn attributeName)
+ .Value
+
+let private setAssemblyName manifest name =
+ manifest |> setAssemblyIdAttributeValue "name" name
+
+let private setAssemblyVersion manifest version =
+ manifest |> setAssemblyIdAttributeValue "version" version
+
+let private copyAssemblyIdAttributeValue attributeName toManifest fromManifest =
+ toManifest
+ |> setAssemblyIdAttributeValue attributeName
+ (fromManifest |> getAssemblyIdAttributeValue attributeName)
+
+let private copyAssemblyIdName =
+ copyAssemblyIdAttributeValue "name"
+
+let private copyAssemblyIdVersion =
+ copyAssemblyIdAttributeValue "version"
+
+let private copyElements ((toManifest:XContainer), toElement) ((fromManifest:XContainer), elementName) =
+ toManifest.Element(nsXn toElement).Add(fromManifest.Descendants(nsXn elementName))
+
+let private copyClrClasses toManifest fromManifest =
+ (fromManifest, "clrClass") |> copyElements (toManifest, "assembly")
+
+/// Embeds a manifest file in a binary using `mt.exe`
+let private embedManiFestAsync workingDir (asyncData: Async) =
+ async {
+ let! (manifestPath, binaryPath) = asyncData
+ let! embedManifestResult = asyncShellExec {defaultParams with
+ Program = mtToolPath
+ WorkingDirectory = workingDir
+ CommandLine = (sprintf "-manifest \"%s\" -outputResource:\"%s\" -nologo -verbose" manifestPath binaryPath)}
+ if embedManifestResult <> 0 then failwith (sprintf "Embedding SxS manifest from %s into %s failed" manifestPath binaryPath)
+ return ()
+ }
+
+/// Created and embeds assembly Side-by-side interop manifests for provided assemblies
+///
+/// ## Parameters
+/// - `workingDir` - somewhere to put any temp files created
+/// - `assemblies` - .net assemblies to create manifests for
+///
+/// ## Process
+///
+/// This function will use `mt.exe` (ref: https://msdn.microsoft.com/en-us/library/aa375649(v=vs.85).aspx)
+/// to create a manifest for each assembly. This created manifest is unfortunately _not_ a valid
+/// interop Side-by-Side manifest, but it has the important `clrClass` elements, + `version` and `name`info that would be the most
+/// difficult to create through other means.
+/// The important info is then put into a valid base manifest and embedded into the assembly as a resource.
+let AddEmbeddedAssemblyManifest workingDir (assemblies: string seq) =
+ traceStartTask "AddEmbeddedAssemblyManifest" (sprintf "Adding assembly manifests to %i assemlbies" (assemblies |> Seq.length))
+ let createManifestPath assembly =
+ workingDir @@ ((Path.GetFileNameWithoutExtension assembly) + ".manifest")
+
+ let assemblyManifestBase =
+ """
+
+
+
+
+ """.Trim()
+
+ let createManiFestBaseAsync assembly =
+ async {
+ let manifestPath = createManifestPath assembly
+ let! createBaseManifestResult = asyncShellExec {defaultParams with
+ Program = mtToolPath
+ WorkingDirectory = workingDir
+ CommandLine = (sprintf "-managedassemblyname:\"%s\" -out:\"%s\" -nodependency -nologo -verbose" assembly manifestPath)
+ }
+ if createBaseManifestResult <> 0 then failwith (sprintf "Failed generating base manifest for %s" assembly)
+ return (assembly, manifestPath)
+ }
+
+ let createManifestAsync (asyncData: Async) =
+ async {
+ let! (assembly, manifestPath) = asyncData
+ let createdManifest = manifestPath |> XDocument.Load
+ let assemblyManifest = assemblyManifestBase |> XDocument.Parse
+ createdManifest |> copyAssemblyIdName assemblyManifest
+ createdManifest |> copyAssemblyIdVersion assemblyManifest
+ createdManifest |> copyClrClasses assemblyManifest
+ assemblyManifest.Save manifestPath
+ return (manifestPath, assembly)
+ }
+
+ assemblies
+ |> Seq.map (createManiFestBaseAsync >> createManifestAsync >> embedManiFestAsync workingDir )
+ |> Async.Parallel
+ |> Async.RunSynchronously
+ |> ignore
+ traceEndTask "AddEmbeddedAssemblyManifest" (sprintf "Adding assembly manifests to %i assemlbies" (assemblies |> Seq.length))
+
+/// Gets `name`, `path', `version` and interop `Guid` for those of the provided assemblies that have
+/// all of the required information.
+///
+/// ## Parameters
+/// - `workingDir` - Somewhere to put temporary files
+/// - `assemblies` - assemblies to get data from
+///
+/// ## Purpose
+///
+/// In order to create _application_ interop side-by-side manifests we need to know some metadata
+/// about the assemblies that may be referenced from COM executables.
+/// For the manifest we need the _assembly version_ and _ assembly name_. And in addition to that
+/// the interop _guid_ is collected so we can determine if the assembly is referenced by _vb6 projects_
+///
+/// ## Process
+///
+/// This function is a _hack_. To avoid using reflection and loading all potential assemblies into the
+/// appdomain (with all the possible problems that may cause). I wanted to get this metadata by other means.
+/// I ended up using the windows sdk dissasembler `ildasm.exe` (ref: https://msdn.microsoft.com/en-us/library/f7dy01k1(v=vs.110).aspx)
+/// to create the smallest dissasembly I could (Really only need the manifest part), and the parse the IL file to get the metadata
+/// (If anyone knows a cleaner / better way, pls improve on the code)
+let GetInteropAssemblyData workingDir assemblies =
+ let toChars (s:string) = s.ToCharArray () |> Seq.ofArray
+ let replace (oldVal:Char) (newVal:Char) (s:string) = (s.Replace(oldVal, newVal))
+ let getValueBetween startChar endChar (line:string) =
+ line
+ |> toChars
+ |> Seq.skipWhile (fun c -> c <> startChar)
+ |> Seq.skip 1
+ |> Seq.takeWhile (fun c -> c <> endChar)
+ |> String.Concat
+
+ let getGuid assembly (customDataLines: string[])=
+ match customDataLines |> Array.tryFind (fun l -> l.Contains("GuidAttribute")) with
+ | None -> None
+ | Some data -> try
+ match data |> getValueBetween '\'' '\'' |> Guid.TryParse with
+ | (true, guid) -> Some(guid)
+ | (false, _ ) -> None
+ with
+ | :? System.ArgumentException as ex -> None
+
+ let tryGetInteropInfo (assembly, (lines: string seq)) =
+ let assemblyData =
+ lines
+ |> Seq.skipWhile (fun l -> not (l.Contains(".assembly") && not (l.Contains("extern"))))
+ |> Seq.takeWhile (fun l -> l <> "}")
+ if assemblyData.Count() = 0 then
+ Failed (sprintf "Did not find assemblydata section for %s" assembly)
+ else
+ let customData = (assemblyData |> Seq.filter (fun l -> let trimmed = l.Trim()
+ trimmed.StartsWith(".custom") ||
+ trimmed.StartsWith("="))
+ |> String.Concat
+ ).Split([|".custom"|], StringSplitOptions.RemoveEmptyEntries)
+
+ let versionLine = assemblyData |> Seq.tryFind(fun l -> l.Trim().StartsWith(".ver"))
+ let assyName = (assemblyData |> Seq.head).Replace(".assembly","").Trim()
+
+
+ match (versionLine, getGuid assembly customData, String.IsNullOrWhiteSpace assyName) with
+ | _, _, true -> Failed(sprintf "No assembly name found for %s" assembly)
+ | None, _, _ -> Failed(sprintf "No version info found for %s" assembly)
+ | _, None, _ -> Failed(sprintf "No guid attribute found for %s" assembly)
+ | Some version, Some guid, false -> Success({
+ Name = assyName
+ Path = assembly
+ Guid = guid
+ Version = version.Replace(".ver","").Trim().Replace(":",".")
+ })
+ let tryGetInteropInfoAsync asyncData =
+ async {
+ let! (assembly, (lines: string[])) = asyncData
+ return tryGetInteropInfo (assembly, lines)
+ }
+
+ let getRawAssemblyDataAsync assembly =
+ async {
+ let ilName = workingDir @@ ((Path.GetFileNameWithoutExtension assembly) + ".il")
+ let! dissasembleResult =
+ asyncShellExec {defaultParams with
+ Program = ildasmPath
+ WorkingDirectory = workingDir
+ CommandLine = (sprintf "\"%s\" /output:\"%s\" /pubonly /caverbal /item:non_items_please /nobar /utf8" assembly ilName)}
+ if dissasembleResult <> 0 then failwith (sprintf "Failed using ildasm to get metadata for %s" assembly)
+ let! lines = async {return File.ReadAllLines ilName}
+ return (assembly, lines)
+ }
+
+
+
+ assemblies
+ // To Avoid rerunning the complete chain for every operation
+ // a list is better.
+ |> List.ofSeq
+ |> List.map ((getRawAssemblyDataAsync >> tryGetInteropInfoAsync))
+ |> Async.Parallel
+ |> Async.RunSynchronously
+ |> List.ofArray
+ |> List.filter (fun l -> match l with
+ | Failed error -> traceImportant error
+ false
+ | Success data -> true)
+ |> List.map (fun l -> match l with
+ | Failed _ -> failwith "This should not be happening"
+ | Success data -> data)
+
+/// Creates and adds _application interop side-by-side manifests_ to provided executables
+///
+/// ## Parameters
+/// - `workingdir` - somewhere to put any temporary files
+/// - `applications` - Metadata about executables to create manifests for.
+let public AddEmbeddedApplicationManifest workingDir (applications: InteropApplicationData seq) =
+ traceStartTask "AddEmbeddedApplicationManifest" (sprintf "Adding embedded application manifest to %i applications" (applications |> Seq.length))
+ let applicationManifestBase =
+ """
+
+
+
+
+ """.Trim()
+
+ let dependencyBase =
+ ("""
+
+
+
+
+
+
+
+
+ """.Trim() |> XDocument.Parse).Descendants(nsXn "dependency").Single()
+
+
+ let createDependencyElements (dependencies:InteropAssemblyData seq) =
+ let createDependencyElement (dependency: InteropAssemblyData) =
+ let dependencyElement = (new XElement(dependencyBase))
+ dependency.Name |> setAssemblyName dependencyElement
+ dependency.Version |> setAssemblyVersion dependencyElement
+ dependencyElement
+
+ dependencies |> Seq.map createDependencyElement
+
+ let createManifest (application: InteropApplicationData) =
+ let appManifest = applicationManifestBase |> XDocument.Parse
+ application.ExecutablePath |> Path.GetFileName |> setAssemblyName appManifest
+ application.Version |> setAssemblyVersion appManifest
+ appManifest.Element(nsXn "assembly").Add(application.Dependencies |> createDependencyElements)
+ let appManifestPath = workingDir @@ ((Path.GetFileName application.ExecutablePath) + ".manifest")
+ appManifest.Save(appManifestPath)
+ (appManifestPath, application.ExecutablePath)
+
+ let createManifestAsync (application: InteropApplicationData) =
+ async {
+ return createManifest application
+ }
+
+ applications
+ |> Seq.map (fun a ->
+ tracefn "Creating manifest for %s" (Path.GetFileNameWithoutExtension a.ExecutablePath)
+ a |> (createManifestAsync >> embedManiFestAsync workingDir) )
+ |> Async.Parallel
+ |> Async.RunSynchronously
+ |> ignore
+ traceEndTask "AddEmbeddedApplicationManifest" (sprintf "Adding embedded application manifest to %i applications" (applications |> Seq.length))
\ No newline at end of file
diff --git a/src/app/FakeLib/Vb6helper.fs b/src/app/FakeLib/Vb6helper.fs
new file mode 100644
index 00000000000..45137be0b2b
--- /dev/null
+++ b/src/app/FakeLib/Vb6helper.fs
@@ -0,0 +1,313 @@
+/// Enables building of Visual Basic 6 projects
+/// Also includes a do-it-all function that will embed interop
+/// side-by-side manifest to executables from Vb6 using
+/// functions from the Side-by-side helper module
+module Fake.Vb6Helper
+
+open Fake
+open Fake.SxsHelper
+open System
+open System.IO
+
+/// Parameters for running a VB6 build
+type Vb6BuildParams =
+ {
+ /// Path to the VB6 executable
+ Toolpath:string;
+
+ /// Directory to put generated binaries
+ Outdir:string;
+
+ /// Directory to put logs and other temporary files
+ /// created during the build process
+ Logdir:string;
+
+ /// Maximum amount of time the entire build is allowed to take
+ Timeout:System.TimeSpan }
+
+type private Vb6BuildJob =
+ { Path:string;
+ Name:string;
+ Started:System.DateTime;
+ Finished:System.DateTime;
+ IsStarted:bool;
+ StartSucceeded:bool
+ IsFinished:bool;
+ LogFile:string;
+ IsSuccessful:bool;
+ ErrorMessage:string }
+
+type private Vb6BuildResult =
+ | Success
+ | Pending
+ | Failed of string
+
+/// Represents the version of a VB6 project
+/// `ToString ()` will return a Maj.Min.Rev.Patch version string
+type Vb6Version = {MajorVer:int; MinorVer:int; RevisionVer:int; AutoIncrementVer:int;}
+ override x.ToString () = sprintf "%i.%i.%i.%i" x.MajorVer x.MinorVer x.RevisionVer x.AutoIncrementVer
+
+/// Represents a VB6 project
+type Vb6Project =
+ {
+ /// Name of binary that will
+ /// be generated from this project
+ BinaryName:string
+
+ /// Version of the project
+ /// in Major.Minor.Revision.Patch format
+ Version: string
+
+ /// GUIDs of all references and components used
+ /// in this VBV6 project
+ References: Guid seq
+ }
+
+let private defaultVb6BuildParams = {
+ Toolpath = ProgramFilesX86 + @"\Microsoft Visual Studio\VB98\VB6.exe"
+ Outdir = "bin"
+ Logdir = "temp"
+ Timeout = System.TimeSpan.FromMinutes 10.0
+ }
+
+/// Executes a VB6 command line make on all provided VB6 projects
+///
+/// Builds will be executed in paralell
+///
+/// ## Parameters
+/// - `getConfig` - function to modify the build params record from default values
+/// - `vb6Projects`- `Seq` of paths to `.vbp` files to build
+let public Vb6Make (getConfig: Vb6BuildParams->Vb6BuildParams) (vb6Projects: string seq) =
+ let config = defaultVb6BuildParams |> getConfig
+ traceStartTask "Vb6Make" (sprintf "Building %i projects" (vb6Projects |> Seq.length))
+ let jobs = vb6Projects
+ |> List.ofSeq
+ |> List.map (fun p ->
+ let name = System.IO.Path.GetFileNameWithoutExtension p
+ {
+ Path = p
+ Name = name
+ Started = System.DateTime.Now
+ Finished = System.DateTime.Now
+ IsFinished = false
+ IsStarted = false
+ StartSucceeded = false
+ IsSuccessful = false
+ ErrorMessage = ""
+ LogFile = config.Logdir @@ (name + ".log")
+ })
+
+ let startBuildAsync j =
+ async {
+ let! startResult = asyncShellExec {defaultParams with
+ Program = config.Toolpath
+ WorkingDirectory = config.Logdir
+ CommandLine = (sprintf "/m \"%s\" /out \"%s\" /outdir \"%s\"" j.Path j.LogFile config.Outdir)}
+
+ if startResult <> 0 then
+ return {j with IsStarted = true; Started = System.DateTime.Now; ErrorMessage = "StartupFailed";}
+ else
+ return {j with IsStarted = true; Started = System.DateTime.Now; StartSucceeded = true}
+ }
+
+ let getLogfileStatusAsync j =
+ async {
+ let! exists = async {return System.IO.File.Exists(j.LogFile)}
+ match exists with
+ | false -> return Pending
+ | true -> let! content = async { return System.IO.File.ReadAllText j.LogFile }
+ match content with
+ | x when x.ToLower().Contains("succeeded") -> return Success
+ | x when x.ToLower().Contains("failed") -> return Failed(x)
+ | _ -> return Pending
+ }
+
+ let rec waitForFinishAsync asyncJ =
+ async {
+ let! j = asyncJ
+ let! logFileStatus = getLogfileStatusAsync j
+ let hasTimedOut = (DateTime.Now - j.Started) > config.Timeout
+ match (logFileStatus, j.StartSucceeded, hasTimedOut) with
+ | Success, _, _ -> tracefn "%s finished successfully after %A" j.Name (System.DateTime.Now - j.Started)
+ return {j with IsFinished = true; IsSuccessful = true; Finished = System.DateTime.Now}
+ | Failed error, _, _ -> traceError (sprintf "%s failed after %A due to %s" j.Name (System.DateTime.Now - j.Started) error)
+ return {j with IsFinished = true; ErrorMessage = error; Finished = System.DateTime.Now}
+ | Pending, false, _ -> traceError (sprintf "%s failed after %A due to failed startup" j.Name (System.DateTime.Now - j.Started))
+ return {j with IsFinished = true; ErrorMessage = "Startup failed"; Finished = System.DateTime.Now}
+ | Pending, _, true -> traceError (sprintf "%s has timed out after %A" j.Name (System.DateTime.Now - j.Started))
+ return {j with IsFinished = true; IsSuccessful = false; ErrorMessage = "Timed out"}
+ | Pending, _,_ -> do! Async.Sleep 500
+ return! waitForFinishAsync asyncJ
+ }
+
+ let startTime = System.DateTime.Now
+
+ let completedWork =
+ jobs
+ |> List.map (startBuildAsync >> waitForFinishAsync)
+ |> Async.Parallel
+ |> Async.RunSynchronously
+ |> List.ofArray
+
+ let failedJobs = completedWork |> List.filter (fun j -> not j.IsSuccessful)
+ match failedJobs with
+ | [] -> traceEndTask "Vb6Make" (sprintf "Building %i projects" (vb6Projects |> Seq.length))
+ | _ -> failwith "Vb6 build failed after %A" (System.DateTime.Now - startTime)
+
+/// Returns application details for provided `.vbp` files.
+///
+/// ## Information returned
+/// - Name of created binary file
+/// - Version as saved in `.vbp`file
+/// - GUIDs of all referenced libraries and components
+///
+/// ## Usage
+///
+/// This is used for creating Side-By-Side interop manifests.
+let public GetVb6ApplicationProjDetails (projects: string seq) =
+ let defaultVb6Version = {MajorVer = 1; MinorVer = 0; RevisionVer = 0; AutoIncrementVer = 0}
+ let toChars (s:string) = s.ToCharArray () |> Seq.ofArray
+
+ let getValueBetween startChar endChar (line:string) =
+ line
+ |> toChars
+ |> Seq.skipWhile (fun c -> c <> startChar)
+ |> Seq.skip 1
+ |> Seq.takeWhile (fun c -> c <> endChar)
+ |> String.Concat
+
+ let getVersionValue l =
+ l
+ |> toChars
+ |> Seq.skipWhile (fun c -> c <> '=')
+ |> Seq.skip 1
+ |> String.Concat
+ |> Int32.Parse
+
+ let getExename project (projectlines: string seq) =
+ let defaultName = (Path.GetFileNameWithoutExtension project) + ".exe"
+ match projectlines |> List.ofSeq |> List.filter (fun l -> l.StartsWith("ExeName32")) with
+ | [unique] -> match unique |> getValueBetween '"' '"' with
+ | name when not (String.IsNullOrWhiteSpace name) -> name
+ | _ -> defaultName
+ | _ -> defaultName
+
+ let getVersion (projectlines: string seq) =
+ let getVersionLines = Seq.filter (fun (l:string) ->
+ l.StartsWith("MajorVer") ||
+ l.StartsWith("MinorVer") ||
+ l.StartsWith("RevisionVer") ||
+ l.StartsWith("AutoIncrementVer")
+ )
+
+ let toVersion = Seq.fold (fun ver (line:string) ->
+ match line with
+ | x when x.StartsWith("MajorVer") -> {ver with MajorVer = x |> getVersionValue }
+ | x when x.StartsWith("MinorVer") -> {ver with MinorVer = x |> getVersionValue }
+ | x when x.StartsWith("RevisionVer") -> {ver with RevisionVer = x |> getVersionValue}
+ | x when x.StartsWith("AutoIncrementVer") -> {ver with AutoIncrementVer = x |> getVersionValue}
+ | _ -> ver) defaultVb6Version
+
+ projectlines |> getVersionLines |> toVersion
+
+ let getReferencesAndObjectGuids (projectLines: string seq) =
+ projectLines
+ |> Seq.filter (fun l -> l.StartsWith("Reference") || l.StartsWith("Object"))
+ |> Seq.map (fun l -> l |> getValueBetween '{' '}' |> Guid.Parse)
+
+ projects
+ |> Seq.map (fun p -> async {return (p, File.ReadAllLines(p, System.Text.Encoding.GetEncoding("ISO-8859-1")))})
+ |> Seq.map (fun asyncData -> async {
+ let! (p, lines) = asyncData
+ return { BinaryName = getExename p lines
+ Version = (lines |> getVersion).ToString()
+ References = lines |> getReferencesAndObjectGuids
+ }})
+ |> Async.Parallel
+ |> Async.RunSynchronously
+ |> Seq.ofArray
+
+/// Determines which of the provided assemblies are referenced by the
+/// provided VB6 projects, and registers them so the VB6 ide can
+/// find them.
+///
+/// ## Paramteters
+/// - `getConfig`- function to alter default VB6 build parameters
+/// - `vb6Projects` - Paths to all `.vbp` files to build
+/// - `possibleAssemblies` - Paths to assemblies that may be referenced by the VB6 projects
+let public RegisterDependenciesForDevelopment (getConfig: Vb6BuildParams->Vb6BuildParams) (vb6Projects: string seq) (possibleAssemblies: string seq) =
+ traceStartTask "RegisterDependenciesForDevelopment" (sprintf "Registering dependenices for %i projects" (vb6Projects |> Seq.length))
+ let config = defaultVb6BuildParams |> getConfig
+ let details = vb6Projects |> GetVb6ApplicationProjDetails
+ let interopReferences = possibleAssemblies |> GetInteropAssemblyData config.Logdir
+ let applications = details |> Seq.map (fun a ->
+ { ExecutablePath = config.Outdir @@ a.BinaryName
+ Version = a.Version
+ Dependencies = a.References
+ |> Seq.filter (fun g -> interopReferences |> Seq.exists (fun r -> r.Guid = g))
+ |> Seq.map (fun g -> interopReferences |> Seq.find (fun r -> r.Guid = g))
+ })
+ let dependenciesToRegister = applications |> Seq.collect (fun a -> a.Dependencies) |> Seq.distinct |> Seq.map (fun d -> d.Path)
+ dependenciesToRegister |> RegisterAssembliesWithCodebase config.Logdir
+ traceEndTask "RegisterDependenciesForDevelopment" (sprintf "Registering dependenices for %i projects" (vb6Projects |> Seq.length))
+
+/// Determins which of the provided assemblies are referenced by the
+/// provided VB6 projects, and __un-registers__ them
+///
+/// ## Paramteters
+/// - `getConfig`- function to alter default VB6 build parameters
+/// - `vb6Projects` - Paths to all `.vbp` files to build
+/// - `possibleAssemblies` - Paths to assemblies that may be referenced by the VB6 projects
+let public UnRegisterDependenciesForDevelopment (getConfig: Vb6BuildParams->Vb6BuildParams) (vb6Projects: string seq) (possibleAssemblies: string seq) =
+ traceStartTask "UnRegisterDependenciesForDevelopment" (sprintf "Un-registering dependenices for %i projects" (vb6Projects |> Seq.length))
+ let config = defaultVb6BuildParams |> getConfig
+ let details = vb6Projects |> GetVb6ApplicationProjDetails
+ let interopReferences = possibleAssemblies |> GetInteropAssemblyData config.Logdir
+ let applications = details |> Seq.map (fun a ->
+ { ExecutablePath = config.Outdir @@ a.BinaryName
+ Version = a.Version
+ Dependencies = a.References
+ |> Seq.filter (fun g -> interopReferences |> Seq.exists (fun r -> r.Guid = g))
+ |> Seq.map (fun g -> interopReferences |> Seq.find (fun r -> r.Guid = g))
+ })
+ let dependenciesToRegister = applications |> Seq.collect (fun a -> a.Dependencies) |> Seq.distinct |> Seq.map (fun d -> d.Path)
+ dependenciesToRegister |> UnregisterAssemblies config.Logdir
+ traceEndTask "UnRegisterDependenciesForDevelopment" (sprintf "Un-registering dependenices for %i projects" (vb6Projects |> Seq.length))
+
+
+/// All-In-one build and manifest function for VB6 __applications__ referencing .net __libraries__
+///
+/// ## Paramteters
+/// - `getConfig`- function to alter default VB6 build parameters
+/// - `vb6Projects` - Paths to all `.vbp` files to build
+/// - `possibleAssemblies` - Paths to assemblies that may be referenced by the VB6 projects
+///
+/// ## Process
+///
+/// This function will:
+///
+/// 1. Determine which of the `possibleAssemnblies` are referenced by any of the provided `.vbp` files
+/// 2. Temporarily register any referenced assemblies using `RegAsm /codebase /tlb`
+/// 3. Run VB6 command line make on all provided `.vbp` projects
+/// 4. Unregister all registered assemblies
+/// 5. Generate and embed Side-By-Side interop appplication manifests in all generated VB6 executables
+/// 6. Generate and embed Side-By-Side interop assembly manifest in all referenced assemblies
+let public BuildAndEmbedInteropManifests (getConfig: Vb6BuildParams->Vb6BuildParams) (vb6Projects: string seq) (possibleAssemblies: string seq) =
+ traceStartTask "BuildAndEmbedInteropManifests" (sprintf "Building and embedding for %i projects" (vb6Projects |> Seq.length))
+ let config = defaultVb6BuildParams |> getConfig
+ let details = vb6Projects |> GetVb6ApplicationProjDetails
+ let interopReferences = possibleAssemblies |> GetInteropAssemblyData config.Logdir
+ let applications = details |> Seq.map (fun a ->
+ { ExecutablePath = config.Outdir @@ a.BinaryName
+ Version = a.Version
+ Dependencies = a.References
+ |> Seq.filter (fun g -> interopReferences |> Seq.exists (fun r -> r.Guid = g))
+ |> Seq.map (fun g -> interopReferences |> Seq.find (fun r -> r.Guid = g))
+ })
+ let dependenciesToRegister = applications |> Seq.collect (fun a -> a.Dependencies) |> Seq.distinct |> Seq.map (fun d -> d.Path)
+ dependenciesToRegister |> RegisterAssembliesWithCodebase config.Logdir
+ vb6Projects |> Vb6Make getConfig
+ dependenciesToRegister |> UnregisterAssemblies config.Logdir
+ applications |> AddEmbeddedApplicationManifest config.Logdir
+ dependenciesToRegister |> AddEmbeddedAssemblyManifest config.Logdir
+ traceEndTask "BuildAndEmbedInteropManifests" (sprintf "Building and embedding for %i projects" (vb6Projects |> Seq.length))
\ No newline at end of file