PureBasic Forums - English

Code: Select all

EnableExplicit

Enumeration
	#SYNTAX_Text
	#SYNTAX_Keyword
	#SYNTAX_Comment
	#SYNTAX_Constant
	#SYNTAX_String
	#SYNTAX_Function
	#SYNTAX_Asm
	#SYNTAX_Operator
	#SYNTAX_Structure
	#SYNTAX_Number
	#SYNTAX_Pointer
	#SYNTAX_Separator
	#SYNTAX_Label
	#SYNTAX_Module
EndEnumeration

#Dll = 0

Global NewMap Var.s()
Global Buffer$, Buffer2$, Length, NotSuccess, *Buffer, Pos, Pos2, flgAdd


Declare.s LTrimChar(String$, TrimChar$ = #CRLF$ + #TAB$ + #FF$ + #VT$ + " ")
Declare.s RTrimChar(String$, TrimChar$ = #CRLF$ + #TAB$ + #FF$ + #VT$ + " ")

Procedure Callback(*Position, Length, Color)
	Protected token$
	; 	Debug 2
	Select Color
		Case #SYNTAX_Text, #SYNTAX_Pointer
			token$ = PeekS(*Position, Length, #PB_Ascii)
			token$ = LTrimChar(token$, #TAB$ + " ")
			token$ = RTrimChar(token$, #CRLF$ + #TAB$ + " ")
			; 			AddMapElement(LCase(token$))
			If flgAdd
				Var(LCase(token$)) = ""
			Else
				Var(LCase(token$)) = token$
 		   EndIf
; 			Debug "|" + token$ + "|"; + Str(*Position)
	EndSelect
EndProcedure

If OpenLibrary(#Dll, #PB_Compiler_Home + "SDK\Syntax Highlighting\SyntaxHighlighting.dll")
; 	MessageRequester("", #PB_Compiler_Home + "SDK\Syntax Highlighting\SyntaxHighlighting.dll")
	
	Buffer$ = GetClipboardText()
	Pos = FindString(Buffer$, "Procedure", 1, #PB_String_NoCase)
	If Pos
		Pos2 = FindString(Buffer$, #LF$, Pos + 9)
		If Pos
			Buffer2$ = Mid(Buffer$, Pos, Pos2 - Pos)
; 			Debug Buffer2$
	    EndIf
    EndIf
	*Buffer = UTF8(Buffer$)
	Length = MemorySize(*Buffer)
	CallFunction(#Dll, "SyntaxHighlight", *Buffer, Length, @Callback(), 0)
	FreeMemory(*Buffer)
	If Asc(Buffer2$)
		flgAdd = 1
		*Buffer = UTF8(Buffer2$)
		Length = MemorySize(*Buffer)
		CallFunction(#Dll, "SyntaxHighlight", *Buffer, Length, @Callback(), 0)
		FreeMemory(*Buffer)
    EndIf
	CloseLibrary(#Dll)
	Buffer$ = "Protected "
	ForEach Var()
		If Asc(Var())
			Buffer$ + Var() + ", "
	    EndIf
	Next
	Buffer$ = Left(Buffer$, Len(Buffer$) - 2)
	Debug Buffer$
	SetClipboardText(Buffer$)
EndIf



Procedure.s LTrimChar(String$, TrimChar$ = #CRLF$ + #TAB$ + #FF$ + #VT$ + " ")
    Protected *jc0, *c.Character, *jc.Character

    If Not Asc(String$)
        ProcedureReturn ""
    EndIf

    *c = @String$
    *jc0 = @TrimChar$

    While *c\c
        *jc = *jc0

        While *jc\c
            If *c\c = *jc\c
                *c\c = 0
                Break
            EndIf
            *jc + SizeOf(Character)
        Wend

        If *c\c
            String$ = PeekS(*c)
            Break
        EndIf
        *c + SizeOf(Character)
    Wend

    ProcedureReturn String$
EndProcedure

Procedure.s RTrimChar(String$, TrimChar$ = #CRLF$ + #TAB$ + #FF$ + #VT$ + " ")
    Protected Len2, Blen, i
    Protected *jc0, *c.Character, *jc.Character

    Len2 = Len(String$)
    Blen = StringByteLength(String$)

    If Not Asc(String$)
        ProcedureReturn ""
    EndIf

    *c = @String$ + Blen - SizeOf(Character)
    *jc0 = @TrimChar$

    For i = Len2 To 1 Step - 1
        *jc = *jc0

        While *jc\c
            If *c\c = *jc\c
                *c\c = 0
                Break
            EndIf
            *jc + SizeOf(Character)
        Wend

        If *c\c
            Break
        EndIf
        *c - SizeOf(Character)
    Next

    ProcedureReturn String$
EndProcedure

Code: Select all

EnableExplicit

XIncludeFile "forlocal.pb"

Enumeration
	#SYNTAX_Text
	#SYNTAX_Keyword
	#SYNTAX_Comment
	#SYNTAX_Constant
	#SYNTAX_String
	#SYNTAX_Function
	#SYNTAX_Asm
	#SYNTAX_Operator
	#SYNTAX_Structure
	#SYNTAX_Number
	#SYNTAX_Pointer
	#SYNTAX_Separator
	#SYNTAX_Label
	#SYNTAX_Module
EndEnumeration

#Dll = 0

Global NewMap Var.s()
Global Buffer$, Buffer2$, Length, NotSuccess, *Buffer, Pos, Pos2, flgAdd

Global PbIdeHandle, ScintillaHandle, Selected$, PathDLL$
Define d, scope$


; For test only
CompilerIf #PB_Compiler_Debugger
Global classText.s = Space(256)
; Finding a PureBasic Window
Procedure.l enumChildren0(hwnd.l)
	If hwnd
		GetClassName_(hwnd, @classText, 256)
		If classText = "WindowClass_2"
			GetWindowText_(hwnd, @classText, 256)
			If Left(classText, 9) = "PureBasic"
				PbIdeHandle = hwnd
				ProcedureReturn 0
			EndIf
		EndIf
		ProcedureReturn 1
	EndIf
	ProcedureReturn 0
EndProcedure

; Finding the Scintilla
Procedure.l enumChildren1(hwnd.l)
	If hwnd
		GetClassName_(hwnd, @classText, 256)
		If classText = "Scintilla"
			ScintillaHandle = hwnd
			ProcedureReturn 0
		EndIf
		ProcedureReturn 1
	EndIf
	ProcedureReturn 0
EndProcedure
CompilerEndIf
; End: For test only

Procedure Initialization()
	Protected LenSelText, Cursor, Anchor, tmp

	; For test only
	CompilerIf #PB_Compiler_Debugger
		EnumChildWindows_(0, @enumChildren0(), 0)
		EnumChildWindows_(PbIdeHandle, @enumChildren1(), 0)
		PathDLL$ = #PB_Compiler_Home + "SDK\Syntax Highlighting\SyntaxHighlighting.dll"
	CompilerElse
		ScintillaHandle = Val(GetEnvironmentVariable("PB_TOOL_Scintilla"))
		If ScintillaHandle = 0 : End : EndIf

		PathDLL$ = GetPathPart(GetEnvironmentVariable("PB_TOOL_IDE")) + "SDK\Syntax Highlighting\SyntaxHighlighting.dll"
		If FileSize(PathDLL$) < 1 : End : EndIf
	CompilerEndIf
	; End: For test only
	Debug PathDLL$

	Anchor = SendMessage_(ScintillaHandle, #SCI_GETANCHOR, 0, 0)
	Cursor = SendMessage_(ScintillaHandle, #SCI_GETCURRENTPOS, 0, 0)
	If Anchor < Cursor
		Cursor = Anchor
	EndIf
	LenSelText = SendMessage_(ScintillaHandle, #SCI_GETSELTEXT, 0, 0)

	Selected$ = GetScintillaRangeText(ScintillaHandle, Cursor, LenSelText)
	Debug LenSelText
	Debug Anchor - Cursor
	; Debug Selected$
EndProcedure

Procedure Callback(*Position, Length, Color)
	Protected token$
	; Debug 2
	Select Color
		Case #SYNTAX_Text, #SYNTAX_Pointer
			token$ = PeekS(*Position, Length, #PB_Ascii)
			token$ = LTrimChar(token$, #TAB$ + " ")
			token$ = RTrimChar(token$, #CRLF$ + #TAB$ + " ")
; 			If Asc(token$) = '@'
; ; 				token$ = LTrim(token$, "@")
; 				token$ = ""
; 			EndIf
			If Asc(token$) <> '@'
				; переменные не учитывают регистр поэтому LCase
				; AddMapElement(LCase(token$))
				If flgAdd ; флаг что найдены переданные в процедуру переменные и их надо обнулить, не добавляя в локальные для Protected
					Var(LCase(token$)) = ""
				Else
					Var(LCase(token$)) = token$
				EndIf
				; Debug "|" + token$ + "|"; + Str(*Position)
			EndIf
			
	EndSelect
EndProcedure

Initialization()

If Not OpenLibrary(#Dll, PathDLL$)
	MessageRequester("", "SyntaxHighlighting.dll not found")
	End
EndIf

; 	MessageRequester("", PathDLL$)


; 	Selected$ = GetClipboardText()
; 	MessageRequester("", Selected$)
Pos = FindString(Selected$, "Procedure", 1, #PB_String_NoCase)
If Pos
	Pos2 = FindString(Selected$, #LF$, Pos + 9)
	If Pos
		Buffer2$ = Mid(Selected$, Pos, Pos2 - Pos)
		; Debug Buffer2$
	EndIf
EndIf
*Buffer = UTF8(Selected$)
Length = MemorySize(*Buffer)
CallFunction(#Dll, "SyntaxHighlight", *Buffer, Length, @Callback(), 0)
FreeMemory(*Buffer)
If Asc(Buffer2$)
	flgAdd = 1
	*Buffer = UTF8(Buffer2$)
	Length = MemorySize(*Buffer)
	CallFunction(#Dll, "SyntaxHighlight", *Buffer, Length, @Callback(), 0)
	FreeMemory(*Buffer)
EndIf
CloseLibrary(#Dll)

If flgAdd
	scope$ = #TAB$ + "Protected "
Else
	scope$ = "Define "
EndIf

Selected$ = #CRLF$ + scope$
ForEach Var()
	If Asc(Var())
		d + 1
		If d > 10; And Len(Selected$) > 100 ; если 8 переменных то делаем новую строку
			d = 0
			Selected$ = Left(Selected$, Len(Selected$) - 2) + #CRLF$ + scope$
		EndIf
		Selected$ + Var() + ", "
	EndIf
Next
Selected$ = Left(Selected$, Len(Selected$) - 2)
Debug Selected$
SetClipboardText(Selected$)

Code: Select all

Procedure.s GetScintillaRangeText(ScintillaHandle, cursor, length)
	Protected String$
; 	Protected length
	Protected *mem
	Protected PID
	Protected hProcess
	Protected *pointer

	If length
		*mem = AllocateMemory(length + 2)
		If *mem
; 			высылаем сообщение ScintillaHandle, чтобы получить указатель (в *pointer) на позицию где находится "курсор"
			SendMessageTimeout_(ScintillaHandle, #SCI_GETRANGEPOINTER, cursor, 0, #SMTO_ABORTIFHUNG, 2000, @*pointer)
			If *pointer ; если указатель получен, то
				GetWindowThreadProcessId_(ScintillaHandle, @PID) ; получаем идентификатор процесса ScintillaHandle
				hProcess = OpenProcess_(#PROCESS_VM_READ | #SYNCHRONIZE, #False, PID) ; запрашиваем доступ к процессу и получаем декскриптор
				If hProcess ; если дескриптор получен, то
					; читаем память процесса по указателю *pointer в выделенную память *mem с заказанной длинной
					ReadProcessMemory_(hProcess, *pointer, *mem, length, 0)
					String$ = PeekS(*mem, -1, #PB_UTF8) ; а может тут стоит указать длину для чтения? Выделено на 2 байта больше чтобы -1
					CloseHandle_(hProcess)
				EndIf
			EndIf
			FreeMemory(*mem)
		EndIf
	EndIf
	ProcedureReturn String$
EndProcedure



Procedure.s LTrimChar(String$, TrimChar$ = #CRLF$ + #TAB$ + #FF$ + #VT$ + " ")
	Protected *jc0, *c.Character, *jc.Character

	If Not Asc(String$)
		ProcedureReturn ""
	EndIf

	*c = @String$
	*jc0 = @TrimChar$

	While *c\c
		*jc = *jc0

		While *jc\c
			If *c\c = *jc\c
				*c\c = 0
				Break
			EndIf
			*jc + SizeOf(Character)
		Wend

		If *c\c
			String$ = PeekS(*c)
			Break
		EndIf
		*c + SizeOf(Character)
	Wend

	ProcedureReturn String$
EndProcedure

Procedure.s RTrimChar(String$, TrimChar$ = #CRLF$ + #TAB$ + #FF$ + #VT$ + " ")
	Protected Len2, Blen, i
	Protected *jc0, *c.Character, *jc.Character

	Len2 = Len(String$)
	Blen = StringByteLength(String$)

	If Not Asc(String$)
		ProcedureReturn ""
	EndIf

	*c = @String$ + Blen - SizeOf(Character)
	*jc0 = @TrimChar$

	For i = Len2 To 1 Step - 1
		*jc = *jc0

		While *jc\c
			If *c\c = *jc\c
				*c\c = 0
				Break
			EndIf
			*jc + SizeOf(Character)
		Wend

		If *c\c
			Break
		EndIf
		*c - SizeOf(Character)
	Next

	ProcedureReturn String$
EndProcedure

Code: Select all

EnableExplicit

#Empty = 1

Global Dim Proc$(0)
Global Dim Var$(0)
Global Dim StrVar$(0)
Global Dim DeclareVar$(0)
Global Dim VarPoint$(0)
Global NbProc, NbStrVar, NbDeclareVar, NbVar, NbVarPoint
Global NativeFunc$, KeyWord$
Global NewMap FuncExceptionMap.s()
Global NewMap KeyWordExceptionMap.s()
Global NewMap ResultMap.s()
; Global NewList ResultList.s()

Procedure.s ReadFileToVar(Path$)
	Protected id_file, Format, Text$

	id_file = ReadFile(#PB_Any, Path$)
	If id_file
		Format = ReadStringFormat(id_file)
		Text$ = ReadString(id_file, Format | #PB_File_IgnoreEOL)
		; Text$ = ReadString(id_file, #PB_UTF8 | #PB_File_IgnoreEOL)
		CloseFile(id_file)
	EndIf

	ProcedureReturn Text$
EndProcedure


Procedure.s StringProcessing(Text$)
	Protected tilda
	Protected *c.Character

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

			Case '!' ; если ASM код, то тупо пропускаем эту строку (строки в кавычках в ASM в виде псевдокода)
				*c\c = 0
				Break

			Case '\' ; элемент структуры
				*c\c = #Empty
				*c + SizeOf(Character)
				Repeat
					Select *c\c
						Case 'A' To 'Z', 'a' To 'z', '0' To '9', '_'
							*c\c = #Empty
							*c + SizeOf(Character)
						Default
							Break
					EndSelect
				Until *c\c = 0

			Case 39 ; ' апостроф
				*c\c = #Empty
				*c + SizeOf(Character)
				If *c\c = 0
					Break
				EndIf
				If *c\c = 39
					*c\c = #Empty
					*c + SizeOf(Character)
					Continue
				EndIf
				Repeat
					*c\c = #Empty
					*c + SizeOf(Character)
				Until *c\c = 0 Or *c\c = 39 ; идём до конца строки или до заканчивающегося апострофа
				If *c\c = 0
					Break
				EndIf	; выпрыг, если конец строки или апостроф в ненадлежащем месте.

			Case '"'
				Repeat
					*c\c = #Empty
					*c + SizeOf(Character)
				Until *c\c = 0 Or *c\c = '"' ; идём до конца строки или до заканчивающегося апострофа
				If *c\c = '"'
					*c\c = #Empty
				ElseIf *c\c = 0
					Break
				EndIf	; выпрыг, если конец строки или апостроф в ненадлежащем месте.

			Case ';'
				; Debug комент
				*c\c = 0
				Break ; если нет открытой кавычки, значит пошли комментарии до конца строки, поэтому выпрыгиваем и запрашиваем новую строку

			Case '~'
				tilda = 1 ; включаем флаг запуска/открытия тильды
				*c\c = #Empty
				*c + SizeOf(Character)
				While *c\c
					Select *c\c
						Case '"'
							Select tilda
								Case 1, 3
									tilda = 2
									*c\c = #Empty
									*c + SizeOf(Character)
									Continue
								Case 2
									; пришли к завершающей кавычке и срабатывает ниже условие flgOpnQt, так как нет Continue по тексту
									; tilda = 0
									*c\c = #Empty
									Break ; выпрыгиваем, чтобы не делать лишний сдвиг, мы прошли до закрывющей кавычки, сброс тильды не обязателен
							EndSelect
						Case '\'
							; этот механизм чисто для проверки экранированных кавычек после тильды
							; двойная проверка флагов изменяет поведение при дублировании кавычки
							Select tilda
								Case 2
									tilda = 3
								Case 3
									tilda = 2
							EndSelect
					EndSelect
					*c\c = #Empty
					*c + SizeOf(Character)
				Wend
			Case '+', '-', '/', '=', ',', ')'
				*c\c = #Empty
		EndSelect
		*c + SizeOf(Character)
	Wend
	ProcedureReturn Text$
EndProcedure


; Функция GetSelText() вызывается один раз, поэтому компиляция регулярных выражений не требуется глобальной
Procedure.s GetSelText()
	Protected Line2, Line1, Line, Format, String$, PathFile$, Text$, i, d
	Protected API, Constant, StrVar, Struct, Imports, Type, HNum, Proc, ProcClear, ModulesClear
	Protected DeclareVar, DeclareVarClear, Var, Num, VarPoint, ProcAll, CountScope, Macros, Modules
	Protected CountProc, Scope$

	If CountProgramParameters() < 2
		End
	EndIf
	; Selected$ = ProgramParameter(0)
	PathFile$ = ProgramParameter(1)
	; 11x22x33x44
	Line1 = Int(Val(StringField(ProgramParameter(0), 1, "x")))
	Line2 = Int(Val(StringField(ProgramParameter(0), 3, "x")))
	
; 	Принудительный тест и надо закомментировать CountProgramParameters()
; 	PathFile$ = "C:\D\PureBasic\Source\!My_projects\Tools\get_local\get_local_Linux.pb"
; 	Line1 = 10
; 	Line2 = 352

	; Добавляём процедуры текущего исходника в список исключений
	#File = 0
	If ReadFile(#File, PathFile$)
		Format = ReadStringFormat(#File)
		Text$ = ReadString(#File, Format | #PB_File_IgnoreEOL)
		CloseFile(#File)
		
		ProcAll = CreateRegularExpression(#PB_Any, "^\h*(?:Procedure[CDL$]{0,5}?(?:\h*\.[abcdfilqsuw])?\h+\K)[A-Za-z_]\w*(?=\h*\()", #PB_RegularExpression_MultiLine | #PB_RegularExpression_NoCase)
		If ProcAll
			If ExamineRegularExpression(ProcAll, Text$)
				While NextRegularExpressionMatch(ProcAll)
					If Not FindMapElement(FuncExceptionMap(), RegularExpressionMatchString(ProcAll))
						AddMapElement(FuncExceptionMap(), RegularExpressionMatchString(ProcAll))
					EndIf
				Wend
			EndIf
		EndIf
	EndIf
	; Конец захват процедур
	
	; Добавляём модуль::функции текущего исходника в список исключений
	Modules = CreateRegularExpression(#PB_Any, "::[A-Za-z_]\w*(?=\h*\()", #PB_RegularExpression_MultiLine | #PB_RegularExpression_NoCase)
	If Modules
		If ExamineRegularExpression(Modules, Text$)
			While NextRegularExpressionMatch(Modules)
				If Not FindMapElement(FuncExceptionMap(), RegularExpressionMatchString(Modules))
					AddMapElement(FuncExceptionMap(), RegularExpressionMatchString(Modules))
				EndIf
			Wend
		EndIf
	EndIf
	; Конец захват модуль::функции
	
	; Добавляём макросы текущего исходника в список исключений
	Macros = CreateRegularExpression(#PB_Any, "^\h*Macro\h+\K[A-Za-z_]\w*(?=\h*\()", #PB_RegularExpression_MultiLine | #PB_RegularExpression_NoCase)
	If Macros
		If ExamineRegularExpression(Macros, Text$)
			While NextRegularExpressionMatch(Macros)
				If Not FindMapElement(FuncExceptionMap(), RegularExpressionMatchString(Macros))
					AddMapElement(FuncExceptionMap(), RegularExpressionMatchString(Macros))
				EndIf
			Wend
		EndIf
	EndIf
	Text$ = ""
	; Конец захват макросов



	; Захват строк выделенного текста
	#File = 0
	If ReadFile(#File, PathFile$)
		Format = ReadStringFormat(#File)
		While Not Eof(0)
			String$ = ReadString(#File, Format)
			Line + 1
			If Line >= Line1 And Line <= Line2
				Text$ + StringProcessing(String$) + #CRLF$ ; первичная чистка от строк, комментариев, операторов, апострофов, ASM-кода
			EndIf
		Wend
		CloseFile(#File)
	EndIf
	; Конец захват выделенного текста

	; MessageRequester("", Text$)
	; Проверяем, сколько функций в выделенном тексте, чтобы правильно подставить область видимости Protected или Define или Global
	If ProcAll
		If ExamineRegularExpression(ProcAll, Text$)
			While NextRegularExpressionMatch(ProcAll)
				CountProc + 1
			Wend
		EndIf
	EndIf

	; Здесь бы ещё сделать списки областей видимости Protected, Define, Global,
	; чтобы для Protected исключить Global, а для Global исключить Protected

	; Удаление API-функций, #констант, ключевых слов, встроенных функций

	Constant = CreateRegularExpression(#PB_Any, "[#@]\w+\$?") ; для удаления #констант и взятие указателей
	API = CreateRegularExpression(#PB_Any, "\w+_\(")		  ; для удаления API-функций
	Struct = CreateRegularExpression(#PB_Any, "Structure\h.+?EndStructure", #PB_RegularExpression_DotAll | #PB_RegularExpression_NoCase) ; для удаления структур
	Imports = CreateRegularExpression(#PB_Any, "ImportC?\h.+?EndImport", #PB_RegularExpression_DotAll | #PB_RegularExpression_NoCase) ; для удаления структур
	Num = CreateRegularExpression(#PB_Any, "\b\d+\b")	 ; для очистки чисел
	HNum = CreateRegularExpression(#PB_Any, "(?<!\w)\$[\da-fA-F]+\b")			
; 	Type = CreateRegularExpression(#PB_Any, "(?<=\w)\.[abcdfilqsuw]\h*(?=\()") ; для очистки типов у переменных со скобками
	Type = CreateRegularExpression(#PB_Any, "(?<=\w)\.\w+") ; для очистки типов у переменных со скобками, включая объявления структур
	ModulesClear = CreateRegularExpression(#PB_Any, "\w+::[A-Za-z_]\w*\h*\(")

	Text$ = ReplaceRegularExpression(Constant, Text$, "")
	Text$ = ReplaceRegularExpression(API, Text$, "")
	Text$ = ReplaceRegularExpression(Struct, Text$, "")
	Text$ = ReplaceRegularExpression(Imports, Text$, "")
	Text$ = ReplaceRegularExpression(Num, Text$, "")
	Text$ = ReplaceRegularExpression(HNum, Text$, "")
	Text$ = ReplaceRegularExpression(Type, Text$, "")
	Text$ = ReplaceRegularExpression(ModulesClear, Text$, "")

	Proc = CreateRegularExpression(#PB_Any, "\w+(?=\h*\()") ; для захвата процедур
	ProcClear = CreateRegularExpression(#PB_Any, "\w+\h*\("); для очистки процедур

	NbProc = ExtractRegularExpression(Proc, Text$, Proc$())
	If NbProc
		For i = 0 To NbProc - 1
			If FindMapElement(FuncExceptionMap(), Proc$(i)) Or FindMapElement(KeyWordExceptionMap(), Proc$(i))
				Proc$(i) = ""
			EndIf
		Next
	EndIf
	Text$ = ReplaceRegularExpression(ProcClear, Text$, "")


	VarPoint = CreateRegularExpression(#PB_Any, "\*[a-zA-Z]\w*") ; для захвата и очистки указателей
	NbVarPoint = ExtractRegularExpression(VarPoint, Text$, VarPoint$())
	Text$ = ReplaceRegularExpression(VarPoint, Text$, "")

	StrVar = CreateRegularExpression(#PB_Any, "\w+\$") ; для захвата и очистки строковых переменных

	NbStrVar = ExtractRegularExpression(StrVar, Text$, StrVar$())
	Text$ = ReplaceRegularExpression(StrVar, Text$, "")

	DeclareVar = CreateRegularExpression(#PB_Any, "\w+(?=\.[abcdfilqsuw])") ; для захвата декларируемых типом переменных
	DeclareVarClear = CreateRegularExpression(#PB_Any, "\w+\.[abcdfilqsuw]"); для очистки декларируемых типом переменных

	NbDeclareVar = ExtractRegularExpression(DeclareVar, Text$, DeclareVar$())
	Text$ = ReplaceRegularExpression(DeclareVarClear, Text$, "")


	Var = CreateRegularExpression(#PB_Any, "\w++") ; для захвата и очистки строковых переменных

	NbVar = ExtractRegularExpression(Var, Text$, Var$())
	If NbVar
		For i = 0 To NbVar - 1
			If FindMapElement(KeyWordExceptionMap(), Var$(i))
				Var$(i) = ""
			EndIf
		Next
	EndIf
	Text$ = ReplaceRegularExpression(Var, Text$, "")

	Select CountProc
		Case 0
			Scope$ = "Define "
		Case 1
			Scope$ = #TAB$ + "Protected "
		Default
			Scope$ = "Global "
	EndSelect

	Text$ = ""
	If NbProc
		d = 0
		Text$ + #CRLF$ + Scope$
		For i = 0 To NbProc - 1
			If Asc(Proc$(i)) And Not FindMapElement(ResultMap(), Proc$(i))
				AddMapElement(ResultMap(), Proc$(i))
				d + 1
				If d > 10; And Len(Text$) > 100 ; если 8 переменных то делаем новую строку
					d = 0 ; обычных переменных всегда много, поэтому делаем следующую строку
					Text$ = Left(Text$, Len(Text$) - 2) + #CRLF$ + Scope$
				EndIf
				Text$ + Proc$(i) + "(), "
				CountScope + 1
			EndIf
		Next
		If CountScope
			Text$ = Left(Text$, Len(Text$) - 2)
		Else
			Text$ = ""
		EndIf
	EndIf

	If NbVarPoint
		d = 0
		Text$ + #CRLF$ + Scope$
		For i = 0 To NbVarPoint - 1
			If Asc(VarPoint$(i)) And Not FindMapElement(ResultMap(), VarPoint$(i))
				AddMapElement(ResultMap(), VarPoint$(i))
				d + 1
				If d > 10; And Len(Text$) > 100 ; если 8 переменных то делаем новую строку
					d = 0 ; обычных переменных всегда много, поэтому делаем следующую строку
					Text$ = Left(Text$, Len(Text$) - 2) + #CRLF$ + Scope$
				EndIf
				Text$ + VarPoint$(i) + ", "
			EndIf
		Next
		Text$ = Left(Text$, Len(Text$) - 2)
	EndIf

	If NbStrVar
		d = 0
		Text$ + #CRLF$ + Scope$
		For i = 0 To NbStrVar - 1
			If Asc(StrVar$(i)) And Not FindMapElement(ResultMap(), StrVar$(i))
				AddMapElement(ResultMap(), StrVar$(i))
				d + 1
				If d > 10; And Len(Text$) > 100 ; если 8 переменных то делаем новую строку
					d = 0 ; обычных переменных всегда много, поэтому делаем следующую строку
					Text$ = Left(Text$, Len(Text$) - 2) + #CRLF$ + Scope$
				EndIf
				Text$ + StrVar$(i) + ", "
			EndIf
		Next
		Text$ = Left(Text$, Len(Text$) - 2)
	EndIf

	If NbVar
		CountScope = 0
		d = 0
		Text$ + #CRLF$ + Scope$
		For i = 0 To NbVar - 1
			If Asc(Var$(i)) And Not FindMapElement(ResultMap(), Var$(i))
				AddMapElement(ResultMap(), Var$(i))
				d + 1
				If d > 10; And Len(Text$) > 100 ; если 8 переменных то делаем новую строку
					d = 0 ; обычных переменных всегда много, поэтому делаем следующую строку
					Text$ = Left(Text$, Len(Text$) - 2) + #CRLF$ + Scope$
				EndIf
				Text$ + Var$(i) + ", "
				CountScope + 1
			EndIf
		Next
		If CountScope
			Text$ = Left(Text$, Len(Text$) - 2)
		Else
			Text$ = Left(Text$, Len(Text$) - Len(Scope$) - 2)
		EndIf
	EndIf
	
	FreeRegularExpression(#PB_All) ; это может стать причиной проблем при создании глобальных регвыр с использованием после этой функции
	ProcedureReturn Text$
EndProcedure


Procedure SplitM(String.s, Map StringMap.s(), Separator.s = " ", CaseSensitive = 1)
	Protected S.String, *S.Integer = @S
	Protected.i p, slen

	slen = Len(Separator)
	ClearMap(StringMap())
	*S\i = @String
	Repeat
		p = FindString(S\s, Separator)
		If CaseSensitive
			AddMapElement(StringMap(), PeekS(*S\i, p - 1))
		Else
			AddMapElement(StringMap(), LCase(PeekS(*S\i, p - 1)))
			StringMap() = PeekS(*S\i, p - 1)
		EndIf

		*S\i + (p + slen - 1) << #PB_Compiler_Unicode
	Until p = 0
	*S\i = 0
EndProcedure


Define Text$, ProgDir$

ProgDir$ = GetPathPart(ProgramFilename())

NativeFunc$ = ReadFileToVar(ProgDir$ + "Procedure.txt")
If Not Asc(NativeFunc$)
	MessageRequester("", "Не удалось прочитать файл" + #CRLF$ + ProgDir$ + "Procedure.txt")
	End
EndIf

KeyWord$ = ReadFileToVar(ProgDir$ + "KeyWord.txt")
If Not Asc(KeyWord$)
	MessageRequester("", "Не удалось прочитать файл" + #CRLF$ + ProgDir$ + "KeyWord.txt")
	End
EndIf
; создаём список исключений из нативных функций до обработки исходника
SplitM(NativeFunc$, FuncExceptionMap(), #CRLF$)
SplitM(KeyWord$, KeyWordExceptionMap(), #CRLF$)

Text$ = GetSelText()
SetClipboardText(Text$)
MessageRequester("", Text$)

Code: Select all

Procedure files_list()
	Shared files()

	If FileSize(#directory_name) = -2
		If ExamineDirectory(#directory, #directory_name, "*.*")

			While NextDirectoryEntry(#directory)
				file_name.s = DirectoryEntryName(#directory)

				If DirectoryEntryType(#directory) = #PB_DirectoryEntry_File
					file_size.q = DirectoryEntrySize(#directory)

					Debug "Найден файл: " + file_name + " (" + Str(file_size) + " байт)"

					AddElement(files())
					files()\file_name = file_name
					files()\file_size = file_size

				EndIf
			Wend

			FinishDirectory(#directory)
		EndIf
	EndIf
EndProcedure