Ich habs ja mit IE6 getestet und geht auch nicht.
ControlFocus vorher bringt auch nichts.
Geht wirklich nur MouseClick - ziemlich blöd.
Beiträge von BugFix
-
-
Mir auch nicht klar, was du möchtest.
Leerzeichen werden doch gelesen und sind in der Ausgabe enthalten.Spoiler anzeigen
[autoit]#include <GUIConstants.au3>
[/autoit] [autoit][/autoit] [autoit]
#include <GuiEdit.au3>Opt("GUIOnEventMode", 1)
[/autoit] [autoit][/autoit] [autoit]
$AForm1 = GUICreate("AForm1", 633, 454, 193, 115)
GUISetOnEvent($GUI_EVENT_CLOSE, "AForm1Close")
$Edit1 = GUICtrlCreateEdit("", 115, 76, 380, 137)
GUICtrlSetData(-1, _
"Befehl1 -Parameter1 -Parameter2 -Parameter3" & @CRLF & _
"Befehl2 -Parameter1 -Parameter2 -Parameter3" & @CRLF & _
"Befehl3 -Parameter1 -Parameter2 -Parameter3" & @CRLF & _
"Befehl4 -Parameter1 -Parameter2 -Parameter3" & @CRLF & _
"Befehl5 -Parameter1 -Parameter2 -Parameter3")
$Button1 = GUICtrlCreateButton("Button1", 356, 244, 137, 29, 0)
GUICtrlSetOnEvent(-1, "Button1Click")
$Input1 = GUICtrlCreateInput("", 115, 316, 380, 21)
GUISetState(@SW_SHOW)While 1
[/autoit] [autoit][/autoit] [autoit]
Sleep(100)
WEndFunc AForm1Close()
[/autoit] [autoit][/autoit] [autoit]
Exit
EndFuncFunc Button1Click()
[/autoit]
For $i = 1 To _GUICtrlEditGetLineCount($Edit1)
$getline = _GUICtrlEditGetLine($Edit1, $i)
GUICtrlSetData($Input1, $getline)
Sleep(2000)
Next
EndFunc -
Zitat
Papst Array der Erste
LOL
Meine Insignien sind:
ROWS
COLUMNS und
INDEXIhre Dreifaltigkeit sei gepriesen.
-
Mein Vorschlag:
[autoit]If Not _SerienNRCheckFunc() Then
[/autoit][autoit][/autoit][autoit]
If InputBox("Passwort", "Bitte Passwort eingeben: ", "", "*") <> $passwort Then
MsgBox(0, '', "Keine Berechtigung - Programm wird beendet")
Exit
EndIf
EndIf
; Hier beginnt das restliche ProgrammFunc _SerienNRCheckFunc()
[/autoit]
; Return "True" wenn gefunden
EndFunc -
Zitat
Original von Tweaky
mache mal einen neuen Tread auf für das Speichern-Problem.
Vielleicht hat da ja jemand einen Tipp.*bg* - was ein fehlendes "h" doch ausmacht, so wird aus einem Diskussionsstrang eine Lauffläche.
-
Hi, hab grad auch mal probiert.
[autoit]
Und wie es aussieht, gibt es wirklich keinen Weg das Fenster "Dateidownload" im MS-IE per AutoIt Befehl zu steuern.
Alle Aktionen um den "Speichern" - Button zu betätigen:ControlClick("Dateidownload", "", 4424)
[/autoit]
ControlClick("Dateidownload", "", "&Speichern")
ControlClick("Dateidownload", "", "[CLASS:Button; INSTANCE:2]")
Send("!s")führen nur dazu, dass der Button markiert wird.
[autoit]
Aber auch einSend("{ENTER}")
[/autoit]wenn der Button markiert ist, bleibt wirkungslos.
Das gilt übrigens für alle Button in diesem Fenster.EDIT: Achja, bevor hier der Tipp kommt mit _INetGet() zu laden: Das ist nicht möglich, weil zum Erreichen der Links eingelogt wird und beim Verlassen des Object Focus die Links nicht mehr erreichbar sind.
Naja, eines geht doch: MouseClick()
Aber wer macht das schon gern... -
Wenn das proggi auf deinem PC schon ist, wird es all deine sicherungsmaßnahmen auch wieder deaktivieren.
Dagegen hilft vorerst nur eingeschränkter Modus. (grauenhaft, weil damit Windows fast arbeitsunfähig ist) -
Also das hier müssten doch die Links auf die Rechnungen sein:
Code<tr bgcolor="#FFF3E5"> <td width="88" valign="middle" class="formtable">xx.xx.xxxx</td> <td width="88" valign="middle" class="formtable">x.xx €</td> <td width="88" valign="middle" class="formtable"><a href="xxxxxxxxxxxxxxxxxxxxxxxxxxxxxx.pdf" target="_blank"><img src="img_fm/ico_pdf.gif" border="0" width="16" height="16"></a> <a href="xxxxxxxxxxxxxxxxxxxxxxxxxxxxxx.pdf.pdf" target="_blank">Download</a></td> <td width="88" valign="middle" class="formtable"><a href="xxxxxxxxxxxxxxxxxxxxxxxxxxxxxx.=CSV" target="_blank"><img src="img_fm/ico_csv.gif" border="0" width="16" height="16"></a> <a href="xxxxxxxxxxxxxxxxxxxxxxxxxxxxxx.pdf=CSV" target="_blank">Download</a></td> <td width="88" valign="middle" class="formtable"><a href="xxxxxxxxxxxxxxxxxxxxxxxxxxxxxx..pdf" target="_blank"><img src="img_fm/ico_pdf.gif" border="0" width="16" height="16"></a> <a href="xxxxxxxxxxxxxxxxxxxxxxxxxxxxxx.pdf.pdf" target="_blank">Download</a></td> <td width="88" valign="middle" class="formtable"><a href="xxxxxxxxxxxxxxxxxxxxxxxxxxxxxx.=CSV" target="_blank"><img src="img_fm/ico_csv.gif" border="0" width="16" height="16"></a> <a href="xxxxxxxxxxxxxxxxxxxxxxxxxxxxxx.pdf=CSV" target="_blank">Download</a></td> </tr>
[autoit]
All das steht in einer Tabelle. Da es die erste auf der Seite ist, hat sie den Index 0. (Falls doch nicht, probier mit 1)
Den Inhalt der Tabelle schreibst du dir erst mal in ein Array.$oTable = _IETableGetCollection ($oIE, 0)
[/autoit]
$aTableData = _IETableWriteToArray ($oTable)Dann kannst du schauen, welche Arrayelemente die Links enthalten. z.B.: In ein anderes Array schreiben, wenn im Element 'Download' enthalten. Mußt du sehen, wie die Tabelle im Array wiedergegeben wird.
-
Der für dich interessante Link ist:
"/privateservice.php?action=invoices"Das ist ein relativer Verweis von der aktuellen Seite aus.
Laß dir mit _IEPropertyGet($oIE, "locationurl") die URL der aktuellen Seite ausgeben (durch das Einloggen hat die ja eine ID mit drin).
Jetzt ruf die aktuelle Seite mit angehängtem Rechnungslink auf (_IENavigate).Kanns selber nicht testen, Viel Erfolg.
-
Hol mal den Quelltext mit Copy&Paste und poste hier. Vergiß nicht Passwörter/Usernamen zu X-en.
Dann schaun 'mer ma... -
Verwende die Seite:
"https://kundenservice.klarmobil.de/privateservice.php?action=uebersicht"Da ist es kein Java
-
[autoit]
$oForm = _IEFormGetCollection($oIE, 0)
[/autoit]
$oName = _IEFormElementGetObjByName($oForm, "username")
$oPW = _IEFormElementGetObjByName($oForm, "password")
_IEFormElementSetValue($oName, $nummer)
_IEFormElementSetValue($oPW, $pw)Habe es grad so getestet - Funzt.
Aber ich habe die Seite für Kundenbereich verwendet:
"https://kundenservice.klarmobil.de/privateservice.php?action=uebersicht"_IESubmit funktioniert übrigens mit dieser Seite nicht, auch _IEImgClick schlägt fehl.
Einfach: Send({ENTER}) stattdessenEDIT
Ich seh grad deinen Fehler:
In diesem Objekt: $oForm = _IEFormGetCollection($oIE, 0)
stecken beide Formelemente (Name und Passwort)
Du beziehst dich plötzlich auf eine Form 1. -
Und _IELoadWait kannst du dir sparen, das hast du bei Create schon festgelegt (maximieren kannst du auch so):
[autoit]#include<IE.au3>
[/autoit][autoit][/autoit][autoit]
AutoitSetOption("WinTitleMatchMode", 2)$internet_adresse = "http://klarmobil.de/"
[/autoit]
$nummer = "3554434"
$oIE = _IECreate ($internet_adresse, 0, 1, 1, 0)
If @error >0 Then Exit
;~ _IELoadWait ($oIE) ; schon mit Flag Wait in _IECreate gesetzt
;~ If @error >0 Then Exit
;~ $oHWND = _IEPropertyGet($oIE, "hwnd") ;maximieren
WinSetState("Microsoft Internet Explorer", "", @SW_MAXIMIZE) ;maximieren -
$STDIN_CHILD brauchst du in deinem Fall eigentlich nicht.
Es wird i.A. verwendet um Usereingaben an die DOS-Umgebung weiterzuleiten (Funktion StdinWrite ). -
Hi, in der Hilfe zu 'Run' findest du es erklärt.
So anzuwenden:
[autoit]$foo = Run(@ComSpec & " /c " & 'commandName', "", @SW_HIDE, $STDOUT_CHILD)
[/autoit]
While 1
$line = StdoutRead($foo)
If @error Then ExitLoop
MsgBox(0, "STDOUT read:", $line)
WendDas Ergebnis von StdoutRead (das was die DOS-Anwendung zurückgibt) kannst du dann in eine Textdatei schreiben. (z.B. FileWrite, _FileWriteLine)
Die Befehle aus deiner Textdatei mußt du dann nacheinander in einer Schleife mit obigem Befehlsaufruf abarbeiten.
-
Ich find auch, dass die Hilfebeispiele klarer nicht sein können.
_IETagNameGetCollection() ==> gibt alle Tags eines Typs zurück (z.B. 'input')
_IETagNameAllGetCollection() ==> gibt alle Tags der Seite zurück mit Typangabe -
So, ich hab schon mal 'nen Anfang gemacht.
Im MS-Support habe ich ein Beispiel gefunden. Natürlich unter Verwendung von Routinen, die in AutoIt nicht verfügbar sind.
Notwendig sind:
- CreateFile (habe ich schon nachgebaut und scheint zu funktionieren)
- PREVENT_MEDIA_REMOVAL (da fehlt mir noch jeder Ansatz, bzw. ich weiß nicht, wie ich das in AutoIt umsetzen soll: )Spoiler anzeigen
Code
Alles anzeigenBOOL PreventRemovalOfVolume(HANDLE hVolume, BOOL fPreventRemoval) { DWORD dwBytesReturned; PREVENT_MEDIA_REMOVAL PMRBuffer; PMRBuffer.PreventMediaRemoval = fPreventRemoval; return DeviceIoControl( hVolume, IOCTL_STORAGE_MEDIA_REMOVAL, &PMRBuffer, sizeof(PREVENT_MEDIA_REMOVAL), NULL, 0, &dwBytesReturned, NULL); }
- DeviceIoControl (Dazu habe ich das Folgende, komme aber auch nicht weiter: )
Spoiler anzeigen
Code
Alles anzeigenThe IOCTL_STORAGE_MEDIA_REMOVAL DeviceIoControl operation enables or disables the mechanism that ejects media, for those devices possessing that locking capability. dwIoControlCode = IOCTL_STORAGE_MEDIA_REMOVAL; // operation code lpInBuffer; // address of input buffer nInBufferSize; // size of input buffer lpOutBuffer = NULL; // address of output buffer; not used; must be NULL nOutBufferSize = 0; // size of output buffer; not used; must be zero lpBytesReturned; // address of actual bytes of output
Und hier gefundener Mustercode und meine Anfänge der Umsetzung in AutoIt:Spoiler anzeigen
[autoit]; Lock / UnLock CD-ROM Drive Link: http://support.microsoft.com/kb/138434/de
[/autoit] [autoit][/autoit] [autoit]
#cs
#include <windows.h>
#include <winioctl.h> // From the Win32 SDK \Mstools\Include
#include "ntddcdrm.h" // From the Windows NT DDK \Ddk\Src\Storage\Inc/*
[/autoit] [autoit][/autoit] [autoit]
This code reads sectors 16 and 17 from a compact disc and writes
the contents to a disk file named Sector.dat
*/{
[/autoit] [autoit][/autoit] [autoit]
HANDLE hCD, hFile;
DWORD dwNotUsed;// Disk file that will hold the CD-ROM sector data.
[/autoit] [autoit][/autoit] [autoit]
hFile = CreateFile ("sector.dat",
GENERIC_WRITE, 0, NULL, CREATE_ALWAYS,
FILE_ATTRIBUTE_NORMAL, NULL);// For the purposes of this sample, drive F: is the CD-ROM
[/autoit] [autoit][/autoit] [autoit]
// drive.
hCD = CreateFile ("\\\\.\\F:", GENERIC_READ,
FILE_SHARE_READ|FILE_SHARE_WRITE,
NULL, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL,
NULL);// If the CD-ROM drive was successfully opened, read sectors 16
[/autoit] [autoit][/autoit] [autoit]
// and 17 from it and write their contents out to a disk file.
if (hCD != INVALID_HANDLE_VALUE)
{
DISK_GEOMETRY dgCDROM;
PREVENT_MEDIA_REMOVAL pmrLockCDROM;// Lock the compact disc in the CD-ROM drive to prevent accidental
[/autoit] [autoit][/autoit] [autoit]
// removal while reading from it.
pmrLockCDROM.PreventMediaRemoval = TRUE;
DeviceIoControl (hCD, IOCTL_CDROM_MEDIA_REMOVAL,
&pmrLockCDROM, sizeof(pmrLockCDROM), NULL,
0, &dwNotUsed, NULL);// Get sector size of compact disc
[/autoit] [autoit][/autoit] [autoit]
if (DeviceIoControl (hCD, IOCTL_CDROM_GET_DRIVE_GEOMETRY,
NULL, 0, &dgCDROM, sizeof(dgCDROM),
&dwNotUsed, NULL))
{
LPBYTE lpSector;
DWORD dwSize = 2 * dgCDROM.BytesPerSector; // 2 sectors// Allocate buffer to hold sectors from compact disc. Note that
[/autoit] [autoit][/autoit] [autoit]
// the buffer will be allocated on a sector boundary because the
// allocation granularity is larger than the size of a sector on a
// compact disk.
lpSector = VirtualAlloc (NULL, dwSize,
MEM_COMMIT|MEM_RESERVE,
PAGE_READWRITE);// Move to 16th sector for something interesting to read.
[/autoit] [autoit][/autoit] [autoit]
SetFilePointer (hCD, dgCDROM.BytesPerSector * 16,
NULL, FILE_BEGIN);// Read sectors from the compact disc and write them to a file.
[/autoit] [autoit][/autoit] [autoit]
if (ReadFile (hCD, lpSector, dwSize, &dwNotUsed, NULL))
WriteFile (hFile, lpSector, dwSize, &dwNotUsed, NULL);VirtualFree (lpSector, 0, MEM_RELEASE);
[/autoit] [autoit][/autoit] [autoit]
}// Unlock the disc in the CD-ROM drive.
[/autoit] [autoit][/autoit] [autoit]
pmrLockCDROM.PreventMediaRemoval = FALSE;
DeviceIoControl (hCD, IOCTL_CDROM_MEDIA_REMOVAL,
&pmrLockCDROM, sizeof(pmrLockCDROM), NULL,
0, &dwNotUsed, NULL);CloseHandle (hCD);
[/autoit] [autoit][/autoit] [autoit]
CloseHandle (hFile);
}
}
#ce#cs Link: http://www.vbarchiv.net/vbapi/CreateFile.php
[/autoit] [autoit][/autoit] [autoit]
Private Declare Function CreateFile Lib "kernel32.dll" Alias "CreateFileA" _
(ByVal lpFileName As String, ByVal dwDesiredAccess As Long, _
ByVal dwShareMode As Long, lpSecurityAttributes As Any, _
ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, _
ByVal hTemplateFile As Long) As Long
#ceConst $GENERIC_READ = 0x80000000 ; Nur Lesen
[/autoit] [autoit][/autoit] [autoit]
Const $GENERIC_WRITE = 0x40000000 ; Nur Schreiben
Const $FILE_SHARE_READ = 0x1
Const $FILE_SHARE_WRITE = 0x2
Const $OPEN_EXISTING = 3
Const $FILE_ATTRIBUTE_NORMAL = 0x80
Dim $Lw = 'F:' ; CD-LaufwerksbuchstabeDim $hCD = CreateFile("\\\\.\\" & $Lw, $GENERIC_READ, BitOR($FILE_SHARE_READ, $FILE_SHARE_WRITE), _
[/autoit] [autoit][/autoit] [autoit]
'NULL', $OPEN_EXISTING, $FILE_ATTRIBUTE_NORMAL, 'NULL')If $hCD = -1 Then
[/autoit] [autoit][/autoit] [autoit]
MsgBox(0, 'Fehler', 'CD-Laufwerk nicht gefunden')
Exit
Else
MsgBox(0, '', "funzt")
EndIf#cs
[/autoit] [autoit][/autoit] [autoit]
PREVENT_MEDIA_REMOVAL pmrLockCDROM;// Lock the compact disc in the CD-ROM drive to prevent accidental
[/autoit] [autoit][/autoit] [autoit]
// removal while reading from it.
pmrLockCDROM.PreventMediaRemoval = TRUE;
DeviceIoControl (hCD, IOCTL_CDROM_MEDIA_REMOVAL,
&pmrLockCDROM, sizeof(pmrLockCDROM), NULL,
0, &dwNotUsed, NULL);
#ce#cs
[/autoit] [autoit][/autoit] [autoit]
// Unlock the disc in the CD-ROM drive.
pmrLockCDROM.PreventMediaRemoval = FALSE;
DeviceIoControl (hCD, IOCTL_CDROM_MEDIA_REMOVAL,
&pmrLockCDROM, sizeof(pmrLockCDROM), NULL,
0, &dwNotUsed, NULL);
#ceFunc CreateFile($lpFileName,$dwDesiredAccess,$dwShareMode,$lpSecurityAttributes, _
[/autoit] [autoit][/autoit] [autoit]
$dwCreationDisposition,$dwFlagsAndAttributes,$hTemplateFile)
Return DllCall("kernel32.dll", "long", "CreateFileA", "str", $lpFileName, "long", $dwDesiredAccess, _
"long", $dwShareMode, "str", $lpSecurityAttributes, "long", $dwCreationDisposition, _
"long", $dwFlagsAndAttributes, "long", $hTemplateFile)
EndFuncFunc DeviceIoControl($hDevice,$dwIoControlCode,$lpInBuffer,$nInBufferSize, _
[/autoit]
$lpOutBuffer,$nOutBufferSize,$lpBytesReturned,$lpOverlapped)
Return DllCall("kernel32.dll", "long", "DeviceIoControl", "long", $hDevice, "long", $dwIoControlCode, _
"str", $lpInBuffer, "long", $nInBufferSize, "str", $lpOutBuffer, "long", $nOutBufferSize, _
"long", $lpBytesReturned, "str", $lpOverlapped)
EndFuncEdit: Die Funktion DeviceIoControl habe ich jetzt auch nachgebaut. (s. Code)
Nun muß also noch 'ne Lösung für PREVENT_MEDIA_REMOVAL her...Die unteren beiden auskommentierten Blöcke müssen noch erledigt werden.
Vielleicht hat ja jemand 'ne Eingebung . -
Hallo und :willkommen:
Schau mal hier:
[autoit]#include <INet.au3>
[/autoit]
_INetGetSource ( $s_URL )Damit kannst du dir den Inhalt der Seite laden.
Zum Selektieren der gewünschten Texte findest du hier schon verschiedene Bsp.
Nutze einfach mal die Suche. -
Zum letzten mal:
Du weißt überhaupt nicht, was du tust.
Es ist wenig sinnvoll mit komplexen Skripten zu beginnen, wenn einem nicht mal der Ablauf klar ist.
Nach einer gesetzten Pause [ _SoundPause() ] kann zum Fortsetzen von der letzten Position nur _SoundResume() genutzt werden. Steht alles in der Hilfe.
Und du solltest dich doch erst mal mit den Programmstrukturen vertraut machen.
z.B. "If.. Then.. (Else).. EndiIf"Spoiler anzeigen
[autoit]Case $Pausebutton
[/autoit]
If $pause = 1 Then
_SoundResume($re)
$pause = 0
Else
_SoundPause($re)
$pause = 1
EndIfPS. Solange du nicht erstmal an deinen Grundkenntnissen arbeitest, war dies vorest meine letzte Hilfe.
-
Also so sieht das ganze mit VB aus. Hier der Code aus "CDRom-Lock.frm" des gleichnamigen Tools.
Den kpl. Sourcecode kannst du hier laden:
SourceForge.netSpoiler anzeigen
Code
Alles anzeigenVERSION 5.00 Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX" Begin VB.Form frmCDRomLock BorderStyle = 1 'Fixed Single Caption = "CDRom-Lock" ClientHeight = 2655 ClientLeft = 45 ClientTop = 780 ClientWidth = 2535 Icon = "CDRom-Lock.frx":0000 LinkTopic = "Form1" MaxButton = 0 'False ScaleHeight = 2655 ScaleWidth = 2535 WhatsThisHelp = -1 'True Begin VB.CheckBox chkPWDSucceeded Caption = "chkPasswordSucceeded" Height = 255 Left = 4680 TabIndex = 9 Top = 1680 Visible = 0 'False Width = 2535 End Begin VB.CheckBox chkWait Caption = "chkWait" Height = 255 Left = 4680 TabIndex = 8 Top = 1440 Visible = 0 'False Width = 2295 End Begin MSComctlLib.ImageCombo imgCboDrives Height = 330 Left = 120 TabIndex = 7 Top = 120 Width = 2295 _ExtentX = 4048 _ExtentY = 582 _Version = 393216 ForeColor = -2147483640 BackColor = -2147483643 Locked = -1 'True Text = "imgCboDrives" End Begin MSComctlLib.ImageList imgList Left = 3120 Top = 960 _ExtentX = 1005 _ExtentY = 1005 BackColor = -2147483643 ImageWidth = 16 ImageHeight = 16 MaskColor = 12632256 _Version = 393216 BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628} NumListImages = 2 BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628} Picture = "CDRom-Lock.frx":0442 Key = "" EndProperty BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628} Picture = "CDRom-Lock.frx":059C Key = "" EndProperty EndProperty End Begin VB.TextBox txtPWRMessage Height = 615 Left = 2640 TabIndex = 6 Text = "Text1" Top = 1800 Visible = 0 'False Width = 1695 End Begin VB.Timer TimerSuspend Interval = 5000 Left = 3720 Top = 1080 End Begin VB.OptionButton optClose Caption = "Close" Height = 255 Left = 600 TabIndex = 5 ToolTipText = "close CD/DVD drive (if supportet by the drive)" Top = 1800 Width = 1335 End Begin VB.OptionButton optOpen Caption = "Open" Height = 255 Left = 600 TabIndex = 4 ToolTipText = "open CD/DVD drive" Top = 1560 Width = 1335 End Begin VB.CheckBox chkAll Caption = "all CD/DVD drives" Height = 255 Left = 240 TabIndex = 3 ToolTipText = "enable to perform action at all devices" Top = 600 Width = 1695 End Begin VB.CommandButton cmdDo BackColor = &H80000004& Caption = "OK" Height = 375 Left = 600 TabIndex = 2 Top = 2160 Width = 1215 End Begin VB.OptionButton optUnlock Caption = "Unlock" Height = 255 Left = 600 TabIndex = 1 ToolTipText = "unlock the CD-Rom button" Top = 1200 Value = -1 'True Width = 1335 End Begin VB.OptionButton optLock Caption = "Lock" Height = 255 Left = 600 TabIndex = 0 ToolTipText = "lock the CD-Rom button" Top = 960 Width = 1335 End Begin VB.Menu mnuPopup Caption = "PopupMenu" Visible = 0 'False Begin VB.Menu mnuLock Caption = "Lock" Begin VB.Menu mnuLockSub Caption = "mnuLockSub" Checked = -1 'True Index = 0 Visible = 0 'False End Begin VB.Menu mnuLockAll Caption = "Lock All Devices" End End Begin VB.Menu mnuUnlock Caption = "Unlock" Begin VB.Menu mnuUnlockSub Caption = "mnuUnlockSub" Checked = -1 'True Index = 0 Visible = 0 'False End Begin VB.Menu mnuUnlockAll Caption = "Unlock all devices" End End Begin VB.Menu mnuSep2 Caption = "-" End Begin VB.Menu mnuOpen Caption = "Open" Begin VB.Menu mnuOpenSub Caption = "mnuOpenSub" Index = 0 Visible = 0 'False End Begin VB.Menu mnuOpenAll Caption = "Open All Devices" End End Begin VB.Menu mnuClose Caption = "Close" Begin VB.Menu mnuCloseSub Caption = "mnuCloseSub" Index = 0 Visible = 0 'False End Begin VB.Menu mnuCloseAll Caption = "Close All Devices" End End Begin VB.Menu mnuSep1 Caption = "-" End Begin VB.Menu mnuShow Caption = "Maximze" End Begin VB.Menu mnuExit Caption = "Exit" End End Begin VB.Menu mnuFile Caption = "&File" Begin VB.Menu mnuExit2 Caption = "E&xit" Shortcut = ^X End End Begin VB.Menu mnuEdit Caption = "&Edit" Begin VB.Menu mnuPreferences Caption = "Preferences" End End Begin VB.Menu mnuHelp Caption = "Help" Begin VB.Menu mnuAbout Caption = "About" End End End Attribute VB_Name = "frmCDRomLock" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False 'CDRom-Lock - tool to lock/unlock the tray of CD/DVD drives 'Copyright (c) 2005 Nils Wiese ' 'This program is free software; you can redistribute it and/or modify it under the terms of 'the GNU General Public License as published by the Free Software Foundation; either version 2 'of the License, or (at your option) any later version. ' 'This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; 'without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. 'See the GNU General Public License for more details. 'You should have received a copy of the GNU General Public License along with this program; 'if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA ' 'author contact: 'Nils Wiese 'email: info@cdrom-lock.de 'Internet: www.cdrom-lock.de ' Option Explicit 'global variables Dim PMR32 As PREVENT_MEDIA_REMOVAL Dim blnAll As Boolean Dim intCountDevicesCD As Integer Dim blnLocked() As Boolean Dim blnWriteIni As Boolean Dim blnResume As Boolean Dim intSelect As Integer Dim intPress As Integer 'für Fehlermeldungen 'globale Variabel für das INI-File Dim strIniFile$ '######################################################## ' Deklarationen ' zum CD-Laufwerk sperren/freigeben '######################################################## Private Const INVALID_HANDLE_VALUE As Long = -1& Private Const OPEN_EXISTING As Long = 3& Private Const FILE_FLAG_DELETE_ON_CLOSE As Long = 67108864 Private Const GENERIC_READ As Long = &H80000000 Private Const GENERIC_WRITE As Long = &H40000000 Private Const IOCTL_STORAGE_EJECT_MEDIA = 2967560 Private Const IOCTL_STORAGE_MEDIA_REMOVAL As Long = &H2D4804 Private Const VWIN32_DIOC_DOS_IOCTL As Long = 1& Private Drv As Drive, Drvs As Drives Private Fs As New Scripting.FileSystemObject Private Type OSVERSIONINFO dwOSVersionInfoSize As Long dwMajorVersion As Long dwMinorVersion As Long dwBuildNumber As Long dwPlatformId As Long szCSDVersion As String * 128 End Type Private Type DIOC_REGISTERS reg_EBX As Long reg_EDX As Long reg_ECX As Long reg_EAX As Long reg_EDI As Long reg_ESI As Long reg_Flags As Long End Type Private Type PREVENT_MEDIA_REMOVAL P1 As Byte End Type Private Type PREVENT_MEDIA_REMOVAL1 P1 As Byte P2 As Byte End Type Private Declare Function GetVersionEx Lib "kernel32" _ Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Long 'FIXIT: As Any is not supported in Visual Basic .NET. Use a specific type. FixIT90210ae-R5608-H1984 Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" ( _ ByVal lpFileName As String, _ ByVal dwDesiredAccess As Long, _ ByVal dwShareMode As Long, _ lpSecurityAttributes As Any, _ ByVal dwCreationDisposition As Long, _ ByVal dwFlagsAndAttributes As Long, _ ByVal hTemplateFile As Long) As Long 'FIXIT: As Any is not supported in Visual Basic .NET. Use a specific type. FixIT90210ae-R5608-H1984 Private Declare Function DeviceIoControl Lib "kernel32" ( _ ByVal hDevice As Long, _ ByVal dwIoControlCode As Long, _ lpInBuffer As Any, _ ByVal nInBufferSize As Long, _ lpOutBuffer As Any, _ ByVal nOutBufferSize As Long, _ lpBytesReturned As Long, _ lpOverlapped As Any) As Long Private Declare Function CloseHandle Lib "kernel32" _ (ByVal hObject As Long) As Long '######################################################## ' Deklarationen ' zum Entfernen des Schließen-Symbols '######################################################## Private Declare Function GetSystemMenu Lib "user32" _ (ByVal hWnd As Long, ByVal bRevert As Long) As Long Private Declare Function DeleteMenu Lib "user32" _ (ByVal hMenu As Long, ByVal nPosition As Long, _ ByVal wFlags As Long) As Long Private Declare Function DrawMenuBar Lib "user32" _ (ByVal hWnd As Long) As Long Private Const SC_CLOSE = &HF060 Private Const MF_BYCOMMAND = &H0 '############################################################################## ' FORM / FORMLOAD ' hier kommt alles, was mit graphischen Interface zu tun hat '############################################################################## Private Sub Form_Load() On Error GoTo ErrHandler 'FIXIT: Declare 'i' with an early-bound data type FixIT90210ae-R1672-R1B8ZE Dim i, j As Integer Dim lngTest As Long Dim error As Boolean 'FIXIT: Declare 's' with an early-bound data type FixIT90210ae-R1672-R1B8ZE Dim s, n As String, sOS As String, temp As String Dim strDrive As String Dim intLock As Integer Dim intResume As Integer Dim intMinimizeToTray As Integer Dim intDeviceValue As Integer Dim intDeviceAll As Integer Dim intLastState As Integer Dim lngDelay As Long Dim sMsg As String Dim X% 'Password related variables Dim strPWDFile$ Dim blnPasswordOld As Boolean Dim strPasswordOld As String Dim strPasswordEncoded As String If App.PrevInstance Then End End If DisableCloseButton Me.hWnd 'initialise local/global variables blnWriteIni = False 'blnResumeSuspend = False error = False Set Drvs = Fs.Drives intDeviceAll = 0 intDeviceValue = 0 blnAll = True intCountDevicesCD = 0 lngDelay = 0 'initialise Path to INI-File strIniFile = App.Path & "\CDRom-Lock.ini" 'initialise images in imgCbODrives imgCboDrives.ImageList = imgList Call SetLanguage(strIniFile) 'Default-Werte aus INI-File auslesen intDeviceAll = CInt(INIGetValue(strIniFile, "Default", "DeviceAll")) intLastState = CInt(INIGetValue(strIniFile, "Default", "UseLastState")) intMinimizeToTray = CInt(INIGetValue(strIniFile, "Default", "Minimize")) intResume = CInt(INIGetValue(strIniFile, "Default", "Standby")) lngDelay = CLng(INIGetValue(strIniFile, "Default", "Delay")) frmPreferences.chkLockAll.Value = intDeviceAll frmPreferences.chkSaveState.Value = intLastState frmPreferences.chkMinimizeToTray.Value = intMinimizeToTray frmPreferences.chkResume = intResume 'Check, if password protection is switched on strPWDFile = App.Path & "\password.txt" strPasswordEncoded = INIGetValue(strPWDFile, "Password", "Password") strPasswordOld = EncodeString(strPasswordEncoded, "9om1z25kOq33FCh2SossUFbnrtf3M000") If strPasswordOld <> "" Then blnPasswordOld = True frmPreferences.chkPassword = 1 Else blnPasswordOld = False frmPreferences.chkPassword = 0 End If 'Auswerten der Default-Werte '1.) letzten Zustand oder alle Sperren? If intLastState = 1 Then frmPreferences.chkSaveState = 1 frmPreferences.chkLockAll.Enabled = False Else frmPreferences.chkSaveState = 0 frmPreferences.chkLockAll.Enabled = True End If '2.) ein wenig warten, (lngDelay) MsgWaitObj (lngDelay) 'alle Laufwerke auf CD/DVD devices scannen und in Liste eintragen For Each Drv In Drvs n = "" s = "" s = Drv.DriveLetter & ":" If Drv.DriveType = 3 Then n = Drv.ShareName Else If Drv.DriveType = 4 Then temp = Drv.VolumeName If temp = "" Then n = " CD/DVD" Else n = " CD/DVD" & temp End If imgCboDrives.ComboItems.Add (intCountDevicesCD + 1), , s imgCboDrives.ComboItems(intCountDevicesCD + 1).Image = 1 intCountDevicesCD = intCountDevicesCD + 1 'Device in Popup-Menu eintragen Call AddMenuItem(s, "mnuLock") Call AddMenuItem(s, "mnuUnlock") Call AddMenuItem(s, "mnuOpen") Call AddMenuItem(s, "mnuClose") Else n = Drv.VolumeName End If End If Next imgCboDrives.ComboItems.Item(1).Selected = True ReDim blnLocked(0 To (intCountDevicesCD - 1)) 'erst einmal alle Laufwerke unlocken Call CDLock(intCountDevicesCD, blnAll) 'ReDim blnLocked-Array und alle Einträge auf False setzen, da alle Laufwerke unlocked sind For i = 0 To (intCountDevicesCD - 1) 'For i = 0 To 99 blnLocked(i) = False Next 'ab hier müssen immer alle Zustandsänderungen der Laufwerke ins INI-File geschrieben werden blnWriteIni = True If intDeviceAll = 1 Then If intLastState = 1 Then blnAll = False frmCDRomLock.chkAll = 0 SetCurrentState Else blnAll = True frmCDRomLock.chkAll = 1 frmCDRomLock.optLock_Click End If Else If intLastState = 1 Then blnAll = False frmCDRomLock.chkAll = 0 SetCurrentState Else blnAll = True frmCDRomLock.chkAll = 0 frmCDRomLock.optUnlock_Click End If End If 'Wenn alle Laufwerke per Default gesperrt oder freigegeben werden sollen, dann jetzt durchführen If blnAll = True Then frmCDRomLock.cmdDo_Click 'Uncheck All devices and set blnAll to False frmCDRomLock.chkAll = 0 blnAll = False 'minimize to tray If intMinimizeToTray = 1 Then AddToTray frmCDRomLock, mnuPopup SetTrayTip ("CDRom-Lock") 'If WindowState <> vbMinimized Then WindowState = vbMinimized frmCDRomLock.Visible = False 'FIXIT: App.TaskVisible property has no Visual Basic .NET equivalent and will not be upgraded. FixIT90210ae-R7593-R67265 App.TaskVisible = False End If 'Wenn nach Standby der Zustand zurückgesetzt werden soll... 'If frmPreferences.chkResume = 1 Then frmCDRomLock.txtPWRMessage = "NA" oldProcAddress = SetWindowLong(Me.hWnd, GWL_WNDPROC, AddressOf VB_WindowProc) 'End If Exit_Sub: Exit Sub ErrHandler: Select Case Err.Number Case 13: Resume Exit_Sub ' wahrscheinlich INI-File nicht gefunden. Wird an anderer Stelle gemeldet. Case 71: Resume Next 'drive A not ready (empty). Überspringen Case Else: Call Undefined_Error(Err.Number, Err.Description, "frmCDRomLock.Form_Load()") End Select Resume Exit_Sub End Sub '############################################################################### ' CD LOCK / UNLOCK ' hier kommt alles, was mit dem Sperren und Freigeben vom CD-Laufwerk zu tun hat '############################################################################### Public Sub CDLock(intCountDevicesCD As Integer, blnAll As Boolean) 'Dieses Sub lockt oder unlockt vorhandenen CD-Laufwerke, 'abhängig vom momentanen Wert von P32.P1 (0=unlock, 1=lock) On Error GoTo ErrHandler Dim strMsg As String Dim OSV As OSVERSIONINFO Dim hLwStatus As Long Dim strDrive As String Dim retDummy As Long Dim blnWrongOS As Boolean Dim i As Integer Dim error As Boolean Dim strStatus As String Dim blnPWD As Boolean Dim intTemp As Integer, intDeviceCurrent As Integer 'Parameter zum unlocken setzen blnWrongOS = False ' Betriebssystem-Plattform bestimmen OSV.dwOSVersionInfoSize = 148 OSV.szCSDVersion = Space$(128) retDummy = GetVersionEx(OSV) strStatus = "" If blnAll = True Then 'für alle Devices LockCD_WinNT aufrufen For i = 0 To intCountDevicesCD - 1 imgCboDrives.ComboItems(i + 1).Selected = True strDrive = imgCboDrives.SelectedItem.Text Call Get_Driveletter(strDrive, error) intTemp = PMR32.P1 If intTemp = 0 Then blnLocked(i) = False imgCboDrives.ComboItems(i + 1).Text = strDrive & " unlocked" imgCboDrives.ComboItems(i + 1).Image = 1 mnuLockSub(i + 1).Checked = False mnuUnlockSub(i + 1).Checked = False End If ' Windows NT/2000/XP If OSV.dwPlatformId >= 2 Then If blnLocked(i) = False Then Call LockCD_WinNT(hLwStatus, strDrive, retDummy) 'Else 'strMsg = "Device" & i & " is already locked" ' MsgBox strMsg End If If intTemp = 1 Then 'blnTemp = True blnLocked(i) = True imgCboDrives.ComboItems(i + 1).Text = strDrive & " locked" imgCboDrives.ComboItems(i + 1).Image = 2 mnuLockSub(i + 1).Checked = True mnuUnlockSub(i + 1).Checked = True End If imgCboDrives.ComboItems(1).Selected = True ' Win9x/Me, other Else blnWrongOS = True End If Next Else 'nur für das ausgewählte Devices LockCD_WinNT aufrufen intDeviceCurrent = imgCboDrives.SelectedItem.Index - 1 strDrive = imgCboDrives.SelectedItem.Text Call Get_Driveletter(strDrive, error) intTemp = PMR32.P1 If intTemp = 0 Then blnLocked(intDeviceCurrent) = False imgCboDrives.ComboItems(intDeviceCurrent + 1).Text = strDrive & " unlocked" imgCboDrives.ComboItems(intDeviceCurrent + 1).Image = 1 mnuLockSub(intDeviceCurrent + 1).Checked = False mnuUnlockSub(intDeviceCurrent + 1).Checked = False End If ' Windows NT/2000/XP If OSV.dwPlatformId >= 2 Then If blnLocked(intDeviceCurrent) = False Then Call LockCD_WinNT(hLwStatus, strDrive, retDummy) Else 'strMsg = "Device" & intDeviceCurrent & " is already locked" 'MsgBox strMsg End If If intTemp = 1 Then 'blnTemp = True blnLocked(intDeviceCurrent) = True imgCboDrives.ComboItems(intDeviceCurrent + 1).Text = strDrive & " locked" imgCboDrives.ComboItems(intDeviceCurrent + 1).Image = 2 mnuLockSub(intDeviceCurrent + 1).Checked = True mnuUnlockSub(intDeviceCurrent + 1).Checked = True End If ' Win9x/Me, other Else blnWrongOS = True End If End If If blnWrongOS = True Then strMsg = "This program only works on Windows NT/2000/XP" MsgBox strMsg End If Exit_Sub: Exit Sub ErrHandler: Call Undefined_Error(Err.Number, Err.Description, "CDLock()") Resume Exit_Sub End Sub '############################################################################## 'hier kommt alles, was mit dem Öffnen und Schließen vom CD-Laufwerk zu tun hat '############################################################################## Private Sub OpenCD() On Error GoTo ErrHandler Dim strDrive As String Dim intDevice As Integer, i As Integer Dim error As Boolean If blnAll = True Then 'von allen Laufwerken die Schublade öffnen For i = 0 To intCountDevicesCD - 1 imgCboDrives.ComboItems(i + 1).Selected = True strDrive = imgCboDrives.SelectedItem.Text intDevice = imgCboDrives.SelectedItem.Index - 1 Call Get_Driveletter(strDrive, error) If error = True Then Exit Sub If blnLocked(intDevice) = True Then 'Auswurf muß erst freigegeben werden PMR32.P1 = 0 Call CDLock(intDevice, False) 'Laufwerk öffnen x_CDOpen strDrive 'Auswurfknopf wieder sperren PMR32.P1 = 1 Call CDLock(intDevice, False) Else: x_CDOpen strDrive End If Next imgCboDrives.ComboItems(1).Selected = True Else 'nur von ausgewähltem Laufwerk die Schublade öffnen intDevice = imgCboDrives.SelectedItem.Index - 1 strDrive = imgCboDrives.SelectedItem.Text Call Get_Driveletter(strDrive, error) If error = True Then Exit Sub If blnLocked(intDevice) = True Then 'Auswurf muß erst freigegeben werden PMR32.P1 = 0 Call CDLock(intDevice, False) 'Laufwerk öffnen x_CDOpen strDrive 'Auswurfknopf wieder sperren PMR32.P1 = 1 Call CDLock(intDevice, False) Else: x_CDOpen strDrive End If End If Exit_Sub: Exit Sub ErrHandler: Call Undefined_Error(Err.Number, Err.Description, "OpenCD()") Resume Exit_Sub End Sub Private Sub CloseCD() On Error GoTo ErrHandler Dim strDrive As String Dim error As Boolean Dim intDevice As Integer, i As Integer Call Get_Driveletter(strDrive, error) If error = True Then GoTo Exit_Sub x_CDClose strDrive If blnAll = True Then 'von allen Laufwerken die Schublade schließen For i = 0 To intCountDevicesCD - 1 imgCboDrives.ComboItems(i + 1).Selected = True strDrive = imgCboDrives.SelectedItem.Text intDevice = imgCboDrives.SelectedItem.Index - 1 Call Get_Driveletter(strDrive, error) If error = True Then Exit Sub x_CDClose strDrive Next imgCboDrives.ComboItems(1).Selected = True Else 'nur von ausgewähltem Laufwerk die Schublade schließen intDevice = imgCboDrives.SelectedItem.Index - 1 strDrive = imgCboDrives.SelectedItem.Text Call Get_Driveletter(strDrive, error) If error = True Then Exit Sub x_CDClose strDrive End If Exit_Sub: Exit Sub ErrHandler: Call Undefined_Error(Err.Number, Err.Description, "CloseCD()") Resume Exit_Sub End Sub Public Sub chkAll_Click() On Error GoTo ErrHandler If chkAll = 1 Then blnAll = True Else: blnAll = 0 End If Exit_Sub: Exit Sub ErrHandler: Call Undefined_Error(Err.Number, Err.Description, "chkAll_Click()") Resume Exit_Sub End Sub Private Sub mnuAbout_Click() frmAbout.Visible = True End Sub Private Sub mnuCloseAll_Click() On Error GoTo ErrHandler frmCDRomLock.optClose.Value = True frmCDRomLock.chkAll.Value = 1 frmCDRomLock.chkAll_Click frmCDRomLock.cmdDo_Click Exit_Sub: Exit Sub ErrHandler: Call Undefined_Error(Err.Number, Err.Description, "mnuCloseAll_Click()") Resume Exit_Sub End Sub Private Sub mnuOpenAll_Click() On Error GoTo ErrHandler frmCDRomLock.optOpen.Value = True frmCDRomLock.chkAll.Value = 1 frmCDRomLock.chkAll_Click frmCDRomLock.cmdDo_Click Exit_Sub: Exit Sub ErrHandler: Call Undefined_Error(Err.Number, Err.Description, "mnuOpenAll_Click()") Resume Exit_Sub End Sub Public Sub optLock_Click() optLock.Value = True intSelect = 1 End Sub Public Sub optUnlock_Click() optUnlock.Value = True intSelect = 2 End Sub Public Sub optOpen_Click() optOpen.Value = True intSelect = 3 End Sub Public Sub optClose_Click() optClose.Value = True intSelect = 4 End Sub '################################################################## ' MENU ' ab hier kommen alle Teile, die mit den Menues zu tun haben '################################################################## Public Sub mnuExit_Click() Dim blnExit As Boolean Call Exit_CDLock(blnExit) If blnExit = True Then Unload Me End If 'End End Sub Private Sub mnuExit2_Click() Dim blnExit As Boolean Call Exit_CDLock(blnExit) If blnExit = True Then Unload Me End If 'End End Sub Public Sub Exit_CDLock(ByRef bExit As Boolean) Dim intPress1 As Integer Dim intlang As Integer On Error GoTo ErrHandler 'Fragen ob Laufwerke wieder freigegeben werden sollen intlang = INIGetValue(strIniFile, "Language", "Language") Select Case intlang Case 0 intPress1 = MsgBox("Exit CDRom-Lock?" & Chr(13) & Chr(10) & Chr(13) _ & Chr(10) & "CDRom-Lock will unlock all CD/DVD drives at programme exit.", _ vbQuestion + vbOKCancel, "Exit CDRom-Lock") Case 1 intPress1 = MsgBox("CDRom-Lock beenden?" & Chr(13) & Chr(10) & Chr(13) _ & Chr(10) & "CDRom-Lock wird alle Laufwerke nach Programmende wieder freigeben.", _ vbQuestion + vbOKCancel, "CDRom-Lock beenden") Case Else intPress1 = MsgBox("Exit CDRom-Lock?" & Chr(13) & Chr(10) & Chr(13) _ & Chr(10) & "CDRom-Lock will unlock all CD/DVD drives at programme exit.", _ vbQuestion + vbOKCancel, "Exit CDRom-Lock") End Select If intPress1 = 1 Then blnWriteIni = False frmCDRomLock.chkAll = 1 frmCDRomLock.optUnlock = True Call frmCDRomLock.cmdDo_Click If frmCDRomLock.chkPWDSucceeded.Value = 1 Or frmPreferences.chkPassword.Value = 0 Then frmCDRomLock.Show 'RemoveFromTray 'Call SetWindowLong(Me.hWnd, GWL_WNDPROC, oldProcAddress) 'Unload frmAbout 'Unload frmPreferences 'Unload frmCDRomLock bExit = True Else 'Password not correct 'GoTo Exit_Sub bExit = False End If End If Exit_Sub: Exit Sub ErrHandler: Select Case Err.Number Case 13: Resume Next ' wahrscheinlich INI-File nicht gefunden. Wird an anderer Stelle gemeldet. Case Else: Call Undefined_Error(Err.Number, Err.Description, "mnuExit_Click()") End Select Resume Next End Sub Private Sub mnuShow_Click() WindowState = vbNormal frmCDRomLock.Visible = True 'Form_MouseMove 0, 0, 7725, 0 End Sub Private Sub mnuLockAll_Click() On Error GoTo ErrHandler frmCDRomLock.optLock.Value = True frmCDRomLock.chkAll.Value = 1 frmCDRomLock.chkAll_Click frmCDRomLock.cmdDo_Click Exit_Sub: Exit Sub ErrHandler: Call Undefined_Error(Err.Number, Err.Description, "mnuLockAll_Click()") Resume Exit_Sub End Sub Private Sub mnuUnlockAll_Click() On Error GoTo ErrHandler frmCDRomLock.optUnlock.Value = True frmCDRomLock.chkAll.Value = 1 frmCDRomLock.chkAll_Click frmCDRomLock.cmdDo_Click Exit_Sub: Exit Sub ErrHandler: Call Undefined_Error(Err.Number, Err.Description, "mnuUnlockAll_Click()") Resume Exit_Sub End Sub Private Sub mnuPreferences_Click() frmPreferences.Visible = True End Sub '############################################################# ' EXECUTION ' ab hier kommen alle Teile, die Aktionen Ausführen, und evtl. ' von mehreren Programteilen verwendet werden '############################################################# Private Sub SetCurrentState() On Error GoTo ErrHandler Dim strDrive As String Dim i As Integer Dim intLock As Integer 'sicherstellen, daß nicht alle Laufwerke gesperrt/freigegeben werden frmCDRomLock.chkAll = 0 For i = 0 To (intCountDevicesCD - 1) imgCboDrives.ComboItems(i + 1).Selected = True strDrive = imgCboDrives.SelectedItem.Text strDrive = Left$(strDrive, 1) ' in strDrive steht nun z.B. "D:" 'FIXIT: Replace 'Left' function with 'Left$' function FixIT90210ae-R9757-R1B8ZE strDrive = "Device" & Left(strDrive, 1) intLock = INIGetValue(strIniFile, "Current", strDrive) imgCboDrives.ComboItems(i + 1).Selected = True If intLock = 1 Then frmCDRomLock.optLock_Click Else: frmCDRomLock.optUnlock_Click End If frmCDRomLock.cmdDo_Click Next i Exit_Sub: Exit Sub ErrHandler: Call Undefined_Error(Err.Number, Err.Description, "SetCurrentState()") Resume Exit_Sub End Sub 'readout the chosen Driveletter Private Sub Get_Driveletter(hDriveX As String, error As Boolean) On Error GoTo ErrHandler Dim txtDrive As String Dim xLockDrive As String txtDrive = imgCboDrives.SelectedItem.Text 'FIXIT: Replace 'UCase' function with 'UCase$' function FixIT90210ae-R9757-R1B8ZE xLockDrive = Left$(UCase(Trim$(txtDrive)), 1) If InStr(1, "ABCDEFGHIJKLMNOPQRSTUVWXYZ", xLockDrive) = 0 Then Exit Sub hDriveX = xLockDrive & ":" Exit_Sub: Exit Sub ErrHandler: Call Undefined_Error(Err.Number, Err.Description, "Get_Driveletter()") Resume Exit_Sub End Sub Private Sub Form_Unload(Cancel As Integer) RemoveFromTray Unload frmAbout Unload frmCheckPWD Unload frmSetPWD Unload frmPreferences Call SetWindowLong(Me.hWnd, GWL_WNDPROC, oldProcAddress) 'End End Sub Public Sub cmdDo_Click() On Error GoTo ErrHandler Dim strMsg As String Dim OSV As OSVERSIONINFO Dim retDummy As Long Dim txtMsg As String Dim blnPWD As Boolean Dim intlang As Integer ' Betriebssystem-Plattform bestimmen OSV.dwOSVersionInfoSize = 148 OSV.szCSDVersion = Space$(128) retDummy = GetVersionEx(OSV) If optLock.Value = True Then ' lock Parameter für Win NT/2K/XP PMR32.P1 = 1 Else ' unlock Parameter für Win NT/2K/XP PMR32.P1 = 0 If frmPreferences.chkPassword.Value = 1 Then If blnResume = True Then 'System comes back from Standby/Hibernate blnPWD = True Else Call CheckPassword(blnPWD) End If Else 'no password protection, therefore boolean has to be set to TRUE blnPWD = True End If If blnPWD = False Then 'Message ausgeben und Aktion abbrechen intlang = INIGetValue(strIniFile, "Language", "Language") Select Case intlang Case 0: strMsg = "Sorry, a password is required for this action." Case 1: strMsg = "Sorry, für diese Aktion wird ein Password gebraucht." Case Else: strMsg = "Sorry, a password is required for this action." End Select MsgBox strMsg GoTo Exit_Sub End If End If Select Case intSelect Case 1 'Laufwerk(e) sperren Call CDLock(intCountDevicesCD, blnAll) Case 2 'Laufwerk(e) freigeben Call CDLock(intCountDevicesCD, blnAll) Case 3 'Laufwerks-Schublade öffnen OpenCD Case 4 'Laufwerks-Schublade schließen CloseCD Case Else txtMsg = "Action not defined." MsgBox txtMsg End Select Exit_Sub: Exit Sub ErrHandler: Call Undefined_Error(Err.Number, Err.Description, "cmdDo_Click()") Resume Exit_Sub End Sub Private Sub LockCD_WinNT(hLwStatus As Long, hDriveX As String, retDummy As Long) On Error GoTo ErrHandler Dim strDrive As String Dim intTemp As Integer hLwStatus = CreateFile("\\.\" & hDriveX, _ GENERIC_READ Or GENERIC_WRITE, 0, ByVal 0, OPEN_EXISTING, 0, 0) If hLwStatus <> INVALID_HANDLE_VALUE Then 'Lock media Call DeviceIoControl(hLwStatus, IOCTL_STORAGE_MEDIA_REMOVAL, _ PMR32, Len(PMR32), ByVal 0, 0, retDummy, ByVal 0) Call CloseHandle(hLwStatus) End If 'den Parameter für das Laufwerk (lock/unlock) im INI-File unter [Current] setzen, 'wenn blnWriteIni = True If blnWriteIni = True Then intTemp = PMR32.P1 'FIXIT: Replace 'Left' function with 'Left$' function FixIT90210ae-R9757-R1B8ZE strDrive = "Device" & Left(hDriveX, 1) Call INISetValue(strIniFile, "Current", strDrive, intTemp) End If Exit_Sub: Exit Sub ErrHandler: Call Undefined_Error(Err.Number, Err.Description, "LockCD_WinNT()") Resume Exit_Sub End Sub '########################################################### ' TIMER ' überprüft alle 5 sec. auf PBT_APMRESUMESUSPEND '########################################################### Private Sub TimerSuspend_Timer() On Error GoTo ErrHandler 'Laufwerke neu setzen: 'Dazu unterbinden, daß ins INIfile geschrieben wird 'alle Laufwerke entsperren 'dann Werte aus INI-File setzen If frmCDRomLock.txtPWRMessage = "PBT_APMRESUMESUSPEND" Then blnResume = True If frmPreferences.chkResume Then blnWriteIni = False optUnlock = True frmCDRomLock.chkAll = 1 Call frmCDRomLock.chkAll_Click Call cmdDo_Click SetCurrentState blnWriteIni = True frmCDRomLock.txtPWRMessage = "" Else blnWriteIni = False optUnlock = True frmCDRomLock.chkAll = 1 Call frmCDRomLock.chkAll_Click Call cmdDo_Click blnWriteIni = True End If End If blnResume = False Exit_Sub: Exit Sub ErrHandler: Call Undefined_Error(Err.Number, Err.Description, "TimerSuspend_Timer()") Resume Exit_Sub End Sub '#################################################### ' EXPERIMENTELL ' ab hier experimenteller Code '#################################################### Private Sub AddMenuItem(ByVal txtCaption As String, ByVal txtMenu As String) Dim intNewIndex As Integer On Error GoTo ErrHandler Select Case txtMenu Case "mnuLock": intNewIndex = mnuLockSub.UBound + 1 Load mnuLockSub(intNewIndex) mnuLockSub(intNewIndex).Caption = txtCaption mnuLockSub(intNewIndex).Visible = True Case "mnuUnlock": intNewIndex = mnuUnlockSub.UBound + 1 Load mnuUnlockSub(intNewIndex) mnuUnlockSub(intNewIndex).Caption = txtCaption mnuUnlockSub(intNewIndex).Visible = True Case "mnuOpen": intNewIndex = mnuOpenSub.UBound + 1 Load mnuOpenSub(intNewIndex) mnuOpenSub(intNewIndex).Caption = txtCaption mnuOpenSub(intNewIndex).Visible = True Case "mnuClose": intNewIndex = mnuCloseSub.UBound + 1 Load mnuCloseSub(intNewIndex) mnuCloseSub(intNewIndex).Caption = txtCaption mnuCloseSub(intNewIndex).Visible = True Case Else: Exit Sub End Select Exit_Sub: Exit Sub ErrHandler: Call Undefined_Error(Err.Number, Err.Description, "AddMenuItem()") Resume Exit_Sub End Sub Private Sub RemoveMenuItem(ByVal txt As String, ByVal txtMenu As String) Dim ctl As Menu On Error GoTo ErrHandler Select Case txtMenu Case "mnuLock": For Each ctl In mnuLockSub If ctl.Caption = txt Then Unload ctl Next ctl Case "mnuUnlock": For Each ctl In mnuUnlockSub If ctl.Caption = txt Then Unload ctl Next ctl Case Else: Exit Sub End Select Exit_Sub: Exit Sub ErrHandler: Call Undefined_Error(Err.Number, Err.Description, "RemoveMenuItem()") Resume Exit_Sub End Sub Private Sub mnuLockSub_Click(Index As Integer) On Error GoTo ErrHandler imgCboDrives.ComboItems(Index).Selected = True If chkAll.Value = 1 Then chkAll.Value = 0 frmCDRomLock.chkAll_Click End If frmCDRomLock.optLock_Click frmCDRomLock.cmdDo_Click Exit_Sub: Exit Sub ErrHandler: Call Undefined_Error(Err.Number, Err.Description, "mnuLockSub_Click()") Resume Exit_Sub End Sub Private Sub mnuUnlockSub_Click(Index As Integer) On Error GoTo ErrHandler imgCboDrives.ComboItems(Index).Selected = True If chkAll.Value = 1 Then chkAll.Value = 0 frmCDRomLock.chkAll_Click End If frmCDRomLock.optUnlock_Click frmCDRomLock.cmdDo_Click Exit_Sub: Exit Sub ErrHandler: Call Undefined_Error(Err.Number, Err.Description, "mnuUnlockAll_Click()") Resume Exit_Sub End Sub Private Sub mnuOpenSub_Click(Index As Integer) On Error GoTo ErrHandler imgCboDrives.ComboItems(Index).Selected = True If chkAll.Value = 1 Then chkAll.Value = 0 frmCDRomLock.chkAll_Click End If frmCDRomLock.optOpen_Click frmCDRomLock.cmdDo_Click Exit_Sub: Exit Sub ErrHandler: Call Undefined_Error(Err.Number, Err.Description, "mnuOpenSub_Click()") Resume Exit_Sub End Sub Private Sub mnuCloseSub_Click(Index As Integer) On Error GoTo ErrHandler imgCboDrives.ComboItems(Index).Selected = True If chkAll.Value = 1 Then chkAll.Value = 0 frmCDRomLock.chkAll_Click End If frmCDRomLock.optClose_Click frmCDRomLock.cmdDo_Click Exit_Sub: Exit Sub ErrHandler: Call Undefined_Error(Err.Number, Err.Description, "mnuCloseSub_Click()") Resume Exit_Sub End Sub 'Entfernen des Schließen-Symbols Public Sub DisableCloseButton(hWnd As Long) Dim hMenu As Long hMenu = GetSystemMenu(hWnd, 0&) If hMenu Then Call DeleteMenu(hMenu, SC_CLOSE, MF_BYCOMMAND) DrawMenuBar hWnd End If End Sub 'Aktivieren des Schließen-Symbols 'Private Sub EnableCloseButton() ' EnableCloseButton frmCDRomLock.hWnd, True 'End Sub