[IDE tool] Code Localization

[AZJIO]

I haven't tested enough yet, but the code is not complicated and gets the job done. I have previously posted this tool written in AutoIt3, but now I have converted it to PureBasic. Interest arose when I wanted to check strings that required localization. Look at the IsLangRange() function to set your range there if your letters are not Latin. The flag "flgLRange = 1" enables it for additional processing. By default, the flag is disabled and localization includes Latin letters.

Download: yandex, upload.ee

Code: Select all

; AZJIO
; https://www.purebasic.fr/english/viewtopic.php?t=83673
EnableExplicit

Define UserIntLang
Define ForceLang

CompilerSelect #PB_Compiler_OS
	CompilerCase #PB_OS_Windows
		Global *Lang
		If OpenLibrary(0, "kernel32.dll")
			*Lang = GetFunction(0, "GetUserDefaultUILanguage")
			If *Lang And CallFunctionFast(*Lang) = 1049
				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 = 24
Global Dim Lng.s(#CountStrLang)
Lng(0) = "Code localization"
Lng(1) = "Open source"
Lng(2) = "pcs"
Lng(3) = "Strings"
Lng(4) = "Settings"
Lng(5) = "Embed translation and paste to clipboard"
Lng(6) = "Reread the list after manually deleting rows"
Lng(7) = "Save"
Lng(8) = "Done. Sent to clipboard. Number of replacements:"
Lng(9) = "Message"
Lng(10) = "The number of lines does not match"
Lng(11) = ", continue?"
Lng(12) = "Use array"
Lng(13) = "Select a file to save."
Lng(14) = "Help"
Lng(15) = "A string with these characters (a-zA-ZÄäÖöÜüß)"
Lng(16) = "Reopen file"
Lng(17) = "No rows found to process"
Lng(18) = "About"
Lng(19) = "Author"
Lng(20) = "Windows + Linux"
Lng(21) = "Windows"
Lng(22) = "External language file"
Lng(23) = "Main language in the left window"
Lng(24) = "A line is part of another line, change the order of the lines."



#date$ = "2025.04.12"
#Menu = 0

Enumeration Window
	#Window
	#WinSet
EndEnumeration

Enumeration Menu
	#mHelp
	#mAbout
EndEnumeration

Enumeration rGadget
	#BtnOpen
	#ReOpen
	#Edit
	#EditTranslation
	#Splitter
	#Setting
	#ReRead
	#Translated
	#Save
	#btnMenu
	#StatusBar
	#txt1
	#txt2
	#LLine
	#Ignore1
	#ChRpc
	#ChLRange
	#StrCharSet
	#Opt0
	#Opt1
	#ChLangfile
	#ChLeftMain
	#OK
EndEnumeration

UseGIFImageDecoder()

XIncludeFile "ForCodeLocalization.pb"


Declare Setting()
Declare IsLangRange(*text)
Declare CallbackGetString(*Position, Length, TypeToken)
Declare GetString(InputFile$)
Declare OpenDoc(sFilePath$)
Declare Clear()
Declare WindowSize()
Declare ParseLang(CharacterSet$)
Declare IsLangRange2(*text)

Structure Two
	start.u
	end0.u
EndStructure
Global NewList Ranges.Two()
Global NewList Letters.u()
Global flgLRange = 0
Global CharacterSet$ = ""



Global tmp, tmp$, tmp2$, tmp3$, flgTemplate, langfile, sCurrentPath$, sTextOrig$, CountStr, flgArr = 1
Global LeftMain
Global ArrSz = 0
Global Dim aTrslText.s(ArrSz)
Global Dim aTrslTextNew.s(0)
Define sTmpTextOut$, sArrayVarText$, sArrayVarTextNew$, CountStrNew, iCountCur, iCount3, n, i, j, Cancel
Define Occurrences
Define isINI
Define w
Define h
Define splitter, splitter0
Define CharacterSet0$, flgLRange0, flgArr0
Define Count

ExamineDesktops()
Define DspW = 600
Define DspH = DesktopHeight(0) * 2 / 3


Procedure Limit(*Value.integer, Min, Max)
	If *Value\i < Min
		*Value\i = Min
	ElseIf *Value\i > Max
		*Value\i = Max
	EndIf
EndProcedure


Global PathConfig$ = GetPathPart(ProgramFilename())
Global ini$ = PathConfig$ + "CodeLocalization.ini"

If FileSize(ini$) > -1 And OpenPreferences(ini$)
	isINI = 1
	w = ReadPreferenceInteger("width", DspW)
	Limit(@w, 250, DesktopWidth(0))
	DspW = w

	h = ReadPreferenceInteger("height", DspH)
	Limit(@h, 250, DesktopHeight(0))
	DspH = h

	splitter = ReadPreferenceInteger("splitter", -1)
	Limit(@splitter, 20, DspW - 30)
	flgLRange = ReadPreferenceInteger("range", flgLRange)
	CharacterSet$ = ReadPreferenceString("char", "")
	ForceLang = ReadPreferenceInteger("forcelang", ForceLang)
	flgTemplate = ReadPreferenceInteger("template", flgTemplate)
	langfile = ReadPreferenceInteger("langfile", langfile)
	flgArr = ReadPreferenceInteger("array", flgArr)
	LeftMain = ReadPreferenceInteger("leftmain", LeftMain)
	ClosePreferences()
EndIf

If ForceLang = 1
	UserIntLang = 0
ElseIf ForceLang = 2
	UserIntLang = 1
EndIf

Procedure SetLangTxt(PathLang$)
	Protected file_id, Format, i, tmp$
	
	file_id = ReadFile(#PB_Any, PathLang$) 
	If file_id
		Format = ReadStringFormat(file_id)
		i=0
		While Eof(file_id) = 0
			tmp$ =  ReadString(file_id, Format)
			tmp$ = RTrim(tmp$ , #CR$)
			If Asc(tmp$) And Asc(tmp$) <> ';'
				i+1
				If i > #CountStrLang
					Break
				EndIf
				Lng(i) = ReplaceString(tmp$, "\n", #LF$)
			Else
				Continue
			EndIf
		Wend
		CloseFile(file_id)
	EndIf
EndProcedure

If FileSize(PathConfig$ + "Lang.txt") > 100
	UserIntLang = 0
	SetLangTxt(PathConfig$ + "Lang.txt")
EndIf

If UserIntLang
	Lng(1) = "Открыть исходник"
	Lng(2) = "шт"
	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) = "Windows + Linux"
	Lng(21) = "Windows"
	Lng(22) = "Внешний языковой файл"
	Lng(23) = "Основной язык в левом окне"
	Lng(24) = "Строка является частью другой строки, измените порядок строк."
EndIf

w = DspW
h = DspH
CharacterSet0$ = CharacterSet$
flgLRange0 = flgLRange
flgArr0 = flgArr
splitter0 = splitter


DataSection
	CompilerIf #PB_Compiler_OS = #PB_OS_Linux
		IconTitle:
		IncludeBinary "images" + #PS$ + "icon.gif"
		IconTitleend:
	CompilerEndIf
	folder:
	IncludeBinary "images" + #PS$ + "folder.gif"
	folderend:
	chbox:
	IncludeBinary "images" + #PS$ + "chbox.gif"
	chboxend:
	do:
	IncludeBinary "images" + #PS$ + "do.gif"
	doend:
	set:
	IncludeBinary "images" + #PS$ + "set.gif"
	setend:
	save:
	IncludeBinary "images" + #PS$ + "save.gif"
	saveend:
	re:
	IncludeBinary "images" + #PS$ + "re.gif"
	reend:
	menu:
	IncludeBinary "images" + #PS$ + "menu.gif"
	menuend:
	template0:
	IncludeBinary "template0.pb"
	template0end:
	template1:
	IncludeBinary "template1.pb"
	template1end:
	template2:
	IncludeBinary "template2.pb"
	template2end:
EndDataSection

CatchImage(0, ?folder)
CatchImage(1, ?chbox)
CatchImage(2, ?do)
CatchImage(3, ?set)
CatchImage(4, ?save)
CatchImage(5, ?re)
CatchImage(6, ?menu)
CompilerIf #PB_Compiler_OS = #PB_OS_Linux
	CatchImage(7, ?IconTitle)
CompilerEndIf

OpenWindow(#Window, 0, 0, DspW, DspH, Lng(0), #PB_Window_SystemMenu | #PB_Window_ScreenCentered | #PB_Window_SizeGadget | #PB_Window_MinimizeGadget | #PB_Window_MaximizeGadget)
CompilerIf #PB_Compiler_OS = #PB_OS_Linux
	gtk_window_set_icon_(WindowID(#Window), ImageID(7))
CompilerEndIf
WindowBounds(#Window, 250, 250, #PB_Ignore, #PB_Ignore)

ButtonImageGadget(#BtnOpen, 5, 4, 28, 28, ImageID(0))
GadgetToolTip(#BtnOpen, Lng(1))

ButtonImageGadget(#ReOpen, 45, 4, 28, 28, ImageID(5))
GadgetToolTip(#ReOpen, Lng(16))

ButtonImageGadget(#ReRead, 85, 4, 28, 28, ImageID(1))
GadgetToolTip(#ReRead, Lng(6))

ButtonImageGadget(#Translated, 125, 4, 28, 28, ImageID(2))
GadgetToolTip(#Translated, Lng(5))

ButtonImageGadget(#Setting, 165, 4, 28, 28, ImageID(3))
GadgetToolTip(#Setting, Lng(4))

ButtonImageGadget(#Save, 205, 4, 28, 28, ImageID(4))
GadgetToolTip(#Save, Lng(7))

ButtonImageGadget(#btnMenu, 245, 4, 28, 28, ImageID(6))

	If CreatePopupMenu(#Menu)
		MenuItem(#mHelp, Lng(14))
		MenuItem(#mAbout, Lng(18))
	EndIf


EditorGadget(#Edit, 5, 40, DspW / 2 - 5, DspH - 60, #PB_Editor_WordWrap)
EditorGadget(#EditTranslation, 5, 40, DspW / 2 - 5, DspH - 60, #PB_Editor_WordWrap)
SplitterGadget(#Splitter, 5, 40, DspW - 10, DspH - 60, #Edit, #EditTranslation, #PB_Splitter_Vertical)
SetGadgetAttribute(#Splitter, #PB_Splitter_FirstMinimumSize, 50)
SetGadgetAttribute(#Splitter, #PB_Splitter_SecondMinimumSize, 50)
SetGadgetState(#Splitter, splitter)

TextGadget(#StatusBar, 5, DspH - 20, DspW - 10, 20, "AZJIO 2024")

EnableGadgetDrop(#Edit, #PB_Drop_Files, #PB_Drag_Copy)
EnableGadgetDrop(#EditTranslation, #PB_Drop_Files, #PB_Drag_Copy)

BindEvent(#PB_Event_SizeWindow, @WindowSize())

If flgLRange And Asc(CharacterSet$)
	ParseLang(CharacterSet$)
EndIf

CompilerIf #PB_Compiler_Debugger
	OpenDoc("C:\ProgramData\PureBasic\Examples\test\Source\zzz.pb")
CompilerElse

	Count = CountProgramParameters()
	For i = 1 To Count
		tmp$ = ProgramParameter()
		If Asc(tmp$) And FileSize(tmp$) > 3 And Left(GetExtensionPart(tmp$), 2) = "pb"
			Break
		EndIf
	Next

	If FileSize(tmp$) > -1
		OpenDoc(tmp$)
	EndIf
CompilerEndIf

Repeat
	Select WaitWindowEvent()
		Case #PB_Event_GadgetDrop
			Select EventGadget()
				Case #EditTranslation
					If Not FindString(EventDropFiles(), #LF$)
						If GetExtensionPart(EventDropFiles()) = "txt"
							SetGadgetText(#EditTranslation, ReadFileToVar(EventDropFiles()))
						Else
							OpenDoc(EventDropFiles())
						EndIf
					EndIf
				Case #Edit
					If Not FindString(EventDropFiles(), #LF$)
						If GetExtensionPart(EventDropFiles()) = "txt"
							SetGadgetText(#Edit, ReadFileToVar(EventDropFiles()))
						Else
							OpenDoc(EventDropFiles())
						EndIf
					EndIf
			EndSelect

		Case #PB_Event_Menu
			Select EventMenu()
				Case #mHelp
					tmp$ = GetPathPart(ProgramFilename()) + "Readme.txt"
					If FileSize(tmp$) > 0
						CompilerSelect #PB_Compiler_OS
							CompilerCase #PB_OS_Windows
								RunProgram(tmp$)
							CompilerCase #PB_OS_Linux
								RunProgram("xdg-open", tmp$, GetPathPart(tmp$))
						CompilerEndSelect
					Else
						MessageRequester("Readme.txt?", tmp$ + "?")
					EndIf
				Case #mAbout
					MessageRequester(Lng(18), Lng(19) + " AZJIO (" + #date$ + ")")
			EndSelect
		Case #PB_Event_Gadget
			Select EventGadget()
				Case #Setting
					Setting()

				Case #btnMenu
					DisplayPopupMenu(#Menu, WindowID(#Window))

				Case #Save
					tmp$ = SaveFileRequester(Lng(13), GetCurrentDirectory(), "(*.txt)|*.txt|(*.*)|*.*", 0)
					If Asc(tmp$)
						CompilerIf #PB_Compiler_OS = #PB_OS_Windows
							If Right(tmp$, 4) <> ".txt"
								tmp$ + ".txt"
							EndIf
						CompilerEndIf
						tmp = CreateFile(#PB_Any, tmp$)
						If tmp
							WriteStringFormat(tmp, #PB_UTF8)
							WriteString(tmp, GetGadgetText(#Edit), #PB_UTF8)
							CloseFile(tmp)
						EndIf

					EndIf

				Case #ReOpen
					If Asc(sCurrentPath$)
						OpenDoc(sCurrentPath$)
					EndIf
				Case #BtnOpen
					tmp$ = OpenFileRequester(Lng(1), GetCurrentDirectory(), "PureBasic (*.pb)|*.pb;*.pbi|(*.*)|*.*", 0)
					If Asc(tmp$)
						OpenDoc(tmp$)
					EndIf
				Case #ReRead
					SplitA2(GetGadgetText(#Edit), aTrslText(), #CRLF$)
					CountStr = ArraySize(aTrslText())
					SetGadgetText(#StatusBar, Lng(3) + " - " + Str(CountStr) + " " + Lng(2))
				Case #Translated
					If Not Asc(sCurrentPath$) Or Not CountStr
						Continue
					EndIf
					SplitA2(GetGadgetText(#EditTranslation), aTrslTextNew(), #CRLF$)

					CountStrNew = ArraySize(aTrslTextNew())
					If CountStrNew <> CountStr And MessageRequester(Lng(9), Lng(10) + " (" + CountStrNew + "<>" + CountStr + ") " + Lng(11), #PB_MessageRequester_YesNo) = #PB_MessageRequester_No
						Continue
					EndIf
					iCountCur = 0
					n = 0
					If CountStrNew < CountStr
						iCount3 = CountStrNew
					Else
						iCount3 = CountStr
					EndIf
					sTmpTextOut$ = sTextOrig$
					
					Cancel = 0
					For i = 0 To iCount3
						For j = i + 1 To iCount3
							If FindString(aTrslText(j), aTrslText(i))
								Cancel = 1
								MessageRequester("", Lng(24) + #CRLF$ + #CRLF$ + "a) " + aTrslText(i) + #CRLF$ + "b) " + aTrslText(j))
								Break
							EndIf
						Next
					Next
					If Cancel
						Continue
					EndIf
					If flgArr
						sArrayVarText$ = ""
						sArrayVarTextNew$ = ""
						For i = 0 To iCount3
							If aTrslText(i) <> aTrslTextNew(i)
								Occurrences = CountString(sTmpTextOut$, aTrslText(i))
								If Occurrences
									n + 1
									If LeftMain
										sArrayVarText$ + #TAB$ + "Lng(" + n + ") = " + aTrslTextNew(i) + #CRLF$
										sArrayVarTextNew$ + "Lng(" + n + ") = " + aTrslText(i) + #CRLF$
									Else
										sArrayVarText$ + "Lng(" + n + ") = " + aTrslTextNew(i) + #CRLF$
										sArrayVarTextNew$ + #TAB$ + "Lng(" + n + ") = " + aTrslText(i) + #CRLF$
									EndIf
									sTmpTextOut$ = ReplaceString(sTmpTextOut$, aTrslText(i), "Lng(" + Str(n) + ")", 0, 1)
									iCountCur + Occurrences
								EndIf
							EndIf
						Next
						Select flgTemplate
							Case 1
								tmp$ = PeekS(?template1, ?template1end - ?template1, #PB_Ascii)
								tmp2$ = "1049 ; ru"
							Default
								tmp$ = PeekS(?template0, ?template0end - ?template0, #PB_Ascii)
								tmp2$ = "1"
						EndSelect
						
						If langfile
							tmp3$ = PeekS(?template2, ?template2end - ?template2, #PB_Ascii) + #CRLF$ + #CRLF$
						Else
							tmp3$ = ""
						EndIf
						
						If LeftMain
							sTmpTextOut$ = tmp$ + #CRLF$ + #CRLF$ +
							               "#CountStrLang = " + Str(n) + #CRLF$ +
							               "Global Dim Lng.s(#CountStrLang)" + #CRLF$ +
							               sArrayVarTextNew$ + #CRLF$ +
							               "If UserIntLang = " + tmp2$ + #CRLF$ + 
							               sArrayVarText$ +
							               "EndIf" + #CRLF$ + #CRLF$ + tmp3$ + sTmpTextOut$
						Else
							sTmpTextOut$ = tmp$ + #CRLF$ + #CRLF$ +
							               "#CountStrLang = " + Str(n) + #CRLF$ +
							               "Global Dim Lng.s(#CountStrLang)" + #CRLF$ +
							               sArrayVarText$ + #CRLF$ +
							               "If UserIntLang = " + tmp2$ + #CRLF$ + 
							               sArrayVarTextNew$ +
							               "EndIf" + #CRLF$ + #CRLF$ + tmp3$ + sTmpTextOut$
						EndIf
					Else
						For i = 0 To iCount3
							If aTrslText(i) <> aTrslTextNew(i)
								Occurrences = CountString(sTmpTextOut$, aTrslText(i))
								If Occurrences
									sTmpTextOut$ = ReplaceString(sTmpTextOut$, aTrslText(i), aTrslTextNew(i), #PB_String_CaseSensitive)
									iCountCur + Occurrences
								EndIf
							EndIf
						Next
					EndIf
					SetClipboardText(sTmpTextOut$)
					SetGadgetText(#StatusBar, Lng(8) + " " + iCountCur)
					sTmpTextOut$ = ""
					ReDim aTrslTextNew(0)
			EndSelect
		Case #PB_Event_CloseWindow

			If isINI And OpenPreferences(ini$)
				w = WindowWidth(#Window)
				If w <> DspW
					WritePreferenceInteger("width", w)
				EndIf
				h = WindowHeight(#Window)
				If h <> DspH
					WritePreferenceInteger("height", h)
				EndIf
				If CharacterSet0$ <> CharacterSet$
					ReadPreferenceString("char", CharacterSet$)
				EndIf
				If flgArr0 <> flgArr
					WritePreferenceInteger("array", flgArr)
				EndIf
				If flgLRange0 <> flgLRange
					WritePreferenceInteger("range", flgLRange)
				EndIf
				splitter = GetGadgetState(#Splitter)
				If splitter0 <> splitter
					WritePreferenceInteger("splitter", splitter)
				EndIf
				ClosePreferences()
			EndIf

			CloseWindow(#Window)
			End
	EndSelect
ForEver


Procedure WindowSize()
	Protected w, h
	h = WindowHeight(#Window)
	w = WindowWidth(#Window)
	ResizeGadget(#Splitter, #PB_Ignore, #PB_Ignore, w - 10, h - 60)
	ResizeGadget(#StatusBar, #PB_Ignore, h - 20, w - 10, #PB_Ignore)
EndProcedure

Procedure DisableGadgetAll(State)
	DisableGadget(#Opt0, State)
	DisableGadget(#Opt1, State)
	DisableGadget(#ChLangfile, State)
	DisableGadget(#ChLeftMain, State)
EndProcedure


Procedure Setting()
	DisableWindow(#Window, #True)

	OpenWindow(#WinSet, 0, 0,  410, 265, Lng(4), #PB_Window_SystemMenu | #PB_Window_WindowCentered, WindowID(#Window))

	CheckBoxGadget(#ChRpc, 10, 5, 400, 25, Lng(12))
	If flgArr
		SetGadgetState(#ChRpc, #PB_Checkbox_Checked)
	EndIf
	
	OptionGadget(#Opt0, 30, 30, 380, 25, Lng(20))
	OptionGadget(#Opt1, 30, 55, 380, 25, Lng(21))
	If flgTemplate
		SetGadgetState(#Opt1, #PB_Checkbox_Checked)
	Else
		SetGadgetState(#Opt0, #PB_Checkbox_Checked)
	EndIf
	CheckBoxGadget(#ChLangfile, 30, 80, 380, 25, Lng(22))
	If langfile
		SetGadgetState(#ChLangfile, #PB_Checkbox_Checked)
	EndIf
	CheckBoxGadget(#ChLeftMain, 30, 105, 380, 25, Lng(23))
	If LeftMain
		SetGadgetState(#ChLeftMain, #PB_Checkbox_Checked)
	EndIf

	CheckBoxGadget(#ChLRange, 10, 140, 400, 25, Lng(15))
	If flgLRange
		SetGadgetState(#ChLRange, #PB_Checkbox_Checked)
	EndIf

	StringGadget(#StrCharSet, 25, 170, 360, 30, "")
	SetGadgetText(#StrCharSet, CharacterSet$)

	ButtonGadget(#OK, (410 - 90) / 2, 265 - 50, 90, 35, "OK")

	If Not flgArr
		DisableGadgetAll(#True)
	EndIf

	Repeat
		Select WaitWindowEvent()
			Case #PB_Event_Gadget
				Select EventGadget()
					Case #ChRpc
						If GetGadgetState(#ChRpc) & #PB_Checkbox_Checked
							DisableGadgetAll(#False)
						Else
							DisableGadgetAll(#True)
						EndIf
					Case #OK
						If GetGadgetState(#ChLeftMain) & #PB_Checkbox_Checked
							LeftMain = 1
						Else
							LeftMain = 0
						EndIf
						If GetGadgetState(#ChRpc) & #PB_Checkbox_Checked
							flgArr = 1
						Else
							flgArr = 0
						EndIf
						If GetGadgetState(#ChLangfile) & #PB_Checkbox_Checked
							langfile = 1
						Else
							langfile = 0
						EndIf
						If GetGadgetState(#Opt1) & #PB_Checkbox_Checked
							flgTemplate = 1
						Else
							flgTemplate = 0
						EndIf
						CharacterSet$ = GetGadgetText(#StrCharSet)
						If Asc(CharacterSet$)
							If GetGadgetState(#ChLRange) & #PB_Checkbox_Checked
								flgLRange = 1
								ParseLang(CharacterSet$)
							Else
								flgLRange = 0
							EndIf
						EndIf
						DisableWindow(#Window, #False)
						CloseWindow(#WinSet)
						Break
				EndSelect
			Case #PB_Event_CloseWindow
				DisableWindow(#Window, #False)
				CloseWindow(#WinSet)
				Break
		EndSelect
	ForEver
EndProcedure




Procedure ParseLang(CharacterSet$)
	Protected *c.Unicode
	Protected pos, tmp$
	Repeat
		pos = FindString(CharacterSet$, "-")
		If Not pos
			Break
		ElseIf pos = 1 Or pos = Len(CharacterSet$)
			ClearList(Ranges())
			ClearList(Letters())
			ProcedureReturn - 1
		ElseIf pos
			tmp$ = Mid(CharacterSet$, pos - 1, 3)
			CharacterSet$ = ReplaceString(CharacterSet$, tmp$, "", #PB_String_CaseSensitive, 1, 1)
			If AddElement(Ranges())
				Ranges()\start = Asc(tmp$)
				Ranges()\end0 = Asc(Mid(tmp$, 3))
			EndIf
		EndIf
	ForEver

	*c = @CharacterSet$
	While *c\u
		If AddElement(Letters())
			Letters() = *c\u
		EndIf
		*c + SizeOf(Unicode)
	Wend
EndProcedure


Procedure IsLangRange(*text)
	Protected flag = #False, *c.Unicode = *text

	If *c = 0 Or *c\u = 0
		ProcedureReturn 0
	EndIf

	Repeat
		ForEach Ranges()
			If *c\u >= Ranges()\start And *c\u <= Ranges()\end0
				ProcedureReturn 1
			EndIf
		Next
		ForEach Letters()
			If *c\u = Letters()
				ProcedureReturn 1
			EndIf
		Next
		*c + SizeOf(Unicode)
	Until Not *c\u
	ProcedureReturn 0
EndProcedure


Procedure IsLangRange2(*text)
	Protected flag = #False, *c.Character = *text

	If *c = 0 Or *c\c = 0
		ProcedureReturn 0
	EndIf

	Repeat
		If (*c\c >= 'А' And *c\c <= 'я') Or *c\c = 'ё' Or  *c\c = 'Ё'
			flag = #True
			Break
		EndIf
		*c + SizeOf(Character)
	Until Not *c\c

	ProcedureReturn flag
EndProcedure


Procedure GetString(InputFile$)
	Protected flgOpnQt, *b0, c, i, tilda
	Protected id_file, Format, Text$, *c.Character
	Protected NewMap LangStrMap()
	ArrSz = 1000
	Dim aTrslText(ArrSz)

	id_file = ReadFile(#PB_Any, InputFile$)
	If id_file
		Format = ReadStringFormat(id_file)
		sTextOrig$ = ReadString(id_file, Format | #PB_File_IgnoreEOL)
		FileSeek(id_file, 0)
		Format = ReadStringFormat(id_file)
		While Not Eof(id_file)
			Text$ = ReadString(id_file, Format)
			Text$ = LTrimChar(Text$, #TAB$ + " ")
			If Asc(Text$) = '!'
				Continue
			EndIf

			*c = @Text$
			flgOpnQt = 0
			While *c\c
				Select *c\c

					Case 39
						If flgOpnQt = 0
							*c + SizeOf(Character)
							If *c\c = 0 : Break : EndIf
							If *c\c = 39
								*c + SizeOf(Character)
								Continue
							EndIf
							Repeat
								*c + SizeOf(Character)
							Until *c\c = 0 Or *c\c = 39
							If *c\c = 0 : Break : EndIf
						EndIf
					Case '"'
						If tilda
							Select tilda
								Case 1, 3
									tilda = 2
									*c + SizeOf(Character)
									Continue
								Case 2
									tilda = 0
							EndSelect
						EndIf


						If flgOpnQt
							flgOpnQt = 0
							If *b0 + SizeOf(Character) = *c
								*c + SizeOf(Character)
								Continue
							EndIf
							*c + SizeOf(Character)
							*c\c = 0
							tmp$ = PeekS(*b0)


							If Not FindMapElement(LangStrMap(), tmp$)
								AddMapElement(LangStrMap(), tmp$)

								If UCase(tmp$) <> LCase(tmp$)
									If flgLRange
										If IsLangRange(@tmp$)
											aTrslText(i) = tmp$
											i + 1
											If i > ArrSz
												ArrSz * 2
												ReDim aTrslText(ArrSz)
											EndIf
										EndIf
									Else
										aTrslText(i) = tmp$
										i + 1
										If i > ArrSz
											ArrSz * 2
											ReDim aTrslText(ArrSz)
										EndIf
									EndIf
								EndIf
							EndIf
							
						Else
							flgOpnQt = 1
							*b0 = *c
						EndIf
					Case '\'
						Select tilda
							Case 2
								tilda = 3
							Case 3
								tilda = 2
						EndSelect
					Case ';'
						If Not flgOpnQt
							Break
						EndIf
					Case '~'
						If Not flgOpnQt
							*c + SizeOf(Character)
							If *c\c = '"'
								flgOpnQt = 1
								tilda = 1
								*b0 = *c -  SizeOf(Character)
							EndIf
							*c - SizeOf(Character)
						EndIf
				EndSelect
				*c + SizeOf(Character)
			Wend
		Wend
		CloseFile(id_file)
	EndIf

	ClearMap(LangStrMap())

	If i - 1 < ArrSz
		ArrSz = i - 1
		ReDim aTrslText(ArrSz)
	EndIf
EndProcedure


Procedure OpenDoc(sFilePath$)
	Protected pos, sRes$
	pos = FindString(sFilePath$, #LF$)
	If pos
		sFilePath$ = Mid(sFilePath$, 1, pos - 1)
	EndIf
	If FileSize(sFilePath$) < 3
		ProcedureReturn
	EndIf
	GetString(sFilePath$)

	sRes$ = ""
	sCurrentPath$ = sFilePath$
	CountStr = ArraySize(aTrslText())
	SetWindowTitle(#Window, Lng(0) + " (" + GetFilePart(sCurrentPath$) + ")")
	If CountStr >= 0
		sRes$ = Join(aTrslText(), #CRLF$)
		sRes$ = RTrimChar(sRes$, #CRLF$)
		SetGadgetText(#Edit, sRes$)
	Else
		ProcedureReturn Clear()
	EndIf
	SetGadgetText(#StatusBar, Lng(3) + " - " + Str(CountStr + 1) + " " + Lng(2))
	SetActiveGadget(#Edit)
EndProcedure


Procedure Clear()
	sTextOrig$ = ""
	CountStr = 0
	Dim aTrslText(0)
	SetGadgetText(#Edit, "")
	SetGadgetText(#StatusBar, Lng(17))
EndProcedure

[AZJIO]

The path to the dll is now viewed in two directories and next to the executable and is offered to open if not found, and with a function search so that it does not turn out to be a third-party library

A universal option has been added with support for specifying a range or listing characters for captured strings (files with the Uni suffix).

[Kwai chang caine]

Thanks for sharing

[AZJIO]

I made my own string parser to capture quoted strings. Lines starting with a tilde (~) are supported.
Now you can try this on Linux, since it does not require a dll.
I added two sources to the archive with the suffix "Enum"
Download

When testing I got a strange thing. At the end of the GetString() function there is the following code:

Code: Select all

	c = MapSize(LangStrMap())
; 	Debug c
	ReDim aTrslText(c - 1)
; 	Debug  ArraySize(aTrslText())

Try opening a file in this program that does not contain a quoted string. The MapSize() function returns 0, and the ArraySize() function returns -1. If I explicitly specify ReDim Arr(-1), I get a warning from the compiler that a negative number cannot be used.

[AZJIO]

Update
0.1.7 (11.03.25)
Selecting the window in which the main language (English), this determines the order of the data in the results.
Fix capturing strings with tilde, tilde should be added to capture.
Added 3 templates for saving (Windows, cross-platform and read from file) to the settings.
Added forced language (forcelang=2) and external language file Lang.txt
Added ignoring of ASM strings because they represent strings in hexadecimal codes.
Added apostrophe check in the character analyzer because we got the problem ' " '.

[AZJIO]

Update
0.1.8 (12.04.25)
The verification has been added that the lines are not part of the lower lines, for example, "e\" and ~"H\"e\"llo"

I wanted to record a video and talk about the reliability of string replacement, but while I was talking about it, I imagined a situation with a tilde (~) character, where quotation marks are possible inside the string. This is a very rare case - one in a million, but I fixed it to ensure 100% reliability. I added a message that you need to move the long line above the short one. I could sort the strings by length, but then the source code would not be beautiful.