PureBasic Forums - English

http://www.purebasic.com
https://www.purebasic.fr/english/

PhoneBookEditor (vcf)

https://www.purebasic.fr/english/viewtopic.php?t=88010

Page 1 of 1

PhoneBookEditor (vcf)

Posted: Thu Dec 04, 2025 11:34 am
by AZJIO
I made a program for viewing, deleting, adding, and changing contacts in a vcf file that is exported from the phone. Changing the contact leads to the loss of fields that were not included in the program. It's better to try with a copy of the file first to understand how it works. It is possible that I will redo the way to change the contact by replacing the text in the original, then no fields will be lost.

Download

Code: Select all

;- TOP
; AZJIO 2025.12.04
EnableExplicit

Define UserIntLang

CompilerSelect #PB_Compiler_OS
	CompilerCase #PB_OS_Windows
		Define *Lang
		If OpenLibrary(0, "kernel32.dll")
			*Lang = GetFunction(0, "GetUserDefaultUILanguage")
			If *Lang And CallFunctionFast(*Lang) = 1049 ; ru
				UserIntLang = 1
			EndIf
			CloseLibrary(0)
		EndIf
	CompilerCase #PB_OS_Linux
		If ExamineEnvironmentVariables()
			While NextEnvironmentVariable()
				If Left(EnvironmentVariableName(), 4) = "LANG" And Left(EnvironmentVariableValue(), 2) = "ru"
					UserIntLang = 1
					Break
				EndIf
			Wend
		EndIf
CompilerEndSelect

#CountStrLang = 23
Global Dim Lng.s(#CountStrLang)
Lng(1) = "Select the file"
Lng(2) = "Phonebook (.vcf)|*.vcf"
Lng(3) = "Add/Edit"
Lng(4) = "Name:"
Lng(5) = "Phone:"
Lng(6) = "Cancel"
Lng(7) = "Error"
Lng(8) = "All fields must be filled in"
Lng(9) = "Phone Book Editor"
Lng(10) = "Name"
Lng(11) = "Full name"
Lng(12) = "Phone"
Lng(13) = "Open"
Lng(14) = "Save"
Lng(15) = "Add item"
Lng(16) = "Change item"
Lng(17) = "Delete item"
Lng(18) = "Sort by phone"
Lng(19) = "Sort by full name"
Lng(20) = "Delete?"
Lng(21) = "Do you want to delete:"
Lng(22) = "Nothing to save"
Lng(23) = "Select a file to save"

If UserIntLang = 1
	Lng(1) = "Выберите файл"
	Lng(2) = "Телефонная книжка (.vcf)|*.vcf"
	Lng(3) = "Добавить/Изменить"
	Lng(4) = "Имя:"
	Lng(5) = "Телефон:"
	Lng(6) = "Отмена"
	Lng(7) = "Ошибка"
	Lng(8) = "Все поля надо заполнить"
	Lng(9) = "Телефонная книжка"
	Lng(10) = "Имя"
	Lng(11) = "Полное имя"
	Lng(12) = "Телефон"
	Lng(13) = "Открыть"
	Lng(14) = "Сохранить"
	Lng(15) = "Добавить пункт"
	Lng(16) = "Изменить пункт"
	Lng(17) = "Удалить пункт"
	Lng(18) = "Сортировать по телефону"
	Lng(19) = "Сортировать по полному имени"
	Lng(20) = "Удалить?"
	Lng(21) = "Вы хотите удалить:"
	Lng(22) = "Нечего сохранять"
	Lng(23) = "Выберите файл для сохранения"
EndIf

;- # Constants
#Window = 0
#AddGUI = 1
#PopupMenu = 0

;- ● Enumeration
Enumeration
	#btn
	#LIG
	#w1_txt1
	#w1_inp1
	#w1_txt2
	#w1_inp2
	#w1_btnYes
	#w1_btnNo
EndEnumeration

Enumeration
	#mOpen
	#mSave
	#mAdd
	#mChange
	#mDelete
	#mSortPhone
	#mSortFName
EndEnumeration


Structure TEL
	ch.i
	orig.s
	n.s
	f.s
	t.s
	b.s
	a.s
	e.s
	u.s
	o.s
EndStructure

;- ● Global
Global NewList TelList.TEL()
Global hListView

;- ● Define
Define i, j
Define File$, idfile, tmp$, tmp
Define Semicolon$, Count
Define w0, h0

Procedure OpenVCF()
	Protected File$, idfile, string$, i, name$, num$, NbFound, tmp$, tmp
	Protected Dim VCARDOrig$(0)
	Protected Dim VCARD$(0)
File$ = OpenFileRequester(Lng(1), GetUserDirectory(#PB_Directory_Documents) + "00001.vcf", Lng(2), 0)
; File$ = "D:\D\MyDocum\00002.vcf"
; File$ = "/media/windows/D/MyDocum/00002.vcf"
ClearList(TelList()) 


If Asc(File$)
	idfile = ReadFile(#PB_Any, File$)
	If idfile
		string$ = ReadString(idfile, #PB_Ascii + #PB_File_IgnoreEOL)
		; 		Debug string$
		
		; 		Экспортируем блоки карточки аккаунтов в массив аккаунтов
		If CreateRegularExpression(0, "(?<=BEGIN:VCARD).+?(?=END:VCARD)", #PB_RegularExpression_DotAll )
; 			Dim VCARDOrig$(0)
			NbFound = ExtractRegularExpression(0, string$, VCARDOrig$())
		EndIf
		
		; 		исправляем переносы строк для длинных имён
		If CreateRegularExpression(0, "=[\r\n]{1,2}=")
			string$ = ReplaceRegularExpression(0, string$, "=")
		EndIf
		; 		Debug string$
		
		; 		Экспортируем блоки карточки аккаунтов в массив аккаунтов
		If CreateRegularExpression(0, "(?<=BEGIN:VCARD).+?(?=END:VCARD)", #PB_RegularExpression_DotAll )
; 			Dim VCARD$(0)
			NbFound = ExtractRegularExpression(0, string$, VCARD$())
			; 			For i = 0 To NbFound-1
			; 				Debug VCARD$(i)
			; 			Next
		EndIf
		
		If ArraySize(VCARD$()) <> ArraySize(VCARDOrig$()) ; вероятность равна 0, но перестрахуемся
			End
		EndIf
		
		; If CreateRegularExpression(0, "[\A\r\n](\w[\w;=-]*?):(.+?[^=])(?=[\r\n])")
		If CreateRegularExpression(0, "^(\w[\w;=-]*?):(.+?)\r?$", #PB_RegularExpression_MultiLine)
			For i = 0 To ArraySize(VCARD$())
; 				Dim param$(0)
				If ExamineRegularExpression(0, VCARD$(i))
					If AddElement(TelList())
						TelList()\orig = VCARDOrig$(i)
						While NextRegularExpressionMatch(0)
							; Debug RegularExpressionGroup(0, 1) + "—————" + RegularExpressionGroup(0, 2)
							tmp = Asc(RegularExpressionGroup(0, 1))
							Select tmp
								Case 'V'
									Continue
								Case 'N'
									If Left(RegularExpressionGroup(0, 1), 2) = "NO" ; NOTE
										Continue
									EndIf
									tmp$ = RegularExpressionGroup(0, 2)
									tmp$ = RTrim(tmp$, ";")
									tmp$ = LTrim(tmp$, ";")
									TelList()\n = URLDecoder(ReplaceString(tmp$, "=", "%"))
								Case 'F'
									tmp$ = RegularExpressionGroup(0, 2)
									TelList()\f = URLDecoder(ReplaceString(tmp$, "=", "%"))
								Case 'T'
									If Left(RegularExpressionGroup(0, 1), 2) = "TI" ; TITLE
										Continue
									EndIf
									TelList()\t = RegularExpressionGroup(0, 2)
								Case 'B'
									TelList()\b = RegularExpressionGroup(0, 2)
								Case 'A'
									TelList()\a = RegularExpressionGroup(0, 2)
								Case 'E'
									TelList()\e = RegularExpressionGroup(0, 2)
								Case 'U'
									TelList()\u = RegularExpressionGroup(0, 2)
								Case 'O'
									TelList()\o = RegularExpressionGroup(0, 2)
							EndSelect
							
						Wend
					EndIf
				EndIf
			Next
		EndIf
		CloseFile(idfile)
	EndIf
	Dim VCARDOrig$(0) ; очищаем массив
EndIf
EndProcedure

Procedure AddGUI(Change = 0)
	Protected item, Width, Height, i, name$, num$
	Width = 370
	Height = 170
	
	item = GetGadgetState(#LIG)
	If item = -1
		If Change
			ProcedureReturn
		EndIf
		LastElement(TelList())
	Else
		SelectElement(TelList() , item)
	EndIf
	
	DisableWindow(#Window, 1)
	
	OpenWindow(#AddGUI, 0, 0, Width, Height, Lng(3), #PB_Window_SystemMenu | #PB_Window_ScreenCentered, WindowID(#Window))
	TextGadget(#w1_txt1, 10, 10, 90, 22, Lng(4))
	StringGadget(#w1_inp1, 105 , 10, 260, 22 , "")
	TextGadget(#w1_txt2, 10, 40, 90, 22, Lng(5))
	StringGadget(#w1_inp2, 105 , 40, 260, 22 , "")
	
	If Change
		name$ = GetGadgetItemText(#LIG, Item, 2)
		num$ = GetGadgetItemText(#LIG, Item, 3)
		SetGadgetText(#w1_inp1, name$)
		SetGadgetText(#w1_inp2, num$)
	EndIf
	
; 	CheckBoxGadget(#w1_ch, 10, Height - 65, Width - 20, 17, LngCheck$)
; 	SetGadgetState(#w1_ch, ChBox)
	
	ButtonGadget(#w1_btnYes, (Width - 150) / 2, Height - 40, 70, 28, "OK")
	ButtonGadget(#w1_btnNo, (Width - 150) / 2 + 80, Height - 40, 70, 28, Lng(6))

	Repeat
		Select WaitWindowEvent()
			Case #PB_Event_Gadget
				Select EventGadget()
					Case #w1_btnYes
						name$ = GetGadgetText(#w1_inp1)
						num$ = GetGadgetText(#w1_inp2)
						If Asc(name$) And Asc(num$)
							If Not Change
								AddElement(TelList())
							EndIf
							
							TelList()\ch = 1
							TelList()\n = name$
							TelList()\f = name$
							TelList()\t = num$
							If Change
								SetGadgetItemText(#LIG, Item, name$, 1)
								SetGadgetItemText(#LIG, Item, name$, 2)
								SetGadgetItemText(#LIG, Item, num$, 3)
							Else
								AddGadgetItem(#LIG, item, Str(i) + #LF$ + TelList()\n + #LF$ + TelList()\f + #LF$ + TelList()\t)
								For i = item To CountGadgetItems(#LIG) - 1
									SetGadgetItemText(#LIG, i, Str(i + 1), 0)
								Next
							EndIf
							Break
						Else
							MessageRequester(Lng(7), Lng(8))
						EndIf
					Case #w1_btnNo
						Break
				EndSelect
			Case #PB_Event_CloseWindow
				Break
		EndSelect
	ForEver

	DisableWindow(#Window, 0)
	CloseWindow(#AddGUI)
EndProcedure

Procedure FillList()
	Protected i
	ClearGadgetItems(#LIG)
	CompilerIf  #PB_Compiler_OS = #PB_OS_Windows
		SendMessage_(hListView, #WM_SETREDRAW, 0, 0)
	CompilerEndIf
	i = 0
	ForEach TelList()
		i+1
		AddGadgetItem(#LIG, -1, Str(i) + #LF$ + TelList()\n + #LF$ + TelList()\f + #LF$ + TelList()\t)
	Next
	CompilerIf  #PB_Compiler_OS = #PB_OS_Windows
		SendMessage_(hListView, #WM_SETREDRAW, 1, 0)
	CompilerEndIf
EndProcedure

Procedure SizeWindowHandler()
	Protected w, h
	w = WindowWidth(#Window)
	h = WindowHeight(#Window)
    ResizeGadget(#LIG, #PB_Ignore, #PB_Ignore, w - 20, h - 50)
EndProcedure

OpenVCF()

w0 = 770
h0 = 620

;-┌──GUI──┐
If OpenWindow(#Window, 0, 0, w0, h0, Lng(9), #PB_Window_SystemMenu | #PB_Window_ScreenCentered | #PB_Window_SizeGadget | #PB_Window_MinimizeGadget | #PB_Window_MaximizeGadget)
;- ├ Gadget
	ButtonGadget(#btn, 10, 5, 30, 30, Chr($2630)) ; ≡ (меню)
	hListView = ListIconGadget(#LIG, 10, 40, w0 - 20, h0 - 50, "N", 40, #PB_ListIcon_GridLines | #PB_ListIcon_FullRowSelect)
	AddGadgetColumn(#LIG, 1, Lng(10), 250)
	AddGadgetColumn(#LIG, 2, Lng(11), 250)
	AddGadgetColumn(#LIG, 3, Lng(12), 150)
	
;- ├ Menu
	If CreatePopupMenu(#PopupMenu)
		MenuItem(#mOpen, Lng(13) + #TAB$ + "Ctrl+N")
		MenuItem(#mSave, Lng(14) + #TAB$ + "Ctrl+S")
		MenuItem(#mAdd, Lng(15) + #TAB$ + "Ctrl+D")
		MenuItem(#mChange, Lng(16) + #TAB$ + "Ctrl+I")
		MenuItem(#mDelete, Lng(17) + #TAB$ + "Ctrl+Delete")
		MenuItem(#mSortPhone, Lng(18))
		MenuItem(#mSortFName, Lng(19))
	EndIf
	
	FillList()

	
	AddKeyboardShortcut(#Window, #PB_Shortcut_Control | #PB_Shortcut_S, #mSave)
	AddKeyboardShortcut(#Window, #PB_Shortcut_Control | #PB_Shortcut_Delete, #mDelete)
	AddKeyboardShortcut(#Window, #PB_Shortcut_Control | #PB_Shortcut_N, #mAdd)
	AddKeyboardShortcut(#Window, #PB_Shortcut_Control | #PB_Shortcut_I, #mChange)
	
	BindEvent(#PB_Event_SizeWindow, @SizeWindowHandler())
	
	
	;-┌──Loop──┐
	Repeat
		Select WaitWindowEvent()
				
				
;- ├ Gadget
			Case #PB_Event_Gadget
				Select EventGadget()
					Case #btn
						DisplayPopupMenu(#PopupMenu, WindowID(#Window))
					Case #LIG
						Select EventType()
							Case #PB_EventType_LeftDoubleClick
								tmp = GetGadgetState(#LIG)
								If tmp <> -1
									SelectElement(TelList() , tmp)
									tmp$ = TelList()\f + #LF$ + TelList()\t + #LF$ + TelList()\b + #LF$ + TelList()\a + #LF$ + TelList()\e + #LF$ + TelList()\u + #LF$ + TelList()\o
									tmp$ = RTrim(tmp$, #LF$)
									; 								If TelList()\b
									; 									tmp$ + #LF$ + TelList()\b
									; 								EndIf
									; 								If TelList()\u
									; 									tmp$ + #LF$ + TelList()\u
									; 								EndIf
									MessageRequester(TelList()\n, tmp$)
								EndIf
							Case #PB_EventType_RightClick
								DisplayPopupMenu(#PopupMenu, WindowID(#Window))
						EndSelect
				EndSelect
				
				
;- ├ Menu
			Case #PB_Event_Menu
				Select EventMenu()
						
					Case #mSortPhone
						SortStructuredList(TelList(), #PB_Sort_Ascending, OffsetOf(TEL\t), TypeOf(TEL\t))
						FillList()
					Case #mSortFName
						SortStructuredList(TelList(), #PB_Sort_Ascending, OffsetOf(TEL\f), TypeOf(TEL\f))
						FillList()
						
					Case #mOpen
						OpenVCF()
						FillList()
						
						
					Case #mAdd
						AddGUI()
						
					Case #mChange
						tmp = GetGadgetState(#LIG)
						If tmp <> -1
							AddGUI(1)
						EndIf
						
					Case #mDelete
						tmp = GetGadgetState(#LIG)
						If tmp <> -1
							SelectElement(TelList() , tmp)
							tmp$ = TelList()\f + #LF$ + TelList()\t + #LF$ + TelList()\b + #LF$ + TelList()\a + #LF$ + TelList()\e + #LF$ + TelList()\u + #LF$ + TelList()\o
							tmp$ = RTrim(tmp$, #LF$)
							If MessageRequester(Lng(20), Lng(21) + #LF$ + #LF$ + tmp$, #PB_MessageRequester_YesNo) = #PB_MessageRequester_Yes
								If DeleteElement(TelList(), 1)
									RemoveGadgetItem(#LIG, tmp)
								EndIf
							EndIf
						EndIf
						
					Case #mSave
						
						If ListSize(TelList()) = 0
							MessageRequester(Lng(7), Lng(22))
							Continue
						EndIf
						
						File$ = SaveFileRequester(Lng(23),  GetUserDirectory(#PB_Directory_Documents) + "TelList.vcf", "*.vcf|*.vcf", 0)
						If Asc(File$)
							If Right(File$, 4) <> ".vcf"
								File$ + ".vcf"
							EndIf
						EndIf
						
						
						idfile = CreateFile(#PB_Any, File$)
						If idfile
							ForEach TelList()
								If TelList()\ch ; если произошли изменения в карточке, то сохраняем их (иначе как есть)
									If TelList()\ch & 32 ; удалить
										Continue
									EndIf
									WriteStringN(idfile, "BEGIN:VCARD")
									WriteStringN(idfile, "VERSION:2.1")
									If Asc(TelList()\n)
; 										Подсчёт разделителей в строке
										Count = 3 - CountString(TelList()\n, ";")
										If Count > 0
											Semicolon$ = LSet(";", Count ,";")
										Else
											Semicolon$ = ""
										EndIf
										WriteStringN(idfile, "N;CHARSET=UTF-8;ENCODING=QUOTED-PRINTABLE:;" + ReplaceString(URLEncoder(TelList()\n), "%", "=") + Semicolon$)
									EndIf
									If Asc(TelList()\f)
										WriteStringN(idfile, "FN;CHARSET=UTF-8;ENCODING=QUOTED-PRINTABLE:" + ReplaceString(URLEncoder(TelList()\f), "%", "="))
									EndIf
									If Asc(TelList()\t)
										WriteStringN(idfile, "TEL;CELL:" + TelList()\t)
									EndIf
									
; 									прочие поля
									If Asc(TelList()\b)
										WriteStringN(idfile, "BDAY:" + TelList()\b)
									EndIf
									If Asc(TelList()\e)
										WriteStringN(idfile, "EMAIL:" + TelList()\e)
									EndIf
									If Asc(TelList()\o)
										WriteStringN(idfile, "ORG;CHARSET=UTF-8;ENCODING=QUOTED-PRINTABLE:" + ReplaceString(URLEncoder(TelList()\o), "%", "="))
									EndIf
									If Asc(TelList()\u)
										WriteStringN(idfile, "URL:" + TelList()\u)
									EndIf
									If Asc(TelList()\a)
										WriteStringN(idfile, "ADR:" + TelList()\a)
									EndIf
									
									WriteStringN(idfile, "END:VCARD")
								Else ; иначе сохраняем оригинал
									WriteString(idfile, "BEGIN:VCARD")
									WriteString(idfile, TelList()\orig)
									WriteStringN(idfile, "END:VCARD")
								EndIf
							Next
							CloseFile(idfile)
						EndIf

						
				EndSelect
			Case #PB_Event_CloseWindow
				CloseWindow(#Window)
				End
		EndSelect
	ForEver
EndIf
All times are UTC+01:00
Page 1 of 1

Powered by phpBB® Forum Software © phpBB Limited