اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

الردود الموصى بها

قام بنشر

بسم الله الرحمن الرحيم


والصلاة والسلام على أول الأنبياء وخاتم المرسلين سيدنا محمد ( صلى الله عليه وسلم  ) صلاةً الى يوم الدين

إخوانى وأحبابى وزملائى  وأساتذتى فى منتدانا العريق السلام عليكم ورحمة الله وبركاته
 
أما بعد

يشرفنى أن أقدم لحضراتكم ملفا به كود منقول أكثر من رائع هذا الكود يمكنه أن يظهر لك ما يأتى


1 - عدد البارتشنات فى الهارد ديسك


2 - نوع البارتشنات فى الهارد ديسك


3 - مساحة كل بارتشن والمساحة الكلية للهارد ديسك

4 - المساحة المستخدمة فى كل بارتشن والمساحة الكلية المستخدمة فى الهارد ديسك

5 -المساحة الفارغة فى كل بارتشن والمساحة الكلية الفارغة  فى الهارد ديسك


  6- اظهار المساحة الكلية و المستخدمة و الفارغة فى أى وحدات التخزين كالفلاشات المتصلة  بجهازك

 

طريقة استخام الملف : بسيطة  ضغطة زر فقط لا غير

ملحوظة 1: اعرف مساحة الهارديسك قبل وضع فلاشة وبعدها 

ملحوظة 2 : أى تغيير بالزيادة والنقص فى المساحات لديك يظهرها الكود بضغطة واحدة

 أتمنى أن تسعدوا به
 
لكم منى كل محبة وتقدير واحترام
 
والحمد لله تعالى من قبل ومن بعد

***************

Drives names Type Size SpaceFree etc.rar

  • Like 3
قام بنشر (معدل)

أستاذى ياسر اللى ما يسمعش كلام أستاذه يا ويله اسألنى أنا عن الموضوع ده . تحياتى

 

أستاذى الفاضل دغيدى شرفت بمروركم

امبارح وأنا بأسجل مشاركة للرد عليكم قطع النور وهذا سبب تأخرى فى الرد

أنا عندى win 7 - 32  بت ولم أجرب تشغيل الملف على النظام  win 7 - 64 وبحثت  عند بعض الأصدقاء عن  win 7 - 64  للتجربة فلم أجد

لذا أقترح على سيادتكم اذا كان الملف لا يعمل مع النظام  win 7 - 64  تغيير المكتبة kernel32 التى نستدعيها فى الكود الى kernel64 .

هذا على حد علمى والله أعلى وأعلم . لابد أن هناك طريقة لتحويل التصريحات فى الكود لكى تعمل مع kernel64 وهذا لا أعلمه .

واسمح لى بنصيحة من تلميذك لك ولكل الزملاء :  

  إن أمكن   فرد تسختى ويندوز مختلفتين على الجهاز الواحد . ( مثلا على جهازى win xp sp3  ,win 7 - 32 )

مع خالص تقديرى واحترامى لشخصكم الكريم .

 

 

أستاذ زيزو بارك الله فيكم وسعدت وشرفت بمروركم الكريم

 

أخى ياسر فتحى بارك الله فيك . أسال الله تعالى أن يوفقنا فى رد الجميل لمنتدانا 

تم تعديل بواسطه مختار حسين محمود
  • 1 month later...
قام بنشر (معدل)

السلام عليكم ورحمة الله وبركاته

اخوانى الكود فى المرفق السابق يعمل مع ويندوز 32   ولا يعمل مع ويندوز 64

الحمد لله وصلت الى التعديل المناسب بمساعدة Mr. Jan Karel Pieterse

 

لكى يعمل الكود مع الأخوة الذين يعملون على ويندوز 64  برجاء تجربة الكود التالى واخبارى بالنتيجة

Option Explicit
 
#If VBA7 Then
    Private Declare PtrSafe Function GetDriveType Lib "kernel32" Alias _
    "GetDriveTypeA" (ByVal sDrive As String) As LongPtr
    Private Declare PtrSafe Function GetDiskFreeSpaceEx Lib "kernel32" Alias _
    "GetDiskFreeSpaceExA" (ByVal lpDirectoryName As String, _
    lpFreeBytesAvailableToCaller As Currency, lpTotalNumberOfBytes As _
    Currency, lpTotalNumberOfFreeBytes As Currency) As LongPtr
#Else
    Private Declare Function GetDriveType Lib "kernel32" Alias _
    "GetDriveTypeA" (ByVal sDrive As String) As Long
    Private Declare Function GetDiskFreeSpaceEx Lib "kernel32" _
    Alias "GetDiskFreeSpaceExA" (ByVal lpDirectoryName As String, _
    lpFreeBytesAvailableToCaller As Currency, _
    lpTotalNumberOfBytes As Currency, _
    lpTotalNumberOfFreeBytes As Currency) As Long
#End If
 
Function DriveSize(DriveLetter As String) As String
    #If VBA7 Then
        Dim Status As LongPtr
    #Else
        Dim Status As Long
    #End If
    Dim TotalBytes As Currency
    Dim FreeBytes As Currency
    Dim BytesAvailableToCaller As Currency
    Status = GetDiskFreeSpaceEx(DriveLetter & ":\", _
    BytesAvailableToCaller, TotalBytes, FreeBytes)
    If Status <> 0 Then
        DriveSize = TotalBytes * 10000
    Else
        DriveSize = ""
    End If
End Function
Function DriveSpaceFree(DriveLetter As String) As String
    #If VBA7 Then
        Dim Status As LongPtr
    #Else
        Dim Status As Long
    #End If
    Dim TotalBytes As Currency
    Dim FreeBytes As Currency
    Dim BytesAvailableToCaller As Currency
    Status = GetDiskFreeSpaceEx(DriveLetter & ":\", _
    BytesAvailableToCaller, TotalBytes, FreeBytes)
    If Status <> 0 Then
        DriveSpaceFree = FreeBytes * 10000
    Else
        DriveSpaceFree = ""
    End If
End Function
Function DriveType(DriveLetter As String) As String
     '   Returns a string that describes the type of drive of DriveLetter
    DriveLetter = Left(DriveLetter, 1) & ":\"
    Select Case GetDriveType(DriveLetter)
    Case 0: DriveType = "Unknown"
    Case 1: DriveType = "Non-existent"
    Case 2: DriveType = "Removable drive"
    Case 3: DriveType = "Fixed drive"
    Case 4: DriveType = "Network drive"
    Case 5: DriveType = "CD-ROM drive"
    Case 6: DriveType = "RAM disk"
    Case Else: DriveType = "Unknown drive type"
    End Select
End Function
Sub ShowAllDrives()
    Dim LetterCode As Long
    Dim Row As Long
    Dim DT As String
    Range("A1:D1") = Array("Drive", "Type", "Total Bytes", "Free Bytes")
    Row = 2
    For LetterCode = 65 To 90
        DT = DriveType(Chr(LetterCode))
        If DT <> "Non-existent" Then
            Cells(Row, 1) = Chr(LetterCode) & ":\"
            Cells(Row, 2) = DT
            Cells(Row, 3) = DriveSize(Chr(LetterCode))
            Cells(Row, 4) = DriveSpaceFree(Chr(LetterCode))
            Row = Row + 1
        End If
    Next LetterCode
End Sub


أرجو من الأخوة الذين يعملون على ويندوز 64  اخبارى بالنتيجة   تقبل الله منا ومنكم صالح الأعمال

تم تعديل بواسطه مختار حسين محمود
قام بنشر

أشكرك أخى وأستاذى العزيز 

 

ربنا يكرمنا بحد يكون عنده  64  وإلا ......ولا أقولك  بلاش نصبر شويه

 

حاولت أبعت على الخاص بتاع أستاذنا  دغيدى  لقيته مغلق لأنه أول من طلب ذلك ولا أعرف كيف أبلغه

 

تحياتى لك

قام بنشر

أخى الكريم /  مختار حسن محمود

سلام الله عليكم

أشكركم على تذكركم لطلبى وهو طلب عام لأخوة كثر

الكود يعمل بشكل جيد .

استفسار مهم :

كيف نستفيد من هذا الكود لنضعة فى كود خاص بـ 32 لتحويله لـ 64

 

شكرا

مرفق ملف به كود نظام 64

Drives names Type Size SpaceFree etc.rar

post-27378-0-95432200-1429939044.gif

قام بنشر (معدل)

الحمد لله أستاذى الفاضل أننا توصلنا الى ذلك

 

 

حقيقةً سيدى الفاضل لم أتمكن بنفسى من التعديل وانما بمساعدة  Mr. Jan Karel Pieterse

أحد مطورى شركة مايكروسوفت .الرجل أعطانى رابط  فى موقعه الخاص :

http://www.jkp-ads.com/articles/apideclarations.asp

 

وبصراحة أنا خدتها من قصيرها وطلبت منه التعديل

عشان أضمن ازاى بيحوّل التصريحات لكى تعمل فى ويندوز 32 و 64  ولم يتأخر الرجل مشكورا .

وبإذن الله  سأحاول فى الفترة القادمة إزاى تم تحويل تصريحات تعمل فى 32 الى تصريحات تعمل فى 32 و64 طبقا للرابط المذكور.

ويبدو أن كلمة السر عند مايكروسوفت فى التعديل الذى أصدرته لـ Win32API.txt  

هذا التعديل هو Office2010Win32API_PtrSafe  حسب ما فهمته من الرابط المذكور

 

ملحوظة : مرفق حضرتك بعمل على  win_ 32 bit  and win_64 bit

 

تحياتى لك

Win32API_PtrSafe.rar

تم تعديل بواسطه مختار حسين محمود
  • Thanks 1
قام بنشر

أخى الكريم /  مختار حسن محمود

سلام الله عليكم

أشكركم على المتابعة

 

 

 

 

لكم منى

post-27378-0-11495700-1429970865.gif

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information