on open x
	repeat with y in x
		ProcessOnevCardFile(y as alias)
	end repeat
end open

on run
	set theFile to (choose file with prompt "Select the vCard (version 3.0) file:") as alias
	ProcessOnevCardFile(theFile)
end run

on ProcessOnevCardFile(theFile)
	tell application "Finder"
		set destFol to (folder of theFile) as text
		set fName to displayed name of theFile
		set fExt to name extension of theFile
	end tell
	set newFile to destFol & fName & "-2.1." & fExt
	
	set CRLF to (ASCII character 13) & (ASCII character 10)
	set cardData to eliminateBlanks(parseTextFile(readTextFile(theFile), CRLF))
	write_to_file(ProcessCardData(cardData), newFile, false)
end ProcessOnevCardFile

on ProcessCardData(cardData)
	set CRLF to (ASCII character 13) & (ASCII character 10)
	set theRet to ""
	repeat with x in cardData
		set y to (x as string)
		set thecolon to (offset of ":" in y)
		set thesemi to (offset of ";" in y)
		if ((thesemi < thecolon) and (thesemi > 0)) then
			set labelpart to (characters 1 thru (thesemi - 1)) of y as string
		else
			set labelpart to (characters 1 thru (thecolon - 1)) of y as string
		end if
		set valuepart to (characters (thecolon + 1) thru (length of y) of y) as string --after :
		--	set theRet to theRet & (offset of ":" in thisItem) & "-" & thisItem & return
		if (labelpart is equal to "BEGIN") then
			set theRet to theRet & "BEGIN:VCARD" & CRLF & "VERSION:2.1" & CRLF
		else if (labelpart is equal to "N") then
			set theRet to theRet & "N:" & valuepart & CRLF
		else if (labelpart is equal to "FN") then
			set theRet to theRet & "FN:" & valuepart & CRLF
		else if (labelpart is equal to "TEL") then
			set tempst to (characters ((offset of "type=" in y) + 5) thru (length of y) of y) as string
			set thecolon2 to (offset of ":" in tempst)
			set thesemi2 to (offset of ";" in tempst)
			if ((thesemi2 < thecolon2) and (thesemi2 > 0)) then
				set telType to (characters 1 thru ((thesemi2) - 1) of tempst) as string
			else
				set telType to (characters 1 thru ((thecolon2) - 1) of tempst) as string
			end if
			set theRet to theRet & "TEL;" & telType & ":" & valuepart & CRLF
		else if (labelpart is equal to "END") then
			set theRet to theRet & "END:VCARD" & CRLF
		end if
	end repeat
	return theRet
end ProcessCardData

on eliminateUTF16(theText)
	--check first byte, if 00, we likely have unicode
	if (first character of theText is (ASCII character 0)) then
		set cleaned to Çclass ktxtÈ of ((theText as string) as record) --extract string theText
	else
		copy theText to cleaned
	end if
	return cleaned
end eliminateUTF16



on parseTextFile(theText, theDelimeter)
	set originalDelimiters to AppleScript's text item delimiters
	set AppleScript's text item delimiters to {theDelimeter}
	set theItems to text items 1 thru (count of text items of theText) of theText
	set AppleScript's text item delimiters to originalDelimiters
	return theItems
end parseTextFile
on eliminateBlanks(theLineSet)
	set theNewSet to {}
	--return (count of items in theLineSet)
	repeat with x in theLineSet
		if (length of x is greater than 4) then
			set theNewSet to theNewSet & x
		end if
	end repeat
	return theNewSet
end eliminateBlanks

on readTextFile(theFile)
	if (character 1 of readFile(theFile)) is equal to (ASCII character 0) then
		try
			set openFile to open for access theFile without write permission
			set theData to read openFile as Unicode text
			close access openFile
		on error errorMessage
			try
				close access openFile
			end try
			set theData to ""
			display dialog errorMessage
		end try
		return theData
	else
		try
			set openFile to open for access theFile without write permission
			set theData to read openFile as text -- this has to be clean text, unstyled
			close access openFile
		on error errorMessage
			try
				close access openFile
			end try
			set theData to ""
			display dialog errorMessage
		end try
		return theData
	end if
end readTextFile

on readFile(theFile)
	try
		set openFile to open for access theFile without write permission
		--		set theData to read openFile as text -- this has to be clean text, unstyled
		--set theData to read openFile as Unicode text
		set theData to read openFile --as text
		close access openFile
	on error errorMessage
		try
			close access openFile
		end try
		set theData to ""
		display dialog errorMessage
	end try
	return theData
end readFile


on saveText(theText, destFolder, destFileName)
	if last character of destFolder is not ":" then
		set destFolder to destFolder & ":"
	end if
	
	write_to_file(theText, (destFolder & destFileName), false)
	
	tell application "Finder"
		set theFile to alias (destFolder & destFileName)
		set the file type of theFile to "TEXT"
		set creator type of theFile to "R*ch"
	end tell
	
end saveText
on write_to_file(this_data, target_file, append_data)
	try
		set the target_file to the target_file as text
		set the open_target_file to Â
			open for access file target_file with write permission
		if append_data is false then Â
			set eof of the open_target_file to 0
		write this_data to the open_target_file starting at eof
		close access the open_target_file
		return true
	on error
		try
			close access file target_file
		end try
		return false
	end try
end write_to_file

on uppercase(someText)
	set newText to ""
	set theChars to (characters 1 thru (length of someText) of someText)
	repeat with a in theChars
		set asciinum to ASCII number of a
		if (asciinum is greater than or equal to (ASCII number of "a")) then
			if (asciinum is less than or equal to (ASCII number of "z")) then
				set a to ASCII character (asciinum - ((ASCII number of "a") - (ASCII number of "A")))
			end if
		end if
		set newText to newText & a
	end repeat
	return newText
end uppercase