PureBasic Forums - English

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

CheckHash

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

Page 1 of 1

CheckHash

Posted: Thu Sep 04, 2025 7:54 pm
by AZJIO
CheckHash

Download

Screenshot on Linux
Image

Code: Select all

;- TOP
;- @AZJIO v0.2 (05.09.2025)

; план: проверить файлы при запуске утилиты по списку

EnableExplicit

Define UserIntLang, *Lang
If OpenLibrary(0, "kernel32.dll")
	*Lang = GetFunction(0, "GetUserDefaultUILanguage")
	If *Lang
		UserIntLang = CallFunctionFast(*Lang)
	EndIf
	CloseLibrary(0)
EndIf

#CountStrLang = 21
Global Dim Lng.s(#CountStrLang)
Lng(1) = "About"
Lng(2) = "File 1:"
Lng(3) = "copy hash to clipboard"
Lng(4) = "File 2:"
Lng(5) = "Compare"
Lng(6) = "Compare hash fields"
Lng(7) = "Change hash type"
Lng(8) = "Clear 'File 2' when pasting into 'File 1'"
Lng(9) = "Warning"
Lng(10) = "Drag and drop a single file"
Lng(11) = "Calculate?"
Lng(12) = "The file has been changed and exists, do you want to calculate for it?"
Lng(13) = "Select a file"
Lng(14) = "All"
Lng(15) = "Author"
Lng(16) = "Hash fields must be filled in"
Lng(17) = "Match"
Lng(18) = "Difference"
Lng(19) = "The same file"
Lng(20) = "Match, file size ratio 1=1"
Lng(21) = "Difference, file size ratio"

If UserIntLang = 10149 ; ru
	Lng(1) = "О программе"
	Lng(2) = "Файл 1:"
	Lng(3) = "копировать хеш в буфер обмена"
	Lng(4) = "Файл 2:"
	Lng(5) = "Сравнить"
	Lng(6) = "Сравить поля хешей"
	Lng(7) = "Сменить тип хеша"
	Lng(8) = "Очищать 'Файл 2' при вставке в 'Файл 1'"
	Lng(9) = "Предупреждение"
	Lng(10) = "Перетаскивайте одиночный файл"
	Lng(11) = "Вычислить?"
	Lng(12) = "Файл изменён и существует, хотите вычислить для него?"
	Lng(13) = "Выбрать файл"
	Lng(14) = "Все"
	Lng(15) = "Автор"
	Lng(16) = "Поля хешей должны быть заполнены"
	Lng(17) = "Совпадение"
	Lng(18) = "Отличие"
	Lng(19) = "Один и тот же файл"
	Lng(20) = "Совпадение,    отношение размеров файла 1=1"
	Lng(21) = "Отличие,    отношение размеров файла"
EndIf


UseMD5Fingerprint()
UseCRC32Fingerprint()
UseSHA1Fingerprint()
UseSHA2Fingerprint()
UseSHA3Fingerprint()

;- # Constants
#Window = 0
#Menu = 0
;- ● Enumeration
; Enumeration
; 	#Font1
; 	#FontDef
; EndEnumeration

Enumeration
	#mMD5 = 1
	#mCRC32
	#mSHA1
	#mSHA2
	#mSHA3
EndEnumeration

Enumeration
	#btn
	#chk

	#txt1
	#file_1
	#tfilen_1
	#openfile_1
	#hash_1
	#hashbuf_1

	#txt2
	#file_2
	#tfilen_2
	#openfile_2
	#hash_2
	#hashbuf_2

	#Sel_Hash
	#ClearInp
	#Compare_Hash
	#CatchDrop1
	#About
	#StatusBar
EndEnumeration

Structure File
	path.s
	hash.s
	size.q
EndStructure

;- ● Global
Global file1.File
Global file2.File
Global tmp$, HashType, ini$, PathConfig$
Global w, h, gh, gmh, margin, bw, bw1
Global cDefault = 0
Global cRed = $0000EE
Global cGreen = $007700
Global cBlue = $990000

Global Dim aHashType.s(5)
aHashType(1) = "MD5"
aHashType(2) = "CRC32"
aHashType(3) = "SHA1"
aHashType(4) = "SHA2"
aHashType(5) = "SHA3"

;- ● Define
Define hicon1, hicon2
Define style, fsz, cb


CompilerIf #PB_Compiler_OS = #PB_OS_Windows
	style = #SS_CENTERIMAGE | #SS_LEFTNOWORDWRAP
CompilerElse
	style = 0
CompilerEndIf

;- ● Declare
Declare SetGColor(Color)
Declare CompareFiles()
Declare CompareHash()
Declare SetFile(*file.File, *path, tfilen, file, hash)

XIncludeFile "ForCheckHash.pb"

; LoadFont(#Font1, "", 0, #PB_Font_Bold)
; LoadFont(#FontDef, "", 0)


HashType = #PB_Cipher_MD5
w = 550
h = 208
cb = 0

;- ● ini
PathConfig$ = GetPathPart(ProgramFilename())
If FileSize(PathConfig$ + "CheckHash.ini") = -1
	CompilerSelect #PB_Compiler_OS
		CompilerCase #PB_OS_Windows
			PathConfig$ = GetHomeDirectory() + "AppData\Roaming\CheckHash\"
		CompilerCase #PB_OS_Linux
			PathConfig$ = GetHomeDirectory() + ".config/CheckHash/"
			If CreateDirectory(PathConfig$)
; 				Файл находится в установочном пакете
				CopyFile("/usr/share/azjio/CheckHash/CheckHash.ini", PathConfig$ + "CheckHash.ini")
			EndIf
			; 		CompilerCase #PB_OS_MacOS
			; 			PathConfig$ = GetHomeDirectory() + "Library/Application Support/CheckHash/"
	CompilerEndSelect
EndIf
; Debug PathConfig$
ini$ = PathConfig$ + "CheckHash.ini"

If OpenPreferences(ini$)
	w = ReadPreferenceInteger("width", w)
	h = ReadPreferenceInteger("height", h)
	HashType = ReadPreferenceInteger("HashType", HashType)
	Limit(@HashType, 1, 5)
	cb = ReadPreferenceInteger("checkbox", cb)
; 	maxsize = ReadPreferenceInteger("maxsize", maxsize)
	cDefault = ColorValidate(ReadPreferenceString("Default", ""), cDefault)
	cRed = ColorValidate(ReadPreferenceString("Red", ""), cRed)
	cGreen = ColorValidate(ReadPreferenceString("Green", ""), cGreen)
	cBlue = ColorValidate(ReadPreferenceString("Blue", ""), cBlue)
	ClosePreferences()
EndIf



gh = h / 8
gmh = gh - 2
margin = 10
bw = w - gh - margin * 2
bw1 = gh * 3

Procedure SizeWindowHandler()
	Protected w1, h1;, kW.f, kH.f, tmp
	w1 = WindowWidth(#Window)
	h1 = WindowHeight(#Window)
; 	kW = w1 / w
; 	kH = h1 / h
	gh = h1 / 8
	gmh = gh - 2
	margin = 10
	bw = w1 - gh - margin * 2
	bw1 = gh * 3

; 	tmp = kW * 24
	ResizeGadget(#About, w1 - gh, 0, gmh, gmh)
; 	tmp = kH * 21
	ResizeGadget(#StatusBar, margin, gh * 7, w1 - margin, gmh)
	ResizeGadget(#txt1, margin, 0, bw1, gmh)
	ResizeGadget(#tfilen_1, margin + bw1, 0, w1 - margin - bw1 - gmh, gmh)
	ResizeGadget(#file_1, margin, gh, bw, gmh)
	ResizeGadget(#openfile_1, bw + margin, gh, gmh, gmh)
	ResizeGadget(#hash_1, margin, gh * 2, bw, gmh)
	ResizeGadget(#hashbuf_1, bw + margin, gh * 2, gmh, gmh)
	ResizeGadget(#txt2, margin, gh * 3, bw1, gmh)
	ResizeGadget(#tfilen_2, margin + bw1, gh * 3, w1 - margin - bw1 - gmh, gmh)
	ResizeGadget(#file_2, margin, gh * 4, bw, gmh)
	ResizeGadget(#openfile_2, bw + margin, gh * 4, gmh, gmh)
	ResizeGadget(#hash_2, margin, gh * 5, bw, gmh)
	ResizeGadget(#hashbuf_2, bw + margin, gh * 5, gmh, gmh)
	ResizeGadget(#Compare_Hash, margin, gh * 6, bw1 + margin * 3, gmh)
	ResizeGadget(#Sel_Hash, margin * 4 + bw1 , gh * 6, bw1 + margin, gmh)
	ResizeGadget(#ClearInp, margin * 6 + bw1 * 2, gh * 6, w1 - margin * 7 - bw1 * 2, gmh)
;     ResizeGadget()
EndProcedure




CompilerIf  #PB_Compiler_OS = #PB_OS_Linux
	; https://www.purebasic.fr/english/viewtopic.php?p=531374#p531374
	ImportC ""
		gtk_window_set_icon(a.l,b.l)
	EndImport

UseGIFImageDecoder()

;- DataSection
DataSection
	IconTitle:
	IncludeBinary "images" + #PS$ + "icon.gif"
	folder:
	IncludeBinary "images" + #PS$ + "folder.gif"
	copy:
	IncludeBinary "images" + #PS$ + "copy.gif"
EndDataSection

CatchImage(0, ?IconTitle)
CatchImage(1, ?copy)
CatchImage(2, ?folder)
CompilerEndIf


;-┌──GUI──┐
If OpenWindow(#Window, 0, 0, w, h, "CheckHash",
              #PB_Window_SystemMenu | #PB_Window_ScreenCentered | #PB_Window_MinimizeGadget | #PB_Window_SizeGadget)
	CompilerIf  #PB_Compiler_OS = #PB_OS_Linux
		gtk_window_set_icon_(WindowID(#Window), ImageID(0)) ; назначаем иконку в заголовке
	CompilerEndIf
	WindowBounds(#Window , 500 , 208 , #PB_Ignore , #PB_Ignore)

	ButtonGadget(#About, w - gh, 0, gmh, gmh, "@")
	GadgetToolTip(#About, Lng(1))

; 	TextGadget(#StatusBar, margin, h - gmh, w - margin, gmh, "Строка состояния")
	TextGadget(#StatusBar, margin, gh * 7, w - margin, gmh, "AZJIO 2025", style)

; 	TextGadget(#CatchDrop1, 0, 30, w, 70, "")
; 	DisableGadget(#CatchDrop1, 1)


;- ├ Файл группа 1
	TextGadget(#txt1, margin, 0, bw1, gmh, Lng(2), style)
	TextGadget(#tfilen_1, margin + bw1, 0, w - margin - bw1 - gmh, gmh, "", style)
	SetGadgetColor(#tfilen_1, #PB_Gadget_FrontColor, cBlue)
;	SetGadgetFont(#tfilen_1, FontID(#Font1))
	StringGadget(#file_1, margin, gh, bw, gmh, "")

	CompilerIf  #PB_Compiler_OS = #PB_OS_Windows
		ExtractIconEx_("Shell32.dll", 3, 0, @hicon1, 1)
		ButtonImageGadget(#openfile_1, bw + margin, gh, gmh, gmh, hicon1)
	CompilerElse
		ButtonImageGadget(#openfile_1, bw + margin, gh, gmh, gmh, ImageID(2))
	CompilerEndIf

	StringGadget(#hash_1, margin, gh * 2, bw, gmh, "")
;	SetGadgetFont(#tfilen_1, FontID(#Font1))
	
	CompilerIf  #PB_Compiler_OS = #PB_OS_Windows
		ExtractIconEx_("Shell32.dll", 54, 0, @hicon2, 1)
		ButtonImageGadget(#hashbuf_1, bw + margin, gh * 2, gmh, gmh, hicon2)
	CompilerElse
		ButtonImageGadget(#hashbuf_1, bw + margin, gh * 2, gmh, gmh, ImageID(1))
	CompilerEndIf
	GadgetToolTip(#hashbuf_1, Lng(3))





;- ├ Файл группа 2
	TextGadget(#txt2, margin, gh * 3, bw1, gmh, Lng(4), style)
	TextGadget(#tfilen_2, margin + bw1, gh * 3, w - margin - bw1 - gmh, gmh, "", style)
	SetGadgetColor(#tfilen_2, #PB_Gadget_FrontColor, cBlue)
;	SetGadgetFont(#tfilen_2, FontID(#Font1))
	StringGadget(#file_2, margin, gh * 4, bw, gmh, "")


	CompilerIf  #PB_Compiler_OS = #PB_OS_Windows
		ExtractIconEx_("Shell32.dll", 3, 0, @hicon1, 1)
		ButtonImageGadget(#openfile_2, bw + margin, gh * 4, gmh, gmh, hicon1)
	CompilerElse
		ButtonImageGadget(#openfile_2, bw + margin, gh * 4, gmh, gmh, ImageID(2))
	CompilerEndIf

	StringGadget(#hash_2, margin, gh * 5, bw, gmh, "")
;	SetGadgetFont(#tfilen_2, FontID(#Font1))

	CompilerIf  #PB_Compiler_OS = #PB_OS_Windows
		ExtractIconEx_("Shell32.dll", 54, 0, @hicon2, 1)
		ButtonImageGadget(#hashbuf_2, bw + margin, gh * 5, gmh, gmh, hicon2)
	CompilerElse
		ButtonImageGadget(#hashbuf_2, bw + margin, gh * 5, gmh, gmh, ImageID(1))
	CompilerEndIf
	GadgetToolTip(#hashbuf_2, Lng(3))


	ButtonGadget(#Compare_Hash, margin, gh * 6, bw1 + margin * 3, gmh, Lng(5))
	GadgetToolTip(#Compare_Hash, Lng(6))
	ButtonGadget(#Sel_Hash, margin * 4 + bw1 , gh * 6, bw1 + margin, gmh, "")
	SetGadgetText(#Sel_Hash , aHashType(HashType))
; 	Select HashType
; 		Case 1
; 			SetGadgetText(#Sel_Hash , "MD5")
; 		Case 2
; 			SetGadgetText(#Sel_Hash , "CRC32")
; 		Case 3
; 			SetGadgetText(#Sel_Hash , "SHA1")
; 		Case 4
; 			SetGadgetText(#Sel_Hash , "SHA2")
; 		Case 5
; 			SetGadgetText(#Sel_Hash , "SHA3")
; 	EndSelect

	GadgetToolTip(#Sel_Hash, Lng(7))
	CheckBoxGadget(#ClearInp, margin * 6 + bw1 * 2, gh * 6, w - margin * 7 - bw1 * 2, gmh, Lng(8))
	If cb
		SetGadgetState(#ClearInp, #PB_Checkbox_Checked)
	EndIf

	EnableGadgetDrop(#file_1, #PB_Drop_Files, #PB_Drag_Copy)
	EnableGadgetDrop(#file_2, #PB_Drop_Files, #PB_Drag_Copy)
	EnableGadgetDrop(#hash_1, #PB_Drop_Files, #PB_Drag_Copy)
	EnableGadgetDrop(#hash_2, #PB_Drop_Files, #PB_Drag_Copy)

	BindEvent(#PB_Event_SizeWindow, @SizeWindowHandler())

;- ├ Menu
	If CreatePopupMenu(#Menu)
		MenuItem(#mMD5, "MD5")
		MenuItem(#mCRC32, "CRC32")
		MenuItem(#mSHA1, "SHA1")
		MenuItem(#mSHA2, "SHA2")
		MenuItem(#mSHA3, "SHA3")
		CloseSubMenu()
	EndIf

	; Здесь параметры командной строки.
; 	Передаются 1 или 2 параметра, каждый из которых абсолютный путь или хеш из 16-ричных символов.
	If CountProgramParameters()
		tmp$ = ProgramParameter(0)
		fsz = FileSize(tmp$)
		If fsz > - 1
			file1\size = fsz
			SetFile(@file1, @tmp$, #tfilen_1, #file_1, #hash_1)
		ElseIf IsHex(@tmp$)
			SetGadgetText(#hash_2, tmp$)
		EndIf
		If CountProgramParameters() > 1
			tmp$ = ProgramParameter(1)
			fsz = FileSize(tmp$)
			If fsz > - 1
				file2\size = fsz
				SetFile(@file2, @tmp$, #tfilen_2, #file_2, #hash_2)
			ElseIf IsHex(@tmp$)
				SetGadgetText(#hash_2, tmp$)
				CompareHash()
			EndIf
		EndIf
	EndIf


;-┌──Loop──┐
	Repeat
		Select WaitWindowEvent()
;- ├ Drop
			Case #PB_Event_GadgetDrop
				fsz = FileSize(EventDropFiles())
				If fsz < 0 Or FindString(EventDropFiles(), Chr(10))
					MessageRequester(Lng(9), Lng(10))
					Continue
				EndIf
				tmp$ = EventDropFiles()
				; 				IsFolder = FileSize(EventDropFiles())
				Select EventGadget()
					Case #file_1, #hash_1 ; гаджеты, получившие событие перетаскивания файла/папки
						file1\size = fsz
						If GetGadgetState(#ClearInp) & #PB_Checkbox_Checked
							SetGadgetText(#tfilen_2, "")
							SetGadgetText(#file_2, "")
							SetGadgetText(#hash_2, "")
							SetGadgetText(#StatusBar, "")
							file2\hash = ""
							file2\path = ""
							file2\size = 0
						EndIf
						SetFile(@file1, @tmp$, #tfilen_1, #file_1, #hash_1)
					Case #file_2, #hash_2
						file2\size = fsz
						SetFile(@file2, @tmp$, #tfilen_2, #file_2, #hash_2)
				EndSelect
;- ├ Gadget
			Case #PB_Event_Gadget
				Select EventGadget()
					Case #file_1
						If EventType() = #PB_EventType_Change
							tmp$ = GetGadgetText(#file_1)
							If file1\path <> tmp$
								fsz = FileSize(tmp$)
								If fsz > - 1
									If MessageRequester(Lng(11), Lng(12),
									                    #PB_MessageRequester_YesNo) = #PB_MessageRequester_Yes

										file1\size = fsz
										SetFile(@file1, @tmp$, #tfilen_1, #file_1, #hash_1)
									EndIf
								EndIf
							EndIf
						EndIf
					Case #file_2
						If EventType() = #PB_EventType_Change
							tmp$ = GetGadgetText(#file_2)
							If file2\path <> tmp$
								fsz = FileSize(tmp$)
								If fsz > - 1
									If MessageRequester(Lng(11), Lng(12),
									                    #PB_MessageRequester_YesNo) = #PB_MessageRequester_Yes
										file2\size = fsz
										SetFile(@file2, @tmp$, #tfilen_2, #file_2, #hash_2)
									EndIf
								EndIf
							EndIf
						EndIf
					Case #openfile_1
						tmp$ = OpenFileRequester(Lng(13), GetCurrentDirectory(), Lng(14) + " (*.*)|*.*|exe|*.exe", 0)
						If Asc(tmp$)
							file1\size = FileSize(tmp$)
							If GetGadgetState(#ClearInp) & #PB_Checkbox_Checked
								SetGadgetText(#tfilen_2, "")
								SetGadgetText(#file_2, "")
								SetGadgetText(#hash_2, "")
								SetGadgetText(#StatusBar, "")
								file2\hash = ""
								file2\path = ""
								file2\size = 0
							EndIf
							SetFile(@file1, @tmp$, #tfilen_1, #file_1, #hash_1)
						EndIf
					Case #openfile_2
						tmp$ = OpenFileRequester(Lng(13), GetCurrentDirectory(), Lng(14) + " (*.*)|*.*|exe|*.exe", 0)
						If Asc(tmp$)
							file2\size = FileSize(tmp$)
							SetFile(@file2, @tmp$, #tfilen_2, #file_2, #hash_2)
						EndIf

					Case #hashbuf_1
						SetClipboardText(GetGadgetText(#hash_1))
					Case #hashbuf_2
						SetClipboardText(GetGadgetText(#hash_2))

					Case #Sel_Hash
						DisplayPopupMenu(#Menu, WindowID(#Window))
					Case #Compare_Hash
						CompareHash()
					Case #About
						MessageRequester(Lng(1), Lng(15) + " AZJIO" + #LF$ + "v0.2   05.09.2025")
				EndSelect
;- ├ Menu
			Case #PB_Event_Menu
				tmp$ = GetGadgetText(#Sel_Hash)
; 				Не очень правильно, так номер события используется как константа хеша, далее Select это правильный метод, заложили проблему
				HashType = EventMenu()
				SetGadgetText(#Sel_Hash, aHashType(HashType))
; 				Select EventMenu()
; ;					Case #mCRC32 To #mSHA3
; ;						ChangingHashType(em)
; 					Case #mCRC32
; 						HashType = #PB_Cipher_CRC32
; 						SetGadgetText(#Sel_Hash, "CRC32")
; 					Case #mMD5
; 						HashType = #PB_Cipher_MD5
; 						SetGadgetText(#Sel_Hash, "MD5")
; 					Case #mSHA1
; 						HashType = #PB_Cipher_SHA1
; 						SetGadgetText(#Sel_Hash, "SHA1")
; 					Case #mSHA2
; 						HashType = #PB_Cipher_SHA2
; 						SetGadgetText(#Sel_Hash, "SHA2")
; 					Case #mSHA3
; 						HashType = #PB_Cipher_SHA3
; 						SetGadgetText(#Sel_Hash, "SHA3")
; 				EndSelect
				If tmp$ <> GetGadgetText(#Sel_Hash)
					tmp$ = GetGadgetText(#file_1)
					If Asc(tmp$)
						fsz = FileSize(tmp$)
						If fsz > - 1
							file1\size = fsz
							SetFile(@file1, @tmp$, #tfilen_1, #file_1, #hash_1)
						EndIf
					EndIf
					tmp$ = GetGadgetText(#file_2)
					If Asc(tmp$)
						fsz = FileSize(tmp$)
						If fsz > - 1
							file2\size = fsz
							SetFile(@file2, @tmp$, #tfilen_2, #file_2, #hash_2)
						EndIf
					EndIf
				EndIf
			Case #PB_Event_CloseWindow
				CloseWindow(#Window)
				End
		EndSelect
	ForEver
EndIf
;-└──Loop──┘



; Procedure ChangingHashType(event)
; 	Protected
; 	Select event
; 		Case #mCRC32
; 			HashType = #PB_Cipher_CRC32
; 			SetGadgetText(#Sel_Hash, "CRC32")
; 		Case #mMD5
; 			HashType = #PB_Cipher_MD5
; 			SetGadgetText(#Sel_Hash, "MD5")
; 		Case #mSHA1
; 			HashType = #PB_Cipher_SHA1
; 			SetGadgetText(#Sel_Hash, "SHA1")
; 		Case #mSHA2
; 			HashType = #PB_Cipher_SHA2
; 			SetGadgetText(#Sel_Hash, "SHA2")
; 		Case #mSHA3
; 			HashType = #PB_Cipher_SHA3
; 			SetGadgetText(#Sel_Hash, "SHA3")
; 	EndSelect
; EndProcedure


Procedure SetFile(*file.File, *path, tfilen, file, hash)
	Protected *p.string = @*path
	*file\path = *p\s
	SetGadgetColor(#hash_1, #PB_Gadget_FrontColor, cDefault)
	SetGadgetColor(#hash_2, #PB_Gadget_FrontColor, cDefault)
	SetGadgetColor(#StatusBar, #PB_Gadget_FrontColor, cDefault)
	SetGadgetText(tfilen, GetFilePart(*file\path))
	SetGadgetText(file, *file\path)
	*file\hash = FileFingerprint(*file\path, HashType)
	SetGadgetText(hash, *file\hash)
	CompareFiles()
EndProcedure


Procedure CompareHash()
	Protected hash1$, hash2$
	hash1$ = GetGadgetText(#hash_1)
	hash2$ = GetGadgetText(#hash_2)
	If Not (Asc(hash1$) And Asc(hash2$))
		MessageRequester(Lng(9), Lng(16))
		ProcedureReturn
	EndIf
	; 	Используем  CompareMemoryString(), чтобы сравнивать без учёта регистра,
	; 	то есть если скопировано из другой программы с другим регистром, то это не проблема
	If CompareMemoryString(@hash1$ , @hash2$, #PB_String_NoCase) = #PB_String_Equal
		SetGColor(cGreen)
		SetGadgetText(#StatusBar, Lng(17))
	Else
		SetGColor(cRed)
		SetGadgetText(#StatusBar, Lng(18))
	EndIf
EndProcedure

Procedure CompareFiles()
	Protected hash1$, hash2$, tmp$, k.d
	hash1$ = GetGadgetText(#hash_1)
	hash2$ = GetGadgetText(#hash_2)
	If Asc(hash2$) = 0 Or Asc(hash1$) = 0
		ProcedureReturn
	EndIf
	If Asc(file1\path) And file1\path = file2\path
		SetGadgetText(#StatusBar, Lng(19))
		MessageRequester(Lng(9), Lng(19))
		ProcedureReturn
	EndIf
	
	; 	Используем  CompareMemoryString(), чтобы сравнивать без учёта регистра,
	; 	то есть если скопировано из другой программы с другим регистром, то это не проблема
	If CompareMemoryString(@hash1$ , @hash2$, #PB_String_NoCase) = #PB_String_Equal
		SetGColor(cGreen)
		SetGadgetText(#StatusBar, Lng(20))
	Else
		SetGColor(cRed)
		If file1\size > file2\size
			k = file1\size / file2\size
; 			Debug file1\size
; 			Debug file2\size
; 			Debug k
			tmp$ = FormatNumber(k, 1, ".", "")
			If tmp$ = "1.0"
				tmp$ = "1"
			EndIf
			tmp$ + " > 1"
		ElseIf file1\size < file2\size
			k = file2\size / file1\size
; 			Debug file1\size
; 			Debug file2\size
; 			Debug k
			tmp$ = FormatNumber(k, 1, ".", "")
			If tmp$ = "1.0"
				tmp$ = "1"
			EndIf
			tmp$ = "1 < " + tmp$
		ElseIf file1\size = file2\size
			tmp$ = "1=1"
		EndIf
		SetGadgetText(#StatusBar, Lng(21) + " " + tmp$)
	EndIf

EndProcedure

Procedure SetGColor(Color)
	SetGadgetColor(#hash_1, #PB_Gadget_FrontColor, Color)
	SetGadgetColor(#hash_2, #PB_Gadget_FrontColor, Color)
	SetGadgetColor(#StatusBar, #PB_Gadget_FrontColor, Color)
EndProcedure
ForCheckHash.pb

Code: Select all

Procedure IsHex(*c.Character)
	Protected flag = #True
	
	If *c = 0 Or *c\c = 0
		ProcedureReturn 0
	EndIf
	
	Repeat
		If Not ((*c\c >= '0' And *c\c <= '9') Or (*c\c >= 'a' And *c\c <= 'f') Or (*c\c >= 'A' And *c\c <= 'F'))
			flag = #False
			Break
		EndIf
		*c + SizeOf(Character)
	Until Not *c\c
	
	ProcedureReturn flag
EndProcedure


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

Procedure RGBtoBGR(c)
; 	ProcedureReturn RGB(Blue(c), Green(c), Red(c))
	ProcedureReturn ((c & $00FF00) | ((c & $0000FF) << 16) | ((c & $FF0000) >> 16))
EndProcedure

; def если пустая строка или больше 6 или 5 или 4
; def в BGR, не RGB, то есть готовое для применения
; Color$ это RGB прочитанный из ini с последующим преобразованием в BGR
Procedure ColorValidate(Color$, def = 0)
	Protected tmp$, tmp2$, i
; 	Debug Color$
	i = Len(Color$)
	If i <= 6 And IsHex(@Color$)
		Select i
			Case 6
; 				def = Val("$" + Color$)
; 				RGBtoBGR2(@def)
				def = RGBtoBGR(Val("$" + Color$))
			Case 1
				def = Val("$" + LSet(Color$, 6, Color$))
			Case 2
				def = Val("$" + Color$ + Color$ + Color$)
			Case 3
; 				сразу переворачиваем в BGR
				For i = 3 To 1 Step -1
					tmp$ = Mid(Color$, i, 1)
					tmp2$ + tmp$ + tmp$
				Next
				def = Val("$" + tmp2$)
		EndSelect
	EndIf
; 	Debug Hex(def)
	ProcedureReturn def
EndProcedure

Re: CheckHash

Posted: Fri Sep 05, 2025 10:16 am
by Axolotl
Thanks for sharing.
I did a brief syntax check and .... the code is not compilable as it is.
Probably you need to download from the Download link. (But I didn't do that.)
IMHO this should be mentioned.

BTW: These three "functions" are missing.

Code: Select all

; functions that are missing, my interpretation of the parameters based on the calls. 
Limit(pHashType, Lowest, Highest) 
ColorValidate(Text$, DefaultColor) 
IsHex(pChar)

Re: CheckHash

Posted: Fri Sep 05, 2025 11:17 am
by AZJIO
I forgot about them, but they were originally in the same source file. For Linux, you need 3 more icons.
By the way, these are standard functions that can be found by searching.

Code: Select all

Procedure IsHex(*c.Character)
	Protected flag = #True
	
	If *c = 0 Or *c\c = 0
		ProcedureReturn 0
	EndIf
	
	Repeat
		If Not ((*c\c >= '0' And *c\c <= '9') Or (*c\c >= 'a' And *c\c <= 'f') Or (*c\c >= 'A' And *c\c <= 'F'))
			flag = #False
			Break
		EndIf
		*c + SizeOf(Character)
	Until Not *c\c
	
	ProcedureReturn flag
EndProcedure


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

Procedure RGBtoBGR(c)
; 	ProcedureReturn RGB(Blue(c), Green(c), Red(c))
	ProcedureReturn ((c & $00FF00) | ((c & $0000FF) << 16) | ((c & $FF0000) >> 16))
EndProcedure

; def если пустая строка или больше 6 или 5 или 4
; def в BGR, не RGB, то есть готовое для применения
; Color$ это RGB прочитанный из ini с последующим преобразованием в BGR
Procedure ColorValidate(Color$, def = 0)
	Protected tmp$, tmp2$, i
; 	Debug Color$
	i = Len(Color$)
	If i <= 6 And IsHex(@Color$)
		Select i
			Case 6
; 				def = Val("$" + Color$)
; 				RGBtoBGR2(@def)
				def = RGBtoBGR(Val("$" + Color$))
			Case 1
				def = Val("$" + LSet(Color$, 6, Color$))
			Case 2
				def = Val("$" + Color$ + Color$ + Color$)
			Case 3
; 				сразу переворачиваем в BGR
				For i = 3 To 1 Step -1
					tmp$ = Mid(Color$, i, 1)
					tmp2$ + tmp$ + tmp$
				Next
				def = Val("$" + tmp2$)
		EndSelect
	EndIf
; 	Debug Hex(def)
	ProcedureReturn def
EndProcedure
CheckHash.ini

Code: Select all

width = 560
height = 248
HashType = 1
checkbox = 0
; The white theme
Red = EE0000
Green = 007700
Blue = 000099
Default = 0
; the black theme in Linux
; Red = FF8080
; Green = 007700
; Blue = 8888FF
; Default = AAAAAA

Re: CheckHash

Posted: Fri Sep 05, 2025 10:43 pm
by idle
Thanks looks useful.

Re: CheckHash

Posted: Sat Sep 06, 2025 12:58 pm
by minimy
Nice tool. Thanks for share!

Re: CheckHash

Posted: Sat Sep 06, 2025 11:17 pm
by AZJIO
New idea. Create a "CheckHashList.ini" file next to the source file and specify in the settings that the compiler should create a temporary file in the source folder. This is necessary to ensure that the "CheckHashList.txt" file is created next to the source file, otherwise it will be created in %appdata%.
When the program is first launched, it will prompt you to create a "CheckHashList.txt" list. When you launch the program again, it will compare the changes in the files. To do this, add a comment in the source file to cause it to change. The program will now display this file as modified.
If you add this program to your startup and add executable files to the list, the program will check that your files have not changed when you start it. If a program updates, a list of updated programs will appear. It's like an antivirus, but it checks file hashes.

Code: Select all

;- TOP
;- @AZJIO v0.2 (09.09.2025)

EnableExplicit

Define UserIntLang, *Lang
If OpenLibrary(0, "kernel32.dll")
	*Lang = GetFunction(0, "GetUserDefaultUILanguage")
	If *Lang
		UserIntLang = CallFunctionFast(*Lang)
	EndIf
	CloseLibrary(0)
EndIf

#CountStrLang = 23
Global Dim Lng.s(#CountStrLang)
Lng(1) = "--- path change"
Lng(2) = "string failure"
Lng(3) = "does not exist"
Lng(4) = "size"
Lng(5) = "hash"
Lng(6) = "Hash type incorrect"
Lng(7) = "auto incorrect"
Lng(8) = "silentl incorrect"
Lng(9) = "Path does not exist"
Lng(10) = "--- current path"
Lng(11) = "Open folder"
Lng(12) = "Hash type"
Lng(13) = "Mask/filter"
Lng(14) = "Empty=all or 'exe,dll'"
Lng(15) = "Create a list with sizes and hashes"
Lng(16) = "Open a list with sizes and hashes"
Lng(17) = "Save new size and hashes"
Lng(18) = "Warning"
Lng(19) = "Drag and drop a single file"
Lng(20) = "Error"
Lng(21) = "The file must be with the txt extension and larger than 16 bytes."
Lng(22) = "Open list file"
Lng(23) = "Save hashes to a file"

If UserIntLang = 1049 ; ru
	Lng(1) = "——— смена пути"
	Lng(2) = "сбой строки"
	Lng(3) = "не существует"
	Lng(4) = "размер"
	Lng(5) = "хеш"
	Lng(6) = "Тип хеша неверный"
	Lng(7) = "auto неверный"
	Lng(8) = "silentl неверный"
	Lng(9) = "Путь не существует"
	Lng(10) = "——— текущий путь"
	Lng(11) = "Открыть папку"
	Lng(12) = "Тип хеша"
	Lng(13) = "Маска/фильтр"
	Lng(14) = "Пусто=все или 'exe,dll'"
	Lng(15) = "Создать список c размерами и хешами"
	Lng(16) = "Открыть список c размерами и хешами"
	Lng(17) = "Сохранить новые размер и хеши"
	Lng(18) = "Предупреждение"
	Lng(19) = "Перетаскивайте одиночный файл"
	Lng(20) = "Ошибка"
	Lng(21) = "Файл должен быть с расширением txt и размером более 16 байт."
	Lng(22) = "Открыть файл-список"
	Lng(23) = "Сохранить хеши в файл"
EndIf



UseMD5Fingerprint()
UseCRC32Fingerprint()
UseSHA1Fingerprint()
UseSHA2Fingerprint()
UseSHA3Fingerprint()

#Window = 0

Enumeration
	#Editor
	#CreateList
	#SaveFile
	#OpenFile
	#GenerateListFile
EndEnumeration

Structure FilePHS
	path.s
	hash.s
	size.s
EndStructure

Structure File
	path.s
	hash.s
	size.s
	msg.s
	abspath.s
	typeError.i
EndStructure

;- ● Global
Global NewList FileError.File()
Global tmp$, HashType, ini$, PathConfig$, CheckHashList$, CountList
Global w, h
Global auto = 1, silentl, sep, path$, BlackTheme
Global flgAbsPath = 1


Global w, h, gh, gmh, margin, bh
Global style
Global fsz

Declare FileSearch(dir.s, mask.s, HashType)
Declare SaveHashList()

XIncludeFile "ForCheckHash.pb"



HashType = #PB_Cipher_MD5
w = 650
h = 208


;- ● ini
PathConfig$ = GetPathPart(ProgramFilename())
If FileSize(PathConfig$ + "CheckHashList.ini") = -1
	CompilerSelect #PB_Compiler_OS
		CompilerCase #PB_OS_Windows
			PathConfig$ = GetHomeDirectory() + "AppData\Roaming\CheckHash\"
			If FileSize(PathConfig$) <> -2
				CreateDirectory(PathConfig$)
			EndIf
		CompilerCase #PB_OS_Linux
			PathConfig$ = GetHomeDirectory() + ".config/CheckHash/"
			If CreateDirectory(PathConfig$)
				CopyFile("/usr/share/azjio/CheckHash/CheckHashList.ini", PathConfig$ + "CheckHashList.ini")
			EndIf
	CompilerEndSelect
EndIf
ini$ = PathConfig$ + "CheckHashList.ini"
CheckHashList$ = PathConfig$ + "CheckHashList.txt"


If OpenPreferences(ini$)
	w = ReadPreferenceInteger("width", w)
	h = ReadPreferenceInteger("height", h)
	HashType = ReadPreferenceInteger("HashType", HashType)
	Limit(@HashType, 1, 5)
	auto = ReadPreferenceInteger("auto", auto)
	BlackTheme = ReadPreferenceInteger("BlackTheme", BlackTheme)
	ClosePreferences()
EndIf



	If CountProgramParameters()
		CheckHashList$ = ProgramParameter(0)
	EndIf


Structure ptr
	*ptr
EndStructure



Procedure SplitToPapam(*u.Unicode)
	Protected *t.Unicode, y, AbsPath$, Size, RealSize
	Protected Dim File.s(2)
	*t = *u
	If *u\u = '.'
		path$ = PeekS(*u + SizeOf(Unicode))
		If flgAbsPath = 0
			FileError()\path = path$ + " ———"
			FileError()\msg = Lng(1)
			FileError()\msg = LSet(FileError()\msg , 16)
			FileError()\typeError = 0
		EndIf
		If Right(path$, 1) <> #PS$
			path$ + #PS$
		EndIf
		ProcedureReturn
	Else
		While *u\u
			If *u\u = sep
				*u\u = 0
				File(y) = PeekS(*t)
				y + 1
				*u + SizeOf(Unicode)
				If *u\u
					*t = *u
				Else
					Break
				EndIf
			EndIf
			*u + SizeOf(Unicode)
		Wend
	EndIf
	File(y) = PeekS(*t)
	
	If Asc(File(0)) = 0 Or Asc(File(1)) = 0 Or Asc(File(2)) = 0
		If AddElement(FileError())
			If flgAbsPath
				FileError()\abspath = PeekS(*t)
			EndIf
			FileError()\path = PeekS(*t)
			FileError()\msg = Lng(2)
			FileError()\typeError = -1
		EndIf
		ProcedureReturn
	EndIf
	
	AbsPath$ = path$ + File(1)
	Size = Val(File(2))
	RealSize = FileSize(AbsPath$)
	If RealSize = -1
		If AddElement(FileError())
			If flgAbsPath
				FileError()\abspath = AbsPath$
			EndIf
			FileError()\path = File(1)
			FileError()\msg = Lng(3)
			FileError()\hash = File(0)
			FileError()\size = File(2)
			FileError()\typeError = 1
		EndIf
	ElseIf FileSize(AbsPath$) <> Size
		If AddElement(FileError())
			If flgAbsPath
				FileError()\abspath = AbsPath$
			EndIf
			FileError()\path = File(1)
			FileError()\msg = Lng(4)
			FileError()\msg = LSet(FileError()\msg , 16)
			FileError()\hash = File(0)
			FileError()\size = File(2)
			FileError()\typeError = 2
		EndIf
	ElseIf FileFingerprint(AbsPath$, HashType) <> File(0)
		If AddElement(FileError())
			If flgAbsPath
				FileError()\abspath = AbsPath$
			EndIf
			FileError()\path = File(1)
			FileError()\msg = Lng(5)
			FileError()\msg = LSet(FileError()\msg , 16)
			FileError()\hash = File(0)
			FileError()\size = File(2)
			FileError()\typeError = 2
		EndIf
	EndIf
EndProcedure


Procedure Parser(List PointerList.ptr())
	Protected i
	If ListSize(PointerList()) > 5
		SelectElement(PointerList(), 0)
		HashType = Val(Chr(PeekU(PointerList()\ptr)))
		If HashType < 1 Or HashType > 5
			If AddElement(FileError())
				FileError()\msg = Lng(6)
				ProcedureReturn
			EndIf
		EndIf
		DeleteElement(PointerList(), #True)
		SelectElement(PointerList(), 0)
		auto = Val(Chr(PeekU(PointerList()\ptr)))
		If auto < 0 Or auto > 1
			If AddElement(FileError())
				FileError()\msg = Lng(7)
				ProcedureReturn
			EndIf
		EndIf
		DeleteElement(PointerList(), #True)
		SelectElement(PointerList(), 0)
		silentl = Val(Chr(PeekU(PointerList()\ptr)))
		If silentl < 0 Or silentl > 1
			If AddElement(FileError())
				FileError()\msg = Lng(8)
				ProcedureReturn
			EndIf
		EndIf
		DeleteElement(PointerList(), #True)
		SelectElement(PointerList(), 0)
		sep = Val(Chr(PeekU(PointerList()\ptr)))
		DeleteElement(PointerList(), #True)
		SelectElement(PointerList(), 0)
		path$ = PeekS(PointerList()\ptr)
		If FileSize(path$) <> -2
			If AddElement(FileError())
				FileError()\msg = Lng(9)
				ProcedureReturn
			EndIf
		EndIf
		If flgAbsPath = 0
			If AddElement(FileError())
				FileError()\path = path$ + " ———"
				FileError()\msg = Lng(10)
				FileError()\msg = LSet(FileError()\msg , 16)
			EndIf
		EndIf
		If Right(path$, 1) <> #PS$
			path$ + #PS$
		EndIf
		DeleteElement(PointerList(), #True)
		
		
		
		ForEach PointerList()
			SplitToPapam(PointerList()\ptr)
		Next
	EndIf
EndProcedure


Procedure SplitToPtr(*u.Unicode, bytes)
    Protected *t.Unicode, Start
    Protected NewList PointerList.ptr()
    *t = *u
    While *u\u
    	While *u\u = 13 Or *u\u = 10
    		*u\u = 0
    		*u + SizeOf(Unicode)
    		Start = 1
    	Wend
    	If *u\u
    		If Start
    			Start = 0
    			If *t\u <> ';'
    				AddElement(PointerList())
    				PointerList()\ptr = *t
    			EndIf
    			*t = *u
    		EndIf
    	Else
    		Break
    	EndIf
    	*u + SizeOf(Unicode)
    Wend
    
    If *t\u <> ';'
    	AddElement(PointerList())
    	PointerList()\ptr = *t
    EndIf
    Parser(PointerList())
EndProcedure


Procedure ReadFileToMemory(Path$)
	Protected id_file, length, bytes, *m, text$, NotFound = 1

	id_file = ReadFile(#PB_Any, Path$)
	If id_file
		length = Lof(id_file)
		*m = AllocateMemory(length + 2)
		If *m
			bytes = ReadData(id_file, *m, length)
			text$ = PeekS(*m, -1, #PB_UTF8)
			FreeMemory(*m)
			SplitToPtr(@text$, bytes)
			NotFound = 0
		EndIf
		CloseFile(id_file)
	EndIf
	ProcedureReturn NotFound
EndProcedure


Procedure GenerateList()
	Protected Path$, HashType$, Mask$
	Path$ = PathRequester(Lng(11), GetCurrentDirectory())
	If Asc(Path$)
		HashType$ = InputRequester(Lng(12), "1-MD5,2-CRC32,3-SHA1,4-SHA2,5-SHA3", "1")
		If Not Asc(HashType$)
			ProcedureReturn
		EndIf
		HashType = Val(HashType$)
		
		Mask$ = InputRequester(Lng(13), Lng(14), "exe,dll")
		FileSearch(Path$, Mask$, HashType)
		RunProgram(CheckHashList$)
		End
	EndIf
	End
EndProcedure

If auto
	If ReadFileToMemory(CheckHashList$)
		GenerateList()
	EndIf
EndIf


Procedure SizeWindowHandler()
	Protected w1, h1
	w1 = WindowWidth(#Window)
	h1 = WindowHeight(#Window)
	gh = h1 / 6
	gmh = gh - 3
	bh = gh + margin - 3
	
	ResizeGadget(#Editor, #PB_Ignore, #PB_Ignore, w1 - margin * 2 , h1 - bh - margin * 2)
	ResizeGadget(#SaveFile, w1 - margin - gh, h1 - bh, gmh, gmh)
	ResizeGadget(#OpenFile, w1 - margin - gh * 2, h1 - bh, gmh, gmh)
	ResizeGadget(#GenerateListFile, w1 - margin - gh * 3, h1 - bh, gmh, gmh)
EndProcedure


ForEach FileError()
	If FileError()\typeError
		CountList + 1
	EndIf
Next
If Not CountList And silentl
	End
EndIf

UseGIFImageDecoder()

CompilerIf  #PB_Compiler_OS = #PB_OS_Linux
	; https://www.purebasic.fr/english/viewtopic.php?p=531374#p531374
	ImportC ""
		gtk_window_set_icon(a.l,b.l)
	EndImport


;- DataSection
DataSection
	IconTitle:
	IncludeBinary "images2" + #PS$ + "icon.gif"
EndDataSection

CatchImage(0, ?IconTitle)
CompilerEndIf


DataSection
	folder:
	IncludeBinary "images2" + #PS$ + "folder.gif"
	copy:
	IncludeBinary "images2" + #PS$ + "save.gif"
	new:
	IncludeBinary "images2" + #PS$ + "new.gif"
EndDataSection

CatchImage(1, ?copy)
CatchImage(2, ?folder)
CatchImage(3, ?new)


gh = h / 6
gmh = gh - 3
margin = 5
bh = gh + margin - 3

;-┌──GUI──┐
If OpenWindow(#Window, 0, 0, w, h, "CheckHashList",
              #PB_Window_SystemMenu | #PB_Window_ScreenCentered | #PB_Window_MinimizeGadget | #PB_Window_SizeGadget)
	CompilerIf  #PB_Compiler_OS = #PB_OS_Linux
		gtk_window_set_icon_(WindowID(#Window), ImageID(0))
	CompilerEndIf
	WindowBounds(#Window , 500 , 208 , #PB_Ignore , #PB_Ignore)
	
	#Font = 0
	LoadFont(#Font, "Consolas", 11)
	EditorGadget(#Editor, margin, margin, w - margin * 2 , h - bh - margin * 2)
	SetGadgetFont(#Editor, FontID(#Font))
	ForEach FileError()
		If flgAbsPath
			AddGadgetItem(#Editor, -1, FileError()\msg + " " + FileError()\abspath)
		Else
			AddGadgetItem(#Editor, -1, FileError()\msg + " " + FileError()\path)
		EndIf
	Next

	ButtonImageGadget(#GenerateListFile, w - margin - gh * 3, h - bh, gmh, gmh, ImageID(3))
	GadgetToolTip(#GenerateListFile, Lng(15))

	ButtonImageGadget(#OpenFile, w - margin - gh * 2, h - bh, gmh, gmh, ImageID(2))
	GadgetToolTip(#OpenFile, Lng(16))
	
	ButtonImageGadget(#SaveFile, w - margin - gh, h - bh, gmh, gmh, ImageID(1))
	GadgetToolTip(#SaveFile, Lng(17))

	BindEvent(#PB_Event_SizeWindow, @SizeWindowHandler())
	
	If BlackTheme
		SetWindowColor(#Window, $222222)
		SetGadgetColor(#Editor, #PB_Gadget_FrontColor, $AAAAAA)
		SetGadgetColor(#Editor, #PB_Gadget_BackColor, $3F3F3F)
	EndIf

	EnableGadgetDrop(#Editor, #PB_Drop_Files, #PB_Drag_Copy)


;-┌──Loop──┐
	Repeat
		Select WaitWindowEvent()
;- ├ Drop
			Case #PB_Event_GadgetDrop
				fsz = FileSize(EventDropFiles())
				If fsz < 0 Or FindString(EventDropFiles(), Chr(10))
					MessageRequester(Lng(18), Lng(19))
					Continue
				EndIf
				tmp$ = EventDropFiles()
				If FileSize(tmp$) < 16 Or GetExtensionPart(tmp$) <> "txt"
					MessageRequester(Lng(20), tmp$ + #LF$ + #LF$ + Lng(21))
					Continue
				EndIf
				If EventGadget() = #Editor
					ClearList(FileError())
					SetGadgetText(#Editor, "")
					ReadFileToMemory(tmp$)
					ForEach FileError()
						If flgAbsPath
							AddGadgetItem(#Editor, -1, FileError()\msg + " " + FileError()\abspath)
						Else
							AddGadgetItem(#Editor, -1, FileError()\msg + " " + FileError()\path)
						EndIf
					Next
				EndIf

;- ├ Gadget
			Case #PB_Event_Gadget
				Select EventGadget()
					Case #OpenFile
						ClearList(FileError())
						SetGadgetText(#Editor, "")
						tmp$ = OpenFileRequester(Lng(22), GetCurrentDirectory(), "*.txt|*.txt", 0)
						If Asc(tmp$) And FileSize(tmp$) > 4
							ReadFileToMemory(tmp$)
							ForEach FileError()
								If flgAbsPath
									AddGadgetItem(#Editor, -1, FileError()\msg + " " + FileError()\abspath)
								Else
									AddGadgetItem(#Editor, -1, FileError()\msg + " " + FileError()\path)
								EndIf
							Next
						EndIf
						
						
					Case #GenerateListFile
						GenerateList()
						
					Case #SaveFile
						SaveHashList()
						
				EndSelect
			Case #PB_Event_CloseWindow
				CloseWindow(#Window)
				End
		EndSelect
	ForEver
EndIf
;-└──Loop──┘


Procedure.s ReadFileToVar(Path$)
	Protected id_file, Text$
	
	id_file = ReadFile(#PB_Any, Path$)
	If id_file
		Text$ = ReadString(id_file, #PB_UTF8 | #PB_File_IgnoreEOL)
		CloseFile(id_file)
	EndIf
	
	ProcedureReturn Text$
EndProcedure

Procedure SaveHashList()
	Protected size, hash$, Text$, sep$, r, id_file
	Text$ = ReadFileToVar(CheckHashList$)
	sep$ = Chr(sep)
	
	ForEach FileError()
		If FileError()\typeError > 0
			size = FileSize(FileError()\path)
			If size > -1
				hash$ = FileFingerprint(FileError()\path, HashType)
				Text$ = ReplaceString(Text$, FileError()\hash + sep$ + FileError()\path + sep$ + FileError()\size, hash$ + sep$ + FileError()\path + sep$ + Str(size))
				r + 1
			ElseIf size = -1
				Text$ = ReplaceString(Text$, FileError()\hash + sep$ + FileError()\path + sep$, "; " + FileError()\hash + sep$ + FileError()\path + sep$)
				r + 1
			EndIf
		EndIf
	Next
	
	If r
		id_file = CreateFile(#PB_Any, CheckHashList$, #PB_UTF8)
		If id_file
			WriteString(id_file, Text$, #PB_UTF8)
			CloseFile(id_file)
		EndIf
	EndIf
EndProcedure

Procedure SplitL(String.s, List StringList.s(), Separator.s = " ")

	Protected S.String, *S.Integer = @S
	Protected.i p, slen
	slen = Len(Separator)
	ClearList(StringList())

	*S\i = @String
	Repeat
		AddElement(StringList())
		p = FindString(S\s, Separator)
		StringList() = PeekS(*S\i, p - 1)
		*S\i + (p + slen - 1) << #PB_Compiler_Unicode
	Until p = 0
	*S\i = 0

EndProcedure

Procedure FileSearch(dir.s, mask.s, HashType)
    Protected Len, *Point, Result.string, TmpPath$, TrimLen, id_file
    Protected depth = 130
	Protected pos, FileExt.s, NotFind
    Protected NewList Files.FilePHS()
	Protected NewList Ext.s()

	Protected Name.s, c
	Protected Dim hDir(depth)
	Protected Dim SearchPath.s(depth)
	
	pos = FindString(mask, ",")
	If pos
		mask = ReplaceString(mask, " ", "", #PB_String_CaseSensitive, pos)
		SplitL(mask, Ext(), ",")
	Else
		If AddElement(Ext())
			If mask = "*"
				mask = ""
			EndIf
			Ext() = mask
			Debug "|" + Ext() + "|"
		EndIf
	EndIf

	If Right(dir, 1) <> #PS$
		dir + #PS$
	EndIf
    
    TrimLen = Len(dir) + 1
    TmpPath$ = dir

	SearchPath(c) = dir
	hDir(c) = ExamineDirectory(#PB_Any, dir, "")
	If Not hDir(c)
		ProcedureReturn
	EndIf

	Repeat
		While NextDirectoryEntry(hDir(c))
			Name = DirectoryEntryName(hDir(c))
			If Name = "." Or Name = ".."
				Continue
			EndIf
			If DirectoryEntryType(hDir(c)) = #PB_DirectoryEntry_Directory
				If c >= depth
					Continue
				EndIf
				dir = SearchPath(c)
				c + 1
				SearchPath(c) = dir + Name + #PS$
				hDir(c) = ExamineDirectory(#PB_Any, SearchPath(c), "")
				If Not hDir(c)
					c - 1
				EndIf
			Else
				If Not Asc(mask) And AddElement(Files())
					Files()\path = SearchPath(c) + Name
					Files()\size = Str(FileSize(Files()\path))
					Files()\hash = FileFingerprint(Files()\path, HashType)
					Files()\path = Mid(Files()\path, TrimLen)
				Else
					NotFind = 0
					FileExt = GetExtensionPart(Name)
					ForEach Ext()
						If FileExt = Ext()
							NotFind = 1
							Break
						EndIf
					Next
					If NotFind And AddElement(Files())
						Files()\path = SearchPath(c) + Name
						Files()\size = Str(FileSize(Files()\path))
						Files()\hash = FileFingerprint(Files()\path, HashType)
						Files()\path = Mid(Files()\path, TrimLen)
					EndIf
				EndIf
			EndIf
		Wend
		FinishDirectory(hDir(c))
		c - 1
	Until c < 0
	
    
    If ListSize(Files()) = 0
    	ProcedureReturn
    EndIf

    Len = 0
    ForEach Files()
        Len + Len(Files()\path)
        Len + Len(Files()\size)
        Len + Len(Files()\hash)
    Next
    CompilerIf #PB_Compiler_OS = #PB_OS_Windows
    	Len + ListSize(Files()) * 4 ; #TAB$ + #TAB$ + #CRLF$
    CompilerElse
    	Len + ListSize(Files()) * 3 ; #TAB$ + #TAB$ + #LF$
    CompilerEndIf
    

    Result\s = Space(Len)
    *Point = @Result\s
    ForEach Files()
        CopyMemoryString(Files()\hash + #TAB$, @*Point)
        CopyMemoryString(Files()\path + #TAB$, @*Point)
        CompilerIf #PB_Compiler_OS = #PB_OS_Windows
        	CopyMemoryString(Files()\size + #CRLF$, @*Point)
        CompilerElse
        	CopyMemoryString(Files()\size + #LF$, @*Point)
        CompilerEndIf
    Next
    ClearList(Files())
    
    If FileSize(CheckHashList$) > 16
    	tmp$ = SaveFileRequester(Lng(23), GetCurrentDirectory(), "*.txt|*.txt", 0)
    	If Asc(tmp$)
    		If Right(tmp$, 4) <> ".txt"
    			tmp$ + ".txt"
    		EndIf
    		CheckHashList$ = tmp$
    	EndIf
    EndIf
	
	id_file = CreateFile(#PB_Any, CheckHashList$, #PB_UTF8)
    If id_file
    	WriteStringN(id_file, Str(HashType), #PB_UTF8)
    	WriteStringN(id_file, "1", #PB_UTF8)
    	WriteStringN(id_file, "1", #PB_UTF8)
    	WriteStringN(id_file, "9", #PB_UTF8)
    	WriteStringN(id_file, TmpPath$, #PB_UTF8)
    	WriteString(id_file, Result\s, #PB_UTF8)
    	CloseFile(id_file)
    EndIf
EndProcedure
All times are UTC+01:00
Page 1 of 1

Powered by phpBB® Forum Software © phpBB Limited