found as working on disk

This commit is contained in:
6543 2019-10-25 16:54:43 +02:00
parent baa9b2695a
commit f46deb1008
2 changed files with 360 additions and 360 deletions

View File

@ -15,7 +15,7 @@ Public Class SB_PictureTagger
Public Pub_nPfadeIndex As Long = 0 'IndexNR des aktuell Geladenen Photos aus pub_aPfade
Public Pub_aConfigForm(0) As String 'Array mit FormConfiguration
Public Pub_nOrdnerTiefe As Integer = 0 'Recursive Ordnertiefe beim Ordnereinlesen
Public Pub_aSupportedFiles() As String = {".jpg", ".bmp", ".gif", ".png", ".jp2", ".tif"} 'Speichert die Unterstützten Extentions
Public Pub_aSupportedFiles() As String = {".jpg", ".bmp", ".gif", ".png", ".jp2", ".tiff"} 'Speichert die Unterstützten Extentions

Private nCountMarks As Integer


View File

@ -1,360 +1,360 @@
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, ...)
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