Software Schnipsel
Visual-Basic
Snippes
Public Function PicResizeByWidth(ByVal SourceImage As
String, ByVal NewWidth As Integer) As Bitmap
Dim InputBitmap As New Bitmap(SourceImage)
Dim SizeFactor As Decimal = NewWidth /
InputBitmap.Width
Dim NewHeigth As Integer = SizeFactor *
InputBitmap.Height
Dim OutputBitmap As New
Bitmap(System.Drawing.Image.FromFile(SourceImage),
NewWidth, NewHeigth)
PicResizeByWidth = OutputBitmap
InputBitmap.Dispose()
OutputBitmap.Dispose()
End Function
Datei mittels Windows Dialog löschen
Private Declare Function SHFileOperation Lib "shell32.dll" Alias "SHFileOperationA" (ByRef lpFileOp As SHFILEOPSTRUCT) As Integer
Private Structure SHFILEOPSTRUCT
Dim hwnd As Integer
Dim wFunc As Integer
Dim pFrom As String
Dim pTo As String
Dim fFlags As Short
Dim fAnyOperationsAborted As Boolean
Dim hNameMappings As Integer
Dim lpszProgressTitle As String
End Structure
Const FO_DELETE As Short = &H3S
Const FOF_NOCONFIRMATION As Short = &H10S
Const FOF_ALLOWUNDO As Short = &H40S
Public Function ShellErase(ByVal strSource As String, ByVal Move2Bin As Boolean, ByVal WithDialog As Boolean, ByVal Handle As Long) As Boolean
Dim SFO As New SHFILEOPSTRUCT
If Right(strSource, 1) = "\" Then strSource = Mid(strSource, 1, Len(strSource) - 1)
ShellErase = True
With SFO
.hwnd = Handle
.wFunc = FO_DELETE
.pFrom = strSource & Chr(0) & Chr(0)
.pTo = "" & Chr(0) & Chr(0)
If Move2Bin = True Then
.fFlags = FOF_ALLOWUNDO
If WithDialog = False Then .fFlags = .fFlags + FOF_NOCONFIRMATION
Else
If WithDialog = False Then .fFlags = FOF_NOCONFIRMATION
End If
End With
Call SHFileOperation(SFO)
If SFO.fAnyOperationsAborted Then ShellErase = False
End Function
Private Declare Function SHFileOperation Lib "shell32.dll" Alias "SHFileOperationA" (ByRef lpFileOp As SHFILEOPSTRUCT) As Integer
Private Structure SHFILEOPSTRUCT
Dim hwnd As Integer
Dim wFunc As Integer
Dim pFrom As String
Dim pTo As String
Dim fFlags As Short
Dim fAnyOperationsAborted As Boolean
Dim hNameMappings As Integer
Dim lpszProgressTitle As String
End Structure
Const FO_COPY As Short = &H2S
Public Function ShellCopy(ByVal strSource As String, ByVal strTarget As String, ByVal Handle As Long) As Boolean
Dim SFO As New SHFILEOPSTRUCT
If Right(strSource, 1) = "\" Then strSource = Mid(strSource, 1, Len(strSource) - 1)
ShellCopy = True
With SFO
.hwnd = Handle
.wFunc = FO_COPY
.pFrom = strSource & Chr(0) & Chr(0)
.pTo = strTarget & Chr(0) & Chr(0)
End With
Call SHFileOperation(SFO)
If SFO.fAnyOperationsAborted Then ShellCopy = False
End Function
Private Function MeasureString(ByVal Text As String, ByVal FontName As String, ByVal FontSize As Single) As SizeF
Dim Bitmap As Bitmap
Dim Graphic As Graphics
Dim Font As New Font(FontName, FontSize)
Bitmap = New Bitmap(1, 1)
Graphic = Graphics.FromImage(Bitmap)
MeasureString = Graphic.MeasureString(Text, Font)
Graphic.Dispose()
Bitmap.Dispose()
End Function
private static bool ValueExist(RegistryKey OurKey, string
strValue)
{
string[] VN = OurKey.GetValueNames();
foreach (string v in VN)
{
string Val;
if (OurKey.GetValue(v) is byte[])
{
System.Text.ASCIIEncoding enc = new
System.Text.ASCIIEncoding();
Val =
enc.GetString((byte[])OurKey.GetValue(v));
}
else { Val = (string)OurKey.GetValue(v);
}
if (Val == strValue)
{
return true;
}
}
return false;
}
Imports Microsoft.Win32
Public Enum HKEY_ROOTS As Integer
HKEY_CLASSES_ROOT = 0
HKEY_CURRENT_USER = 1
HKEY_LOCAL_MACHINE = 2
HKEY_USERS = 3
HKEY_CURRENT_CONFIG = 4
VB_AND_VBA_PROGRAM_SETTINGS = 5
End Enum
Public Function RegDelValueName(ByVal Root As HKEY_ROOTS, ByVal Path As String, ByVal ValueName As String) As Boolean
Try
Select Case Root
Case 0 : Registry.ClassesRoot.OpenSubKey(Path, True).DeleteValue(ValueName)
Case 1 : Registry.CurrentUser.OpenSubKey(Path, True).DeleteValue(ValueName)
Case 2 : Registry.LocalMachine.OpenSubKey(Path, True).DeleteValue(ValueName)
Case 3 : Registry.Users.OpenSubKey(Path, True).DeleteValue(ValueName)
Case 4 : Registry.CurrentConfig.OpenSubKey(Path, True).DeleteValue(ValueName)
Case 5 : Registry.CurrentUser.OpenSubKey("Software\VB and VBA Program Settings\" & Path, True).DeleteValue(ValueName)
End Select
Return True
Catch ex As Exception
Return False
End Try
End Function
In der Registry eingetragenen IP-Addressen auslesen.
Das nachfolgenden Snippet ermöglicht dies und gibt die Daten
als String zurück.
Public Shared Function GetIPAddresses(ByVal adapter As
String) As String()
Dim oBuffer As New ArrayList()
Dim sInterface As String
Dim arrInterface As String()
Dim sIPAddress As String
Dim arrIPAddress As String()
Dim bDHCP As Boolean
Dim strBaseKey As String =
"SYSTEM\CurrentControlSet\Services\Tcpip\Parameters\Interfac
es\"
Dim objRootKey As Microsoft.Win32.RegistryKey
Dim objKey As Microsoft.Win32.RegistryKey
Dim Registry As Microsoft.Win32.Registry = Nothing
objRootKey = Registry.LocalMachine.OpenSubKey(strBaseKey,
False)
If objRootKey Is Nothing Then
Return oBuffer.ToArray(Type.GetType("System.String"))
Exit Function
End If
arrInterface = objRootKey.GetSubKeyNames()
For Each sInterface In arrInterface
objKey = Registry.LocalMachine.OpenSubKey(strBaseKey &
sInterface & "\", False)
' Make sure that we got a key!
If Not (objKey Is Nothing) Then
' Pruft ob DHCP eingeschaltet ist
' wenn nicht, werden alle vorghanden IP addressen
geladen
bDHCP = objKey.GetValue("EnableDCHP", False)
If bDHCP Then
' Einzelne IP address auslesen
sIPAddress = objKey.GetValue("DhcpIPAddress", "")
' Pruefung ob gueltige IP
If (sIPAddress.Length > 0) And (sIPAddress <>
"0.0.0.0") Then
oBuffer.Add(sIPAddress)
End If
Else
For Each oName As Object In objKey.GetValueNames
' MsgBox(oName.ToString())
If oName.ToString.ToLower = "ipaddress" Then
' Lesen und array erstellen
arrIPAddress = objKey.GetValue(oName, "")
' Pruefung ob gueltige IP
For Each sIPAddress In arrIPAddress
If (sIPAddress.Length > 0) And (sIPAddress <>
"0.0.0.0") Then
oBuffer.Add(sIPAddress)
End If
Next
End If
Next
End If
End If
Next
Registry.LocalMachine.Close()
Return oBuffer.ToArray(Type.GetType("System.String"))
End Function