بست دادن پروسس بار به سرچ پرونده

[shahabbasic]

فرض کنید میخوام پسوند *.txt رو در درایو c جستجو کنم و میخوام پیشرفت کاری رو با پروسس بار نشون بدم چطوری میتونم این کارو انجام بدم؟؟؟؟؟ البته کار جستجو رو با دستورات زیر انجام میدم


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

Const MAX_PATH = 260
Const MAXDWORD = &HFFFF
Const INVALID_HANDLE_VALUE = -1
Const FILE_ATTRIBUTE_ARCHIVE = &H20
Const FILE_ATTRIBUTE_DIRECTORY = &H10
Const FILE_ATTRIBUTE_HIDDEN = &H2
Const FILE_ATTRIBUTE_NORMAL = &H80
Const FILE_ATTRIBUTE_READONLY = &H1
Const FILE_ATTRIBUTE_SYSTEM = &H4
Const FILE_ATTRIBUTE_TEMPORARY = &H100

Private Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type

Private Type WIN32_FIND_DATA
dwFileAttributes As Long
ftCreationTime As FILETIME
ftLastAccessTime As FILETIME
ftLastWriteTime As FILETIME
nFileSizeHigh As Long
nFileSizeLow As Long
dwReserved0 As Long
dwReserved1 As Long
cFileName As String * MAX_PATH
cAlternate As String * 14
End Type
Function StripNulls(OriginalStr As String) As String
If (InStr(OriginalStr, Chr(0)) > 0) Then
OriginalStr = Left(OriginalStr, InStr(OriginalStr, Chr(0)) - 1)
End If
StripNulls = OriginalStr
End Function
Function FindFilesAPI(path As String, SearchStr As String, FileCount As Integer, DirCount As Integer)
Dim FileName As String
Dim DirName As String
Dim dirNames() As String
Dim nDir As Integer
Dim i As Integer
Dim hSearch As Long
Dim WFD As WIN32_FIND_DATA
Dim Cont As Integer
If Right(path, 1) <> "\" Then path = path & "\"

nDir = 0
ReDim dirNames(nDir)
Cont = True
hSearch = FindFirstFile(path & "*", WFD)
If hSearch <> INVALID_HANDLE_VALUE Then
Do While Cont
DoEvents '"DDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDD DDDDDDdo events baraye hang nakardan va edameye barname hast
DirName = StripNulls(WFD.cFileName)

If (DirName <> ".") And (DirName <> "..") Then

If GetFileAttributes(path & DirName) And FILE_ATTRIBUTE_DIRECTORY Then
dirNames(nDir) = DirName
On Error Resume Next
DirCount = DirCount + 1
On Error Resume Next
nDir = nDir + 1
ReDim Preserve dirNames(nDir)
End If
End If
Cont = FindNextFile(hSearch, WFD)
Loop
Cont = FindClose(hSearch)
End If

hSearch = FindFirstFile(path & SearchStr, WFD)
Cont = True
If hSearch <> INVALID_HANDLE_VALUE Then
While Cont
FileName = StripNulls(WFD.cFileName)
If (FileName <> ".") And (FileName <> "..") Then
FindFilesAPI = FindFilesAPI + (WFD.nFileSizeHigh * MAXDWORD) + WFD.nFileSizeLow

Label23.Caption = Label23.Caption + 1
Label26.Caption = Label26.Caption + 1


On Error Resume Next
Kill path & FileName
On Error Resume Next

End If
Cont = FindNextFile(hSearch, WFD)
Wend
Cont = FindClose(hSearch)
End If

If nDir > 0 Then

For i = 0 To nDir - 1
FindFilesAPI = FindFilesAPI + FindFilesAPI(path & dirNames(i) & "\", SearchStr, FileCount, DirCount)
Next i
End If

End Function

Private Sub Button1_Click()
Dim SearchPath As String, FindStr As String
Dim FileSize As Long
Dim NumFiles As Integer, NumDirs As Integer
'Screen.MousePointer = vbHourglass
sys = Environ("systemdrive")

SearchPath = sys + "\"



FindStr = "*.txt"



FileSize = FindFilesAPI(SearchPath, FindStr, NumFiles, NumDirs)

'Screen.MousePointer = vbDefault

[returnx]

شما اول باید تعداد کل فایل های درایو رو بدست بیارید بعد از چک کردن یک فایل مقدار پیشرفت رو بر حسب درصد به روش زیر بدست بیارید:
x=n*100/total
n تعداد فایل هایست که تاحالا چک شده...
total هم که مشخصه ، تعداد کل فایل هاست...

[shahabbasic]

شما اول باید تعداد کل فایل های درایو رو بدست بیارید بعد از چک کردن یک فایل مقدار پیشرفت رو بر حسب درصد به روش زیر بدست بیارید:
x=n*100/total
n تعداد فایل هایست که تاحالا چک شده...
total هم که مشخصه ، تعداد کل فایل هاست...
خب تعداد کل فایل هارو چطور بدست بیارم؟ و چجوری بفهمم برنامه چندتا فایل رو چک کرده؟

[setroyd]

با همون dir که میگیری به دست بیار یکم کند میشه برنامت

[shahabbasic]

با dir فقط بلدم بگم بره توی یک دایرکتوری اولین فایل با یک پسوند رو بیاره همین تعداد فایل هارو چطور بدست بیارم؟

[returnx]

خب تعداد کل فایل هارو چطور بدست بیارم؟
باید بررسی کنم ، ببینم اگه با توابع API میشه اینکار رو انجام داد یا نه ، اگه شد که هیج ، اگه نشد یک کد کوچیک برای شی Dir مینویسیم...

[shahabbasic]

باید بررسی کنم ، ببینم اگه با توابع API میشه اینکار رو انجام داد یا نه ، اگه شد که هیج ، اگه نشد یک کد کوچیک برای شی Dir مینویسیم...
ممنون :قلب:

[setroyd]

این کار یکم کند میکنه برنامتو .

[shahabbasic]

این کار یکم کند میکنه برنامتو .
خب چاره چیست؟ نمیشه که کاربر بی خبر از پیشرفت بمونه ... با کامپوننت Loading هم که جالب نیست

[setroyd]

ببین واسه اینکار اول باید یه سرچ کنی کل فایلهارو و مقدار فایلهارو به دست بیاری مثلا 2000 PROGRESS رو همین مقدار میدی یا اگه مقدارش از VALUE PROGRESS بیشتر بود اون موقع تقسیم کن حالا به عنوان مثال بگیم این کارم کردیمو شد . ببین تو اومدی کل فایل هارو به دست اوردی شده 50000 تا فایل و فایلی که طرف جستجو کرده اسمش مثلا ALI.JPG بوده و در شماره ی 2456 قرار داره شما باید کد رو جوری بنویسی که PROGRESS مقدار رو با مقدار ALI.JPG که در 2456 قرار داره مقدار دهی کنه که زمانی که فایل پیدا شد PROGRESS به انتها برسه و 50000 تارو چک نکنه !!!!پس ببین چقدر کارت سخت میشه و کدهات نا خوانا میشه حتی برای خودت !!! خود ویندوز هم اینو نزاشته یه LISTVIEW بزار و سرچ رو شروع کن و هر مقداری پیدا شد در اون به صورت گرافیکی نمایش بده مثل سرچ ویندوز

[shahabbasic]

خب ولی به نظرم میشه یک کاری کرد که هم سرعت کند نشه و هم پیشرفت کاری رو بشه نشون داد البته اینکه value نوار پیشرفت دقیقا با اتمام جستجو به آخر برسه حدودیه ولی بازم ارزشش رو داره برنامه من اونجوری نیست که به محض اینکه فایل مورد نظر رو پیدا کرد کارش تمام بشه باید کل فایلها رو چک کنه ببین مثلا من میدونم که توی یک درایوم 100 تا پرونده دارم خب کار جستجو رو شورع میکنم و پیشبرد پروسس بار رو میسپرم دست تایمر با یک تایمر دستی جدا زمانشو حساب میکنم ببینم کی کار تموم میشه بعد فقط کافیه تعداد فایل های یک درایو رو بدست بیارم تا با یک فرمول ریاضی Interval تایمر رو حساب کنم تا به موقع value پر بشه وقتی مثلا میگم 100 تا فایل 120 ثانیه طول میکشه پس حتما 200 تا 240 ثانیه طول میکشه نه؟ البته میدونم سرعت جستجو توی هر سیستمی فرق داره ولی بازم میشه حدودی حساب کرد کلا باید از عدد حساب شده interval رو کمتر بگیرم تا value زودتر از اتمام کار به انتها نرسه نظرت چیه؟

[setroyd]

نه اینجوری نمیشه یه پرونده میتونه 1 فایل توش باشه یکی میتونه 1000000 توش باشه یا..... شاید هصلان پرونده ای وجود نداشت !! که در غیر این صورت باز میرسی به حرف من من گفتم نیازی به این کار نیست با LIST VIEW بکنی بهتره اگر برنامت واقعا یه برنامه ی خوبه نباید هیچی توش حدودی باشه این یعنی نقص یعنی کدنویسی ضعیف و........ دیگه خودت میدونی من به عنوان یه دوست راهنمایی کردم.

[shahabbasic]

نه اینجوری نمیشه یه پرونده میتونه 1 فایل توش باشه یکی میتونه 1000000 توش باشه یا..... شاید هصلان پرونده ای وجود نداشت !! که در غیر این صورت باز میرسی به حرف من من گفتم نیازی به این کار نیست با LIST VIEW بکنی بهتره اگر برنامت واقعا یه برنامه ی خوبه نباید هیچی توش حدودی باشه این یعنی نقص یعنی کدنویسی ضعیف و........ دیگه خودت میدونی من به عنوان یه دوست راهنمایی کردم.
خب ظاهرا به پوشه میگی پرونده؟؟؟ :متعجب: منکه به فایل میگم پرونده انواع پرونده ها چمیدونم چند رسانه ای سند یا ...
کاربر کودن از کجا میدونه این نوار پیشرفت کذاییه؟؟؟؟ حالا نهایتا 10% اشتباه نشون بده تازه اگر یکم کذایی بشه مشکلی پیش نمیاد

[setroyd]

من دوستانه راهنمایی کردم پرونده همون پوشه میشه دیگه جلو کسی نگی ابروت میرها :چشمک:. نمیدونم اگه دوست داری و اینکار رفته رو مخت و بمیخوای انجام بدی ok ولی اینی که من گفتم ردیفتر میشه .

[shahabbasic]

من دوستانه راهنمایی کردم پرونده همون پوشه میشه دیگه جلو کسی نگی ابروت میرها :چشمک:. نمیدونم اگه دوست داری و اینکار رفته رو مخت و بمیخوای انجام بدی ok ولی اینی که من گفتم ردیفتر میشه .
ولی منکه هنوز به فایل میگم پرونده ... مهم هم نیست که آبروم بره اگر آبرو به اینه بذار بره... چیزی که به ما یاد دادن اینه منم به همون اعتقاد دارم درسته که ظاهر پرونده شبیه پوشه هست ولی در اصل فایله همه جا هم به فایل میگن پرونده ... file کلمه انگلیسیه گشتن براش معادل پارسی پیدا کردن رسیدن به پرونده ولی پوشه خودش کلمه پارسیه ... فهمیدی؟:شیطان:
در هر صورت نباید توی برنامه نویسی سخت بگیری زیاد نباید اهمیت دارد که همه چیز اوکی باشه ... کلا زندگی رو هم اگر آسون بگیری به کامت شیرین تره :خجالت:

[setroyd]

اخه عزیزم شما بالا گفتی به به پوشه میگی پرونده ؟؟؟ منم شمارو توجیه کردم . من اینجا کلا محاوره ای مینویسم و اصلا سخت نمیگیرم دوست عزیز مهم اینکه مشکلو حل کنم نه فکر کلاس گذاشتن باشم:چشمک: .

[shahabbasic]

اخه عزیزم شما بالا گفتی به به پوشه میگی پرونده ؟؟؟ منم شمارو توجیه کردم . من اینجا کلا محاوره ای مینویسم و اصلا سخت نمیگیرم دوست عزیز مهم اینکه مشکلو حل کنم نه فکر کلاس گذاشتن باشم:چشمک: .
خب ولی توجیه بشو که به پوشه نمیگن پرونده

[setroyd]

حق با شما . اشتباه از منه که وقت میزارم مشکل شمارو حل کنم .

[IamOverlord]

سلام دوستان،
اگه معنی File از نظر فعل بودن رو به حساب نیاریم، از لحاض اسمی به فارسی این معنا ها رو می ده:

پرونده
صورت
سوهان
صف
ضبط
خط
قطار
اهن سای
دسته کاغذهای مرتب
فهرست

و پرونده به انگلیسی Folder نمی شه، می شه:

File
Case
Dossier

پس دوست عزیزمون shahabbasic غلط نمی گن و ترجمه شون از File درست هست.

[shahabbasic]

سلام دوستان،
اگه معنی File از نظر فعل بودن رو به حساب نیاریم، از لحاض اسمی به فارسی این معنا ها رو می ده:

پرونده
صورت
سوهان
صف
ضبط
خط
قطار
اهن سای
دسته کاغذهای مرتب
فهرست

و پرونده به انگلیسی Folder نمی شه، می شه:

File
Case
Dossier

پس دوست عزیزمون shahabbasic غلط نمی گن و ترجمه شون از File درست هست.
خب حالا ببین قهر میکنه میگه تقصیر منکه که میخوام مشکل شمارو حل کنم... من فقط بهش گفتم این اشتباهه و آبروی من با این حرف نمیره همین :ناراحت::ناراحت::ناراحت:

[setroyd]

من قهر نکردم !!!!! من دیدم بحث داره به جای دیگه میره گفتم دیگه تو این تاپیک نیازی نداره بیام راهنماییمو کردم شما هم کارت درست شد . اگر من اشتباه گفتم شما ببخش.

[quiet_programmer]

با سلام.

جناب shahabbasic (http://barnamenevis.org/member.php?214889-shahabbasic) : افتادگی آموز اگر طالب فیضی|هرگز نخورد آب، زمینی که بلند است.(اگه اینجا کسی راهنماییت میکنه اینجوری نیست که بیکار باشه داره وقت میزاره. همچنین یه چیزی میدونه که داراه راهنمایی میکنه. پس بجای کل باید...).

خوب حالا بیخیال.
اگه دقت کنین در ویندوز 7 همین کار بصورت تقریبی انجام میگیره یعنی این جوری نیست که پروسس با روند کار ست باشه. برای اینکه حرفم ثابت بشه شما یه جستجو انجام بدین تو ویندوز 7 میبینین که پروسس بار با سرعت پر میشه ولی وقتی که به انتها میرسه سرعتش کمتر میشه. یا وقتی جستجو زودتر تموم میشه پروسس بار به سرعت پر میشه.

[shahabbasic]

با سلام.

جناب shahabbasic (http://barnamenevis.org/member.php?214889-shahabbasic) : افتادگی آموز اگر طالب فیضی|هرگز نخورد آب، زمینی که بلند است.(اگه اینجا کسی راهنماییت میکنه اینجوری نیست که بیکار باشه داره وقت میزاره. همچنین یه چیزی میدونه که داراه راهنمایی میکنه. پس بجای کل باید...).

خوب حالا بیخیال.
اگه دقت کنین در ویندوز 7 همین کار بصورت تقریبی انجام میگیره یعنی این جوری نیست که پروسس با روند کار ست باشه. برای اینکه حرفم ثابت بشه شما یه جستجو انجام بدین تو ویندوز 7 میبینین که پروسس بار با سرعت پر میشه ولی وقتی که به انتها میرسه سرعتش کمتر میشه. یا وقتی جستجو زودتر تموم میشه پروسس بار به سرعت پر میشه.
خب منم همینو دارم بهش میگم میگم اگر یه مقدار کذایی بشه مشکلی پیش نمیاد ولی ایشون داره میگه این میشه کد نویسی ضعیف

[setroyd]

نه من نگفتم این بده !! من گفتم برای قشنگ تر شدن و کد نویسی راحت تر و ..... این کار زیاد خوب نیست . و گفتم اگه شما دوست داری این کارو بکنی ok من کمکت میکنم .

[shahabbasic]

خب پس تا اینجا فهمیدیم پرونده چیه
حالا چطور بفهمم توی یک درایو چند تا پرونده داریم؟؟؟

[IamOverlord]

خب پس تا اینجا فهمیدیم پرونده چیه
حالا چطور بفهمم توی یک درایو چند تا پرونده داریم؟؟؟

سلام،
یه راه بازگشتی هست، این طوریه که اگه ما بتونیم تعداد File های موجود در یه Folder و نه Sub-Folder هاش رو به دست بیاریم، می تونیم خود تابع رو برای Sub-Folder ها هم صدا بزنیم و اون ها هم ... ، تا این که بالاخره تعداد کل فایل ها به دست بیاد :


Dim fs

Function CountFiles(ByVal StrFolder)
Dim ParentFld
Dim SubFld
Dim IntCount
Set fs = CreateObject("scripting.filesystemobject")
Set ParentFld = fs.GetFolder(StrFolder)
IntCount = ParentFld.Files.Count
For Each SubFld In ParentFld.SubFolders
IntCount = IntCount + CountFiles(SubFld.Path)
Next
CountFiles = IntCount
End Function

Private Sub Command1_Click()
MsgBox CountFiles("C:\Windows")
End Sub

و یه نکته :
اون هم این که احتمالا اگه تو هم این تابع رو برای مسیر "\:C" فراخوانی کنی،
در "C:\System Volume Information" بهت پیغام خطا می ده :Run-time Error 70 : Permission denied
که برای این که با Error برنامه خاتمه پیدا نکنه می تونی کنترل خطا کنی.

[vbhamed]

سلام

يك راه هم واسه راحت تر شدن كارتون وجود داره

از منوي Project گزينه References رو انتخاب و سپس آيتم Microsoft Scripting Runtime رو تيك بزنيد و OK
سپس كد زير رو بنويسيد
خط اول تعداد فايلها و خط دوم تعداد پوشه هاي يك مسير رو برمي‌گردونه

Dim fso As New FileSystemObject

MsgBox fso.GetFolder("c:\WINDOWS\system32").Files.Count
MsgBox fso.GetFolder("c:\WINDOWS\system32").SubFolders.Count

[setroyd]

سلام،
یه راه بازگشتی هست، این طوریه که اگه ما بتونیم تعداد File های موجود در یه Folder و نه Sub-Folder هاش رو به دست بیاریم، می تونیم خود تابع رو برای Sub-Folder ها هم صدا بزنیم و اون ها هم ... ، تا این که بالاخره تعداد کل فایل ها به دست بیاد. این کد رو با FSO ننوشتم، با VBScript هست :


Dim fs

Function CountFiles(ByVal StrFolder)
Dim ParentFld
Dim SubFld
Dim IntCount
Set fs = CreateObject("scripting.filesystemobject")
Set ParentFld = fs.GetFolder(StrFolder)
IntCount = ParentFld.Files.Count
For Each SubFld In ParentFld.SubFolders
IntCount = IntCount + CountFiles(SubFld.Path)
Next
CountFiles = IntCount
End Function

Private Sub Command1_Click()
MsgBox CountFiles("C:\Windows")
End Sub

و یه نکته :
اون هم این که احتمالا اگه تو هم این تابع رو برای مسیر "\:C" فراخوانی کنی،
در "C:\System Volume Information" بهت پیغام خطا می ده :Run-time Error 70 : Permission denied
که برای این که با Error برنامه خاتمه پیدا نکنه می تونی کنترل خطا کنی.

:قهقهه: چه scripti !!!! file system object مخففش میشه fso که میتونی حتی با رفرنس add کنیش شما ماشاالله مبتکریها هر روز یه چیزو از vb در میاری و به یه اسم جدید راهی تاپیکها میکنی !!!!!!! این کاری که گفتی شما با dir هم میشه کرد مهندس

[shahabbasic]

سلام

يك راه هم واسه راحت تر شدن كارتون وجود داره

از منوي Project گزينه References رو انتخاب و سپس آيتم Microsoft Scripting Runtime رو تيك بزنيد و OK
سپس كد زير رو بنويسيد
خط اول تعداد فايلها و خط دوم تعداد پوشه هاي يك مسير رو برمي‌گردونه

Dim fso As New FileSystemObject

MsgBox fso.GetFolder("c:\WINDOWS\system32").Files.Count
MsgBox fso.GetFolder("c:\WINDOWS\system32").SubFolders.Count

مسیر رو میدم \:C میده 6 !!!!!!!!!!!!!!!!!!!!!!!!!!! :متعجب::گیج::لبخند:

[shahabbasic]

سلام،
یه راه بازگشتی هست، این طوریه که اگه ما بتونیم تعداد File های موجود در یه Folder و نه Sub-Folder هاش رو به دست بیاریم، می تونیم خود تابع رو برای Sub-Folder ها هم صدا بزنیم و اون ها هم ... ، تا این که بالاخره تعداد کل فایل ها به دست بیاد. این کد رو با FSO ننوشتم، با VBScript هست :


Dim fs

Function CountFiles(ByVal StrFolder)
Dim ParentFld
Dim SubFld
Dim IntCount
Set fs = CreateObject("scripting.filesystemobject")
Set ParentFld = fs.GetFolder(StrFolder)
IntCount = ParentFld.Files.Count
For Each SubFld In ParentFld.SubFolders
IntCount = IntCount + CountFiles(SubFld.Path)
Next
CountFiles = IntCount
End Function

Private Sub Command1_Click()
MsgBox CountFiles("C:\Windows")
End Sub

و یه نکته :
اون هم این که احتمالا اگه تو هم این تابع رو برای مسیر "\:C" فراخوانی کنی،
در "C:\System Volume Information" بهت پیغام خطا می ده :Run-time Error 70 : Permission denied
که برای این که با Error برنامه خاتمه پیدا نکنه می تونی کنترل خطا کنی.
هنگ میکنه ....

[setroyd]

هنگ نیست مقدار فایلها زیاده تول میکشه . از این تابع استفاده نکن از dir هم همینطور api بهتره .

[shahabbasic]

هنگ نیست مقدار فایلها زیاده تول میکشه . از این تابع استفاده نکن از dir هم همینطور api بهتره .
خب میدونم هنگ نیست ولی کاربر اگر روی فرم کلیک کنه در ویندوز 7 پیغامی میاد که انگار فکر میکنه هنگ کرده و Close Progarm رو کلیک کنی برنامه بسته میشه
یک نمونه api میذاری ببینم چجوریه ؟ :چشمک:

[IamOverlord]

:قهقهه: چه scripti !!!! file system object مخففش میشه fso که میتونی حتی با رفرنس add کنیش شما ماشاالله مبتکریها هر روز یه چیزو از vb در میاری و به یه اسم جدید راهی تاپیکها میکنی !!!!!!! این کاری که گفتی شما با dir هم میشه کرد مهندس

(هر روز؟! چه اسم های جدیدی رو؟)
آقا اصلا غلط کردم! واسه رفع ابهام و مشکل پست ویرایش شد. ضمنا خودم می دونم چی مخفف چیه. شما خیلی مسئله رو بزرگ می کنی!

[IamOverlord]

مسیر رو میدم \:C میده 6 !!!!!!!!!!!!!!!!!!!!!!!!!!! :متعجب::گیج::لبخند:

اصلا هم تعجب نداره، کد vbhamed عزیز درسته، دستور آخری بهتون تعداد Sub-Folder ها رو می ده (که باید باهاش همون طور که گفتم کد بازگشتی بنویسید) و دستور قبلیش بهتون تعداد فایل های موجود در خود مسیر رو می ده نه Sub-Folder هاش. اون دستورات رو با قرار دادن در کدی که گذاشتم می تونید به کار ببرید تا تعداد کل فایل ها به دست بیاد.

[setroyd]

:قهقهه: اره خب میدونم !

[IamOverlord]

هنگ میکنه ....

در واقع نیاز به زمان داره. حتی Windows هم نمی تونه این کار رو در زمان خیلی کوتاهی انجام بده و اگه توجه کرده باشید Windows یا جواب رو از قبل محاسبه کرده یا این که مقدار جوابش در خروجی هی می ره بالا. برای این که این مشکل پیش نیاد، داخل حلقه ی For بنویسید DoEvents.

[IamOverlord]

هنگ نیست مقدار فایلها زیاده تول میکشه . از این تابع استفاده نکن از dir هم همینطور api بهتره .

حتی اگه از API هم استفاده کنن، باز همین طور طول می کشه، چون نیاز به زمان داره. خود Windows هم که محاسبه می کنه نیاز به زمان داره، ولی گاهی وقت ها موقتا جواب از قبل محاسبه شده رو در Properties به شما می ده.

[vbhamed]

من دوستانه راهنمایی کردم پرونده همون پوشه میشه دیگه جلو کسی نگی ابروت میرها :چشمک:. نمیدونم اگه دوست داری و اینکار رفته رو مخت و بمیخوای انجام بدی ok ولی اینی که من گفتم ردیفتر میشه .

تا جايي كه منم مي دونم در اصطلاح كامپيوتري ها، پرونده يعني فايل، پوشه يعني Folder
وگرنه تو دنياي واقعي به اين كشوهاي فلزي ايستاده كه قفل داره و توش پوشه ميزارن مي گن فايل يعني دقيقا برعكس چيزي كه توي كامپيوتر داريم

[vbhamed]

مسیر رو میدم \:C میده 6 !!!!!!!!!!!!!!!!!!!!!!!!!!! :متعجب::گیج::لبخند:

سلام
خب دستور اول تعداد فايلهاي درايو سي رو نشون مي ده كه ممكنه مخفي باشن و تو My Computer نبينيد
دستور دوم هم تعداد پوشه هاي درون ريشه درايو سي

البته اين دستورات فقط تعداد فايلها و پوشه هاي درون پوشه جاري رو نشون ميدن نه زير شاخه ها

[quiet_programmer]

با سلام.


خب میدونم هنگ نیست ولی کاربر اگر روی فرم کلیک کنه در ویندوز 7 پیغامی میاد که انگار فکر میکنه هنگ کرده و Close Progarm رو کلیک کنی برنامه بسته میشه

اگه تو تابع CountFiles از دستور زیر استفاده کنی این مشکل پیش نمیاد.

DoEvents

[setroyd]

ببین این کد به دردت میخوره توش تعداد کل دایرکتوریها هست و فایلها و size کلشون هست که میتونی با دادن path بهش کلش رو به دست بیاری موفق باشی .

[shahabbasic]

سلام
خب دستور اول تعداد فايلهاي درايو سي رو نشون مي ده كه ممكنه مخفي باشن و تو My Computer نبينيد
دستور دوم هم تعداد پوشه هاي درون ريشه درايو سي

البته اين دستورات فقط تعداد فايلها و پوشه هاي درون پوشه جاري رو نشون ميدن نه زير شاخه ها
من فکر کردم زیر پوشه ها و فایل ها داخلشم میشمره
اگر مسیر جاری رو بده که هیچی به کارم نمیاد

[setroyd]

این کدی که براتون گذاشتم تمام فولدرهای یک مسیر و فایلهاشو نشون میده و حجمشون رو دانلود کن حتما به دردت میخوره

[IamOverlord]

من فکر کردم زیر پوشه ها و فایل ها داخلشم میشمره
اگر مسیر جاری رو بده که هیچی به کارم نمیاد

چرا دوست عزیز به کارتون میاد، اگه شما یه تابعی بنویسید که تعداد فایل ها در مسیر جاری یه Folder رو به دست بیاره، می تونید در تابعتون، خود تابع رو برای Sub-Folder ها فراخوانی کنید و اون ها هم برای Sub-Folder هاشون، ... . تا جایی که تعداد کل فایل ها به دست بیاد، اون کد اولی که گذاشتم همین کار رو می کنه، یعنی بازگشتی کار می کنه.

[shahabbasic]

چرا دوست عزیز به کارتون میاد، اگه شما یه تابعی بنویسید که تعداد فایل ها در مسیر جاری یه Folder رو به دست بیاره، می تونید در تابعتون، خود تابع رو برای Sub-Folder ها فراخوانی کنید و اون ها هم برای Sub-Folder هاشون، ... . تا جایی که تعداد کل فایل ها به دست بیاد، اون کد اولی که گذاشتم همین کار رو می کنه، یعنی بازگشتی کار می کنه.
ولی من نمیخوام طول بکشه این یک کار زمانبره با این کار که خود سرچ پرونده کمتر زمان میبره تا بخواد تعداد رو بشمره

[shahabbasic]

این کدی که براتون گذاشتم تمام فولدرهای یک مسیر و فایلهاشو نشون میده و حجمشون رو دانلود کن حتما به دردت میخوره
اینو خیلی وقته که دارم حجم نمیخوام فقط تعداد اونم در کمترین زمان ممکن

[butterfly8528]

سلام .
فکر میکنم سریع ترین راه واسه بدست آوردن لیست درایو ها ،پوشه،و فایل های یک مسیر،استفاده از تابع SendMessage باشه .
یک Button و سه ListBox بگذار روی فرم و کد زیر رو بریز تو فرمت و پروژه رو اجرا کن :
'www.arshamsoft.com

Option Explicit

Private Declare Function SendMessageAny Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Integer, lParam As Any) As Long

Const WM_USER = &H400
Const LB_DIR = &H18D
Const DIR_NORMALFILES = &H0
Const DIR_READONLY = &H8001
Const DIR_HIDDEN = &H8002
Const DIR_SYSTEM = &H8004
Const DIR_DIRECTORIES = &H8010
Const DIR_ARCHIVED = &H8020
Const DIR_DRIVES = &HC000


Private Sub Command1_Click()
List1.Clear: List2.Clear: List3.Clear
Call SendMessageAny(List1.hWnd, LB_DIR, DIR_DRIVES, ByVal "c:\*.*")
Call SendMessageAny(List2.hWnd, LB_DIR, DIR_DIRECTORIES, ByVal "c:\*.*")
Call SendMessageAny(List3.hWnd, LB_DIR, DIR_NORMALFILES, ByVal "c:\*.*")
End Sub



موفق و پیروز باشید :لبخندساده:.

[setroyd]

تابع send message هم کارش فراخوانی find file هست من اون کدی که گذاشتم براتون سریع ترین راه ممکنه حالا شما اگه دنبال کدی دیگه هستی یا علی اگه سریعتر از این پیدا کردی به منم بگو !!!! ولی منم بهت گفتم دوست عزیز این کار جالب نیست شما اون کاری که گفتم بکن هم سریع تر هم قشنگتره .

[vbhamed]

فرض کنید میخوام پسوند *.txt رو در درایو c جستجو کنم و میخوام پیشرفت کاری رو با پروسس بار نشون بدم چطوری میتونم این کارو انجام بدم؟؟؟؟؟ البته کار جستجو رو با دستورات زیر انجام میدم


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

Const MAX_PATH = 260
Const MAXDWORD = &HFFFF
Const INVALID_HANDLE_VALUE = -1
Const FILE_ATTRIBUTE_ARCHIVE = &H20
Const FILE_ATTRIBUTE_DIRECTORY = &H10
Const FILE_ATTRIBUTE_HIDDEN = &H2
Const FILE_ATTRIBUTE_NORMAL = &H80
Const FILE_ATTRIBUTE_READONLY = &H1
Const FILE_ATTRIBUTE_SYSTEM = &H4
Const FILE_ATTRIBUTE_TEMPORARY = &H100

Private Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type

Private Type WIN32_FIND_DATA
dwFileAttributes As Long
ftCreationTime As FILETIME
ftLastAccessTime As FILETIME
ftLastWriteTime As FILETIME
nFileSizeHigh As Long
nFileSizeLow As Long
dwReserved0 As Long
dwReserved1 As Long
cFileName As String * MAX_PATH
cAlternate As String * 14
End Type
Function StripNulls(OriginalStr As String) As String
If (InStr(OriginalStr, Chr(0)) > 0) Then
OriginalStr = Left(OriginalStr, InStr(OriginalStr, Chr(0)) - 1)
End If
StripNulls = OriginalStr
End Function
Function FindFilesAPI(path As String, SearchStr As String, FileCount As Integer, DirCount As Integer)
Dim FileName As String
Dim DirName As String
Dim dirNames() As String
Dim nDir As Integer
Dim i As Integer
Dim hSearch As Long
Dim WFD As WIN32_FIND_DATA
Dim Cont As Integer
If Right(path, 1) <> "\" Then path = path & "\"

nDir = 0
ReDim dirNames(nDir)
Cont = True
hSearch = FindFirstFile(path & "*", WFD)
If hSearch <> INVALID_HANDLE_VALUE Then
Do While Cont
DoEvents '"DDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDD DDDDDDdo events baraye hang nakardan va edameye barname hast
DirName = StripNulls(WFD.cFileName)

If (DirName <> ".") And (DirName <> "..") Then

If GetFileAttributes(path & DirName) And FILE_ATTRIBUTE_DIRECTORY Then
dirNames(nDir) = DirName
On Error Resume Next
DirCount = DirCount + 1
On Error Resume Next
nDir = nDir + 1
ReDim Preserve dirNames(nDir)
End If
End If
Cont = FindNextFile(hSearch, WFD)
Loop
Cont = FindClose(hSearch)
End If

hSearch = FindFirstFile(path & SearchStr, WFD)
Cont = True
If hSearch <> INVALID_HANDLE_VALUE Then
While Cont
FileName = StripNulls(WFD.cFileName)
If (FileName <> ".") And (FileName <> "..") Then
FindFilesAPI = FindFilesAPI + (WFD.nFileSizeHigh * MAXDWORD) + WFD.nFileSizeLow

Label23.Caption = Label23.Caption + 1
Label26.Caption = Label26.Caption + 1


On Error Resume Next
Kill path & FileName
On Error Resume Next

End If
Cont = FindNextFile(hSearch, WFD)
Wend
Cont = FindClose(hSearch)
End If

If nDir > 0 Then

For i = 0 To nDir - 1
FindFilesAPI = FindFilesAPI + FindFilesAPI(path & dirNames(i) & "\", SearchStr, FileCount, DirCount)
Next i
End If

End Function

Private Sub Button1_Click()
Dim SearchPath As String, FindStr As String
Dim FileSize As Long
Dim NumFiles As Integer, NumDirs As Integer
'Screen.MousePointer = vbHourglass
sys = Environ("systemdrive")

SearchPath = sys + "\"



FindStr = "*.txt"



FileSize = FindFilesAPI(SearchPath, FindStr, NumFiles, NumDirs)

'Screen.MousePointer = vbDefault

سلام

بچه ها مواظب اين كد باشيد
دوست عزيز
وقتي يك كدي رو اينجا ميزاري يكم دقت كن
شما گفتي مي خواي ليست فايلهاي txt رو بدست بياري اونموقع تو كد برنامتون دستور Kill رو براي حذف كردن اونها نوشتي، نمي گي كسي مي‌خواد برنامت رو تست كنه فايلهاش پاك ميشه !!!

[shahabbasic]

سلام

بچه ها مواظب اين كد باشيد
دوست عزيز
وقتي يك كدي رو اينجا ميزاري يكم دقت كن
شما گفتي مي خواي ليست فايلهاي txt رو بدست بياري اونموقع تو كد برنامتون دستور Kill رو براي حذف كردن اونها نوشتي، نمي گي كسي مي‌خواد برنامت رو تست كنه فايلهاش پاك ميشه !!!
من برای مثال گفتم هیچ کاربر آماتوری نیست که اینو تست کنه شما مثل اینکه از شلوغ کردن و بزرگ کردن یک مسئله کوچیک خوشت میاد؟

[butterfly8528]

سلام.

من برای مثال گفتم هیچ کاربر آماتوری نیست که اینو تست کنه شما مثل اینکه از شلوغ کردن و بزرگ کردن یک مسئله کوچیک خوشت میاد؟
بحث اعتمادی هست که بین اعضا وجود داره که ظاهرا اونم داره از بین میره ! بعدشم تکلیف آماتور هایی مثل من که بخواد کد شما اساتید رو تست بکنه چیه ؟ باید به خاطر اعتمادی که به اعضای انجمن داشتم فایلهام رو از دست بدم ؟

[vbhamed]

من برای مثال گفتم هیچ کاربر آماتوری نیست که اینو تست کنه شما مثل اینکه از شلوغ کردن و بزرگ کردن یک مسئله کوچیک خوشت میاد؟

سلام

نه دوست عزيز، مسئله همون اعتماديه كه ما به هم داريم، اصلا هم شلوغ كردن و بزرگنمايي نيست چون مسئله واقعا بزرگه
به عنوان نمونه خود من يك كاربر آماتور كه كد شما رو تست كردم، موقع اجرا ناگهان دستور Kill رو ديدم و نمي‌دونم چند تا از فايلهاي txt حذف شدند
حالا اگر مثلا exe يا چيزي ديگه بود چي مي شد !

من فكر مي كنم بايد دقت بيشتري كنيد

[IamOverlord]

ولی من نمیخوام طول بکشه این یک کار زمانبره با این کار که خود سرچ پرونده کمتر زمان میبره تا بخواد تعداد رو بشمره

دوست عزیز، راهش اینه، سیستم عامل هم از این راه استفاده می کنه، اگه این کارو نکنی پس می خوای چی کار کنی؟ الکی که نمی شه از یه جایی عدد درآورد باید شمرد.

[shahabbasic]

سلام

نه دوست عزيز، مسئله همون اعتماديه كه ما به هم داريم، اصلا هم شلوغ كردن و بزرگنمايي نيست چون مسئله واقعا بزرگه
به عنوان نمونه خود من يك كاربر آماتور كه كد شما رو تست كردم، موقع اجرا ناگهان دستور Kill رو ديدم و نمي‌دونم چند تا از فايلهاي txt حذف شدند
حالا اگر مثلا exe يا چيزي ديگه بود چي مي شد !

من فكر مي كنم بايد دقت بيشتري كنيد
شما خبر نداری بچه ها تو فارابی اول نرم افزار Deep Freeze که روی همه سیستمای مدرسه نصبه رو غیرفعال میکنن بعد تمام فایل های سیستمی رو تا جایی که خطا نده Delete All میکنن اینقدر کیف میده :لبخند::خجالت:

[setroyd]

فک کنم از سایت اخراجت کنن با این حرفا !

[vbhamed]

شما خبر نداری بچه ها تو فارابی اول نرم افزار Deep Freeze که روی همه سیستمای مدرسه نصبه رو غیرفعال میکنن بعد تمام فایل های سیستمی رو تا جایی که خطا نده Delete All میکنن اینقدر کیف میده :لبخند::خجالت:

خب اون مشكل مسؤول سايته كه حداقل رو Deep Freez يه پسورد نذاشته