360 lines
19 KiB
VB.net
Executable File
360 lines
19 KiB
VB.net
Executable File
Namespace Tools
|
|
Namespace Filesystem
|
|
<HideModuleName()>
|
|
Module Filesystem
|
|
|
|
'######################################################################################
|
|
'################Function GetFilesFromDir(Pfad; Extention; RecursionsTiefe)############
|
|
Public Function GetFilesFromDir(ByVal Pfad As String, ByVal Extention() As String, Optional ByVal RecursionsTiefe As Integer = 0) As String()
|
|
|
|
If Extention.Length <= 0 Then ReDim Extention(0)
|
|
If Extention(0) = Nothing Then Extention(0) = ""
|
|
|
|
Dim aPathList(0) As String
|
|
Dim aPathList_Extention(0) As String
|
|
|
|
'Überprüfen auf Pfad Korektheit
|
|
If System.IO.Directory.Exists(Pfad) Then
|
|
|
|
'Auslesen der Ordner
|
|
_GetFilesFromDir(aPathList, Pfad, RecursionsTiefe)
|
|
If aPathList.Length <= 0 Then ReDim aPathList(0)
|
|
|
|
'Extention Rausfiltern
|
|
If Not (Array.IndexOf(Extention, "*") >= 0) Then
|
|
For Each EachFile In aPathList
|
|
If (Array.IndexOf(Extention, System.IO.Path.GetExtension(EachFile)) >= 0) Then
|
|
'Undimensionierte Arrays werden Dimensioniert
|
|
If aPathList_Extention.Length <= 0 Then ReDim aPathList_Extention(0)
|
|
|
|
'Wenn Letzter Wert Im Array nicht vergeben ist
|
|
If (aPathList_Extention(UBound(aPathList_Extention)) = Nothing) Or (aPathList_Extention(UBound(aPathList_Extention)) = "") Then
|
|
aPathList_Extention(UBound(aPathList_Extention)) = EachFile
|
|
Else
|
|
'Wenn Letzter Wert Im Array ist vergeben!
|
|
ReDim Preserve aPathList_Extention(UBound(aPathList_Extention) + 1)
|
|
aPathList_Extention(UBound(aPathList_Extention)) = EachFile
|
|
End If
|
|
End If
|
|
Next
|
|
Else
|
|
aPathList_Extention = aPathList
|
|
End If
|
|
|
|
'Array Sortieren
|
|
Array.Sort(aPathList_Extention)
|
|
|
|
Else
|
|
aPathList_Extention(0) = Nothing
|
|
End If
|
|
GetFilesFromDir = aPathList_Extention
|
|
End Function
|
|
|
|
Private Sub _GetFilesFromDir(ByRef aAim As String(), ByVal Pfad As String, ByVal RecursionsTiefe As Integer)
|
|
Try 'Um das Zugrifsrecht Problem zu Beseitigen
|
|
If RecursionsTiefe > 0 Then
|
|
Dim aDirs As String() = System.IO.Directory.GetDirectories(Pfad)
|
|
For Each EachDir In aDirs
|
|
_GetFilesFromDir(aAim, EachDir, (RecursionsTiefe - 1))
|
|
Next
|
|
End If
|
|
Dim aFiles As String() = System.IO.Directory.GetFiles(Pfad)
|
|
|
|
For Each EachFile In aFiles
|
|
If aAim.Length <= 0 Then ReDim aAim(0)
|
|
If (aAim(UBound(aAim)) = Nothing) Or (aAim(UBound(aAim)) = "") Then
|
|
aAim(UBound(aAim)) = EachFile
|
|
Else
|
|
ReDim Preserve aAim(UBound(aAim) + 1)
|
|
aAim(UBound(aAim)) = EachFile
|
|
End If
|
|
Next
|
|
Catch err As System.UnauthorizedAccessException
|
|
End Try
|
|
End Sub 'Teil von Finction GetFilesFromDir
|
|
'######################################################################################
|
|
'######################################################################################
|
|
|
|
'### with .Net: Imports System.IO; Directory.Exists(Path)####
|
|
Private Function FileExists(ByVal FileName As String) As Boolean
|
|
On Error Resume Next
|
|
FileExists = Not CBool(GetAttr(FileName) And (vbDirectory Or vbVolume))
|
|
On Error GoTo 0
|
|
End Function 'FileExists Vor VBA AND VB without .Net
|
|
|
|
'### with .Net: Imports System.IO; File.Exists(Path)####
|
|
Private Function DirExists(ByVal DirectoryName As String) As Boolean
|
|
On Error Resume Next
|
|
DirExists = CBool(GetAttr(DirectoryName) And vbDirectory)
|
|
On Error GoTo 0
|
|
End Function 'DirExists Vor VBA AND VB without .Net
|
|
'######################################################################################
|
|
'######################################################################################
|
|
|
|
End Module
|
|
End Namespace 'Filesystem
|
|
Namespace Dialoge
|
|
<HideModuleName()>
|
|
Module Dialoge
|
|
|
|
Public Function FolderBrowserDialog(Optional ByVal sStartPath As String = "C:\", Optional ByVal ShowNewFolderButton As Boolean = True, Optional ByRef CheckError As Boolean = False) As String
|
|
'Verändert die übergebene variable,
|
|
'wenn der benutzer durch "OK" den neuen Pfad bestätigt
|
|
FolderBrowserDialog = ""
|
|
Using FolderBrowserD As New FolderBrowserDialog
|
|
With FolderBrowserD
|
|
' Ordnervorschlag
|
|
.SelectedPath = sStartPath
|
|
|
|
.Description = "Bitte einen Ordner auswählen."
|
|
|
|
'#Button "Neuen Ordner erstellen" anzeigen
|
|
.ShowNewFolderButton = ShowNewFolderButton
|
|
|
|
'#ruft Dialog auf, weitere Ausführung nur bei Resultat "OK"
|
|
If .ShowDialog = Windows.Forms.DialogResult.OK Then
|
|
FolderBrowserDialog = .SelectedPath
|
|
Else
|
|
CheckError = True '#Ausführung bei Abruch
|
|
End If
|
|
End With 'FolderBrowserD
|
|
End Using
|
|
End Function 'FolderBrowserDialog
|
|
|
|
'###################################################################################################################
|
|
'############### OpenFileDialog ####################################################################################
|
|
'###################################################################################################################
|
|
|
|
'Private Sub Button1_Click(ByVal sender As Object, ByVal e As _
|
|
' EventArgs) Handles Button1.Click
|
|
' ' ### OpenFileDialog ###
|
|
' Dim txt As String = ""
|
|
' Using ofd As New OpenFileDialog
|
|
|
|
' With ofd
|
|
' ' Ordnervorschlag
|
|
' .InitialDirectory = Pfad
|
|
' .Title = "Wähle Datei zum öffnen"
|
|
' ' Dateivorschlag (falls sinnvoll)
|
|
' ' .FileName = "Datei.gif"
|
|
|
|
' ' Filter
|
|
' .Filter = TextBox2.Text
|
|
' ' boolsche Abfrage ob Mehrfachauswahl zulässig
|
|
' .Multiselect = Not ChkEinzel.Checked
|
|
|
|
' ' Zeile ruft den Dialog auf, weitere Ausführung nur bei
|
|
' ' Resultat OK:
|
|
' If .ShowDialog = Windows.Forms.DialogResult.OK Then
|
|
' If ChkEinzel.Checked = True Then
|
|
' ' Bei Einzelauswahl wertet man .FileName aus
|
|
' txt = .FileName & vbNewLine
|
|
|
|
' Else
|
|
' ' Bei möglicher Multiselektion wertet man
|
|
' ' das Array .FileNames aus
|
|
' For Each filename As String In .FileNames
|
|
' txt &= filename & vbNewLine
|
|
' Next
|
|
' End If
|
|
' ' Welcher Filter wurde verwendet?
|
|
' Dim idx As Integer = .FilterIndex
|
|
' txt &= "FilterIndex: " & idx.ToString & vbNewLine
|
|
' txt &= "Gewählter Filter: " & FilterDescription(.Filter, _
|
|
' idx) & vbNewLine
|
|
' txt &= "Multiselect: " & .Multiselect.ToString
|
|
' Else
|
|
' txt = "Abbruch durch Benutzer"
|
|
' End If
|
|
' End With
|
|
' End Using
|
|
' TextBox1.Text = txt
|
|
'End Sub 'OpenFileDialog
|
|
|
|
'###################################################################################################################
|
|
'############### SaveFileDialog ####################################################################################
|
|
'###################################################################################################################
|
|
|
|
'Private Sub Button2_Click(ByVal sender As Object, ByVal e As _
|
|
' EventArgs) Handles Button2.Click
|
|
' ' ### SaveFileDialog ###
|
|
' Dim txt As String
|
|
' Using sfd As New SaveFileDialog
|
|
|
|
' With sfd
|
|
' ' Ordnervorschlag
|
|
' .InitialDirectory = Pfad
|
|
' .Title = "Eingabe Datei zum speichern (Es wird hier nicht "_
|
|
' "wirklich überschrieben)"
|
|
' ' Dateivorschlag
|
|
' .FileName = "Datei.gif"
|
|
' ' Filter
|
|
' .Filter = TextBox2.Text
|
|
|
|
' ' Zeile ruft den Dialog auf, weitere Ausführung nur bei
|
|
' ' Resultat OK:
|
|
' If .ShowDialog = Windows.Forms.DialogResult.OK Then
|
|
' txt = .FileName & vbNewLine
|
|
|
|
' ' Welcher Filter wurde verwendet?
|
|
' Dim idx As Integer = .FilterIndex
|
|
' txt &= "FilterIndex: " & idx.ToString & vbNewLine
|
|
' txt &= "Gewählter Filter: " & FilterDescription(.Filter, _
|
|
' idx)
|
|
' Else
|
|
' txt = "Abbruch durch Benutzer"
|
|
' End If
|
|
' End With
|
|
' End Using
|
|
' TextBox1.Text = txt
|
|
'End Sub 'SaveFileDialog
|
|
|
|
'###################################################################################################################
|
|
'############### xxxxxxxxxxxxxxxxxxxxxxx ###########################################################################
|
|
'###################################################################################################################
|
|
|
|
'Private Sub ComboBox1_SelectedIndexChanged(ByVal sender As _
|
|
' Object, ByVal e As EventArgs) _
|
|
' Handles ComboBox1.SelectedIndexChanged
|
|
' Dim strFilter As String
|
|
' Select Case ComboBox1.SelectedIndex
|
|
' Case 0
|
|
' ' Einfacher Filter
|
|
' strFilter = "Gif Bilddateien|*.gif"
|
|
' Case 1
|
|
' ' Erweiterter Filter
|
|
' strFilter = "JPEG Bilddateien|*.jpg|Gif Bilddateien|*.gif|Alle Dateien|*.*"
|
|
' Case Else
|
|
' ' Mehrere Dateierweiterungen in einer Auswahl
|
|
' strFilter = "Alle Bilddateien|*.jpg; *.jpeg; *.bmp; *.gif, *.tif|Alle Dateien|*.*"
|
|
' End Select
|
|
|
|
' TextBox2.Text = strFilter
|
|
'End Sub 'ComboBox1_SelectedIndexChanged
|
|
|
|
'Private Function FilterDescription(ByVal Filter As String, _
|
|
' ByVal Index As Integer) As String
|
|
' ' erstellt aus dem Filterstring die Bezeichnung
|
|
' Dim strArr() As String = Split(Filter, "|"), _
|
|
' MyList As New List(Of String)
|
|
' For i As Integer = 0 To strArr.GetUpperBound(0)
|
|
' If (i Mod 2 = 0) Then MyList.Add(strArr(i))
|
|
' Next
|
|
' Return MyList(Index - 1)
|
|
'End Function 'FilterDescription
|
|
|
|
End Module
|
|
End Namespace 'Dialoge (Ordner Öffnen, Datei Öffnen, Datei Speichern, Ja/Nein, ...
|
|
Namespace Convert
|
|
Namespace Numeral_System
|
|
'Gehört noch Proggramiert (Hex - Dezi - Dual - Römisch - ...)
|
|
End Namespace 'Numeral_System (Hex - Dezi - Dual - Römisch - ...) in work
|
|
Namespace Coding
|
|
<HideModuleName()>
|
|
Module Coding
|
|
'######################################################################################
|
|
'##################################Ascii AND Base64####################################
|
|
'Ascii to Base64
|
|
Public Function Ascii_To_Base64(ByVal AsciiString As String) As String
|
|
If AsciiString = Nothing Then AsciiString = ""
|
|
Dim raw As Byte() = System.Text.ASCIIEncoding.ASCII.GetBytes(AsciiString)
|
|
Ascii_To_Base64 = System.Convert.ToBase64String(raw)
|
|
End Function
|
|
'Base64 to Ascii
|
|
Public Function Base64_To_Ascii(ByVal Base64String As String) As String
|
|
Try
|
|
Dim raw As Byte() = System.Convert.FromBase64String(Base64String)
|
|
Base64_To_Ascii = System.Text.ASCIIEncoding.ASCII.GetString(raw)
|
|
Catch ex As Exception
|
|
Base64_To_Ascii = ""
|
|
End Try
|
|
End Function
|
|
'######################################################################################
|
|
'######################################################################################
|
|
End Module 'Coding
|
|
End Namespace 'Coding (Ascii, Base64, Dual<-in work, ...)
|
|
Namespace Koordinaten
|
|
<HideModuleName()>
|
|
Module Koordinaten
|
|
'Soll anhand der GPS Koordinaten GoogleMaps öfnen
|
|
'URL ansteuerung: https://developers.google.com/maps/documentation/staticmaps/
|
|
' String = "52.520817 13.40945"
|
|
'
|
|
'Umrechnung von Geo-Koordinaten: http://rechneronline.de/geo-koordinaten/
|
|
' ___________________________________________________________________________________________________
|
|
'| Grad, Minuten, Sekunden | Dezimalgrad | Grad, Dezimalminuten |
|
|
'| z.B. N52° 31' 14.941" E13° 24' 34.020" | z.B. 52.520817 13.40945 | z.B. N52° 31.249 E13° 24.567 |
|
|
' ---------------------------------------------------------------------------------------------------
|
|
' URL= "http://maps.google.com/maps?q=" & String
|
|
'In Projekt SB-PictureTagger: Set a LincLable ;)
|
|
End Module 'Koordinaten
|
|
End Namespace 'Koordinaten (GPS einheiten, MapsURLs,...)
|
|
End Namespace 'Convert
|
|
Namespace Prog_Org
|
|
<HideModuleName()>
|
|
Module Prog_Org
|
|
'######################################################################################
|
|
'############################## PORTABLE MODE TOOLS ###################################
|
|
'Festlegung ob Portable oder nicht, ...
|
|
Public Function PortableModeTrue(ByVal ConfigFileName As String) As Boolean
|
|
If System.IO.File.Exists(".\" & ConfigFileName) Then
|
|
PortableModeTrue = True
|
|
Else
|
|
PortableModeTrue = False
|
|
End If
|
|
|
|
End Function 'PortableModeTrue
|
|
'PortableMode:
|
|
'Übergabe: ConfigFile [WorkDir] [AppName] Return: (PortableMode=True/False)
|
|
'ConfigFile Nahme und Extendion - Wird Indirekt Geändert zu KonfigPfad
|
|
'WorkDir Pfad des Arbeitsverzeichnises - Wird Indirekt Geändert
|
|
'AppName Erstellt einen Neuern Ordner mit Diesen Nahme, wenn Nicht Portabler Mode
|
|
Public Function PortableMode(ByRef ConfigFile As String, Optional ByRef WorkDir As String = "-default-", Optional ByVal AppName As String = "-default-") As Boolean
|
|
If AppName = ("-default-" Or "") Then
|
|
AppName = Application.ProductName
|
|
End If
|
|
If Not System.IO.Directory.Exists(WorkDir) Then WorkDir = "-default-"
|
|
If WorkDir = ("-default-" Or "") Then
|
|
WorkDir = Application.StartupPath
|
|
End If
|
|
|
|
If System.IO.File.Exists(System.IO.Path.Combine(WorkDir, ConfigFile)) Then
|
|
PortableMode = True
|
|
ConfigFile = System.IO.Path.Combine(WorkDir, ConfigFile)
|
|
Else
|
|
PortableMode = False
|
|
WorkDir = Environment.GetEnvironmentVariable("APPDATA") & "\" & AppName
|
|
If Not System.IO.Directory.Exists(WorkDir) Then System.IO.Directory.CreateDirectory(WorkDir)
|
|
ConfigFile = System.IO.Path.Combine(WorkDir, ConfigFile)
|
|
If Not System.IO.File.Exists(ConfigFile) Then System.IO.File.Create(ConfigFile)
|
|
End If
|
|
|
|
End Function 'PortableMode
|
|
'######################################################################################
|
|
'######################################################################################
|
|
End Module
|
|
End Namespace 'Prog_Org
|
|
Namespace Data
|
|
Namespace DB
|
|
'Verschiedenen DBs mit ihren Befehlen
|
|
End Namespace 'DBs (SQLite, SQL, MySQL, ...)
|
|
Namespace File
|
|
<HideModuleName()>
|
|
Module File
|
|
'Declaration für INI:
|
|
Private Declare Ansi Function GetPrivateProfileString Lib "kernel32.dll" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Int32, ByVal lpFileName As String) As Int32
|
|
Private Declare Ansi Function WritePrivateProfileString Lib "kernel32.dll" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal lpString As String, ByVal lpFileName As String) As Int32
|
|
|
|
Public Function INI_ReadValue(ByVal sFilePath As String, ByVal sSection As String, ByVal sKey As String, Optional ByVal sDefault As String = "") As String
|
|
Dim strTemp As String = Space(1024), lLength As Integer
|
|
lLength = GetPrivateProfileString(sSection, sKey, sDefault, strTemp, strTemp.Length, sFilePath)
|
|
Return (strTemp.Substring(0, lLength))
|
|
End Function 'Read a INI
|
|
Public Function INI_WriteValue(ByVal sFilePath As String, ByVal sSection As String, ByVal sKey As String, ByVal sValue As String) As Boolean
|
|
Return (Not (WritePrivateProfileString(sSection, sKey, sValue, sFilePath) = 0))
|
|
End Function 'Write a INI
|
|
|
|
End Module
|
|
End Namespace 'File (INI, XML, ...)
|
|
End Namespace 'Data = Manage Infos (DBs, Files, ...)
|
|
End Namespace 'Tools |