(تمت الاجابة) تحويل كود من vb.net الى vba

[محمد ايمن]

اصدقائي الاعزاء

هل يمكن تحويل كود من لغة vb.net الى vba

vb.net.txt

[أبو آدم]

ممكن توضيح الغاية من الكود الذي تبحث عنه !!! ... لإصدقائك ولن يبخلوا عليك بما لديهم ...

............

[محمد ايمن]

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

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

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

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

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

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

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

تم تعديل مارس 30, 2012 بواسطه nart lebzo
: لإحتواء الكود ضمن المعالج

[محمد ايمن]

هل من جديد ؟؟؟

تم تعديل أبريل 2, 2012 بواسطه aimanano

[محمد ايمن]

هل يستطيع الاكسسز عمل مثل هذا ام لا ؟

[أبو آدم]

قيد النظر ......

..................

[محمد ايمن]

هل من جديد

[أبو آدم]

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

أخي محمد أيمن

أرفق لك كود 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

تم تعديل أبريل 19, 2012 بواسطه محمد ايمن

[محمد ايمن]

اخي نارت

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

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

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

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

تم تعديل أبريل 20, 2012 بواسطه محمد ايمن

[أبو آدم]

أخي محمد أيمن

تفضل ......

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

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

...........

[محمد ايمن]

والله يا استاذي يعجز لساني عن شكرك ولم اعد اجد كلمات لمدحك بها

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

[أبو آدم]

الحمدلله الذي بفضله تقضى الحاجات

(تمت الاجابة)