Форумы GIS-Lab.info

Код: Выделить всё

Include "MapBasic.def"
Type FILETIME
	dwLowDateTime As Integer
	dwHighDateTime As Integer
End Type 



Type WIN32_FIND_DATA
    dwFileAttributes As Integer
    ftCreationTime As FILETIME
    ftLastAccessTime As FILETIME
    ftLastWriteTime As FILETIME
    nFileSizeHigh As Integer
    nFileSizeLow As Integer
    dwReserved0 As Integer
    dwReserved1 As Integer
    cFileName As String * 260
    cAlternate As String * 14
End Type

Define FILE_ATTRIBUTE_DIRECTORY = &H10

Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Integer
Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" (ByVal hFindFile As Integer, lpFindFileData As WIN32_FIND_DATA) As Integer
Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Integer) As Integer

Declare Function FileExists(ByVal Path as String) As Logical
Declare Function GetFileList(ByVal Path as String, FileNames() as String) as Logical

Declare Sub Main()

Function FileExists(ByVal Path As String) As Logical
	Dim hFind As Integer
	Dim wfd As WIN32_FIND_DATA	

	Dim FName As String
	Dim Ret As Integer

	'Get the first file to initialize the find engine
	hFind = FindFirstFile(Path, wfd)
	
	'Trim off any spaces
	FName = LTrim$(RTrim$(wfd.cFileName))

	'No files found
	If Len(FName) = 0 Then
		FileExists = FALSE
	
	Else 'Found it
		FileExists = TRUE
	End If

	'Close the find engine
	Ret = FindClose(hFind)
End Function

Function GetFileList(ByVal Path as String, FileNames() as String) as Logical
	Dim hFind As Integer
	Dim wfd As WIN32_FIND_DATA	
	Dim wfdArray() As WIN32_FIND_DATA ' will use this to reset wfdArray after each use -- avoiding system crash!	

	Dim FName As String
	Dim Ret, i As Integer


	i=0
	ReDim FileNames(i)
	ReDim wfdArray(0)
	ReDim wfdArray(1)

	'Get the first file to initialize the find engine
	hFind = FindFirstFile(Path, wfdArray(1))
	
	'Trim off any spaces
	FName = LTrim$(RTrim$(wfdArray(1).cFileName))

	GetFileList=(Len(FName)>0) ' return "True" if at least one file found

	Do
		i=i+1
		ReDim FileNames(i)
		FileNames(i)=FName
		ReDim wfdArray(0)
		ReDim wfdArray(1)
		Ret = FindNextFile(hFind, wfdArray(1))
		
		'Trim off any spaces
		if Ret=0 then exit do end if
		FName = LTrim$(RTrim$(wfdArray(1).cFileName))
		if FName="" then note "Search failed." exit do end if ' should not happen
	Loop

	'Close the find engine
	Ret = FindClose(hFind)

End Function

Sub Main()

Dim AKT As String
Dialog
Title "Поиск"
Control StaticText
Title "Введите номер АКТа:"
Control EditText
Into AKT
Control OKButton
Control CancelButton
'
'Dim YEAR As String
'Dialog
'Title "Поиск"
'Control StaticText
'Title "Введите ГОД поставки:"
'Control EditText
'Into YEAR
'Control OKButton
'Control CancelButton

'Dim MOUNTH As String
'Dialog
'Title "Поиск"
'Control StaticText
'Title "Введите МЕСЯЦ поставки:"
'Control EditText
'Into MOUNTH
'Control OKButton
'Control CancelButton
'
'Dim DAY As String
'Dialog
'Title "Поиск"
'Control StaticText
'Title "Введите ДЕНЬ поставки:"
'Control EditText
'Into DAY
'Control OKButton
'Control CancelButton

	Dim Ret As Logical
	Dim FName As String
	Dim FileNames() as String
	Dim i as integer
	'run program "cmd /c net use y: \\sonas\FTP\ROOM_DATA\APPSRV03vm\ &"
	FName = "S:\DEP_122_PHOTO\WORK\*" + Str$(AKT) + "*.*"

	Ret = GetFileList(FName, FileNames())

	If Ret = True Then

		for i = 1 to ubound(FileNames())
			print i & ":  " & FileNames(i)
		next

		Note "Total files found:  " & UBound(FileNames())
	else
		note FName + " Doesn't Exist"
	End If

End Sub