maskinvare kommandoer

[andesam]

Finnes det noen kommandoer i BASIC språket som gjør at f.eks cd rommen åpner seg? eller skrur av dataen..

 

Er nuub i basic

[aadnk]

For å avslutte windows (støtter NT), legg følgende kode i en modul. Dette gjør du ved å velge Project i menyen og så trykke Add module. Lim så hele denne koden inn:

 

Option Explicit

Private Declare Function GetCurrentProcess Lib "kernel32" () As Long
Private Declare Function OpenProcessToken Lib "advapi32" (ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, TokenHandle As Long) As Long
Private Declare Function LookupPrivilegeValue Lib "advapi32" Alias "LookupPrivilegeValueA" (ByVal lpSystemName As String, ByVal lpName As String, lpLuid As LUID) As Long
Private Declare Function AdjustTokenPrivileges Lib "advapi32" (ByVal TokenHandle As Long, ByVal DisableAllPrivileges As Long, NewState As TOKEN_PRIVILEGES, ByVal BufferLength As Long, PreviousState As TOKEN_PRIVILEGES, ReturnLength As Long) As Long
Private Declare Function ExitWindowsEx Lib "user32" (ByVal uFlags As Long, ByVal dwReserved As Long) As Long
Private Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (ByRef lpVersionInformation As OSVERSIONINFO) As Long

Private Const TOKEN_ADJUST_PRIVILEGES = &H20
Private Const TOKEN_QUERY = &H8
Private Const SE_PRIVILEGE_ENABLED = &H2
Private Const ANYSIZE_ARRAY = 1
Private Const VER_PLATFORM_WIN32_NT = 2
Private Const EWX_FORCE = 4

Type LUID
   LowPart As Long
   HighPart As Long
End Type

Type LUID_AND_ATTRIBUTES
   pLuid As LUID
   Attributes As Long
End Type

Type TOKEN_PRIVILEGES
   PrivilegeCount As Long
   Privileges(ANYSIZE_ARRAY) As LUID_AND_ATTRIBUTES
End Type

Type OSVERSIONINFO
   dwOSVersionInfoSize As Long
   dwMajorVersion As Long
   dwMinorVersion As Long
   dwBuildNumber As Long
   dwPlatformId As Long
   szCSDVersion As String * 128
End Type

Enum ActionContants
EWX_LOGOFF = 0
EWX_SHUTDOWN = 1
EWX_REBOOT = 2
End Enum

Public Function IsWinNT() As Boolean

   Dim myOS As OSVERSIONINFO
   
   myOS.dwOSVersionInfoSize = Len(myOS)
   GetVersionEx myOS
   IsWinNT = (myOS.dwPlatformId = VER_PLATFORM_WIN32_NT)
   
End Function

Private Sub EnableShutDown()

   Dim hProc As Long
   Dim hToken As Long
   Dim mLUID As LUID
   Dim mPriv As TOKEN_PRIVILEGES
   Dim mNewPriv As TOKEN_PRIVILEGES
   
   hProc = GetCurrentProcess()
   OpenProcessToken hProc, TOKEN_ADJUST_PRIVILEGES + TOKEN_QUERY, hToken
   
   LookupPrivilegeValue "", "SeShutdownPrivilege", mLUID
   mPriv.PrivilegeCount = 1
   mPriv.Privileges(0).Attributes = SE_PRIVILEGE_ENABLED
   mPriv.Privileges(0).pLuid = mLUID

   AdjustTokenPrivileges hToken, False, mPriv, 4 + (12 * mPriv.PrivilegeCount), mNewPriv, 4 + (12 * mNewPriv.PrivilegeCount)

End Sub

Public Sub ExitWindows(Action As ActionConstants, Force As Boolean)

   Dim ret As Long
   Dim Flags As Long
   
   Flags = Action
   
   If Force Then Flags = Flags + EWX_FORCE
   If IsWinNT Then EnableShutDown
   
   ExitWindowsEx Flags, 0
   
End Sub

 

Du kan nå avslutte windows med følgende koder:

 

Logger windows av:

 

ExitWindows EWX_LOGOFF, False

 

Restarter datamaskinen:

 

ExitWindows EWX_REBOOT, False

 

Slår av datamaskinen

 

ExitWindows EWX_SHUTDOWN, False

 

 

Bruk denne koden for å åpne/lukke CD-rommen (legg det inn i første-formens kode vindu):

 

Private Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long

Public Sub EjectCdDoor()
' Lukker cd-rom døra
   mciSendString ("Set CDAudio Door Open Wait"), 0&, 0&, 0&
End Sub
Public Sub CloseCdDoor()
' Åpner cd-rom døra
   mciSendString ("Set CDAudio Door Closed Wait"), 0&, 0&, 0&
End Sub

 

Alt du nå trenger å gjøre er å skrive inn navnet på den relevante prosedyren for å åpne eller lukke CD-rommen.

[timtowtdi]

Finnes det en tilsvarende måte å disable eject knappen på cd-brenneren og dvd-leseren på?

 

Har en 1 år gammel baby som synes det er veldig gøy å trykke på disse knappene, og det går fint inntil hun en dag begynner å heise seg opp etter skuffene! Selvfølgelig er disse knappene svært interessante fordi det skjer noe når man trykker på de, hun slekter i høy grad på sin far

 

Vil derfor helst disable disse knappene slik at jeg kan bruke høyreklikk-eject fra windows istedetfor.

 

Er ikke helt grønn på VB, men har liten erfaring med HW kall.

 

timtowtdi

[ratata]

ikkje viet eg, men du kan prøva Vbcode.com gjer eit lite søk så finn du kanskje noko

[endrebjo]

End Sub

 

Public Sub ExitWindows(Action As ActionConstants, Force As Boolean)

 

  Dim ret As Long

  Dim Flags As Long

 

  Flags = Action

 

  If Force Then Flags = Flags + EWX_FORCE

  If IsWinNT Then EnableShutDown

 

  ExitWindowsEx Flags, 0

 

End Sub

Mener du ActionContants eller AlignConstants?

[Jonas]

Orker ikke å teste koden, men jeg regner med han mener ActionContants, siden det står helt øverst i koden.

[endrebjo]

Fant ut av det, det funker med ActionContants

[JonH]

Du kan jo ta en titt på disse:

 

CD/DVD

Locking Removable Media Devices Using DeviceIoControl

Loading and Ejecting Removable Media Using DeviceIoControl

Ejecting Media from a CDROM

Detects when a CD/DVD is inserted or removed from the drive

 

Shutdown

How to Shut Down, Reboot, Log Off or Power Off using ExitWindowsEx

Terminating Remote Windows Sessions with InitiateSystemShutdown

Herunterfahren des Systems abbrechen (prevent system shutdown)

Den siste linken er på tysk, men koden er forståelig.

 

Noen subclassing-tutorials:

vb-helper

developerfusion

 

Håper dette var til hjelp. Begynner å bli dreven i VB, og det er utrolig hva man kan få til!

 

Når jeg først er inne på en tråd med tittelen "maskinvare kommandoer"...

Direct read/write disk access går nokså langt når det gjelder tilgang til hardware, men er det noen som vet om disk defragmenting er mulig i VB?

Endret 12. desember 2004 av JonH

[svamp]

Bruk denne koden for å åpne/lukke CD-rommen (legg det inn i første-formens kode vindu):

 

Private Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long

Public Sub EjectCdDoor()
' Lukker cd-rom døra
   mciSendString ("Set CDAudio Door Open Wait"), 0&, 0&, 0&
End Sub
Public Sub CloseCdDoor()
' Åpner cd-rom døra
   mciSendString ("Set CDAudio Door Closed Wait"), 0&, 0&, 0&
End Sub

 

Alt du nå trenger å gjøre er å skrive inn navnet på den relevante prosedyren for å åpne eller lukke CD-rommen.

Hva skjer om du legger åpne-lukke kodene inn i en løkke og looper denne f.eks 100 ganger?

[endrebjo]

F.eks?

Dim Tell As Long

Do Until Tell = 100
  If Tell Mod 2 = 0 Then
      ' Tallet er et partall
      mciSendString ("Set CDAudio Door Open Wait"), 0&, 0&, 0&
  Else
      ' Tallet er et oddetall
      mciSendString ("Set CDAudio Door Closed Wait"), 0&, 0&, 0&
  End If

  Tell = Tell + 1
  DoEvents ' Lar programmet utføre andre operasjoner, som å reagere på museklikk.
Loop

 

Da vil døren åpne og lukke seg 50 ganger.

 

litt *klippe, klipp* fra en av aadnk's fantastiske koder

[Jaffe]

I QBASIC bruker man OUT og INP for å gjøre ting.. Da kan du fks. sende den rette byten til den rette adressen og få noe til