Kirjautuminen

Haku

Tehtävät

Kilpailu

Putka Open 2025
Alkuerät ovat ohi.

Keskustelu: Ohjelmointikysymykset: VB6: Visual Basic - CD/DVD asemat ja DriveListBox

Sivun loppuun

Happy [14.11.2007 13:29:35]

#

Eli onko DriveListBoxilla mahdollista saada vain käytettävissä olevat CD ja DVD asemat näkyviin, niin että kovalevy ja floppy ei näy "valikossa" ?

Vielä kiva yksityiskohta olisi jos saisi CD/DVD asemien malli - ym. tiedot näkyviin...

Esim.

D:HL-DT-DVDRAM GSA-4167B ATA DEVICE.
E:NO4067W BKB433Y SCSI CdRom DEVICE.

eikä näin tylsästi kuten:

D:
E:

KIITOS JO ETUKÄTEEN....!

neau33 [14.11.2007 19:41:45]

#

Heippa Happy!

tässä sulle purkkaviritelmä...

Private Sub Form_Load()

  'formille ComboBoxi & DirList kontrollit
  'combolle nimeksi: DriveListBox1

  'referenssi Microsoft Scripting Runtime
  Dim fso
  Set fso = New Scripting.FileSystemObject
  Dim drv As Scripting.Drive

  For Each drv In fso.Drives

    With drv

      If .DriveType = CDRom Then

        If .IsReady Then
          DriveListBox1.AddItem .Path & _
          "   Tyyppi: CD/DVD " & " Nimi: " & _
          .VolumeName & " Sarjanumero: " & _
          CStr(.SerialNumber)
        Else
          DriveListBox1.AddItem .Path & _
          "   Tyyppi: CD/DVD " & " Ei valmiina"
        End If

      End If

    End With

  Next drv

  Set fso = Nothing

  If DriveListBox1.ListCount > 0 Then
    DriveListBox1.ListIndex = 0
  End If

End Sub

Private Sub DriveListBox1_Click()

  If InStr(DriveListBox1.Text, "Ei valmiina") > 0 Then
    Dir1.Enabled = False: Dir1.Visible = False: Beep
  Else
    Dir1.Enabled = True: Dir1.Visible = True
    Dir1.Path = Left(DriveListBox1.Text, 2)
  End If

End Sub

Happy [15.11.2007 01:59:01]

#

KIITOS Nea !!!!!!!

Tulin just töistä ja olihan tätä vielä pakko kokeilla..... TOIMII :) !

Mutta saako noi CD/DVD aseman tiedot haettua esim. Järjestelmätiedoista?
Eli että se näyttäis CD/DVD aseman mallin, tyypin... (what ever), eikä asemassa olevan levyn tietoja.

Jos mahdollista... pystyykö jollain tunnistamaan tavallisen ja tallentavan aseman...?
(Noin ohimennen kysyisin, jos yrittäs joskus tehdä poltto ohjelmaa..)
Mutta näillä päästiin taas eteenpäin.

Kiitos vielä kerran -Nea- !

neau33 [15.11.2007 20:25:17]

#

Heippa taas Happy!

tässä sulle lisää purkkaviritelmää...

'formille ComboBoxi & DirList kontrollit
'combolle nimeksi: DriveListBox1

Option Explicit

Private Sub Form_Load()

  wmiInfo

End Sub

Private Sub wmiInfo()

  Dim CDRomAsemat As SWbemObjectSet
  Dim cdasema As SWbemObject

  ReDim tiedot(0 To 7, 0) As String
  Dim i As Integer, j As Integer
  Dim hlpStr As String, k As Integer


  'referenssi: Microsoft WMI Scripting V1.2 Library
  '(C:\WINDOWS\system32\wbem\wbemdisp.TLB)
  Set CDRomAsemat = GetObject _
  ("winmgmts:{impersonationLevel=impersonate}") _
  .InstancesOf("Win32_CDRomDrive")

  For Each cdasema In CDRomAsemat

    With cdasema

    ReDim Preserve tiedot(0 To 7, i)

      tiedot(0, i) = .Drive
      tiedot(2, i) = .Description
      tiedot(1, i) = .Name
      tiedot(3, i) = .DeviceID
      tiedot(4, i) = .Manufacturer
      tiedot(5, i) = .MediaLoaded
      tiedot(6, i) = .Status
      tiedot(7, i) = FormatNumber(.Size, 0)


   End With

   For i = 0 To UBound(tiedot, 1)

     For j = 0 To UBound(tiedot, 2)

       Select Case i

         Case 0 To 2

           If Len(tiedot(i, j)) > 0 Then
             hlpStr = hlpStr & tiedot(i, j)
           Else
             hlpStr = hlpStr & " - "
           End If

         Case 3

           If Len(tiedot(i, j)) > 0 Then

             If InStr(tiedot(i, j), "\") > 0 Then
               hlpStr = hlpStr & _
               Left(tiedot(i, j), InStr(tiedot(i, j), "\") - 1) _
               & " "
             Else
               hlpStr = hlpStr & " - "
             End If

           End If

         Case 4 To 6

           If Len(tiedot(i, j)) > 0 Then
             hlpStr = hlpStr & tiedot(i, j)
           Else
             hlpStr = hlpStr & " - "
          End If

         Case 7

           If Val(tiedot(i, j)) > 0 Then
             hlpStr = hlpStr & _
             Format$(CLng(tiedot(i, j)) / 1048576, "0.00") & " MB"
           Else
             hlpStr = hlpStr & " - "
           End If

      End Select

        If i <> 3 Then hlpStr = hlpStr & "  |  "

        'Mgbox tiedot(i, j)
        'MsgBox hlpStr

    Next j

   Next i

    i = i + 1

    DriveListBox1.AddItem hlpStr: hlpStr = ""

  Next

    Set levyasemat = Nothing

  If DriveListBox1.ListCount > 0 Then
    DriveListBox1.ListIndex = 0
  End If

End Sub

Private Sub DriveListBox1_Click()

  Select Case InStr(DriveListBox1.Text, "False")
    Case > 0
      Dir1.Enabled = False: Dir1.Visible = False: Beep
    Case Else
      If Mid(DriveListBox1.Text, 2, 1) = ":" Then
        Dir1.Enabled = True: Dir1.Visible = True
        Dir1.Path = Left(DriveListBox1.Text, 2)
      End If
  End Select

End Sub

-Nea-

neau33 [16.11.2007 00:51:15]

#

Heippa taas Happy!

pikku purkkakoodi lisäys vielä liittyen kysymykseesi: pystyykö jollain tunnistamaan tavallisen ja tallentavan aseman...?

Case 7

  If Val(tiedot(i, j)) > 0 Then
    hlpStr = hlpStr & _
    Format$(CLng(tiedot(i, j)) / 1048576, "0.00") & " MB"
  Else
    hlpStr = hlpStr & " - "
  End If

  ' lisää tänne ----------------------------------------------------

  'Koska osa laite/ajurivalmistajista ilmoittaa laitteen
  'R[l]W[/l]-ominaisuuksista suoraan Description-stringissä
  'ja jättävät siten usein ilmoituksen pois Capabilities-
  'taulukosta niin on aluksi tutkittava sisältyykö tieto jo
  'tässä vaiheessa apu-stringiin (hlpStr) ja jos ei löydy niin...***
  If InStr(hlpStr, "RW") = 0 And InStr(hlpStr, "R/W") = 0 Then

    ' tutkitaan löytyykö tieto Capabilities taulukosta
    ' nyt on sitten niin että valmistajien tyylit ilmoitella
    ' ominaisuuksista ko. taulukossa venyvät kuin kuminauha
    ' (tiedot pukataan/jätetään pukkaamatta taulukkoon)...
    For k = 0 To UBound(asema.capabilities)

        'elikä taulukon alkioita voi olla enempi tai vähempi,
        'mutta jos jokin alkio palauttaa arvon: 4 niin laitteen
        'pitäisi olla myös writeable elikä 'kirjoittava'.

        'tutkitaan taulukkoa silmukassa...
        If asema.capabilities(i) = 4 Then
            'mikäli tieto löytyy niin sijoitetaan tieto
            'apu-stringiin ja hypätään pois silmukastata
            hlpStr = hlpStr & "  |   RW ": Exit For
        End If
    Next k

    'jos tietoa ei löytynyt taulukostakaan niin  sijoitetaan
    'sitten tämä 'ReadOnly' tieto apustringiin...
    If InStr(hlpStr, "RW") = 0 Then
        hlpStr = hlpStr & "  |   RO "
    End If

    Else '*** mutta jos tieto löytyi jo alussa niin varmuuden
         'vuoksi sijoitetaan tieto vielä 'omaan' paikkaansa...
        hlpStr = hlpStr & "  |   RW "
    End If

  'väliin jäänyt pätkä ----------------------------------------------

End Select

lisäinfoa

neau33 [16.11.2007 08:01:40]

#

Bugi-Päivitys: eli siis levyasemat piti vaihtaa jokapaikassa -> CDRomAsemat
ja vastaavasti asema -> cdasema...

Happy [18.11.2007 15:37:34]

#

Moi Nea.

Tuohon koodiin oli kai tullu joku virhe?

 If InStr(hlpStr, "RW") = 0 And InStr(hlpStr, "R/W") = 0 Then

 For k = 0 To UBound(cdasema.capabilities)

 If cdasema.capabilities(i) = 4 Then

end if

Eli vaihdoin ton cdasema.capabilities(i) -> cdasema.capabilities(k)

Ilmoitti muuten että Run time error'2147352565(8002000b)

Nyt toimii :)

Vielä yksi juttu sekaa pakkaa. Virtuaali asemat.

Toi koodi kyllä löytää ne, mutta se ei suostu lukemaan "levyn" sisältöä.
Onnistuisiko virtuaali asemien sisällön lukeminen tai vieläparempi vaihtoehto olisi jos ne saisi kokonaan pois käytöstä ohjelman ajon ajaksi ja taas sitten käyttöön kun ohjelma lopetetaan.

Kiitti Nea.

neau33 [18.11.2007 20:49:25]

#

Heippa taas Happy!

siis ekaa lukuunottamatta noi edelliset viritykset on täysin syvältä...unohda ne!

Option Explicit

Private Sub Form_Load()
   wmiInfo
End Sub

Private Sub wmiInfo()

  Dim CDRomAsemat As SWbemObjectSet
  Dim cdasema As SWbemObject

  ReDim tiedot(0 To 7, 0) As String
  Dim i As Integer, j As Integer
  Dim k As Integer, l As Integer
  Dim hlpStr As String

  Set CDRomAsemat = GetObject _
  ("winmgmts:{impersonationLevel=impersonate}") _
  .InstancesOf("Win32_CDROMDrive")

  For Each cdasema In CDRomAsemat

  With cdasema

   ReDim Preserve tiedot(0 To 7, i)

   tiedot(0, i) = .Drive
   tiedot(2, i) = .Description
   tiedot(1, i) = .Name
   tiedot(3, i) = .DeviceID
   tiedot(4, i) = .Manufacturer
   tiedot(5, i) = .MediaLoaded
   tiedot(6, i) = .Status
   tiedot(7, i) = FormatNumber(.Size, 0)

   End With

   For j = 0 To UBound(tiedot, 1)

      Select Case j

        Case 0 To 2
          If Len(tiedot(j, i)) > 0 Then
            hlpStr = hlpStr & tiedot(j, i)
          Else
            hlpStr = hlpStr & " - "
          End If
        Case 3
          If Len(tiedot(j, i)) > 0 Then
            If InStr(tiedot(j, i), "\") > 0 Then
              hlpStr = hlpStr & _
              Left(tiedot(j, i), InStr(tiedot(j, i), "\") - 1) _
              & " "
            Else
            End If
          End If
        Case 4 To 6
          If Len(tiedot(j, i)) > 0 Then
            hlpStr = hlpStr & tiedot(j, i)
          Else
            hlpStr = hlpStr & " - "
          End If
        Case 7

          If Val(tiedot(j, i)) > 0 Then
            hlpStr = hlpStr & _
            Format$(CLng(tiedot(j, i)) / 1048576, "0.00") & " MB"
          Else
            hlpStr = hlpStr & " - "
          End If

          'poista nää kaks riviä, ja hipsu pois kaikista muista
          'niin virtuaali-jutskat ei oo mukana tässä kuviossa...
          Dim rw As Boolean ', wrl As Boolean
          rw = False ': wrl = False

          For k = 1 To Len(hlpStr)

            If UCase(Mid(hlpStr, k, 2)) = "RW" Or _
            UCase(Mid(hlpStr, k, 3)) = "R/W" Or _
            UCase(Mid(hlpStr, k, 5)) = "IMAGE" Or _
            UCase(Mid(hlpStr, k, 7)) = "VIRTUAL" Then

              'If UCase(Mid(hlpStr, k, 5)) = "IMAGE" Or _
              'UCase(Mid(hlpStr, k, 7)) = "VIRTUAL" Then
                'wrl = True
              'End If

              rw = True: Exit For

            End If

          Next k

          If Not rw Then

            For l = 0 To UBound(cdasema.capabilities)
              If cdasema.capabilities(k) = 4 Then
                hlpStr = hlpStr & "  |  " & " RW ": Exit For
              End If
            Next l

            If InStr(hlpStr, "RW") = 0 Then
              hlpStr = hlpStr & "  |  " & " RO "
            End If

          Else
            hlpStr = hlpStr & "  |  " & " RW "
          End If

      End Select

        If j <> 3 And j <> 7 Then _
        hlpStr = hlpStr & "  |  "

   Next j

    i = i + 1

   'If Not wrl Then
    DriveListBox1.AddItem hlpStr
   'End If
    hlpStr = ""

  Next

    Erase tiedot
    Set CDRomAsemat = Nothing

  If DriveListBox1.ListCount > 0 Then
    DriveListBox1.ListIndex = 0
  End If

End Sub

Private Sub DriveListBox1_Click()

  Select Case InStr(DriveListBox1.Text, "False")
    Case Is > 0
      Dir1.Enabled = False: Dir1.Visible = False: Beep
    Case Else
      If Mid(DriveListBox1.Text, 2, 1) = ":" Then
        Dir1.Enabled = True: Dir1.Visible = True
        Dir1.Path = Left(DriveListBox1.Text, 2)
      End If
  End Select

End Sub

-Nea-

Happy [19.11.2007 16:25:56]

#

Moi taas Nea!

Joo sain toimimaan pikku hinkkauksen jälkeen, MUTTA.....

Kun asemaan laittaa DVD-Levyn, antaa virheen Overflow.

Debuggasin koodia ..

hlpStr = hlpStr & _
            Format$(CLng(tiedot(j, i)) / 1048576, "0.00") & " MB"

toi "tiedot(j, i)" näyttää just niinku pitääkin, mutta jostain syystä se ei vissii "osaa" laskea...

Mitäs nyt tehdää ???

Onko joku muukin juttu DVD-asemille kuin toi "Win32_CDROMDrive" ?

----------------------------------------------------------------------

No nyt sain sen toimimaa...

muutin tuota koodia hiukan.

hlpStr = hlpStr & _
            Format$(CLng(tiedot(j, i)) / 1048576, "0.00") & " MB"

Otin ton CLng jutun pois eli ->

hlpStr = hlpStr & _
            Format$(tiedot(j, i) / 1048576, "0.00") & " MB"

Saapi nähdä tuleeko vielä jotain ongelmii ;)

neau33 [19.11.2007 19:44:47]

#

Heippa taas Happy!

Virhe johtui sulkuvirheestä (sori se k - l:ien välissä)...DVD-asemasta saat todennäköisesti Giga-tavuja, joten tässä vähän lisäviilattavaa

If tiedot(j, i) < 1073741824 Then
hlpStr = hlpStr & _
   Format$(CLng(tiedot(j, i) / 1048576), "0.00") & " MB"
Else
hlpStr = hlpStr & _
   Format$(CLng(tiedot(j, i) / 1073741824), "0.00") & " GB"
End If

Sivun alkuun

Vastaus

Aihe on jo aika vanha, joten et voi enää vastata siihen.

Tietoa sivustosta