Plugin Store

Add Media URL Shortcut.fh_lua

--[[
@Title:			Add Media URL Shortcut
@Type:				Standard
@Author:			Mike Tate
@Contributors:	
@Version:			1.8
@Keywords:		
@LastUpdated:		05 Oct 2026
@Licence:			This plugin is copyright (c) 2026 Mike Tate & contributors and is licensed under the MIT License which is hereby incorporated by reference (see https://pluginstore.family-historian.co.uk/fh-plugin-licence)
@Description:		Add a Media tab link to a Media record for a URL Shortcut to a web page.
@V1.8:				Use FSO to cater for Unicode file paths; Centre windows on FH window; Check for Updates button; FH V8 _ADDR; Add Rec Id; fhInitialise();
@V1.3:				FH V7 Lua 3.5 IUP 3.28 compatible version;
@V1.2:				Allow the URL to contain Lua magic pattern %n capture index.
@V1.1:				Allows a Title name for new Media record.
@V1.0:				First published in Plugin Store.
]]

require "iuplua"																		-- To access GUI window builder

require "luacom"
FSO = luacom.CreateObject("Scripting.FileSystemObject")						-- V1.8

local strVersion = "1.8"
local strName = "V"..strVersion.." Add Media URL Shortcut"

-- Report error message --
local function doError(strMessage,errFunction)
	-- strMessage		~ error message text
	-- errFunction		~ optional error reporting function
	if type(errFunction) == "function" then
		errFunction(strMessage)
	else
		error(strMessage)
	end
end -- local function doError

-- Convert filename to ANSI alternative and indicate success --
function FileNameToANSI(strFileName,strAnsiName)
	-- strFileName		~ full file path
	-- strAnsiFile		~ ANSI file name & type
	-- return values	~ ANSI file path, true if original path was ANSI compatible
	if stringx.encoding() == "ANSI" then return strFileName, true end
	local isFlag = fhIsConversionLossFlagSet()
	fhSetConversionLossFlag(false)
	local strAnsi = fhConvertUTF8toANSI(strFileName)
	local wasAnsi = true
	if fhIsConversionLossFlagSet() then
		strAnsiName = strAnsiName or "ANSI.ANSI"
		strAnsi = fhGetContextInfo("CI_APP_DATA_FOLDER").."\\Plugin Data\\"..strAnsiName
		wasAnsi = false
	end
	fhSetConversionLossFlag(isFlag)
	return strAnsi, wasAnsi
end -- local function FileNameToANSI

-- Check if folder exists --
function FlgFolderExists(strFolderName)
	-- strFolderName	~ full file path
	-- return value		~ true if it exists
	return FSO:FolderExists(strFolderName)
end -- function FlgFolderExists

-- Get parent folder --
function GetParentFolder(strFileName)
	-- strFileName		~ full file path
	-- return value		~ parent folder path
	local strParent = FSO:GetParentFolderName(strFileName)	--! Faulty in FH v6 with Unicode chars in path
	if fhGetAppVersion() == 6 then
		local _, wasAnsi = FileNameToANSI(strFileName)
		if not wasAnsi then
			strParent = strFileName:match("^(.+)[\\/][^\\/]+[\\/]?$")
		end
	end
	return strParent
end -- function GetParentFolder

-- Make subfolder recursively if does not exist --
function MakeFolder(strFolderName,errFunction)
	-- strFolderName	~ full source folder path
	-- errFunction		~ optional error reporting function
	-- return value		~ true if folder exists or created else false
	if not FSO:FolderExists(strFolderName) then
		if not MakeFolder(GetParentFolder(strFolderName),errFunction) then
			return false
		end
		FSO:CreateFolder(strFolderName)
		if not FSO:FolderExists(strFolderName) then
			doError("Cannot Make Folder:\n"..strFolderName.."\n",errFunction)
			return false
		end
	end
	return true
end -- function MakeFolder

-- Open File with ANSI path and return Handle --
function OpenFile(strFileName,strMode)
	-- strFileName		~ full file path
	-- strMode			~ "r", "w", "a" optionally suffixed with "+" &/or "b"
	-- return value		~ file handle
	local fileHandle, strError = io.open(strFileName,strMode)
	if fileHandle == nil then
		error("\n Unable to open file in \""..strMode.."\" mode. \n "..strFileName.." \n "..strError.." \n")
	end
	return fileHandle
end -- function OpenFile

-- Save string to file --
function SaveStringToFile(strContents,strFileName,strFormat)
	-- strContents		~ text string
	-- strFileName		~ full file path
	-- strFormat			~ optional "UTF-8" or "UTF-16LE"
	-- return value		~ true if successful else false
	strFormat = strFormat or "UTF-8"
	if fhGetAppVersion() > 6 then
		return fhSaveTextFile(strFileName,strContents,strFormat)
	end
	local strAnsi, wasAnsi = FileNameToANSI(strFileName)
	local fileHandle = OpenFile(strAnsi,"w")
	fileHandle:write(strContents)
	assert(fileHandle:close())
	if not wasAnsi then
		MoveFile(strAnsi,strFileName)
	end
	return true
end -- function SaveStringToFile

--[[
@Function:		CheckVersionInStore
@Author:			Mike Tate
@Version:			1.4
@LastUpdated:		15 Feb 2026
@Description:		Check plugin version against version in Plugin Store
@Parameter:		Plugin name and version
@Returns:			None
@Requires:		luacom
@V1.4:				Dispense with files and assume called via IUP button;
@V1.3:				Save and retrieve latest version in file;
@V1.2:				Ensure the Plugin Data folder exists;
@V1.1:				Monthly interval between checks; Report if Internet is inaccessible;
@V1.0:				Initial version;
]]

function CheckVersionInStore(strPlugin,strVersion)							-- Check if later Version available in Plugin Store

	require("luacom")
	local FSO = luacom.CreateObject("Scripting.FileSystemObject")
	local strFile = fhGetContextInfo("CI_APP_DATA_FOLDER").."\\Plugin Data\\VersionInStore "..strPlugin..".dat"
	if FSO:FileExists(strFile) then FSO:DeleteFile(strFile,true) end		-- Delete obsolete file

	local function httpRequest(strRequest)										-- Luacom http request protected by pcall() below
		local http = luacom.CreateObject("winhttp.winhttprequest.5.1")
		http:Open("GET",strRequest,false)
		http:Send()
		return http.Responsebody
	end -- local function httpRequest

	local function intVersion(strVersion)										-- Convert version string to comparable integer
		local intVersion = 0
		local arrNumbers = {}
		strVersion:gsub("(%d+)", function(strDigits) table.insert(arrNumbers,strDigits) end)
		for i = 1, 5 do
			intVersion = intVersion * 100 + tonumber(arrNumbers[i] or 0)
		end
		return intVersion
	end -- local function intVersion

	local strLatest = "0"
	if strPlugin then
		local strRequest ="http://www.family-historian.co.uk/lnk/checkpluginversion.php?name="..tostring(strPlugin)
		local isOK, strReturn = pcall(httpRequest,strRequest)
		if not isOK then																-- Problem with Internet access
			fhMessageBox(strReturn.."\n The Internet appears to be inaccessible. ")
		elseif strReturn then
			strLatest = strReturn:match("([%d%.]*),%d*")						-- Version digits & dots then comma and Id digits 
		end
	end
	local strMessage = "No later Version"
	if intVersion(strLatest) > intVersion(strVersion or "0") then
		strMessage = "Later Version "..strLatest
	end
	fhMessageBox(strMessage.." of this Plugin is available from the 'Plugin Store'.")
end -- function CheckVersionInStore

function strMakeShortcutFile(strURL)												-- Make the URL Shortcut File (.url)
	local strShortcut =																-- URL Shortcut file template
	[[
		[{000214A0-0000-0000-C000-000000000046}]
		Prop3=19,2
		[InternetShortcut]
		URL=<URL>
		IDList=
	]]
	local tblPattern = {}															-- Filename encodings for disallowed chars \/:"<>|*?
	tblPattern['"'] = "%22"
	tblPattern["*"] = "%2A"
	tblPattern["/"] = " "
	tblPattern[":"] = "%3A"
	tblPattern["<"] = "%3C"
	tblPattern[">"] = "%3E"
	tblPattern["?"] = "%3F"
	tblPattern["\\"]= "%5C"
	tblPattern["|"] = "%7C"
	local strFileName = strURL:gsub("://"," "):gsub('[\\/:"<>|%*%?%.]',tblPattern)..".url"
	local strMediaDir = fhGetContextInfo("CI_PROJECT_DATA_FOLDER").."\\Media\\"
	local strMediaURL = strMediaDir.."URL\\"
	MakeFolder(strMediaURL)															-- Ensure ...\Media\URL\ folders exist -- V1.8
	strShortcut = strShortcut:gsub("\t",""):gsub("<URL>",function() return strURL end)	-- V1.2 fix
	SaveStringToFile(strShortcut,strMediaURL..strFileName)					-- Might overwrite an existing file
	return "Media\\URL\\"..strFileName
end -- function strMakeShortcutFile

function ptrMakeMediaRecord(strURL,strTitl,strFile)							-- Make Media record with URL Title linked to Shortcut file
	local isOK = false
	local ptrObje = fhNewItemPtr()
	ptrObje:MoveToFirstRecord("OBJE")
	if fhGetAppVersion() < 7 then
		while ptrObje:IsNotNull() do												-- Check for existing Media record for same Shortcut in GEDCOM 5.5
			if fhGetItemText(ptrObje,"~._FILE") == strFile
			and fhGetItemText(ptrObje,"~.TITL") == strTitl then
				return ptrObje
			end
			ptrObje:MoveNext()
		end
		ptrObje = fhCreateItem("OBJE")											-- Otherwise create new Media record in GEDCOM 5.5
		if ptrObje:IsNotNull() then
			for strTag, strVal in pairs ({ _KEYS="URL"; _FILE=strFile; TITL=strTitl; FORM="url"; }) do
				local ptrTag = fhCreateItem(strTag,ptrObje,true)
				if ptrTag:IsNotNull() then
					isOK = fhSetValueAsText(ptrTag,strVal)
					if not isOK then break end
				end
			end
		end
	else
		while ptrObje:IsNotNull() do												-- Check for existing Media record for same Shortcut in GEDCOM 5.5.1
			if fhGetItemText(ptrObje,"~.FILE") == strFile
			and fhGetItemText(ptrObje,"~.FILE.TITL") == strTitl then
				return ptrObje
			end
			ptrObje:MoveNext()
		end
		ptrObje = fhCreateItem("OBJE")											-- Otherwise create new Media record in GEDCOM 5.5.1
		if ptrObje:IsNotNull() then
			local ptrRoot = ptrObje:Clone()
			for _, strData in ipairs ({ "_KEYS:URL"; "FILE:"..strFile; "TITL:"..strTitl; "FORM:url"; }) do
				local strTag, strVal = strData:match("^(.+):(.+)$")
				local ptrTag = fhCreateItem(strTag,ptrRoot,true)
				if ptrTag:IsNotNull() then
					isOK = fhSetValueAsText(ptrTag,strVal)
					if not isOK then break end
				end
				if strTag == "FILE" then ptrRoot = ptrTag end
			end
		end
	end
	if not isOK then
		fhMessageBox("\nFailed to add Media record for URL Shortcut.\n")
		ptrObje:SetNull()
	end
	return ptrObje
end -- function ptrMakeMediaRecord

function ptrLinkMediaRecord(ptrRec,ptrObje)										-- Link Media record to Media tab of selected record
	local isOK = false
	local ptrLink = fhNewItemPtr()
	if ptrObje:IsNull() then return ptrLink end
	ptrLink:MoveTo(ptrRec,"~.OBJE")
	while ptrLink:IsNotNull() do													-- Check for existing Media link for same Shortcut
		if fhGetValueAsLink(ptrLink):IsSame(ptrObje) then
			return ptrLink
		end
		ptrLink:MoveNext("SAME_TAG")
	end
	ptrLink = fhCreateItem("OBJE",ptrRec,true)									-- Otherwise create new link to Media record
	if ptrLink:IsNotNull() then
		isOK = fhSetValueAsLink(ptrLink,ptrObje)
	end
	if not isOK then
		fhMessageBox("\nFailed to add Media tab link to Media record.\n")
		ptrLink:SetNull()
	end
	return ptrLink
end -- function ptrLinkMediaRecord

function strGetShortcutURL(ptrRec)												-- Get Shortcut URL via user dialogue	-- V1.8

	local strHelp =																	-- Help and Advice message
	[[
	This adds a web page URL Shortcut to the Media tab of a chosen record.
	
	Enter desired web page URL and Title, then click 'Link Media URL' button.

	The Plugin then:
	  Adds a Shortcut file to the ...<project>.fh_data\Media\URL\ folder
	  Adds a Media record with chosen Title and URL, and Keyword = 'URL'
	  Adds a link to that Media record in the chosen record Media tab 

	To open Media URL click the triangular 'Open in Editor/Player' button.

	To undo changes use 'Edit > Undo Plugin Updates' before closing FH,
	& delete new shortcut files in ...<project>.fh_data\Media\URL\ folder.
	]]

	local strHead = strName.." to Media tab of '"..fhGetDisplayText(ptrRec):gsub("^%.%.%.of ","").."' ["..fhGetRecordId(ptrRec).."]"
	local strURL, strTitl

	local function setArg(txtURL,txtTitl)										-- Action for btnLink, btnQuit, and Close window
		strURL = txtURL
		if #strURL < 9 then
			strURL = nil
		else
			strTitl = txtTitl
			if strTitl == "" then
				strTitl = strURL
			end
		end
		return iup.CLOSE
	end -- local function setArg

	-- Define IUP controls for user dialogue
	local labURL  = iup.label { Title="Enter web page URL: "; }
	local txtURL  = iup.text  { Expand="Yes"; Tip="Copy and Paste the URL here (http://...)"; }
	local boxURL  = iup.hbox  { Expand="Yes"; labURL; txtURL; }
	local labTitl = iup.label { Title="Enter the media Title:"; }
	local txtTitl = iup.text  { Expand="Yes"; Tip="If left blank, the Title defaults to URL"; }
	local boxTitl = iup.hbox  { Expand="Yes"; labTitl; txtTitl; }
	local btnLink = iup.button{ Expand="Yes"; Tip="Add Media URL Shortcut"	; Title="Link Media URL"	; FgColor="0 128 0"; action=function() return setArg(txtURL.Value,txtTitl.Value) end; }
	local btnChck = iup.button{ Expand="Yes"; Tip="Check for Plugin Updates"	; Title="Plugin Updates?"	; FgColor="0 128 0"; }
	local btnHelp = iup.button{ Expand="Yes"; Tip="Obtain Help and Advice"	; Title="Help and Advice"	; FgColor="0 128 0"; action=function() iup.Message(strName.." ~ Help and Advice",strHelp:gsub("\t","")) end; }
	local btnQuit = iup.button{ Expand="Yes"; Tip="Quit from this Plugin"		; Title="Quit the Plugin"	; FgColor="255 0 0"; action=function() return setArg(" ") end; }
	local boxBtn  = iup.hbox  { Expand="Yes"; btnLink; btnChck; btnHelp; btnQuit; }
	local labUndo = iup.label { Expand="Yes"; Title="Undo changes by using command 'Edit > Undo Plugin Updates' before closing Family Historian"; Alignment="Acenter"; }
	local boxAll  = iup.vbox  { Expand="Yes"; boxURL; boxTitl; boxBtn; labUndo; Homogeneous="Yes"; }
	local dialog  = iup.dialog{ Title=strHead; boxAll; RasterSize="700x280"; MinSize="700x280"; Padding="4x4"; Gap="9"; Margin="8x8"; MinBox="No"; MaxBox="No"; DefaultEnter=btnLink; DefaultEsc=btnQuit; close_cb=function() return setArg(" ") end; }
	if fhGetAppVersion() > 6 then 												-- Window centres on FH parent
		iup.SetAttribute(dialog,"NATIVEPARENT",fhGetContextInfo("CI_PARENT_HWND"))
	end

	function btnChck:action()														-- Action for Plugin Updates button	-- V1.8
		dialog.Active = "NO"
		CheckVersionInStore("Add Media URL Shortcut",strVersion)
		dialog.Active = "YES"
		dialog.BringFront = "YES"
	end -- function btnChck:action

	dialog:showxy(iup.CENTERPARENT,iup.CENTERPARENT)
	iup.MainLoop()  
	return strURL, strTitl
end -- function strGetShortcutURL

function MainAction()
	local strMessage = "\nPlease select just one Individual, Family, or Source record.\n"
	if fhGetAppVersion() > 5 then													-- Cater for FH V6 Unicode and Place records
		fhSetStringEncoding("UTF-8")
		iup.SetGlobal("UTF8MODE","YES")
		iup.SetGlobal("UTF8MODE_FILE","NO")
		iup.SetGlobal("CUSTOMQUITMESSAGE","YES")								-- Needed for IUP 3.28
		strMessage = strMessage:gsub("or Source","Source, or Place")
		if fhGetAppVersion() > 7 then
			strMessage = strMessage:gsub("or Place","Place, or Address")	-- For FH V8 Addresses	-- V1.8
		end
	end	
	local arrRec = {}
	for _, strTag in ipairs ({"INDI";"FAM";"SOUR";"_PLAC";"_ADDR";}) do	-- For FH V8 Addresses	-- V1.8
		local ptrRec = fhNewItemPtr()
		ptrRec:MoveToFirstRecord(strTag)
		if ptrRec:IsNotNull() then													-- Search for selected records	-- V1.8
			arrRec = fhGetCurrentRecordSel(strTag)
			if #arrRec > 0 then break end
		end
	end
	if #arrRec == 1 then															-- Just one record selected, so get URL string
		local ptrRec = arrRec[1]
		local strURL, strTitl = strGetShortcutURL(ptrRec)						-- Get URL and Title via user dialogue	-- V1.8
		if strURL then
			local strFile = strMakeShortcutFile(strURL)							-- Make Shortcut file in \Media\URL\
			local ptrObje = ptrMakeMediaRecord(strURL,strTitl,strFile)		-- Make Media record for Shortcut
			local ptrLink = ptrLinkMediaRecord(ptrRec,ptrObje)				-- Link Media tab to Media record
			if ptrLink:IsNull() then
				error("\n\nPlugin failed to add Media URL.")
			end
		end
	else
		fhMessageBox(strName.."\n"..strMessage)									-- Zero or more than one record selected
	end
end -- function MainAction

if fhGetContextInfo("CI_APP_MODE") == "Project Mode" then

	fhInitialise(5,0,0,"save_recommended")										-- V1.8

	MainAction()
else
	fhMessageBox("\nThis Plugin only works for Projects, not standalone GEDCOM.\n")
end

Source: Add-Media-URL-Shortcut-1.fh_lua