Für den hier dargestellte Inhalt ist nicht der Betreiber der Plattform,
sondern der jeweilige Autor verantwortlich.
Falls Sie Missbrauch vermuten, bitten wir Sie, uns unter missbrauch@it-academy.cc
zu kontaktieren.
Wenn Sie Win9x auf ihrem PC laufen haben und am Start ein Codewort eingerichtet ist, kann man es per Druck auf Abbrechen problemlos umgehen. Wenn Sie dieses Programm in den Autostartordner schieben, kann ein unbetuchter Neugieriger den Zugriff auf Ihre Daten vergessen...
'Erstellen Sie bitte eine Form mit dem Parameter ControlBox = False, damit man diese nicht mehr beenden 'kann. Dann fügen Sie folgende Steuerelemente hinzu:
'Textfeld Text1
'Timer Timer1
'Zunächst die benötigten API-Deklarationen
Private Declare Function setcursorpos Lib "user32" Alias "SetCursorPos" _
(ByVal X As Long, ByVal Y As Long) As Long
Private Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" _
(ByVal uAction As Long, ByVal uParam As Long, lpvParam As Any, ByVal fuWinIni As Long) As Long
'Deklaration der nötigen Variablen
Private aw As Boolean
Private RetVal As Long
Private SysParam As Long
'Type-Variable, um die Maus auf der Stelle festzusetzen
Private Type tInputState
MouseX As Single
MouseButton As Integer
KeyCode As Long
End Type
'Bei Formstart wird der Timer angeschaltet, sofern er das noch nicht ist und das Interval auf 1 gesetzt
'Die Formgröße wird maximiert
Private Sub Form_Load()
Timer1.Interval = 1
Timer1.Enabled = True
Form1.WindowState = 2
End Sub
'Sollte das Codewort eingegeben sein (in diesem Falle "qwert"), so schließt sich die Form
'und nomales arbeiten ist möglich
Private Sub Text1_Change()
If Text1.Text = "qwert" Then End
End Sub
'strg+alt+entf, strg+alt und alt+F4 deaktivieren und die Maus auf der selben Stelle festsetzen
Private Sub Timer1_Timer()
SysParam = 97
RetVal = SystemParametersInfo(SysParam, True, aw, 0)
setcursorpos 460, 330
End Sub
So dürfte es dem unerwünschtem Anwender schwerer gemacht werden, unter Win9x an Ihre Daten heranzukommen. Sicherlich gibt es noch Möglichkeiten, das Ganze zu umgehen, aber einen weniger erfahrenen Anwender dürfte diese Programm erstmal abschrecken. Sie können dann auch auf die Form ein Label mit einer netten Nachricht einfügen oder die Zugänge im Hintergrund mitloggen (siehe Absatz "Dateien aus VB6 erzeugen und öffnen"). Das eignet sich vorzüglich, wenn Sie im Urlaub sind und wollen, dass Ihr PC unangetastet bleibt.
Internetverweise (Links) mit VB6 realisieren
Links sind mit der Programmiersprache HTML kein Problem. Aber unter VB6 erfordert das direkte Verweisen auf eine Internetseite oder ein HTML-Dokument schon ein wenig mehr Aufwand...
'Erstellen Sie bitte ein Standard-EXE Projekt und fügen Sie darauf ein Label mit Namen Label1 ein
'Zunächst die benötigten API-Deklarationen
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hWnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Private Sub URLGoTo(ByVal hWnd As Long)
'Internetseite aktivieren und Mauspointer auf "Hand" setzen
Screen.MousePointer = 11
'Die Seite abc besuchen und den Mauspointer wieder auf Standard setzen
Call ShellExecute(hWnd, "Open", "http://www.abc.de/";, "", "", 1)
Screen.MousePointer = 0
End Sub
'Beim Formstart die Labelcaption auf die gewünschte Adresse setzen (Labelfarbe linktypisch blau)
Private Sub Form_Load()
Label1.Caption = "http://www.abc.de/";
Label1.ForeColor = vbBlue
End Sub
'Beim Klicken auf das Label die Funktion URLGoTo aufrufen
Private Sub Label1_Click()
URLGoTo Me.hWnd
End Sub
Anmerkung: Bei einigen VB-Systemen funktioniert das Umstellen auf den Mauspointer "Hand" nicht. Dann müssen Sie eben mit normalem Mauscursor zurechtkommen.
VB6 und die Netzwerkprogrammierung
Dieser Tipp versteht sich als kleiner Teil des riesengroßen Kapitels "Netzwerkprogrammierung unter VB6" und beschränkt sich auf das Auslesen der eigenen IP-Adresse und das Ändern des eigenen PC-Namens.
'Starten Sie ein neues EXE-Projekt und fügen Sie folgendes hinzu:
'Commandbutton cmdPCname
'Textfeld txtpcname
'Winsock-Steuerelement (Strg+T in der Formansicht drücken und das
'Microsoft Winsock Control 6.0 auswählen (Name Winsock1)
'Commandbutton cmdIP
'Zuerst die benötigte API-Deklaration, um den PC-Namen zu ändern
Private Declare Function SetComputerName Lib "kernel32" _
Alias "SetComputerNameA" (ByVal lpComputerName As _
String) As Long
Private Sub cmdPCname_Click()
Dim PCname
Dim retval
PCname = txtpcname.text
'Der neue PCname ist der Text des Textfelds txtpcname
retval = SetComputerName(PcName)
'PCname wurde festgelegt
End Sub
Private Sub cmdIP_Click()
'In einer MessageBox die IP ausgeben
Msgbox "Ihre IP lautet: " & Winsock1.LocalIP & "!",vbInformation + vbOKonly, "IP-Adresse: "
End Sub
Dateien aus VB6 erzeugen und öffnen
Angenommen, Sie programmieren ein Programm, dass viele Optionen und Einstellmöglichkeiten bietet und Sie wollen dieses Programm möglichst komfortabel auslegen. Normalerweise müsste der User jedesmal alle Optionen neu einstellen. Da wäre es doch ganz nützlich, wenn der arme Anwender die mühsam eingestellten Optionen auch sichern kann und das Programm beim nächsten mal automatisch damit aufwartet. Hier der Code und ein paar Erklärungen.
'Bitte eine Form (normale EXE) starten und darauf einfügen:
'Textfenster txttext
'Commandbutton cmdsp
'Commandbutton cmdok
'Diese Sub speichert den Inhalt des Tetxfensters txttext in der Datei XYZ.txt in den eigenen Dateien
Private Sub cmdsp_click()
Dim dateiname As String
Dim dateinummer As Integer
'Dateiname ist der Pfad der anzulegenden Datei und Dateinummer ist eine von VB benötigte Nummer
dateiname = "C:Dateien;
dateinummer = FreeFile
'Freefile übergibt nötige Parameter
Open dateiname For Output As dateinummer
'Output erstellt eine neue Textdatei, Append hängt den Inhalt an. Es gibt noch weitere, aber eher unwichtige 'Optionen neben Output und Append
Print #dateinummer, txttext.Text
'Der Text des Textfensters soll in die Datei geschrieben werden.
'Print #dateinummer, "Irgendein Text" ist auch möglich
Close dateinummer
End Sub
'Datei schließen und Sub beenden. Der Anwender bekommt davon nichts mit
'Diese Sub öffnet die datei XYZ.txt und schreibt den Inhalt in das Textfenster
Private Sub cmdok_click()
Dim dateinummer As Integer
Dim dateigroesse As Long
dateinummer = FreeFile
dateiname = "C:Dateien;
Open dateiname For Input As dateinummer
'Input veranlasst VB dazu, die Textdatei in das Textfenster txttext zu schreiben. Bei nicht vorhandensein der
'Textdatei wird eine Fehlermeldung ausgegeben
dateigroesse = LOF(dateinummer)
'Nötige Parameterübergabe (LOF = Lead of File)
txttext.Text = Input(dateigroesse, dateinummer)
'Ins Textfenster hineinschreiben
Close dateinummer
End Sub
'Datei wieder schließen.
Man kann damit natürlich variieren. Man kann auch Captions von Labeln oder ausgedachte Werte schreiben. Alles andere können Sie ja selbst ausprobieren. Weiteres erfahren Sie, wenn Sie die VB-Hilfe aufrufen.
VB6 und der Arbeitsspeicher
VB6 kann auch so einiges über den Arbeitsspeicher herausfinden: Momentane Belegung (Insgesamt und in Prozent), Größe der Auslagerungsdate usw. Im Debug-Fenster werden hierbei alle relevanten Werte angezeigt.
'Erstellen Sie bitte ein neues EXE-Projekt mit dem Commandbutton cmdstart darauf
'Zunächst die benötigte API-Funktion
Private Declare Sub GlobalMemoryStatus Lib "kernel32" _
(lpBuffer As MEMORYSTATUS)
'Auslese-Type-Struktur
Private Type MEMORYSTATUS
dwLength As Long
dwMemoryLoad As Long
dwTotalPhys As Long
dwAvailPhys As Long
dwTotalPageFile As Long
dwAvailPageFile As Long
dwTotalVirtual As Long
dwAvailVirtual As Long
End Type
Dim lpInfoPuffer As MEMORYSTATUS
'Ausgabe der Infos im Debugfenster. Die /64's sind dazu da, die Größe (von Bit) auf MByte zu bringen
Private Sub cmdStart_Click()
lpInfoPuffer.dwLength = Len(lpInfoPuffer)
GlobalMemoryStatus lpInfoPuffer
Debug.Print "Prozent des belegten Speichers: " & _
lpInfoPuffer.dwMemoryLoad & "%"
Debug.Print "Gesamtarbeitsspeicher: " & _
Format(lpInfoPuffer.dwTotalPhys, "###,####,###") / 64 / 64 / 64 / 64
Debug.Print "Verfügbarer Arbeitsspeicher: " & _
Format(lpInfoPuffer.dwAvailPhys, "###,####,###") / 64 / 64 / 64 / 64
Debug.Print "Größe der Auslagerungsdatei: " & _
Format(lpInfoPuffer.dwTotalPageFile, "###,####,###") / 64 / 64 / 64 / 64
Debug.Print "Verfügbarer Arbeitsspeicher: " & _
Format(lpInfoPuffer.dwAvailPageFile, "###,####,###") / 64 / 64 / 64 / 64
Debug.Print "Größe d. virtuellen Speichers: " & _
Format(lpInfoPuffer.dwTotalVirtual, "###,####,###") / 64 / 64 / 64 / 64
Debug.Print "Verfügbarer virtueller Speicher: " & _
Format(lpInfoPuffer.dwAvailVirtual, "###,####,###") / 64 / 64 / 64 / 64
End Sub
Einen Screenshot unter VB6 erstellen
Sie müssen/wollen aus welchem Grund auch immer einen Screenshot des aktuellen Fensters erstellen? Kein Problem! Hier der Code.
'Erstellen Sie bitte eine neue Form und fügen Sie einen Commandbutton Command1 ein
'zunächst die benötigten API-Deklarationen
Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
'Die nachfolgende Prozedur erstellt das Screenshot
Private Sub MakeScreenshot(ByVal ActiveWindow As Boolean)
'Übergebene Parameter
If ActiveWindow Then keybd_event VK_MENU, 0, 0, 0
keybd_event VK_SNAPSHOT, 0, 0, 0
keybd_event VK_SNAPSHOT, 0, KEYEVENTF_KEYUP, 0
If ActiveWindow Then keybd_event VK_MENU, 0, KEYEVENTF_KEYUP, 0
DoEvents
End Sub
Private Sub Command1_Click()
'Funktion aufrufen
MakeScreenshot (Index = 0)
'Der Screenshot lässt sich per Einfügen-Befehl in z.B. Paint einfügen
End Sub
VB6 und die Registry
Der Name "Basic" täuscht: VB6 kann sogar in die Registry eingreifen. In nachfolgendem Artikel demonstriere ich, wie man das Windows-Stammverzeichnis aus der Registry ausliest.
'Erstellen Sie bitte eine neue Form und fügen Sie den Quellcode ein. Auf die Form müssen Sie den 'Commandbutton Command1 platzieren
'Zunächst die benötigten API-Deklarationen
Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lPCbData As Long) As Long ' Besitzt lpData den Typ String, muss ByVal vorausgehen
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Sub command1_Click()
Dim hKey As Long, RetVal As Long
Dim Wert As String
Wert = Space(256)
' Schlüssel öffnen
RetVal = RegOpenKeyEx(HKEY_LOCAL_MACHINE, _
"SOFTWARE;, 0, _
KEY_QUERY_VALUE, hKey)
' Wert abfragen
RetVal = RegQueryValueEx(hKey, "WinDir", 0, REG_SZ, _
ByVal Wert, Len(Wert))
' Ergebnis ausgeben
MsgBox "System installiert in: " & Wert, _
vbInformation, "Systeminstallationsermittler"
' Schlüssel nun wieder schließen
RetVal = RegCloseKey(hKey)
End Sub
Das war doch alles andere als "Basic", oder ?? ;-)
Mit VB6 das Verzeichnis des Temporären Ordner ermitteln
In Zusamenhang mit dem Tipp >>Dateien aus VB6 erzeugen und öffnen<< könnte sich dieser Artikel für Sie als aüßerst nützlich erweisen. Mit ihm kann man das Verzeichnis des Temporären Ordners ermitteln und die relevanten Dateien dort hineinschreiben. Daraus kann man sie selbstverständlich auch wieder auslesen. Aber auch, wenn Sie beim Beenden per >>Form_Terminate()<< noch schnell Werte "hinterlassen" möchten empfiehlt sich es zu wissen, wo sich der Temporäre Ordner >>versteckt<<.
'Bitte starten Sie ein normales EXE-Projekt und fügen einen Commandbutton cmd ein
'Zunächst die benötigte API-Deklaration
Private Declare Function GetTempPath Lib "kernel32" Alias _
"GetTempPathA" (ByVal nBufferLength As Long, ByVal _
lpBuffer As String) As Long
'Maximale Pfadlänge in Zeichen
Private Const MAX_PATH = 260
'Erstellen einer Funktion
Private Function GetTmpPath()
'Das Verzeichnis des Ordners
Dim strFolder As String
'Variable für das Speichern des Ergebnisses
Dim lngResult As Long
'Übergabe des Parameters
strFolder = String(MAX_PATH, 0)
'Übergabe der Struktur des Ergebnisses
lngResult = GetTempPath(MAX_PATH, strFolder)
'Wenn der Pfadname länger als 0 ist (was in der Regel der Fall sein sollte),
'dann wird der Pfadname übergeben, anderenfalls ist der Name nichts (Fehler)
If lngResult <> 0 Then
GetTmpPath = Left(strFolder, InStr(strFolder, Chr(0)) - 1)
Else
GetTmpPath = ""
End If
End Function
'Der Commandbutton präsentiert die Messagebox mit dem Pfad des Temporären Ordners
Private Sub Command1_Click()
Msgbox "Das Verzeichnis des temporären Ordners lautet: " & GetTmpPath &"",vbinformation + vbokonly,"Temporäreer Ordner: "
End Sub
Natürlich muss das Ergebnis (GetTmpPath) nicht in einer MessageBox ausgegeben werden, sondern kann auch zum schreiben einer Datei verwendet werden.
VB6 und die Auflösung
Die Auflösung zu ändern kann in manchen Fällen (etwa bei Freunden...) ganz witzig sein. Hier der Quellcode zum Ändern der Auflösung unter VB6. Ich übernehme kein Gewähr für die Funktion des Programms. U.U. kann es sogar den Monitor beschädigen ("falsche" Auflösungen wie 699x1987)
'Erstellen Sie bitte ein normales EXE-Projekt und fügen einen Commandbutton cmdÄndern ein
'Zunächst die benötigten API-Deklarationen
Private Declare Function EnumDisplaySettings Lib "user32" Alias "EnumDisplaySettingsA" (ByVal lpszDeviceName As Long, ByVal iModeNum As Long, lpDevMode As Any) As Boolean
Private Declare Function ChangeDisplaySettings Lib "user32" Alias "ChangeDisplaySettingsA" (lpDevMode As Any, ByVal dwflags As Long) As Long
'Konstanten und Type-Variablen, um die Infrastruktur zu schaffen
Const CCHDEVICENAME = 32
Const CCHFORMNAME = 32
Const DM_PELSWIDTH = &H80000
Const DM_PELSHEIGHT = &H100000
Private Type DEVMODE
dmDeviceName As String * CCHDEVICENAME
dmSpecVersion As Integer
dmDriverVersion As Integer
dmSize As Integer
dmDriverExtra As Integer
dmFields As Long
dmOrientation As Integer
dmPaperSize As Integer
dmPaperLength As Integer
dmPaperWidth As Integer
dmScale As Integer
dmCopies As Integer
dmDefaultSource As Integer
dmPrintQuality As Integer
dmColor As Integer
dmDuplex As Integer
dmYResolution As Integer
dmTTOption As Integer
dmCollate As Integer
dmFormName As String * CCHFORMNAME
dmUnusedPadding As Integer
dmBitsPerPel As Integer
dmPelsWidth As Long
dmPelsHeight As Long
dmDisplayFlags As Long
dmDisplayFrequency As Long
End Type
Private n As DEVMODE
'Ändern-Button
Private Sub cmdÄndern_Click()
'Ablagevariablen definieren
Dim RetVal As Long, i As Long
'Diese auf Ablage "vorbereiten"
'Do-While Schleife erstellen
Do
RetVal = EnumDisplaySettings(0&, i&, n)
i = i + 1
'Solange Wiederholen, bis "Vorbereitung" abgeschlossen ist
Loop Until RetVal = False
'Der Änderungsvariable die Auflösung zuweißen
With n
.dmFields = DM_PELSWIDTH Or DM_PELSHEIGHT
.dmPelsWidth = 1024 'Breite der Auflösung in Pixeln (andere gültige Werte: 640, 800, 1280, 1600)
.dmPelsHeight = 768 'Höhe der Auflösung in Pixeln (andere gültige Werte: 480, 600, 1024, 1200)
End With
'Hier wird umgestellt
RetVal = ChangeDisplaySettings(n, 0)
End Sub
Nochmals die Anmerkung: Nicht jeder Monitor verträgt alle Auflösungen! Ich übernehme keine Haftung für aus dem Gebrauch mit diesem Programm entstehende Schäden!
