مشگل در فراخوانی از فایل ریسورس

[Snoopboy]

با سلام و خسته نباشید
من یه سوال داشتم از خدمت عزیزان
من یک عکس تو فایل ریسورس دارم که می خوام بریزم توی پوشه برای مثال Aks
حالا ممکنه این پوشه توی درایو C باشه . ممکنه توی درایو D باشه .
این شناخت رو چطوری توی برنامه اعمال کنم؟ ممنون از کمک

[محسن واژدی]

سلام علیکم
برای استخراج فایل تصویرتون از ریسورس باید از تابع LoadResPicture استفاده کنین، این تابع با دریافت شماره ID تصویر مورد نظر، تصویر را از ریسورس استخراج میکند؛ نمونه کد زیر تصویر شما را از ریسورس در یک مسیر مشخص شده در هارددیسک ذخیره میکند

    SavePicture LoadResPicture(101, 0), "C:\Aks\MyPicture.bmp"

عدد 101 هم ID تصویرتون هست که اگه "VB Resource Editor" رو باز کنین و رو تصویرتون دابل کلیک کنین میتونین IDشو مشاهده کنین

موفق باشید
یاعلی

[Snoopboy]

میدونم داداش این هارو
می خوام فایل رو بریزم توی پوشه aks
حالا احتمال میدم این پوشه توی درایو C یا D باشه . چطوری بفهمم این پوشه کجاست و یعد از فهمیدن فایل رو بریزم توی اون پوشه

[محسن واژدی]

میدونم داداش این هارو
می خوام فایل رو بریزم توی پوشه aks
حالا احتمال میدم این پوشه توی درایو C یا D باشه . چطوری بفهمم این پوشه کجاست و یعد از فهمیدن فایل رو بریزم توی اون پوشه

پس ببخشین که کمی مبتدی جوابتون رو دادم، البته نحوی پرسشتون باعث شد
بهر حال...
اینگونه که بنده از سوالتون برداشت کردم شما میخواین بدونین قبل از کپی آیا پوشه ای بنام 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

موفق باشید

[Snoopboy]

ممنون جناب . دنبال همچین چیزی می گشتم .
حالا یک سوال ما این رو برای 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

همچنین یه فایل ریسورس هم لازمه تا خطا نده؛ البته خودتون بهتر واردین

موفق باشید

[Snoopboy]

ممنون آقا محسن ولی به get Drive type گیر میده . کد ها رو جابه جا کردم ولی باز گیر میده

[محسن واژدی]

واقعا ببخشید یادم رفت api هارو هم ضمیمه کنم
مجددا پست رو ویرایشش کردم
مشکلی بود در خدمتیم

موفق باشید

[Snoopboy]

آقا محسن عالی شد . خیلی خوب شد ولی یه مشگلی که من متوجه شدم اینه که مثلا از پوشه به نام Aks
این پوشه هم در درایو D مثلا دارم و هم در درایو G
برنامه بعد از کپی کردن در درایو اولی دیگه نمی رسه به درایو G و اررور میده

[محسن واژدی]

میتونین متن error رو پست کنین چون دستورات بالا رو تست کردم اما به مشکلی بر نخوردم و با موفقیت انجام شد

[Snoopboy]

Path Not Found
برای اینه که مثلا توی درایو C پوشه Aks هست توی درایو E پوشه Aks هم هست
بعد از کپی توی درایو C میره به درایو D ولی چون همچین پوشه توی درایو D نیست اررور میده. اگه ممکنه این مسیر رو رد کنه و بره به درایو بعدی رو جسنجو کنه

[محسن واژدی]

خب اگه هندل خطا رو غیرفعال کنین دیگه نباید مشکلی باشه؛

[Snoopboy]

چطوری این کار رو بکنم . هر کاری می کنم . نمیشه . اگه ممکنه روی کد توضیح بدید

[محسن واژدی]

همین دستور پست قبله فقط هندل خطا داخلش غیرفعال شده

  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

موفق باشید
یاعلی

[Snoopboy]

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

[محسن واژدی]

باورتنون میشه این کده تو سیستم ویندوز من هیچ مشکلی نداره
البته میتونه مشکل از جای دیگه باشه مثلا id اشتباه وارد کرده باشید
این کدا رو سورس کردم اول همین سورسه رو روی ویندوز خودتون تست کنین ببینین error میده یا نه (داخل ویندوز خودم تستش کردم موفق بود)؛ بعد با کدا تون مقایسش کنین ببینین مشکل از کجاست

موفق باشید

[Snoopboy]

کد این قسمت رو نداشت اول
AllCopings$ = AllCopings$ & Cur_Drv$ & "\Aks" & vbNewLine
این رو باید اضافه می کردیم

[محسن واژدی]

کد این قسمت رو نداشت اول
AllCopings$ = AllCopings$ & Cur_Drv$ & "\Aks" & vbNewLine
این رو باید اضافه می کردیم

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

موفق باشید