IT-Academy Logo
Sign Up Login Help
Home - Programmieren - Visual Basic - Programmiermöglichkeiten mit VB6



Programmiermöglichkeiten mit VB6

Mit Visual Basic lassen sich viele nützliche kleine Programme schreiben. Hier ein paar Beispiele.


Autor: Peter Schmitz (dav133)
Datum: 27-10-2003, 01:01:32
Referenzen: keine
Schwierigkeit: Fortgeschrittene
Ansichten: 15063x
Rating: 10 (3x bewertet)

Hinweis:

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.

[Druckansicht] [Als E-Mail senden] [Kommentar verfassen]



Zugangssperre mit VB6 erstellen

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)

'Nötige Konstanten
Const KEYEVENTF_KEYUP = &H2
Const VK_MENU = &H12
Const VK_SNAPSHOT = &H2C

'Ü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

'Benötigte Konstanten, um Werte auszulesen
Const REG_NONE = 0
Const REG_SZ = 1
Const REG_EXPAND_SZ = 2
Const REG_BINARY = 3
Const REG_DWORD = 4
Const HKEY_CLASSES_ROOT = &H80000000
Const HKEY_CURRENT_USER = &H80000001
Const HKEY_LOCAL_MACHINE = &H80000002
Const HKEY_USERS = &H80000003
Const KEY_QUERY_VALUE = &H1

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!


[back to top]



Userdaten
User nicht eingeloggt

Gesamtranking
Werbung
Datenbankstand
Autoren:04510
Artikel:00815
Glossar:04116
News:13565
Userbeiträge:16552
Queueeinträge:06247
News Umfrage
Ihre Anforderungen an ein Online-Zeiterfassungs-Produkt?
Mobile Nutzung möglich (Ipone, Android)
Externe API Schnittstelle/Plugins dritter
Zeiterfassung meiner Mitarbeiter
Exportieren in CSV/XLS
Siehe Kommentar



[Results] | [Archiv] Votes: 1158
Comments: 0