Software Schnipsel

Visual-Basic

Snippes


 
Public Function PicResizeByWidth(ByVal SourceImage As 
StringByVal 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), 
NewWidthNewHeigth)
    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 StringByVal Move2Bin As BooleanByVal WithDialog As BooleanByVal Handle As Long) As Boolean
    Dim SFO As New SHFILEOPSTRUCT
    If Right(strSource1) = "\" 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 StringByVal strTarget As StringByVal Handle As Long) As Boolean
    Dim SFO As New SHFILEOPSTRUCT
    If Right(strSource1) = "\" 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 StringByVal FontName As StringByVal FontSize As Single) As SizeF
    Dim Bitmap As Bitmap
    Dim Graphic As Graphics
    Dim Font As New Font(FontNameFontSize)
    Bitmap = New Bitmap(11)
    Graphic Graphics.FromImage(Bitmap)
    MeasureString Graphic.MeasureString(TextFont)
    Graphic.Dispose()
    Bitmap.Dispose()
End Function





 
private static bool ValueExist(RegistryKey OurKeystring 
strValue)
   {
	     string[] VN OurKey.GetValueNames();
	    foreach (string v in VN)
	    {
		                string Val;
		                if (OurKey.GetValue(vis 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_ROOTSByVal Path As StringByVal ValueName As String) As Boolean
    Try
        Select Case Root
            Case Registry.ClassesRoot.OpenSubKey(PathTrue).DeleteValue(ValueName)
            Case Registry.CurrentUser.OpenSubKey(PathTrue).DeleteValue(ValueName)
            Case Registry.LocalMachine.OpenSubKey(PathTrue).DeleteValue(ValueName)
            Case Registry.Users.OpenSubKey(PathTrue).DeleteValue(ValueName)
            Case Registry.CurrentConfig.OpenSubKey(PathTrue).DeleteValue(ValueName)
            Case 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