#include once "window9.bi"

Type data_type As Integer

Type stack
	Public:
	Declare Constructor(ByVal memory_block_step As Integer = 1)
	Declare Sub push(ByRef item As data_type)
	Declare Function pop() As data_type
	Declare Function size() As Integer
	Private:
	Dim As data_type Ptr mp 'pointer to memory
	Dim As Integer mi       'index to memory
	Dim As Integer mb = 1   'current memory resizing per block of N integers (N>=1)
	Dim As Integer mb0 = 1  'initial memory resizing per block of N integers (N>=1)
End Type

Constructor stack(ByVal memory_block_step As Integer = 1)
	If memory_block_step > 0 Then
		this.mb0 = memory_block_step
	End If
End Constructor

Sub stack.push(ByRef item As data_type)
	If this.mi Mod this.mb = 0 Then
		this.mb = this.mb0 + this.mi / 10
		While this.mi Mod this.mb <> 0
			this.mb = this.mb - 1
		Wend
		this.mp = ReAllocate(this.mp, (this.mi + this.mb) * SizeOf(data_type))
		if this.mp then
			Clear this.mp[this.mi], 0, this.mb * SizeOf(data_type)
		endif
	End If
	if this.mp then this.mp[this.mi] = item
	this.mi = this.mi + 1
End Sub

Function stack.pop() As data_type
	Dim empty As data_type
	this.mi = this.mi - 1
	Function = this.mp[this.mi]
	this.mp[this.mi] = empty
	If this.mi Mod this.mb = 0 Then
		this.mp = ReAllocate(this.mp, this.mi * SizeOf(data_type))
		this.mb = this.mb0 + this.mi / 10
		While this.mi Mod this.mb <> 0
			this.mb = this.mb - 1
		Wend
	End If
End Function

Function stack.size() As Integer
	Function = this.mi
End Function

'//////////////////////////////// структура Дочернего списка/////////////////////////////////////

Type List
	pNext As List Ptr = 0
	pPrev As List Ptr = 0
	iId As Integer = 0
	boolFlagFolder As BOOL = 0 ' является ли папкой (1 является)	
	iSize As ULongInt
	sSizeFlag As BOOL = 0 ' Для шельмования во время сортировки с нулевыми файлами
	#ifdef UNICODE
		sValue As wString*MAX_PATH
		sType As wString*MAX_PATH
		sModified As wString*20
		sModifiedTemp As wString*20
		szExtension As wString*3 = " "			
	#else	
		sValue As ZString*MAX_PATH
		sType As ZString*MAX_PATH
		sModified As ZString*20
		sModifiedTemp As ZString*20
		szExtension As String*3 = " "	
	#EndIf
End Type

'//////////////////////////////// структура Главного списка/////////////////////////////////////

Type MainList
	pFirst As List Ptr = 0
	pLast As List Ptr = 0
	bFlagMinMax As bool = 0 ' сортировка по min или max значению
	iColumnNumber As Integer = 0  ' номер столбца для сортировки
	Declare Sub AddItem(byval sValue As USTRING, byval sSize As ULongInt, byval sType As USTRING, byval sModified As USTRING, byval boolFlagFolder As BOOL, byval sSizeFlag As BOOL = 0, byval sModifiedTemp As USTRING = " ")
	Declare Sub DeleteAll()
	Declare Function GetIdPointer(byval iId As Integer) As List Ptr
	Declare Sub AddItemsArray(byval iCount As Integer)
	Declare Sub AddItemsListInArray()
End Type

'//////////////////////////////// Главная структура ExplorerGadget/////////////////////////////////////

Type ExplorerGadget
	Hwnd As HWND
	intWidth As Integer
	IntHeight As Integer
	iCurentItem As Integer
	szPath As USTRING
	szMask As USTRING
	iFlagFolderOrFiles As Integer
	LGElocal As OptionsExplorerGadget Ptr
	NList As MainList Ptr = new  MainList
	Declare Function UpdateDirs(byval sPath As USTRING) As Integer
	Declare Function CheckDirs(byval sPath As USTRING) As BOOL
	Declare Function CheckNetRoot(byval sPath As USTRING) As BOOL
End Type

'//////////////////////////////// Cтруктура для получения активного окна и текста из Item/////////////////////////////////////

Type GlobalInfo
	GlobalHwnd As HWND
	Text As USTRING
End Type

'//////////////////////////////// Глобальные данные/////////////////////////////////////


#Define StyleLW LVS_OWNERDATA Or LVS_REPORT Or WS_VISIBLE Or WS_CHILD
#Define ExStyle LVS_EX_FULLROWSELECT
Dim Shared oldproc As integer
Dim Shared GlobalInfo As GlobalInfo
Dim Shared MainTEG As ExplorerGadget Ptr ' указатель на объект
Dim Shared TempList As MainList Ptr ' Временный список
Dim Shared FlagErrorFind As BOOL ' включается если , не найдено ни одного файла по маске
ReDim Shared listSortArray() As List Ptr
Dim Shared As WIN32_FIND_DATA FileInformation
TempList = new MainList


'//////////////////////////////// Добавление в список/////////////////////////////////////

Sub MainList.AddItem(byval sValue As USTRING, _
byval iSize As ULongInt, _
byval sType As USTRING, _
byval sModified As USTRING, _
byval boolFlagFolder As BOOL, _
byval sSizeFlag As BOOL, _
byval sModifiedTemp As USTRING)
	Dim TList As List Ptr = New List
	if TList = 0 then exit sub
	TList->sValue = sValue
	TList->iSize = iSize
	TList->sType = sType
	If sValue <> ".." Then
		TList->sModified = sModified
	EndIf
	TList->sModifiedTemp = sModifiedTemp
	TList->boolFlagFolder = boolFlagFolder
	If boolFlagFolder = 0 Then
		TList->szExtension = LCase(Right(sValue,3))
		If sSizeFlag = 0 Then
			If iSize=0 Then TList->iSize=1: TList->sSizeFlag = 1
		Else
			If iSize=1 Then TList->iSize=0
		EndIf
	EndIf
	If pFirst = 0 Then
		pFirst = TList
		TList->iId = 1
	Else
		pLast->pNext = TList
		TList->pPrev = pLast
		TList->iId = pLast->iId+1
	EndIf
	pLast = TList
End Sub

'//////////////////////////////// Получение объекта списка по ID/////////////////////////////////////

Function MainList.GetIdPointer(byval iId As Integer) As List Ptr
	If pFirst<>0 Or iId<>0 Then
		Dim pTemp As List Ptr = pFirst
		Do
			If pTemp->iId = iId Then
				Return pTemp
			EndIf
			pTemp=pTemp->pNext
		Loop While pTemp<>0
		Return 0
	EndIf
End Function

'//////////////////////////////// Очистка списка/////////////////////////////////////

Sub MainList.DeleteAll()
	If pFirst<> 0 Then
		Dim pTemp As List Ptr
		Dim pDel As List Ptr = pFirst
		Do
			pTemp=pDel->pNext
			Delete pDel
			pDel=pTemp
		Loop While pTemp<>0
		pFirst = 0
		pLast = 0
	EndIf
End Sub

'//////////////////////////////// Сортировка///////////////////

#Macro QsortMacro (typemacro,parametermacro,QsortM)
	Sub QsortM(byval Start As Integer, byval Finish As UInteger)
		Dim As stack s = 1024
		Dim As Integer xs, ys, io
		s.push(start):s.push(Finish)
		Do While s.size > 0
			ys = s.pop:xs = s.pop
			Dim As UInteger I=xs,J=ys
			Dim As typemacro X=listSortArray(Int((I+J)/2))->parametermacro
			Dim A As LIST Ptr
			While  I <= J
				If I>0 And I<=UBound(listSortArray) Then
					While listSortArray(I)->parametermacro < X And i<=UBound(listSortArray)
						I+=1
					Wend
				EndIf
				If J>0 And J<=UBound(listSortArray) Then
					While listSortArray(J)->parametermacro > X And J>=0
						J-=1
					Wend
				EndIf
				If I<=J Then
					A = listSortArray(I)
					listSortArray(I) = listSortArray(J)
					listSortArray(J) = A
					I+=1
					J-=1
				EndIf
			Wend
			If J > xs Then s.push(xs):s.push(J)
			If I < ys Then s.push(I):s.push(ys)
		Loop
	End Sub
#EndMacro

QsortMacro(USTRING,szExtension,QsortExtension)
QsortMacro(ULongInt,iSize,QsortSize)
QsortMacro(USTRING,sModifiedTemp,QsortModified)

'//////////////////////////////// Заполнение массива указателями списка///////////////////


Sub MainList.AddItemsArray(byval iCount As Integer)
	TempList->bFlagMinMax = MainTEG->Nlist->bFlagMinMax
	TempList->iColumnNumber = MainTEG->Nlist->iColumnNumber
	ReDim listSortArray(iCount) As List Ptr
	Select Case iColumnNumber
		Case 0 ' заполнение по имени
			Dim n As Integer
			Dim pTemp As List Ptr = pLast
			If pFirst<>0 Then
				If pFirst->sValue =".." Then
					listSortArray(0) = pFirst
					n = 1
				EndIf
			EndIf
			For i As Integer = n To iCount-1
				listSortArray(i) = pTemp
				pTemp=pTemp->pPrev
			Next
		Case 1
			Dim n As Integer
			Dim pTemp As List Ptr = pLast
			If pFirst<>0 Then
				If pFirst->sValue =".." Then
					listSortArray(0) = pFirst
					n = 1
				EndIf
			EndIf
			For i As Integer = n To iCount-1
				listSortArray(i) = pTemp
				pTemp=pTemp->pPrev
			Next
			QsortSize(n,iCount-1)
		Case 2
			Dim n As Integer
			Dim pTemp As List Ptr = pLast
			If pFirst<>0 Then
				If pFirst->sValue =".." Then
					listSortArray(0) = pFirst
					n = 1
				EndIf
			EndIf
			For i As Integer = n To iCount-1
				listSortArray(i) = pTemp
				pTemp=pTemp->pPrev
			Next
			QsortExtension(n,iCount-1)
		Case 3
			Dim n As Integer
			Dim pTemp As List Ptr = pLast
			If pFirst<>0 Then
				If pFirst->sValue =".." Then
					listSortArray(0) = pFirst
					n = 1
				EndIf
			EndIf
			For i As Integer = n To iCount-1
				listSortArray(i) = pTemp
				pTemp=pTemp->pPrev
			Next
			QsortModified(n,iCount-1)
	End Select
End Sub

'//////////////////////////////// Заполнение главного списка указателями из массива///////////////////

Sub MainList.AddItemsListInArray()
	#Macro AD()
		If listSortArray(i)->sSizeFlag = 1 Then listSortArray(i)->iSize = 0
		AddItem( _
		listSortArray(i)->sValue, _
		listSortArray(i)->iSize, _
		listSortArray(i)->sType, _
		listSortArray(i)->sModified, _
		listSortArray(i)->boolFlagFolder, _
		listSortArray(i)->sSizeFlag)
	#EndMacro
	If bFlagMinMax = 1 Then
		For i As Integer = 0 To UBound(listSortArray)-1
			AD()
		Next
	Else
		If listSortArray(0)<>0 Then
			If listSortArray(0)->sValue = ".." Then
				AddItem( _
				listSortArray(0)->sValue, _
				listSortArray(0)->iSize, _
				listSortArray(0)->sType, _
				listSortArray(0)->sModified, _
				listSortArray(0)->boolFlagFolder)
				For i As Integer = UBound(listSortArray)-1 To 1 Step -1
					AD()
				Next
			Else
				For i As Integer = UBound(listSortArray)-1 To 0 Step -1
					AD()
				Next
			EndIf
		EndIf
		
	EndIf
End Sub

'//////////////////////////////// Проверка директории///////////////////

Function ExplorerGadget.CheckDirs(byval sPath As USTRING) As BOOL
	
	Dim As WIN32_FIND_DATA FileInformation
	Dim As HANDLE iDir
	#ifdef UNICODE
		If MainTEG->szMask<>"" Then
			iDir = FindFirstFile(*sPath, @FileInformation)
		Else
			dim as USTRING wszTemp = sPath & "*.*"
			iDir = FindFirstFile(*wszTemp, @FileInformation)
		EndIf		
	#else	
		If MainTEG->szMask<>"" Then
			iDir = FindFirstFile(sPath, @FileInformation)
		Else
			iDir = FindFirstFile(sPath + "*.*", @FileInformation)
		EndIf			
	#EndIf
	If iDir = INVALID_HANDLE_VALUE Then
		If GetLastError() = 5 Then
			Function = 0
		ElseIf GetLastError() = 2 Then
			Function = 2
		Else
			Function = -1
		EndIf
	Else
		Function = 1
	EndIf
	FindClose(iDir)
End Function

'//////////////////////////////// Получение времени изменения файла///////////////////

Function DirectoryEntryDateStatic(ByVal Flag As Bool = 0) As USTRING
	Dim As FILETIME fttime
	Dim As FILETIME ftlocal
	Dim As SYSTEMTIME SYS_TIME
	Dim As USTRING hour_,minute_,second_,month_,Day_
	
	fttime=FileInformation.ftLastWriteTime
	FileTimeToLocalFileTime(@fttime,@ftlocal)
	FileTimeToSystemTime(@ftlocal,@SYS_TIME)
	If SYS_TIME.wday<10 Then
		Day_="0" & SYS_TIME.wday
	Else
		Day_=Str( SYS_TIME.wday)
	EndIf
	If SYS_TIME.wmonth<10 Then
		month_="0" & SYS_TIME.wmonth
	Else
		month_=Str( SYS_TIME.wmonth)
	EndIf
	If SYS_TIME.whour<10 Then
		hour_="0" & SYS_TIME.whour
	Else
		hour_=Str( SYS_TIME.whour)
	EndIf
	If SYS_TIME.wminute<10 Then
		minute_="0" & SYS_TIME.wminute
	Else
		minute_=Str( SYS_TIME.wminute)
	EndIf
	If SYS_TIME.wsecond<10 Then
		second_="0" & SYS_TIME.wsecond
	Else
		second_=Str(SYS_TIME.wsecond)
	EndIf
	If Flag = 0 Then
		day_ = day_ & "." & month_ & "." & SYS_TIME.wyear & " " & hour_ & ":" & minute_ & ":" & second_
		Return day_
	Else
		day_ = SYS_TIME.wyear & "." & month_ & "." & day_ & " " & hour_ & ":" & minute_ & ":" & second_
		Return day_
	EndIf
	
End Function

'//////////////////////////////// Установка нового пути///////////////////

Private Function SetPath(byval iItem As Integer, byval sPath As USTRING = "", byval hwnd As HWND = 0, byval FullPath As Bool = 0) As bool
	
	Dim As USTRING sBuf
	
	#ifdef UNICODE
		Dim As WSTRING*256 buf
	#else
		Dim As ZSTRING*256 buf
	#EndIf
	
	If sPath = "" Then
		Dim LV_ITEM As LVITEM
		LV_ITEM.iSubItem=0
		#ifdef UNICODE
			LV_ITEM.pszText= cast(any ptr , @buf)
		#else	
			LV_ITEM.pszText= Cast(LPSTR,strptr(buf))
		#EndIf		
		LV_ITEM.cchTextMax=256
		SendMessage(MainTEG->Hwnd,LVM_GETITEMTEXT,iItem,Cast(lparam,@LV_ITEM))
	Else
		Buf = sPath
		MainTEG->Hwnd = hwnd
	EndIf
	
	If FullPath = 0 Then
		If len(MainTEG->szPath)= 3 And Buf = ".." Then
		Else
			If MainTEG->szMask<>"" Then
				MainTEG->szPath = RtrimA(MainTEG->szPath,MainTEG->szMask)
			EndIf
			If buf = ".." Then
				buf = RtrimA(MainTEG->szPath,"\")
				sBuf = Mid(buf,1,InStrRev(buf,"\"))
			Else
				If Len(MainTEG->szPath)>1 Then
					sBuf = MainTEG->szPath & buf & "\"
				Else
					sBuf = buf
				EndIf
			EndIf
			If MainTEG->szMask<>"" Then
				sBuf &= MainTEG->szMask
			EndIf
		EndIf
	Else
		If MainTEG->szMask<>"" Then
			sBuf = sPath
		Else
			If Right(sPath,1)<>"\" Then
				sBuf = sPath & "\"
			Else
				sBuf = sPath
			EndIf
		EndIf
	EndIf
	
	Dim As Integer iResult
	
	If len(MainTEG->szPath)= 3 Andalso Buf = ".." Then
		MainTEG->szPath = "\"
		sBuf = "\"
		iResult = 1
	Else
		iResult = MainTEG->CheckDirs(sBuf)
	EndIf
	
	If iResult = 1 Then
		SendMessage(MainTEG->Hwnd,LVM_DELETEALLITEMS,0,0)
		SendMessage(MainTEG->Hwnd, LVM_SETITEMCOUNT, MainTEG->UpdateDirs(sBuf),1 )
		MainTEG->szPath = sBuf
		Return TRUE
	ElseIf iResult = 2 Then
		If MainTEG->szMask<>"" Then
			SendMessage(MainTEG->Hwnd,LVM_DELETEALLITEMS,0,0)
			Var PosS = InStr(sBuf,"*")
			If PosS>0 Then
				MainTEG->szPath = Mid(sBuf,1,PosS-1)
				MainTEG->szMask = "*..*"
				FlagErrorFind = TRUE
				SendMessage(MainTEG->Hwnd, LVM_SETITEMCOUNT, MainTEG->UpdateDirs(MainTEG->szPath & "*..*"),1 )
				MainTEG->szMask = "*.*"
				Return TRUE
			EndIf
		EndIf
	ElseIf iResult = 0 Then
		MsgBox(MainTEG->LGElocal->szCaptionError ,MainTEG->LGElocal->szTextError,MB_ICONERROR)
	EndIf
End Function

'//////////////////////////////// Проверка свободного места на CD диске ///////////////////

Private Function GetDriveSize(byval cdr As USTRING) As LongInt
	Dim As LongInt SectorsPerCluster,BytesPerSector,NumberOfFreeClusters
	SetErrorMode(SEM_FAILCRITICALERRORS)
	#ifdef UNICODE
		GetDiskFreeSpaceEx(*cdr,_
		Cast(Any Ptr,@SectorsPerCluster),_
		Cast(Any Ptr,@BytesPerSector),_
		Cast(Any Ptr,@NumberOfFreeClusters)_
		)	
	#else
		GetDiskFreeSpaceEx(cdr,_
		Cast(Any Ptr,@SectorsPerCluster),_
		Cast(Any Ptr,@BytesPerSector),_
		Cast(Any Ptr,@NumberOfFreeClusters)_
		)
	#EndIf
	Return BytesPerSector
End Function

'//////////////////////////////// Проверка корневой NET папки ///////////////////

Function ExplorerGadget.CheckNetRoot(byval sPath As USTRING) As BOOL
	Dim As Integer count
	If Left(sPath,2) = "\" & "\" Then
		For i As Integer = 0 To Len(sPath)-1
			If sPath[i] = 92 Then
				count+=1
				If count>4 Then Return FALSE
			EndIf
		Next
	Else
		Return FALSE
	EndIf
	Return TRUE
End Function

'//////////////////////////////// Заполнение списка новыми данными///////////////////

Function ExplorerGadget.UpdateDirs(byval sPath As USTRING) As Integer
	Dim As Integer iCount, iSize
	Dim As HANDLE iDir
	Dim As USTRING szGetDir
	
	If Len(sPath) > 1 Then
		#ifdef UNICODE
			If MainTEG->szMask<>"" Then
				iDir = FindFirstFile(*sPath, @FileInformation)
			Else
				dim as USTRING sTemp = sPath + "*.*"
				iDir = FindFirstFile(*sTemp, @FileInformation)
			EndIf			
		#else	
			If MainTEG->szMask<>"" Then
				iDir = FindFirstFile(sPath, @FileInformation)
			Else
				iDir = FindFirstFile(sPath + "*.*", @FileInformation)
			EndIf			
		#EndIf
		
		If iDir = INVALID_HANDLE_VALUE Then
			FindClose(iDir)
			Return 0
		EndIf
		
		NList->DeleteAll()
		
		Dim iFirstRootDisk As Integer
		Dim iduplicate As Integer
		
		Do
			If FileInformation.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY Then
				szGetDir = FileInformation.cFileName
				If szGetDir=".." And CheckNetRoot(sPath)  Then
				ElseIf szGetDir<>"." Then
					If MainTEG->iFlagFolderOrFiles<>2 Then
						if len(sPath)<4 and iFirstRootDisk= 0 Then
							iduplicate = 1
							iCount+=1
							TempList->AddItem _
							( _
							"..", _
							0, _
							sPath & "..", _
							DirectoryEntryDateStatic(0), _
							1 ,, _
							DirectoryEntryDateStatic(1))
							iFirstRootDisk=1
						EndIf
						If iduplicate = 1 And szGetDir = ".." Then
						Else
							iCount+=1
							TempList->AddItem _
							( _
							szGetDir, _
							0, _
							sPath & szGetDir, _
							DirectoryEntryDateStatic(0), _
							1 ,, _
							DirectoryEntryDateStatic(1))
							If FlagErrorFind = TRUE Then Exit Do
						EndIf
					Else
						If szGetDir = ".." And iduplicate = 0 Then
							iCount+=1
							TempList->AddItem _
							( _
							szGetDir, _
							0, _
							sPath & szGetDir, _
							DirectoryEntryDateStatic(0), _
							1 ,, _
							DirectoryEntryDateStatic(1))
							If FlagErrorFind = TRUE Then Exit Do
						EndIf
					EndIf
				EndIf
			EndIf
		Loop While FindNextFile(iDir, @FileInformation)
		
		FindClose(iDir)
		
		
		If FlagErrorFind = FALSE Then
			
			#ifdef UNICODE
				If MainTEG->szMask<>"" Then
					iDir = FindFirstFile(*sPath, @FileInformation)
				Else
					dim as USTRING sTemp = sPath + "*.*"
					iDir = FindFirstFile(*sTemp, @FileInformation)
				EndIf				
			#else	
				If MainTEG->szMask<>"" Then
					iDir = FindFirstFile(sPath, @FileInformation)
				Else
					iDir = FindFirstFile(sPath + "*.*", @FileInformation)
				EndIf					
			#EndIf
			
			
			If MainTEG->iFlagFolderOrFiles<>1 Then
				Do
					If FileInformation.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY Then
					Else
						szGetDir = FileInformation.cFileName
						iCount+=1
						TempList->AddItem( _
						szGetDir, _
						FileInformation.nFileSizeHigh*(MAXDWORD+1) + FileInformation.nFileSizeLow, _
						sPath & szGetDir, _
						DirectoryEntryDateStatic(0), _
						0 ,, _
						DirectoryEntryDateStatic(1))
					EndIf
				Loop While FindNextFile(iDir, @FileInformation)
			EndIf
			
			FindClose(iDir)
			
		Else
			FlagErrorFind = FALSE
		EndIf
	Else
		NList->DeleteAll()
		Dim sDisk As STRING = space(256)
		Dim As Integer sLen
		sLen = GetLogicalDriveStringsA(256,Cast(Lpstr,strptr(sDisk)))
		For i As Integer =0 To sLen\4-1
			iCount+=1
			szGetDir = Mid(sDisk,i*4+1,3)
			TempList->AddItem( _
			szGetDir, _
			GetDriveSize(szGetDir), _
			szGetDir, _
			"", _
			0 ,, _
			"")
		Next
	EndIf
	TempList->AddItemsArray(iCount)
	NList->AddItemsListInArray()
	TempList->DeleteAll()
	Return iCount
End Function

'//////////////////////////////// Оконная функция LISTVIEW///////////////////

Function wndclasslistviewproc(byval hwnd As HWND, byval msg As UINT, byval wparam As WPARAM, byval lparam As LPARAM) As LRESULT
	If msg = WM_KEYUP Then
		If wparam = 13 Then
			If GlobalInfo.GlobalHwnd = hwnd Then
				SetPath(0,GlobalInfo.Text,GlobalInfo.GlobalHwnd)
			EndIf
		EndIf
	EndIf
	Return CallWindowProc(Cast(wndproc,oldproc),hwnd,msg,wparam,lparam)
End Function

'//////////////////////////////// Оконная функция родителя LISTVIEW///////////////////

Function wndproc(byval hwnd As HWND, byval msg As UINT, byval wparam As WPARAM, byval lparam As LPARAM) As LRESULT
	Select Case msg
		Case WM_CREATE
			Dim Hlist As HIMAGELIST
			Dim Info As SHFILEINFO
			If MainTEG->LGElocal = 0 Then
				Dim LGElocal As OptionsExplorerGadget
				MainTEG->LGElocal = @LGElocal
			EndIf
			
			MainTEG->Hwnd=CreateWindowEx(0,"SysListView32","",StyleLW,0,0,MainTEG->intWidth - 4,MainTEG->IntHeight - 4,hWnd,0,0,0)
			SetProp(hwnd,"EXPLORERGADGETLISTVIEWWINDOW",MainTEG->Hwnd)
			win9AddColor(MainTEG->Hwnd,16777215,0)
			win9SetCurrentColors(16777215,0)
			If win9GetGadgetFont()<>0 Then
				SendMessage(MainTEG->Hwnd,WM_SETFONT,win9GetGadgetFont(),0)
			End If
			oldproc  = SetWindowLongPtr(MainTEG->Hwnd,GWLP_WNDPROC,cast(LONG_PTR,@wndclasslistviewproc))
			Hlist = Cast(HIMAGELIST,SHGetFileInfo("", 0, @Info, SizeOf(SHFILEINFO), SHGFI_SMALLICON Or SHGFI_ICON  Or SHGFI_SYSICONINDEX))
			Dim As LVCOLUMN LVS
			LVS.mask=LVCF_FMT Or LVCF_SUBITEM Or LVCF_TEXT Or LVCF_WIDTH
			If MainTEG->LGElocal->iOneWidth<>FB_IGNORE Then
				LVS.cx=MainTEG->LGElocal->iOneWidth
			Else
				LVS.cx=MainTEG->intWidth\4
			EndIf
			LVS.pszText =StrPtr(MainTEG->LGElocal->szName)
			LVS.cchTextMax = Len(MainTEG->LGElocal->szName)
			LVS.iSubItem = 1
			SendMessage(MainTEG->Hwnd,LVM_INSERTCOLUMN,0,Cast(LPARAM,@LVS))
			If MainTEG->LGElocal->iTwoWidth<>FB_IGNORE Then
				LVS.cx=MainTEG->LGElocal->iTwoWidth
			Else
				LVS.cx=MainTEG->intWidth\4
			EndIf
			LVS.pszText =StrPtr(MainTEG->LGElocal->szSize)
			LVS.cchTextMax = Len(MainTEG->LGElocal->szSize)
			LVS.iSubItem = 2
			SendMessage(MainTEG->Hwnd,LVM_INSERTCOLUMN,1,Cast(LPARAM,@LVS))
			If MainTEG->LGElocal->iThreeWidth<>FB_IGNORE Then
				LVS.cx=MainTEG->LGElocal->iThreeWidth
			Else
				LVS.cx=MainTEG->intWidth\4
			EndIf
			LVS.pszText =StrPtr(MainTEG->LGElocal->szType)
			LVS.cchTextMax = Len(MainTEG->LGElocal->szType)
			LVS.iSubItem = 3
			SendMessage(MainTEG->Hwnd,LVM_INSERTCOLUMN,2,Cast(LPARAM,@LVS))
			If MainTEG->LGElocal->iFourWidth<>FB_IGNORE Then
				LVS.cx=MainTEG->LGElocal->iFourWidth
			Else
				LVS.cx=MainTEG->intWidth\4
			EndIf
			LVS.pszText =StrPtr(MainTEG->LGElocal->szModified)
			LVS.cchTextMax = Len(MainTEG->LGElocal->szModified)
			LVS.iSubItem = 4
			SendMessage(MainTEG->Hwnd,LVM_INSERTCOLUMN,3,Cast(LPARAM,@LVS))
			SendMessage(MainTEG->Hwnd,LVM_SETEXTENDEDLISTVIEWSTYLE,0 ,Cast(LPARAM,ExStyle))
			ImageList_SetBkColor(Hlist, CLR_NONE)
			SendMessage(MainTEG->Hwnd, LVM_SETIMAGELIST, LVSIL_SMALL, Cast(LPARAM,Hlist))
			SendMessage(MainTEG->Hwnd, LVM_SETCALLBACKMASK , LVIS_STATEIMAGEMASK , 0)
			SendMessage(MainTEG->Hwnd,LVM_DELETEALLITEMS,0,0)
			SendMessage(MainTEG->Hwnd, LVM_SETITEMCOUNT, MainTEG->UpdateDirs(MainTEG->szPath),1 )
		Case WM_COMMAND
		Case WM_SIZE
			'Var iIdmain  = ID_In_Number(hwnd)
			Dim t As ExplorerGadget Ptr
			t = Cast(ExplorerGadget Ptr,GetProp(hwnd,"addparam60000"))
			If t<>0 Then
				MoveWindow(t->Hwnd,0,0,LoWord(lParam),HiWord(Lparam),TRUE)
			EndIf
		Case WM_NOTIFY
			Dim Nmhdr As NMHDR Ptr=Cast(NMHDR Ptr,lParam)
			Dim As ExplorerGadget Ptr TempTEG2 = Cast(ExplorerGadget Ptr,GetProp(GetParent(Nmhdr->hwndFrom),"addparam60000"))
			If TempTEG2<>0 Then
				MainTEG = TempTEG2
			EndIf
			Select Case  Nmhdr->code
				Case LVN_GETDISPINFO
					Dim Ndisp As NMLVDISPINFO Ptr = Cast(NMLVDISPINFO Ptr,lParam)
					If Ndisp->item.mask And LVIF_TEXT Then
						Dim shfi As SHFILEINFO
						Dim pTemp As List Ptr = MainTEG->NList->GetIdPointer(Ndisp->item.iItem+1)
						If pTemp<>0 Then
							Select Case Ndisp->item.iSubItem
								Case 0
									*Ndisp->item.pszText = pTemp->sValue
									If ListView_GetItemState(Nmhdr->hwndFrom,Ndisp->item.iItem,LVIS_SELECTED) Then
										GlobalInfo.GlobalHwnd = Nmhdr->hwndFrom
										GlobalInfo.Text = pTemp->sValue
										MainTEG->iCurentItem = Ndisp->item.iItem
									EndIf
								Case 1
									Dim szSize As USTRING
									If pTemp->boolFlagFolder = 0 Then
										If pTemp->iSize<1024 Then
											szSize = pTemp->iSize & " B"
										ElseIf pTemp->iSize<1024*1024 And pTemp->iSize>=1024 Then
											szSize = pTemp->iSize\1024 & " KB"
										ElseIf pTemp->iSize<(1024*1024*1024) And pTemp->iSize>=(1024*1024) Then
											szSize = pTemp->iSize\(1024*1024) & "." & (Cast(UByte,pTemp->iSize Mod 1048576)) & " MB"
										Else
											Dim As USTRING d =  Str(pTemp->iSize/(1024 Shl 20))
											szSize = Left(d,4) & " GB"
										EndIf
									Else
										szSize = " "
									EndIf
									*Ndisp->item.pszText = szSize
								Case 2
									If Right(pTemp->sValue,2) = ".." Then
										*Ndisp->item.pszText = " "
									Else
										If pTemp->boolFlagFolder = 0 Then
											SHGetFileInfo(pTemp->sType,0, @shfi, SizeOf(shfi), SHGFI_TYPENAME)
											*Ndisp->item.pszText = shfi.szTypeName
										EndIf
									EndIf
								Case 3
									*Ndisp->item.pszText = pTemp->sModified
							End Select
						EndIf
					EndIf
					If Ndisp->item.mask And LVIF_IMAGE Then
						Dim shfi As SHFILEINFO
						Dim pTemp As List Ptr = MainTEG->NList->GetIdPointer(Ndisp->item.iItem+1)
						If pTemp<>0 Then
							If pTemp->sType<>"" Then
								If MainTEG->szMask<>"" Then
									pTemp->sType = ReplaceString(pTemp->sType,MainTEG->szMask,"")
								EndIf
								If Right(pTemp->sValue,2) = ".." Then
									SHGetFileInfo("..",0, @shfi, SizeOf(SHFILEINFO), SHGFI_ICON Or SHGFI_SHELLICONSIZE Or SHGFI_SYSICONINDEX)
								Else
									pTemp->sType = ReplaceString(pTemp->sType,MainTEG->szMask,"")
									SHGetFileInfo(pTemp->sType,0, @shfi, SizeOf(SHFILEINFO), SHGFI_ICON Or SHGFI_SHELLICONSIZE Or SHGFI_SYSICONINDEX)
								EndIf
								Ndisp->item.iImage = shfi.iIcon
							EndIf
						EndIf
					EndIf
				Case NM_DBLCLK
					Dim act_ As LPNMITEMACTIVATE=Cast(LPNMITEMACTIVATE,Nmhdr)
					MainTEG->Hwnd = Nmhdr->hwndFrom
					If act_->iItem<> -1 Then
						SetPath(act_->iItem)
					EndIf
				Case LVN_COLUMNCLICK
					Dim nmlw As NMLISTVIEW Ptr = Cast(LPNMLISTVIEW,Nmhdr)
					MainTEG->Nlist->bFlagMinMax Xor= 1
					MainTEG->Nlist->iColumnNumber = nmlw->iSubItem
					SendMessage(Nmhdr->hwndFrom,LVM_DELETEALLITEMS,0,0)
					SendMessage(Nmhdr->hwndFrom, LVM_SETITEMCOUNT, MainTEG->UpdateDirs(MainTEG->szPath),1 )
				Case NM_RCLICK
					Dim buf As USTRING
					Dim act_ As LPNMITEMACTIVATE=Cast(LPNMITEMACTIVATE,Nmhdr)
					Dim LV_ITEM As LV_ITEM
					LV_ITEM.iSubItem=act_->iSubItem
					#ifdef UNICODE
						LV_ITEM.pszText= cast(any ptr , *buf)
					#else	
						LV_ITEM.pszText= Cast(LPSTR,@buf)
					#EndIf
					LV_ITEM.cchTextMax=256
					SendMessage(Nmhdr->hwndFrom,LVM_GETITEMTEXT,act_->iItem,Cast(lparam,@LV_ITEM)) ' здесь тоже нужна проверка!!!!!!!!!!!!!!!!
			End Select
			Nmhdr->idFrom = ID_In_Number(GetParent(Nmhdr->hwndFrom))
			SendMessage(GetParent(hwnd),WM_NOTIFY,wparam,Cast(LParam,Nmhdr))
	End Select
	
	Return DefWindowProc(hwnd,msg,wparam,lparam)
End Function

'//////////////////////////////// Регистрация класса ExplorerGadget///////////////////

Function RegClassExplorerGadget() As BOOL
	Dim msg As MSG
	Dim As WNDCLASSEX wc
	Dim As USTRING NameClass="ExplorerGadget"
	With wc
		.cbSize=SizeOf(WNDCLASSEX)
		.style=CS_HREDRAW Or CS_VREDRAW
		.lpfnWndProc=@wndproc
		.hInstance=GetModuleHandle(0)
		.hbrBackground=Cast(HBRUSH,COLOR_WINDOW)
		#ifdef UNICODE
			.lpszClassName=*NameClass
		#else	
			.lpszClassName=StrPtr(NameClass)
		#EndIf
	End With
	If RegisterClassEx(@wc)=0 Then
		Print "Register error, press any key"
		Return 0
	EndIf
	Return 1
End Function


'//////////////////////////////// Очистка ресурсов ExplorerListGadget///////////////////

Function FreeExplorerGadgetresource(byval pEG As Any Ptr) As bool Export
	Dim p As ExplorerGadget Ptr = Cast(ExplorerGadget Ptr,pEG)
	p->NList->DeleteAll
	Delete p->NList
	Delete p
	Return TRUE
End Function

'//////////////////////////////// Создание гаджета ExplorerListGadget///////////////////

Function ExplorerListGadget(byval gadget As Long, _
byval x As Long, byval y As Long, _
byval w As long, byval h As Long, _
byref sPath As USTRING, _
byval LGELocal As OptionsExplorerGadget Ptr) As HWND Export
	Static FlagRegister As bool
	Dim As Integer iTempStyle,PosMask
	Dim T_EG As ExplorerGadget Ptr = new ExplorerGadget
	if T_EG = 0 then return 0
	If FlagRegister = 0 Then
		RegClassExplorerGadget()
		FlagRegister = 1
	End If
	T_EG->intWidth  = w
	T_EG->IntHeight = h
	T_EG->szPath    = sPath
	T_EG->LGElocal  = LGELocal
	PosMask = InStr(sPath,"*")
	If PosMask>1 Then
		T_EG->szMask = Mid(sPath,PosMask)
	Else
		If right(T_EG->szPath,1)<>"\" Then T_EG->szPath &="\"
	End If
	MainTEG = T_EG
	If LGELocal<>0 Then  iTempStyle = T_EG->LGElocal->iStyle
	var hWin = CreateWindowEx(iTempStyle,"ExplorerGadget","", WS_VISIBLE Or WS_CHILD, x,y,w,h, Cast(HWND,win9GetCurrent()), Cast(HMENU,CInt(gadget)),0,0)
	win9AddNewGadget(gadget, hWin)
	SetProp(hWin, "addparam60000",T_EG)
	SetProp(hWin, "EXPLORERLISTFREEPROC",@FreeExplorerGadgetresource)
	dim as hwnd hwParent = Cast(HWND,win9GetCurrent())
	for i as Long = 0 to 1000
		dim as USTRING sz = getclassname_(hwParent)
		if instr(sz , "CLASSCLASS_") andalso getparent(hwParent) = 0 then
			if getprop(hwParent , "tabstopenable") then
				win9AddTabStop(hwParent , gadget)
			EndIf
			exit for
		else
			hwParent = getparent(hwParent)
			if hwParent = 0 then exit for
		EndIf
	Next
	Return hWin
End Function

'////////////////////////////////Получение окна ListView///////////////////

Function GetExplorerListGadgetHwnd(byval gadget As Long) As HWND Export
	Dim t As ExplorerGadget Ptr
	t = Cast(ExplorerGadget Ptr,GetProp(GadgetID(gadget),"addparam60000"))
	Return t->Hwnd
End Function

'////////////////////////////////Получение текущего пути ExplorerListGadget///////////////////

Function GetExplorerListGadgetPath(byval gadget As Long) As USTRING Export
	Dim t As ExplorerGadget Ptr
	Dim As Integer PosMask
	t = Cast(ExplorerGadget Ptr,GetProp(GadgetID(gadget),"addparam60000"))
	If t->szMask<>"" Then
		PosMask = InStr(t->szPath,"*")
		If PosMask>1 Then
			Return Mid(t->szPath,1,PosMask-1)
		EndIf
	EndIf
	Return t->szPath
End Function

'////////////////////////////////Установка текущего пути ExplorerListGadget///////////////////

Function SetExplorerListGadgetPath(byval gadget As Integer, byref sPath As USTRING) As BOOL Export
	Dim As Integer PosMask = InStr(sPath,"*")
	If PosMask>1 Then
		MainTEG->szMask = Mid(sPath,PosMask)
	Else
		MainTEG->szMask = ""
	EndIf
	Dim As ExplorerGadget Ptr t = Cast(ExplorerGadget Ptr,GetProp(GadgetID(gadget),"addparam60000"))
	Return SetPath(0, sPath, t->Hwnd,1)
End Function

'/////////Установка сортировки в зависимости от столбца ExplorerListGadget///////////////////

Function SetExplorerListGadgetSort(byval gadget As Integer, byval Column As Integer) As Integer Export
	Dim As ExplorerGadget Ptr t = Cast(ExplorerGadget Ptr,GetProp(GadgetID(gadget),"addparam60000"))
	Dim nmlw As NMLISTVIEW
	nmlw.iSubItem = Column
	nmlw.hdr.hwndFrom = t->Hwnd
	nmlw.hdr.code = LVN_COLUMNCLICK
	Return SendMessage(GadgetID(gadget),WM_NOTIFY,0,Cast(Lparam,@nmlw))
End Function

Function GetExplorerListGadgetCurentItem(byval gadget As Long) As Integer Export
	Dim t As ExplorerGadget Ptr
	t = Cast(ExplorerGadget Ptr,GetProp(GadgetID(gadget),"addparam60000"))
	Return t->iCurentItem
End Function

'/////////Замена стиля ExplorerListGadget///////////////////

Function SetExplorerListGadgetStyle(byval gadget As Integer, byval Style As Integer) As Integer Export
	Dim Info As SHFILEINFO
	Static iFlag As Integer
	Static As HIMAGELIST HlistSmall,HlistLarge
	Dim As HWND hwndList = GetExplorerListGadgetHwnd(gadget)
	
	If iFlag = FALSE Then
		HlistSmall = Cast(HIMAGELIST, SendMessage(hwndList, LVM_GETIMAGELIST, LVSIL_SMALL  ,0))
		HlistLarge = Cast(HIMAGELIST,SHGetFileInfo("", 0, @Info, SizeOf(SHFILEINFO), SHGFI_LARGEICON Or SHGFI_ICON  Or SHGFI_SYSICONINDEX))
	EndIf
	
	If gadget>0 Then
		Select Case Style
			Case LVS_ICON,LVS_SMALLICON,LVS_LIST,LVS_REPORT
				Select Case Style
					Case LVS_ICON
						SendMessage(hwndList, LVM_SETIMAGELIST, LVSIL_NORMAL, Cast(LPARAM,HlistLarge))
						SetWindowLongPtr(hwndList, GWL_STYLE, WS_VISIBLE Or WS_CHILD Or LVS_ICON Or LVS_OWNERDATA)
					Case LVS_SMALLICON
						SendMessage(hwndList, LVM_SETIMAGELIST, LVSIL_NORMAL, Cast(LPARAM,HlistLarge))
						SetWindowLongPtr(hwndList, GWL_STYLE, _
						WS_VISIBLE Or WS_CHILD Or LVS_ICON   Or LVS_OWNERDATA)
						SendMessage(hwndList, LVM_SETIMAGELIST, LVSIL_SMALL, Cast(LPARAM,HlistSmall))
						SetWindowLongPtr(hwndList, GWL_STYLE, _
						WS_VISIBLE Or WS_CHILD Or LVS_SMALLICON  Or LVS_OWNERDATA)
						SetExplorerListGadgetPath(gadget,GetExplorerListGadgetPath(gadget)) ' UpdateList
					Case LVS_LIST
						SendMessage(hwndList, LVM_SETIMAGELIST, LVSIL_NORMAL, Cast(LPARAM,HlistLarge))
						SetWindowLongPtr(hwndList, GWL_STYLE, WS_VISIBLE Or WS_CHILD Or LVS_ICON   Or LVS_OWNERDATA)
						SendMessage(hwndList, LVM_SETIMAGELIST, LVSIL_SMALL, Cast(LPARAM,HlistSmall))
						SetWindowLongPtr(hwndList, GWL_STYLE,  WS_VISIBLE Or WS_CHILD Or LVS_LIST  Or LVS_OWNERDATA)
						SetExplorerListGadgetPath(gadget,GetExplorerListGadgetPath(gadget)) ' UpdateList
					Case LVS_REPORT
						SendMessage(hwndList, LVM_SETIMAGELIST, LVSIL_SMALL, Cast(LPARAM,HlistSmall))
						SetWindowLongPtr(hwndList, GWL_STYLE,  WS_VISIBLE Or WS_CHILD Or LVS_REPORT Or LVS_OWNERDATA)
				End Select
				Function = TRUE
		End Select
	End If
End Function

Sub FlagExplorerListGadget(byval gadget As Integer, byval iFlag As Integer = 3)
	Dim t As ExplorerGadget Ptr
	t = Cast(ExplorerGadget Ptr,GetProp(GadgetID(gadget),"addparam60000"))
	t->iFlagFolderOrFiles = iFlag
	SetPath(0,t->szPath,t->Hwnd,1)
End Sub
