B4A=true
Group=Default Group
ModulesStructureVersion=1
Type=Class
Version=6
@EndOfDesignText@
'Version: 2.00 from @walt61 with firstname and lastname added by @Alain75, more functions for groups, return codes, DataId for elementary functions and customizations
'Class module
Sub Class_Globals
	Dim const cidANDmt		As String = "contact_id = ? AND mimetype = ?"
	Dim const didANDmt		As String = "_id = ? AND mimetype = ?"
	Dim Const skipgrp		As String = "My Contacts,Starred in Android"
	
	Dim Const mt_address 	As String = "vnd.android.cursor.item/postal-address_v2"
	Dim const mt_custom		As String = "vnd.com.google.cursor.item/contact_user_defined_field"
	Dim const mt_event		As String = "vnd.android.cursor.item/contact_event"
	Dim Const mt_job		As String = "vnd.android.cursor.item/organization"
	Dim Const mt_email 		As String = "vnd.android.cursor.item/email_v2"
	Dim Const mt_member 	As String = "vnd.android.cursor.item/group_membership"
	Dim Const mt_name		As String = "vnd.android.cursor.item/name"
	Dim Const mt_note		As String = "vnd.android.cursor.item/note"
	Dim Const mt_phone 		As String = "vnd.android.cursor.item/phone_v2"
	Dim const mt_photo		As String = "vnd.android.cursor.item/photo"
	Dim const mt_website	As String = "vnd.android.cursor.item/website"
	
	Dim const cols_account	As String = "account_name=AccountName,account_type=AccountType"
	Dim const cols_address	As String = "_id=DataId,data1=RawAddress,data2=DataType,data3=UserType,data4=Street,data6=Neighborhood,data7=City,data9=PostCode"
	Dim const cols_custom	As String = "_id=DataId,data1=Name,data2=Text"
	Dim const cols_event	As String = "_id=DataId,data1=Date,data2=DataType,data3=UserType"
	Dim const cols_job		As String = "_id=CtactId,data1=Company,data4=Title,data5=Department"
	Dim const cols_email	As String = "_id=DataId,data1=Email,data2=DataType,data3=UserType"
	Dim const cols_name		As String = "contact_id=CtactId,raw_contact_id=RawId,data2=FirstName,data3=LastName,data1=DisplayName,account_type=AccountType"
	Dim const cols_note		As String = "_id=DataId,data1=Text"
	Dim const cols_phone	As String = "_id=DataId,data1=Number,data2=DataType,data3=UserType,account_type=AccountType"
	Dim const cols_photo	As String = "data15=Photo"
	Dim const cols_website	As String = "_id=DataId,data1=Website,data2=DataType,data3=UserType"
	
	Type cuAccount		(AccountName As String, AccountType As String)
	Type cuContact		(CtactId As Long, DisplayName As String, FirstName As String, LastName As String, AccountType As String, RawId As Long)
	Type cuJob			(CtactId As Long, Company As String, Title As String, Department As String)
	Type cuAddress		(DataId As Long, Street As String, Neighborhood As String, City As String, PostCode As String, DataType As String, RawAddress As String)
	Type cuCustom		(DataId As Long, Name As String, Text As String)
	Type cuEmail		(DataId As Long, Email As String, DataType As String)
	Type cuEvent 		(DataId As Long, Date As String, DataType As String)
	Type cuNote			(DataId As Long, Text As String)
	Type cuPhone		(DataId As Long, Number As String, DataType As String, AccountType As String)
	Type cuWebsite		(DataId As Long, Website As String, DataType As String)
	
	Private cr 			As ContentResolver
	Private Filters 	As Map
	Private FDisplay	As String = ""
	Private emTypes, phTypes, evTypes, adTypes, wbTypes 	As Map 
	Private UriData, UriGroup, UriContact, UriRawContact 	As Uri 

End Sub

'**************************************************************************************************************************************************
' FIND FUNCTIONS (returning lists of items)
'**************************************************************************************************************************************************

'Returns all contacts.
Public Sub FindAllContacts() As List
	Return FindContactsIdFromData("name", "data1 <> ?", "null")
End Sub
'Returns list of all defined groups or all only user groups
Public Sub FindAllGroups(UserOnly As Boolean) As List
	Dim res As List, Selection As String = UseFilters("deleted = 0"), title As String
	res.Initialize
	Dim c As Cursor = cr.Query(UriGroup, Array As String("system_id","title"), Selection, Null, "")
	For i = 0 To c.RowCount -1
		c.Position 	= i
		title 		= c.GetString("title").Trim
		If title=Null Then Continue
		If Not(UserOnly) Or c.GetString("system_id")=Null Then res.Add(title)
	Next
	c.Close
	res.Sort(True)
	Return res
End Sub
'Returns a List with cuContact items based on the name (may contain caracters joker %)
Public Sub FindContactsByName(SelName As String) As List
	Return FindContactsIdFromData("name", "data1 = ?", SelName)
End Sub
'Similar to FindContactsByName : finds contacts based on the mail (may contain caracters joker %)
Public Sub FindContactsByMail(SelMail As String) As List
	Return FindContactsIdFromData("email_v2", "data1 = ?", SelMail)
End Sub
'Similar to FindContactsByName : finds contacts based on the notes field (may contain caracters joker %)
Public Sub FindContactsByNotes(SelNote As String) As List
	Return FindContactsIdFromData("note", "data1 = ?", SelNote)
End Sub
'Similar to FindContactsByName : finds contacts based on the phone number (may contain caracters joker %)
Public Sub FindContactsByPhone(SelPhone As String) As List
	Return FindContactsIdFromData("phone_v2", "data1 = ?", SelPhone)
End Sub
'Returns starred or not starred contacts.
Public Sub FindContactsByStarred(Starred As Boolean) As List
	Return FindContactsIdFromData("name", "starred = ?", IIf(Starred,"1","0"))
End Sub
'Returns all contacts with a photo.
Public Sub FindContactsWithPhotos As List
	Return FindContactsIdFromData("photo", "data15 <> ?", "null")
End Sub
'Returns all contacts that are member of the specified group ID.
Public Sub FindContactsByGroupId(GroupId As Int) As List
	Return FindContactsIdFromData("group_membership", "data1 = ?", GroupId)
End Sub
'Returns all contacts that are member of a specified group name (may contain caracters joker %)
Public Sub FindContactsByGroupName(SelGroup As String) As List
	Dim res As List
	res.Initialize
	Dim gid As Long = GetGroupId(SelGroup)
	Return IIf(gid<0,res,FindContactsIdFromData("group_membership", "data1 = ?", gid)) 
End Sub
'Returns display_name based on default format (firstname + lastname) or optional custom format
Public Sub FormatDisplay(FirstName As String, LastName As String) As String
	If FDisplay="" Then Return (FirstName&" "&LastName).Trim
	Dim sep As String = FDisplay.Replace("%firstname","").Replace("%lastname","")
	Dim new As String = FDisplay.Replace("%firstname",FirstName).Replace("%lastname",LastName)
	new = Regex.Replace("^"&sep&"|"&sep&"$",new,"")
	Return new
End Sub

' Private functions used by find functions ********************************************************************************************************
Private Sub FindContactsIdFromData(Mime As String, Criteria As String, Value As String) As List
	If Value.Contains("%") Then Criteria = Criteria.Replace("=","LIKE").Replace("<>","LIKE")
	Dim Selection As String = UseFilters("mimetype = ? AND " & Criteria)
	Dim c As Cursor = cr.Query(UriData, Array As String("contact_id", "data1","data2","data3", "account_type","raw_contact_id"), _
		Selection, Array As String("vnd.android.cursor.item/"&Mime, Value), "")
	Dim res As List, one As Map
	res.Initialize
	one.Initialize
	For i = 0 To c.RowCount - 1
		c.Position 	= i
		Dim Id As Long	= c.GetLong("contact_id"), AccTyp As String = n2e(c.GetString("account_type"))
		If one.ContainsKey(Id&AccTyp) Then Continue
		one.Put(Id&AccTyp, Null)
		If Mime = "name" Then
			Dim cu As cuContact
			cu.Initialize
			cu.CtactId 		= Id
			cu.RawId		= c.GetString("raw_contact_id")
			cu.FirstName	= n2e(c.GetString("data2"))
			cu.LastName		= n2e(c.GetString("data3"))
			cu.DisplayName	= IIf(FDisplay="",c.GetString("data1"),FormatDisplay(cu.FirstName,cu.LastName))
		Else
			Dim cu As cuContact = GetNames(Id)
		End If
		' Display AccountType of selected object and not from GetNames
		cu.AccountType		= AccTyp
		res.Add(cu)
	Next
	c.Close
	Return res
End Sub
'Convert Null object to empty string
Private Sub n2e(koa As Object) As String
	Return IIf(koa=Null,"",koa.As(String).Trim)
End Sub

'*************************************************************************************************************************************************
' ADD FUNCTIONS
'*************************************************************************************************************************************************

' Adds an structured postal address for a contact.
Public Sub AddAddress(CtactId As Long, a As cuAddress) As Long
	Dim v As ContentValues = SetData(cols_address,a)
	Return AddData(v,CtactId,mt_address)
End Sub
'Adds a custom google field for the given id.
Public Sub AddCustom(CtactId As Long, c As cuCustom) As Int
	If n2e(c.Name)="" Or n2e(c.Text)="" Then Return 0
	Dim v As ContentValues = SetData(cols_custom,c)
	Return AddData(v,CtactId,mt_custom)
End Sub
'Adds an email field to the given contact id.
Public Sub AddEmail(CtactId As Long, e As cuEmail) As Long
	Dim v As ContentValues = SetData(cols_email,e)
	Return AddData(v,CtactId,mt_email)
End Sub
'Adds an event field to the given contact id
Public Sub AddEvent(CtactId As Long, e As cuEvent) As Long
	Dim v As ContentValues = SetData(cols_event,e)
	Return AddData(v,CtactId,mt_event)
End Sub
'Adds a group to the given contact id
Public Sub AddGroupById(CtactId As Long, GroupId As Long) As Long
	Dim v As ContentValues, RawId As Long = GetRawIDFromId(CtactId)
	v.initialize
	v.PutString("mimetype",mt_member)
	v.PutLong("raw_contact_id",RawId)
	v.PutLong("data1",GroupId)
	Return cr.Insert(UriData,v).ParseId
End Sub
'Adds a group to the given contact id
Public Sub AddGroupByName(CtactId As Long, GrpName As String, AccountName As String, AccountType As String) As Long
	GrpName = GrpName.Trim
	If GrpName="" Then Return -1
	Dim gid As Long = GetGroupId(GrpName)
	If gid<0 Then gid = CreateGroup(GrpName,AccountName,AccountType)
	Return AddGroupById(CtactId,gid)
End Sub
'Adds an additional note to the given contact id (non standard)
Public Sub AddNote2(CtactId As Long, n As cuNote) As Long
	Dim v As ContentValues = SetData(cols_note,n)
	Return AddData(v,CtactId,mt_note)
End Sub
'Adds a phone field to the given contact id.
Public Sub AddPhone(CtactId As Long, p As cuPhone) As Long
	Dim v As ContentValues = SetData(cols_phone,p)
	Return AddData(v,CtactId,mt_phone)
End Sub
'Adds a website field to the given contact id
Public Sub AddWebsite(CtactId As Long, w As cuWebsite) As Long
	Dim v As ContentValues = SetData(cols_website,w)
	Return AddData(v,CtactId,mt_website)
End Sub

'Private functions used by add functions *********************************************************************************************************
Private Sub AddData(v As ContentValues, CtactId As Long, Mime As String) As Long
	Dim RawId As Long = GetRawIDFromId(CtactId)
	If RawId<0 Then Return -1
	v.PutString("raw_contact_id", RawId)
	v.PutString("mimetype", Mime)
	Return cr.Insert(UriData, v).ParseId
End Sub

'**************************************************************************************************************************************************
' CREATE FUNCTIONS
'**************************************************************************************************************************************************

'Creates a new contact and returns the cuContact object of him
Public Sub CreateContact(Name As String, AccountName As String, AccountType As String) As cuContact
	Dim v As ContentValues
	v.Initialize
	' Optional get find filter values
	If Filters.ContainsKey("AccountName") Then AccountName = Filters.Get("AccountName")
	If Filters.ContainsKey("AccountType") Then AccountType = Filters.Get("AccountType")
	
	' Create rawcontact
	If AccountName <> "" Then v.PutString("account_name",AccountName) Else v.PutNull("account_name")
	If AccountType <> "" Then v.PutString("account_type",AccountType) Else v.PutNull("account_type")
	Dim rawUri As Uri = cr.Insert(UriRawContact, v)
	Dim rawContactId As Long = rawUri.ParseId

	' Create contact
	v.Initialize
	v.PutLong("raw_contact_id", rawContactId)
	v.PutString("mimetype", mt_name)
	v.PutString("data1", Name)
	cr.Insert(UriData, v)
	
	Dim new As cuContact
	new.Initialize
	Dim c As Cursor = cr.Query(UriData, Array As String("contact_id", "display_name"), "raw_contact_id = ?", Array As String(rawContactId), "")
	c.Position 		= 0
	new.DisplayName = c.GetString("display_name")
	new.CtactId 	= c.GetLong("contact_id")
	new.RawId		= rawContactId
	new.AccountType	= AccountType
	Return new
End Sub
'Create a new group and returns the GroupId of it
Public Sub CreateGroup(Name As String, AccountName As String, AccountType As String) As Long
	Dim gid As Long = GetGroupId(Name)
	If gid>0 Or Name.Trim="" Then Return -1
	Dim v As ContentValues
	v.Initialize
	v.PutString("title",Name)
	' Optional get find filter values
	If AccountName="" Then AccountName = Filters.Get("AccountName")
	If AccountType="" Then AccountType = Filters.Get("AccountType")
	If AccountName <> "" Then v.PutString("account_name",AccountName) Else v.PutNull("account_name")
	If AccountType <> "" Then v.PutString("account_type",AccountType) Else v.PutNull("account_type")
	v.PutInteger("group_visible",1)
	Dim new As Uri = cr.Insert(UriGroup,v)
	Return new.ParseId
End Sub

'**************************************************************************************************************************************************
' DELETE FUNCTIONS
'**************************************************************************************************************************************************

'Delete the given address of the given type
Public Sub DeleteAddress(DataId As Long) As Int
	Return cr.Delete(UriData, didANDmt, Array As String(DataId,mt_address))
End Sub
Public Sub DeleteAddressByType(CtactId As Long, AddressType As String) As Int
	Dim Data2 As Int = GetKeyFromValue(adTypes, AddressType, "999") 'if not recognized, no deletion of default !
	Return DeleteByType(CtactId,mt_address,Data2)
End Sub
'Deletes the contact with the given Id.
Public Sub DeleteContact(CtactId As Long) As Int
	Return cr.Delete(UriRawContact, "contact_id = ?", Array As String(CtactId))
End Sub
'Deletes the given custom field
Public Sub DeleteCustom(DataId As Long) As Int
	Return cr.Delete(UriData, didANDmt, Array As String(DataId,mt_custom))
End Sub
'Deletes the given email address.
Public Sub DeleteEmail(DataId As Long) As Int
	Return cr.Delete(UriData, didANDmt, Array As String(DataId,mt_email))
End Sub
'Deletes all the mails of a given type
Public Sub DeleteEmailByType(CtactId As Long, EmailType As String) As Int
	Dim Data2 As Int = GetKeyFromValue(emTypes, EmailType, "999") 'if not recognized, no deletion of default !
	Return DeleteByType(CtactId,mt_email,Data2)
End Sub
'Deletes the given event 
Public Sub DeleteEvent(DataId As Long) As Int
	Return cr.Delete(UriData, didANDmt, Array As String(DataId,mt_event))
End Sub
'Delete group
Public Sub DeleteGroup(GrpName As String) As Int
	If GrpName="" Then Return 0
	Dim selection As String = UseFilters("group_is_read_only = 0 AND title = ?")
	Return cr.Delete(UriGroup, selection, Array As String(GrpName))
End Sub
'Delete contact in group
Public Sub DeleteGroupMember(CtactId As Long,GrpName As String) As Int
	Dim gid As Long = GetGroupId(GrpName)
	If gid<0 Then Return 0
	Return cr.Delete(UriData, cidANDmt & " AND data1 = ?", Array As String(CtactId,mt_member, gid))
End Sub
'Deletes an additional note (non standard)
Public Sub DeleteNote2(DataId As Long) As Int
	Return cr.Delete(UriData,didANDmt,Array As String(DataId,mt_note))
End Sub
'Deletes the given phone number.
Public Sub DeletePhone(DataId As Long) As Int
	Return cr.Delete(UriData, didANDmt, Array As String(DataId,mt_phone))
End Sub
'Deletes all the phone numbers of a given type
Public Sub DeletePhoneByType(CtactId As Long, PhoneType As String) As Int
	Dim Data2 As Int = GetKeyFromValue(phTypes, PhoneType, "999") 'if not recognized, no deletion of default !
	Return DeleteByType(CtactId,mt_phone,Data2)
End Sub
'Deletes the given website 
Public Sub DeleteWebsite(DataId As Long) As Int
	Return cr.Delete(UriData, didANDmt, Array As String(DataId,mt_website))
End Sub

'Private functions used by delete functions ******************************************************************************************************
Private Sub DeleteByType(CtactId As Long,Mime As String,DataType As String) As Int
	Return cr.Delete(UriData, "contact_id = ? and mimetype = ? AND data2 = ? ", Array As String(CtactId, Mime, DataType))
End Sub

'*************************************************************************************************************************************************
' GET FUNCTIONS
'*************************************************************************************************************************************************

'Returns Contact_id fromr data_id
Public Sub GetIdFromDataId(DataId As Long) As Long
	Return GetLong(UriData,"contact_id",DataId)
End Sub
'Get raw_contact_id from id
Public Sub GetRawIDFromId(CtactId As Long) As Long
	Return GetLong(UriContact,"name_raw_contact_id",CtactId)
End Sub
'Returns Contact_id fromr raw_contact_id
Public Sub GetIdFromRawId(RawId As Long) As Long
	Return GetLong(UriRawContact,"contact_id",RawId)
End Sub
'Returns a list with cuAccount items
Public Sub GetAccounts(CtactId As Long) As List
	Dim obj As cuAccount, res As List, one As String
	res = GetListItems(UriData,cols_account,"contact_id = ?",Array As String(CtactId))
	res.SortTypeCaseInsensitive("AccountType",True)
	For i=res.Size -1 To 0 Step -1
		obj = res.Get(i)
		If one=obj.AccountType Then res.RemoveAt(i) Else one=obj.AccountType
	Next
	Return res
End Sub
'Returns a List with cuAddress items.
Public Sub GetAddresses(CtactId As Long) As List
	Return GetListItems(UriData,cols_address,cidANDmt,Array As String(CtactId,mt_address))
End Sub
'Return a map with selected lists of infos as values
Public Sub GetContactInfos(CtactId As Long,m As Map)
	Dim all As Boolean = (m.Size = 0)
	If all Or m.ContainsKey("address") 		Then AddContactInfos(m,"address",GetAddresses(CtactId))
	If all Or m.ContainsKey("custom") 		Then AddContactInfos(m,"custom",GetCustoms(CtactId))
	If all Or m.ContainsKey("email")		Then AddContactInfos(m,"email",GetEmails(CtactId))
	If all Or m.ContainsKey("event") 		Then AddContactInfos(m,"event",GetEvents(CtactId))
	If all Or m.ContainsKey("group")		Then AddContactInfos(m,"group",GetGroups(CtactId))
	If all Or m.ContainsKey("job")			Then AddContactInfos(m,"job",GetJob(CtactId))
	If all Or m.ContainsKey("name")			Then AddContactInfos(m,"name",GetNames(CtactId))
	If all Or m.ContainsKey("note") 		Then AddContactInfos(m,"note",GetNotes(CtactId))
	If all Or m.ContainsKey("phone")		Then AddContactInfos(m,"phone",GetPhones(CtactId))
	If all Or m.ContainsKey("website")		Then AddContactInfos(m,"website",GetWebsites(CtactId))
End Sub
'Returns the Google custom fields
Public Sub GetCustoms(CtactId As Long) As List
	Return GetListItems(UriData,cols_custom,cidANDmt,Array As String(CtactId,mt_custom))
End Sub
'Returns a List with cuEmail items.
Public Sub GetEmails(CtactId As Long) As List
	Return GetListItems(UriData,cols_email,cidANDmt,Array As String(CtactId,mt_email))
End Sub
'Returns a List with cuEvents items.
Public Sub GetEvents(CtactId As Long) As List
	Return GetListItems(UriData,cols_event,cidANDmt,Array As String(CtactId,mt_event))
End Sub
'Returns a list of groups of Contact
Public Sub GetGroups(CtactId As Long) As List
	Dim uri As Uri
	uri.WithAppendedPath(UriContact,CtactId & "/entities")
	Dim c As Cursor = cr.Query(uri,Array As String("title"),"mimetype = ? AND deleted = 0",Array As String(mt_member),"")
	Dim res As List
	res.Initialize
	For i = 0 To c.RowCount -1
		c.Position	= i
		res.Add(c.getstring("title"))
	Next
	c.Close
	Return res
End Sub
'Returns the job fields (company and title)
Public Sub GetJob(CtactId As Long) As cuJob
	Dim obj As cuJob, res As List = GetListItems(UriData,cols_job,cidANDmt,Array As String(CtactId,mt_job))
	If res.Size>0 Then
		obj 				= res.Get(0)
		obj.IsInitialized	= True
	End If
	Return obj
End Sub
'Returns the names fields of the contact
Public Sub GetNames(CtactId As Long) As cuContact
	Dim obj As cuContact, res As List = GetListItems(UriData,cols_name,cidANDmt,Array As String(CtactId,mt_name))
	If res.Size>0 Then
		obj = res.Get(0)
		If (FDisplay<>"") Then obj.DisplayName	= FormatDisplay(obj.FirstName,obj.LastName)
	End If
	Return obj
End Sub
'Returns the note field.
Public Sub GetNotes(CtactId As Long) As List
	Return GetListItems(UriData,cols_note,cidANDmt,Array As String(CtactId,mt_note))
End Sub
'Returns the owner(s) gmail
Public Sub GetOwners() As List
	Dim res As List, c As JavaObject, j As JavaObject
	res.Initialize
	c.InitializeContext
	j = j.InitializeStatic("android.accounts.AccountManager").RunMethod("get", Array(c))
	Dim accounts() As Object = j.RunMethod("getAccountsByType", Array("com.google"))
	For Each a As JavaObject In accounts
		res.Add(a.GetField("name"))
	Next
	Return res
End Sub
'Returns a List with cuPhone items.
Public Sub GetPhones(CtactId As Long) As List
	Return GetListItems(UriData,cols_phone,cidANDmt,Array As String(CtactId,mt_phone))
End Sub
'Returns the thumbnail photo of the given contact. Returns an uninitialized bitmap if no photo is available.
Public Sub GetPhoto(CtactId As Long) As Bitmap
	Dim bmp As Bitmap, res As List = GetListItems(UriData,cols_photo,cidANDmt,Array As String(CtactId,mt_photo))
	If res.Size>0 And res.Get(0)<>Null Then
		Dim in As InputStream, blob() As Byte = res.Get(0)
		in.InitializeFromBytesArray(blob, 0, blob.Length)
		bmp.Initialize2(in)
		in.Close
	End If
	Return bmp
End Sub
'Gets whether the contact is "starred".
Public Sub GetStarred(CtactId As Long) As Boolean
	Dim c As Cursor = cr.Query(UriContact, Array As String("starred"), "_id = ?", Array As String(CtactId), "")
	c.Position = 0
	Dim res As Boolean = IIf(c.RowCount>0, (c.GetInt("starred")=1), False)
	c.Close
	Return res
End Sub
'Returns a List with cuWebsite items.
Public Sub GetWebsites(CtactId As Long) As List
	Return GetListItems(UriData,cols_website,cidANDmt,Array As String(CtactId,mt_website))
End Sub

'Private functions used by get functions **********************************************************************************************************
Private Sub AddContactInfos(m As Map,key As String,v As Object)
	Dim l As List
	If m.ContainsKey(key) Then l = m.Get(key) Else l.Initialize
	If v Is List Then l.AddAll(v) Else l.Add(v)
	m.put(key,l)
End Sub
Private Sub GetGroupId(GrpName As String) As Long
	Dim part As Boolean = GrpName.Contains("%"), Selection As String = UseFilters("deleted = 0 AND title = ?"), res As Long = -1
	If part Then Selection	= Selection.Replace("title =","title LIKE")
	Dim c As Cursor = cr.Query(UriGroup, Array As String("_id","title"), Selection, Array As String(GrpName), "")
	For i = 0 To c.RowCount -1
		c.Position	= i
		res			= c.GetLong("_id")
		' skip groups managed through other find functions (FindAllContacts or FindContactsByStarred)
		If Not(part And skipgrp.Contains(c.GetString("title"))) Then Exit
	Next
	c.Close
	Return res
End Sub
Private Sub GetGroupName(GroupId As Long) As String 'Ignore
	Dim Selection As String = UseFilters("deleted = 0 AND _id = ?"), res As String = ""
	Dim c As Cursor = cr.Query(UriGroup, Array As String("title"), Selection, Array As String(GroupId), "")
	If c.RowCount > 0 Then
		c.Position	= 0
		res			= c.GetString("title")
	End If
	c.Close
	Return res
End Sub
Private Sub GetKeyFromValue(m As Map, v As String, Force As String) As Int
	Dim Default As Int = IIf(IsNumber(Force),Force,m.Get("99"))
	For i = 0 To m.Size - 1
		If v.EqualsIgnoreCase(m.GetValueAt(i)) Then Exit
	Next
	Return IIf(i<m.Size,m.GetKeyAt(i),Default)
End Sub
Private Sub GetLong(Uri As Uri,ColumnId As String,Value As String) As Long
	Dim res As Long = -1, c As Cursor = cr.Query(Uri,Array As String(ColumnId),"_id = ?",Array As String(Value),"")
	If c.RowCount>0 Then
		c.Position	= 0
		res			= c.GetLong(ColumnId)
	End If
	Return res
End Sub
Private Sub GetListItems(uri As Uri,cols As String, sel As String, args() As String) As List 'ignore
	Dim c As Cursor, res As List, data As String = "", map As Map = GetMapTypes(cols)	
	Dim nc() As String = Regex.Split(",",Regex.Replace("=[^,]*",cols,""))	' Names of columns read from cursor
	Dim nf() As String = Regex.Split(",",Regex.Replace("[^=,]*=",cols,""))	' Names of fields in the object
	c = cr.Query(uri,nc,sel,args,"")
	res.initialize
	For i = 0 To c.RowCount -1
		Dim new As Object = SelectItem(cols)
		c.Position = i
		For j=0 To c.ColumnCount -1
			Select nf(j)
				Case "DataId","CtactId","RawId":	SetField(new,nf(j),c.GetLong2(j))
				Case "DataType":					data = IIf(map.ContainsKey(c.GetString2(j)),map.Get(c.GetString2(j)),map.Get(map.Get("99")))
													SetField(new,nf(j),data)
				Case "UserType":					If data=nc(j) Then SetField(new,nf(j-1),c.getString2(j))
				Case "Photo":						new = c.GetBlob2(j)
				Case Else:							SetField(new,nf(j),n2e(c.GetString2(j)))
			End Select
		Next
		res.Add(new)
	Next
	c.Close
	Return res
End Sub
Private Sub SelectItem(cols As String) As Object
	Select cols
		Case cols_account:	Dim objx As cuAccount	: Return objx
		Case cols_address:	Dim obja As cuAddress	: Return obja
		Case cols_custom:	Dim objc As cuCustom	: Return objc
		Case cols_event:	Dim obje As cuEvent		: Return obje
		Case cols_job:		Dim objj As cuJob		: Return objj
		Case cols_email:	Dim objm As cuEmail		: Return objm
		Case cols_note:		Dim objn As cuNote		: Return objn
		Case cols_phone:	Dim objp As cuPhone		: Return objp
		Case cols_photo:	Dim objb() As Byte		: Return objb
		Case cols_website:	Dim objw As cuWebsite 	: Return objw
	End Select
	Dim obj As cuContact : Return obj
End Sub
Private Sub SetField(jo As JavaObject,fld As String, val As Object)
	jo.SetField(fld,val)
End Sub

'*************************************************************************************************************************************************
' SET FUNCTIONS
'*************************************************************************************************************************************************

' Sets an structured postal address for a contact.
Public Sub SetAddress(a As cuAddress) As Int
	Dim v As ContentValues = SetData(cols_address,a)
	Return cr.Update(UriData, v, didANDmt, Array As String(a.DataId,mt_address))
End Sub
'Sets a custom google field of the given id.
Public Sub SetCustom(c As cuCustom) As Int
	If n2e(c.Name)="" Or n2e(c.Text)="" Then Return 0
	Dim v As ContentValues = SetData(cols_custom,c)
	Return cr.Update(UriData, v, didANDmt, Array As String(c.DataId,mt_custom))
End Sub
'Sets the email field of the given id.
Public Sub SetEmail(e As cuEmail) As Int
	Dim v As ContentValues = SetData(cols_email,e)
	Return cr.Update(UriData, v, didANDmt, Array As String(e.DataId,mt_email))
End Sub
'Sets an existing event field to the given contact id
Public Sub SetEvent(e As cuEvent) As Int
	Dim v As ContentValues = SetData(cols_event,e)
	Return cr.Update(UriData, v, didANDmt, Array As String(e.DataId,mt_event))
End Sub
' Adds/Sets/Deletes the job fields of the given id
Public Sub SetJob(CtactId As Long, job As cuJob) As Long
	Dim v As ContentValues = SetData(cols_job,job)
	If n2e(job.Company)&n2e(job.Title)&n2e(job.Department)="" Then
		Return cr.Delete(UriData, cidANDmt, Array As String(CtactId,mt_job))
	else if job.IsInitialized Then
		Return cr.Update(UriData, v, cidANDmt, Array As String(CtactId,mt_job))
	Else
		Return AddData(v,CtactId,mt_job)
	End If
End Sub
'Rename existing GroupName
Public Sub SetGroupName(OldName As String, NewName As String) As Int ' Ignore
	Dim gid As Long	= GetGroupId(OldName)
	NewName 		= NewName.Trim
	If gid<0 Or NewName="" Or GetGroupId(NewName)>0 Then Return 0
	Dim v As ContentValues
	v.Initialize
	v.PutString("title",NewName)
	Return cr.Update(UriGroup, v, "_id = ? and title = ?", Array As String(gid, OldName))
End Sub
'Sets firstname, lastname and display_name to the given contact id
Public Sub SetNames(c As cuContact) As Int
	Dim v As ContentValues = SetData(cols_name,c)
	Return cr.Update(UriData, v, cidANDmt, Array As String(c.CtactId,mt_name))
End Sub
'Sets the standard note of a given contact (DataId is not used, pass an empty cuNote Text to delete))
Public Sub SetNote(CtactId As Long, n As cuNote) As Int
	Dim ls As List = GetNotes(CtactId), v As ContentValues = SetData(cols_note,n)
	If ls.Size=0 Then Return AddData(v,CtactId,mt_note) ' No note found for the contact : creates it !!!
	n.DataId = ls.Get(0).As(cuNote).DataId
	Return cr.Update(UriData, v, didANDmt, Array As String(n.DataId,mt_note))
End Sub
'Sets an additional note (non standard)
Public Sub SetNote2(n As cuNote) As Int
	Dim v As ContentValues = SetData(cols_note,n)
	Return cr.Update(UriData, v, didANDmt, Array As String(n.DataId,mt_note))
End Sub
'Sets a phone field to the given contact id.
Public Sub SetPhone(p As cuPhone) As Int
	Dim v As ContentValues = SetData(cols_phone,p)
	Return cr.Update(UriData, v, didANDmt, Array As String(p.DataId,mt_phone))
End Sub
'Sets the starred state of the given id.
Public Sub SetStarred (CtactId As Long, Starred As Boolean) As Int
	Dim v As ContentValues
	v.Initialize
	v.PutInteger("starred", IIf(Starred,1,0))
	Return cr.Update(UriContact, v, "_id = ?", Array As String(CtactId))
End Sub
'Sets a website field of the given contact id.
Public Sub SetWebsite(w As cuWebsite) As Int
	Dim v As ContentValues = SetData(cols_website,w)
	Return cr.Update(UriData, v, didANDmt, Array As String(w.DataId,mt_website))
End Sub

' Private functions used by set and add functions ************************************************************************************************
Private Sub SetData(col As String, obj As Object) As ContentValues
	Dim v As ContentValues, data As String, map As Map = GetMapTypes(col)
	v.Initialize
	Dim nc() As String = Regex.Split(",",Regex.Replace("=[^,]*",col,""))	' Names of columns
	Dim nf() As String = Regex.Split(",",Regex.Replace("[^=,]*=",col,""))	' Names of fields in the object
	For i=0 To nf.Length -1
		If nc(i).StartsWith("data") Then
			If nf(i)<>"UserType" Then data = obj.As(JavaObject).GetField(nf(i))
			If Regex.IsMatch("\d{2}/\d{2}/\d{4}",data) Then data = Regex.Replace("(..)/(..)/(....)",data,"$3-$2-$1")
			Select nc(i)
				Case "data2":	If nf(i)="DataType" Then SetData2(v, map, data) Else v.PutString(nc(i),data) 
				Case "data3":	' Already treated through data2
				Case Else:		If data<>"" And data<>"null" Then v.PutString(nc(i),data) Else v.PutNull(nc(i))
			End Select
		End If
	Next
	Return v
End Sub
Private Sub SetData2(v As ContentValues, mapTypes As Map, dataType As String)
	Dim data3 As String	= mapTypes.Get("0")
	Dim data2 As Int 	= GetKeyFromValue(mapTypes,dataType,IIf(data3<>"null","0",""))
	v.PutInteger("data2",data2)
	If data3<>"null" Then
		If data2=0 Then v.PutString(data3,dataType) Else v.PutNull(data3)
	End If
End Sub


'**************************************************************************************************************************************************
' INITIALIZATIONS
'**************************************************************************************************************************************************
Public Sub Initialize(AccountType As String, AccountName As String, CustomFilter As String, CustomDisplay As String)
	cr.Initialize("cr")
	UriData.Parse("content://com.android.contacts/data")
	UriGroup.Parse("content://com.android.contacts/groups")
	UriContact.Parse("content://com.android.contacts/contacts")
	UriRawContact.Parse("content://com.android.contacts/raw_contacts")
	
	' Initialization of all map types
	InitializeTypes("*")
	
	' Store user parameters
	If Not(Filters.IsInitialized) Then Filters.Initialize
	If AccountType<>""	Then Filters.Put("AccountType",AccountType)
	If AccountName<>""	Then Filters.Put("AccountName",AccountName)
	If CustomFilter<>"" Then Filters.Put("CustomFilter",CustomFilter)
	If CustomDisplay.Contains("%") Then FDisplay = CustomDisplay.ToLowerCase
End Sub
'Set types for internal maps of types in order to allow translations (Values = "cod=lib,cod=lib,..." with first one beeing default)
Public Sub SetTypes(obj As String,Values As String) As Boolean
	obj = obj.ToLowerCase
	If Values="" Then Return InitializeTypes(obj)
	Dim cod() As String = Regex.Split(",",Regex.Replace("=[^,]*",Values,""))
	Dim lib() As String = Regex.Split(",",Regex.Replace("[^=,]*=",Values,""))
	Dim m As Map
	Select obj
		Case "phone":	m = phTypes
		Case "email":	m = emTypes
		Case "event":	m = evTypes
		Case "address":	m = adTypes
		Case "website": m = wbTypes
		Case Else:		Return False
	End Select
	m.Clear
	For i = 0 To cod.Length -1
		m.Put(cod(i),lib(i))
	Next
	' New default valeur
	m.Put("99",cod(0))
	Return True
End Sub

' Private functions *******************************************************************************************************************************
Private Sub GetMapTypes(cols As String) As Map
	Select cols
		Case cols_address:	Return adTypes
		Case cols_event:	Return evTypes
		Case cols_email:	Return emTypes
		Case cols_phone:	Return phTypes
		Case cols_website:	Return wbTypes
	End Select
	Return Null
End Sub
Private Sub InitializeTypes(obj As String) As Boolean
	If "*address".Contains(obj) Then
		If Not(adTypes.IsInitialized) Then adTypes.Initialize
		SetTypes("address","1=home,2=work,3=other,0=data3") ' Default is first : home
	End If
	If "*event".Contains(obj) Then
		If Not(evTypes.IsInitialized) Then evTypes.Initialize
		SetTypes("event","3=birthday,1=anniversary,2=other,0=data3") ' Default is first : birhday
	End If
	If "*mail".Contains(obj) Then
		If Not(emTypes.IsInitialized) Then emTypes.Initialize
		SetTypes("email","1=home,2=work,3=other,4=mobile,0=data3") ' Default is first : home
	End If
	If "*phone".Contains(obj) Then
		If Not(phTypes.IsInitialized) Then phTypes.Initialize
		Dim init As String = "2=mobile,1=home,3=work,4=fax_work,5=fax_home,6=pager,7=other,8=callback,9=car,10=company_main,"
		init = init & "11=isdn,12=Main,13=other_fax,14=radio,15=telex,16=tty_tdd,17=work_mobile,18=work_pager,19=assistant,20=mms,0=data3"
		SetTypes("phone",init) ' Default is first = mobile
	End If
	If "*website".Contains(obj) Then
		If Not(wbTypes.IsInitialized) Then wbTypes.Initialize
		SetTypes("website","1=homepage,2=blog,3=profile,4=home,5=work,6=ftp,7=other,0=data3") ' Default is first : homepage
	End If
	Return True
End Sub
'Add defined filters to a find criteria
Private Sub UseFilters(Criteria As String) As String
	' Criteria must stay at the end of the string
	If Filters.ContainsKey("CustomFilter") Then
		Criteria = Filters.Get("CustomFilter") & " AND " & Criteria
	Else
		If Filters.ContainsKey("AccountType") Then Criteria = "account_type = '" & Filters.Get("AccountType") & "' AND " & Criteria
		If Filters.ContainsKey("AccountName") Then Criteria = "account_name = '" & Filters.Get("AccountName") & "' AND " & Criteria
	End If
	Return Criteria
End Sub