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

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

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

مشكور اخي الكريم

اخي نارت الكود يقوم باستخراج الرقم التسلسلي الاصلي للفلاش ميموري

وهو مشابة لهذا الكود


On Error GoTo ssx

Dim fso As Object

Dim dc As Object

Dim d As Object

Dim xx, xxx As String

Set fso = CreateObject("Scripting.FileSystemObject")

Set dc = fso.Drives

For Each d In dc

xx = d.DriveLetter

Next

xxx = fso.GetDrive(xx).serialnumber

MsgBox (xxx), vbInformation, "استخراج رقم الفلاش ميموري"

ssx:

If Err.Number = 71 Then

MsgBox "يرجى ادخال الفلاش ميموري", vbCritical + vbOKOnly, "استخراج رقم الفلاش ميموري"

End If

ولكن الفرق بي الكودين هو ان الكود الاول يعطيك رقم لا يتغير عند اجراء فورمات للفلاش ميموري

اما الكود الثاني الثاني فيعطيك رقم يتغير عند كل عملية فورمات

وجزيل الشكر سلفا لكل اخوتي

تم تعديل بواسطه nart lebzo
: لإحتواء الكود ضمن المعالج
  • 2 weeks later...
قام بنشر

إخوتي الفضلاء

أخي محمد أيمن

أرفق لك كود VBA يحقق ما تريد -على ما أظن- عموماً ، وفيما أعرف ، هذا أقصى ما يمكن إستخراجه من Win32_DiskDrive ، كانت رحلة طويلة ومتعبة ولكن أتمنى أن تكون مجدية لك ، فقد كانت غنية ومفيدة وممتعة بالنسبة لي ......

تفضل ... ووافني بالنتيجة .....


Dim objWMIService, objItem, colItems, strComputer

On Error Resume Next

strComputer = "."

Set objWMIService = GetObject("winmgmts:\\" _

& strComputer & "\root\cimv2")

Set colItems = objWMIService.ExecQuery("Select * from Win32_DiskDrive")

For Each objItem In colItems

MsgBox "Computer: " & objItem.SystemName & vbCr & _

"Status: " & objItem.Status & vbCr & _

" ==================================" & vbCr & _

"Name: " & objItem.Name & vbCr & _

"Description: " & objItem.Description & vbCr & _

"Signature: " & objItem.Signature & vbCr & _

"Manufacturer: " & objItem.Manufacturer & vbCr & _

"Model: " & objItem.Model & vbCr & _

"Size: " & Int(objItem.Size / (1073741824)) & " GB" & vbCr & _

"Number of Partitions: " & objItem.Partitions & vbCr & _

"Total Cylinders: " & objItem.TotalCylinders & vbCr & _

"Tracks PerCylinder: " & objItem.TracksPerCylinder & vbCr & _

"Total Heads: " & objItem.TotalHeads & vbCr & _

"Total Sectors: " & objItem.TotalSectors & vbCr & _

"Bytes PerSector: " & objItem.BytesPerSector & vbCr & _

"Sectors PerTrack: " & objItem.SectorsPerTrack & vbCr & _

"Total Tracks: " & objItem.TotalTracks & vbCr & _

"Total SerialNumber: " & objItem.SerialNumber & vbCr & _

" -------- DeviceID Info ---------- " & vbCr & _

"PNPDeviceID: " & objItem.PNPDeviceID

Next


والله من وراء القصد ... وهو حسبي

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

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

اخي نارت في البداية اسال الله عز وجل ان يجزيك الجنة وكل خير

اخي نارت اغبطك على خبرتك واتمنى ان يكون لدي 1 من 100000 من خبرتك

الكود يعمل بشكل صحيح ولكن هناك بعض التعديلات التي اريدها

اولا الكود يعطي رسالة لكافة الاقراص وهو يجب ان يعطي رسالة للقرص القابل للازالة فقط ( الفلاش ميموري )

ثانيا الكود يعطي رقم الفلاش كمايلي :

USBSTOR\DISK&VEN_GENERIC&PROD_USB_FLASH_DISK&REV_0.00\01AF0000000003EA&0

بينما يجب ان يعطي

01AF0000000003EA فقط

استخراج رقم الفلاش ميموري 2.rar

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

اخي نارت

تحية طيبة و بعد

جربت البرنامج اكثر من مرة و تبن لي انه لامشكلة من ظهور الرقم كاملا ( اقصد يمكن الاستغناء عن الطلب الثاني في المشاركة السابقة )

اما التعديل الاول ( امكانية البحث عن الاقراص القلابلة للازالة ) اذا كان ممكنا فيا حبذا واذا لم يكن ممكنا فلا مشكلة

واسال الله العلي العظيم ان يجزيك الجنة و كل خير

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

أخي محمد أيمن

تفضل ......


Dim objWMIService, objItem, colItems, strComputer, IDD

On Error Resume Next

strComputer = "."

Set objWMIService = GetObject("winmgmts:\\" _

& strComputer & "\root\cimv2")

Set colItems = objWMIService.ExecQuery("Select * from Win32_DiskDrive")

For Each objItem In colItems

If objItem.InterfaceType = "USB" Then

MsgBox "Computer: " & objItem.SystemName & vbCr & _

"Status: " & objItem.Status & vbCr & _

" ==================================" & vbCr & _

"Name: " & objItem.Name & vbCr & _

"Description: " & objItem.Description & vbCr & _

"Signature: " & objItem.Signature & vbCr & _

"Manufacturer: " & objItem.Manufacturer & vbCr & _

"Model: " & objItem.Model & vbCr & _

"Size: " & Int(objItem.Size / (1073741824)) & " GB" & vbCr & _

"Number of Partitions: " & objItem.Partitions & vbCr & _

"Total Cylinders: " & objItem.TotalCylinders & vbCr & _

"Tracks PerCylinder: " & objItem.TracksPerCylinder & vbCr & _

"Total Heads: " & objItem.TotalHeads & vbCr & _

"Total Sectors: " & objItem.TotalSectors & vbCr & _

"Bytes PerSector: " & objItem.BytesPerSector & vbCr & _

"Sectors PerTrack: " & objItem.SectorsPerTrack & vbCr & _

"Total Tracks: " & objItem.TotalTracks & vbCr & _

"Total SerialNumber: " & objItem.SerialNumber & vbCr & _

" -------- DeviceID Info ---------- " & vbCr & _

"PNPDeviceID: " & objItem.PNPDeviceID & vbCr & _

"InterfaceType: " & objItem.InterfaceType

End If

Next

والله من وراء القصد ... وهو حسبي

...........

انشئ حساب جديد او قم بتسجيل دخولك لتتمكن من اضافه تعليق جديد

يجب ان تكون عضوا لدينا لتتمكن من التعليق

انشئ حساب جديد

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

سجل حساب جديد

تسجيل دخول

هل تمتلك حساب بالفعل ؟ سجل دخولك من هنا.

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

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

Important Information