با سلام و خسته نباشید
من یه سوال داشتم از خدمت عزیزان
من یک عکس تو فایل ریسورس دارم که می خوام بریزم توی پوشه برای مثال Aks
حالا ممکنه این پوشه توی درایو C باشه . ممکنه توی درایو D باشه .
این شناخت رو چطوری توی برنامه اعمال کنم؟ ممنون از کمک:قلب:
Printable View
با سلام و خسته نباشید
من یه سوال داشتم از خدمت عزیزان
من یک عکس تو فایل ریسورس دارم که می خوام بریزم توی پوشه برای مثال Aks
حالا ممکنه این پوشه توی درایو C باشه . ممکنه توی درایو D باشه .
این شناخت رو چطوری توی برنامه اعمال کنم؟ ممنون از کمک:قلب:
سلام علیکم
برای استخراج فایل تصویرتون از ریسورس باید از تابع LoadResPicture استفاده کنین، این تابع با دریافت شماره ID تصویر مورد نظر، تصویر را از ریسورس استخراج میکند؛ نمونه کد زیر تصویر شما را از ریسورس در یک مسیر مشخص شده در هارددیسک ذخیره میکند
SavePicture LoadResPicture(101, 0), "C:\Aks\MyPicture.bmp"
عدد 101 هم ID تصویرتون هست که اگه "VB Resource Editor" رو باز کنین و رو تصویرتون دابل کلیک کنین میتونین IDشو مشاهده کنین
موفق باشید
یاعلی
میدونم داداش این هارو
می خوام فایل رو بریزم توی پوشه aks
حالا احتمال میدم این پوشه توی درایو C یا D باشه . چطوری بفهمم این پوشه کجاست و یعد از فهمیدن فایل رو بریزم توی اون پوشه
پس ببخشین که کمی مبتدی جوابتون رو دادم، البته نحوی پرسشتون باعث شدنقل قول:
نوشته شده توسط Snoopboy
بهر حال...
اینگونه که بنده از سوالتون برداشت کردم شما میخواین بدونین قبل از کپی آیا پوشه ای بنام Aks در درایو مشخص شده وجود دارد یا خیر که در صورت وجود فایل تصویرتون کپی بشه (اگه اینگونه نیست مجددا بفرمائید)
برای اینکار میتونین از دستورات و APIز یر استفاده کنین (البته با دستور Dir هم میشود برای تشخیص موجودیت یک فایل استفاده کرد ولی این API تخصصی تره)
Private Declare Function PathFileExists Lib "shlwapi.dll" Alias "PathFileExistsA" (ByVal pszPath As String) As Long
Private Sub Command1_Click()
Dim Drvs$(1), Cur_Drv As Variant
Drvs$(0) = "C:\"
Drvs$(1) = "D:\"
For Each Cur_Drv In Drvs$
If CBool(PathFileExists(Cur_Drv & "\Aks")) = True Then
'Copy your resource commands
MsgBox "Found target in the " & Cur_Drv & " drive..."
End If
Next Cur_Drv
End Sub
موفق باشید
ممنون جناب . دنبال همچین چیزی می گشتم .
حالا یک سوال ما این رو برای 2 تا درایو نوشتیم . حالا ممکنه خودش همه درایو ها روئ به دست بیاره و چک کنه؟
اگه ممکنه اون قسمت به جای msg box کد خود load az فایل res رو بگذارید چون من امتحان کردم با دستور load مسکل داشت
اون کد بالا رو بصورت زیر ویرایش کردم؛ فقط اولش یه DriveControl رو به فرم برنام تون اضافه کنین چون عملیات تست درایوها از رو اون کنترل انجام میشه؛ البته با API هم میشه اما فعلا از این کنترل استفاده کردم)
Private Declare Function PathFileExists Lib "shlwapi.dll" Alias "PathFileExistsA" (ByVal pszPath As String) As Long
Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long
Private Sub Command1_Click()
Dim Cur_Drv$, i
Drive1.Refresh
For i = 1 To Drive1.ListCount - 1
MsgBox Left(Drive1.List(i), 2)
Cur_Drv$ = Left(Drive1.List(i), 2)
If CBool(PathFileExists(Cur_Drv$ & "\Aks")) = True Then
If GetDriveType(Cur_Drv$) = 3 Then '3: HDD Drive value
SavePicture LoadResPicture(101, 0), Cur_Drv$ & "\Aks\MyPicture.bmp"
End If
End If
Next i
MsgBox "Finished...", vbInformation
End Sub
همچنین یه فایل ریسورس هم لازمه تا خطا نده؛ البته خودتون بهتر واردین
موفق باشید
ممنون آقا محسن ولی به get Drive type گیر میده . کد ها رو جابه جا کردم ولی باز گیر میده
واقعا ببخشید یادم رفت api هارو هم ضمیمه کنم
مجددا پست رو ویرایشش کردم
مشکلی بود در خدمتیم
موفق باشید
آقا محسن عالی شد . خیلی خوب شد ولی یه مشگلی که من متوجه شدم اینه که مثلا از پوشه به نام Aks
این پوشه هم در درایو D مثلا دارم و هم در درایو G
برنامه بعد از کپی کردن در درایو اولی دیگه نمی رسه به درایو G و اررور میده
میتونین متن error رو پست کنین چون دستورات بالا رو تست کردم اما به مشکلی بر نخوردم و با موفقیت انجام شد
Path Not Found
برای اینه که مثلا توی درایو C پوشه Aks هست توی درایو E پوشه Aks هم هست
بعد از کپی توی درایو C میره به درایو D ولی چون همچین پوشه توی درایو D نیست اررور میده. اگه ممکنه این مسیر رو رد کنه و بره به درایو بعدی رو جسنجو کنه
خب اگه هندل خطا رو غیرفعال کنین دیگه نباید مشکلی باشه؛
چطوری این کار رو بکنم . هر کاری می کنم . نمیشه . اگه ممکنه روی کد توضیح بدید
همین دستور پست قبله فقط هندل خطا داخلش غیرفعال شده
Private Declare Function PathFileExists Lib "shlwapi.dll" Alias "PathFileExistsA" (ByVal pszPath As String) As Long
Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long
Private Sub Command1_Click()
On Error Resume Next
Dim Cur_Drv$, i
Drive1.Refresh
For i = 1 To Drive1.ListCount - 1
MsgBox Left(Drive1.List(i), 2)
Cur_Drv$ = Left(Drive1.List(i), 2)
If CBool(PathFileExists(Cur_Drv$ & "\Aks")) = True Then
If GetDriveType(Cur_Drv$) = 3 Then '3: HDD Drive value
SavePicture LoadResPicture(101, 0), Cur_Drv$ & "\Aks\MyPicture.bmp"
End If
End If
Next i
MsgBox "Finished...", vbInformation
End Sub
موفق باشید
یاعلی
این کار رو کردم ولی اینطوری رد می کنه بدون اینکه فایل رو کپی کنه. اینطوری فقط می خونه عمل رو انجام نمیده
می خوام که توی هر مسیر که همچین پوشه این بود فایل رو کپی کنه
باورتنون میشه این کده تو سیستم ویندوز من هیچ مشکلی نداره
البته میتونه مشکل از جای دیگه باشه مثلا id اشتباه وارد کرده باشید
این کدا رو سورس کردم اول همین سورسه رو روی ویندوز خودتون تست کنین ببینین error میده یا نه (داخل ویندوز خودم تستش کردم موفق بود)؛ بعد با کدا تون مقایسش کنین ببینین مشکل از کجاست
موفق باشید
کد این قسمت رو نداشت اول
AllCopings$ = AllCopings$ & Cur_Drv$ & "\Aks" & vbNewLine
این رو باید اضافه می کردیم
نه این کدا رو فقط برای گزارش کار گذاشتم که بعد از اتمام عملیات مطلع بشیم که فایلمون در کجا و کجا extract شدهنقل قول:
نوشته شده توسط Snoopboy
در صورت تمایل میتونین این کد رو غیرفعالش کنین
درواقع هیچ تغییری رو در کدا اعمال نکرده ام
این تغییراتی که دیدن هم واسه این بود که چون کدا رو سورسش کردم خواستم یه کمی عملیات واستون واضح تر باشه
موفق باشید