Einarbeitung UTA und Bugfix RMC

UID/frmAPIEinstellungen.vb

@@ -75,19 +75,19 @@ Public Class frmAPIEinstellungen
                     End If
 
                     For Each r As DataGridViewRow In .Rows
-                            If r.Cells("api_url").Value Is DBNull.Value Then
-                                r.DefaultCellStyle.ForeColor = Color.Gray
-                            ElseIf CBool(r.Cells("api_active").Value) = False Then
-                                r.DefaultCellStyle.ForeColor = Color.Gray
-                            End If
+                        If r.Cells("api_url").Value Is DBNull.Value Then
+                            r.DefaultCellStyle.ForeColor = Color.Gray
+                        ElseIf CBool(r.Cells("api_active").Value) = False Then
+                            r.DefaultCellStyle.ForeColor = Color.Gray
+                        End If
 
-                            If r.Cells("api_url").Value IsNot DBNull.Value AndAlso CheckAddress(r.Cells("api_url").Value) Then
-                                DirectCast(r.Cells("isRunning"), DataGridViewImageCell).Value = My.Resources.ok
-                            Else
-                                DirectCast(r.Cells("isRunning"), DataGridViewImageCell).Value = My.Resources.del
-                            End If
-                        Next
-                    End If
+                        If r.Cells("api_url").Value IsNot DBNull.Value AndAlso CheckAddress(r.Cells("api_url").Value, r.Cells("api_user").Value, r.Cells("api_password").Value) Then
+                            DirectCast(r.Cells("isRunning"), DataGridViewImageCell).Value = My.Resources.ok
+                        Else
+                            DirectCast(r.Cells("isRunning"), DataGridViewImageCell).Value = My.Resources.del
+                        End If
+                    Next
+                End If
 
 
             End With
@@ -144,15 +144,42 @@ Public Class frmAPIEinstellungen
         If DataGridView.SelectedRows.Count = 0 Then Exit Sub
     End Sub
 
-    Private Function CheckAddress(url As String) As Boolean
-        Try
-            If url = "" Then Return False
-            Dim request As WebRequest = WebRequest.Create(url)
-            Dim response As WebResponse = request.GetResponse()
-        Catch ex As Exception
-            Return False
-        End Try
-        Return True
+    Private Function CheckAddress(url As String, user As String, pw As String) As Boolean
+
+        If url = "" Then Return False
+
+        If Not url.Contains("ftp") Then
+
+            Try
+                Dim request As WebRequest
+                request = WebRequest.Create(url)
+                Dim response As WebResponse = request.GetResponse()
+            Catch ex As Exception
+                Return False
+            End Try
+            Return True
+        Else
+
+            If url.StartsWith("ftp") Then
+                Dim request As FtpWebRequest
+                request = WebRequest.Create(url)
+                request.Credentials = New NetworkCredential(user, pw)
+                request.Method = WebRequestMethods.Ftp.GetFileSize
+
+                Try
+                    Dim response As FtpWebResponse = request.GetResponse()
+                Catch ex As WebException
+                    Dim response As FtpWebResponse = ex.Response
+                    If FtpStatusCode.ActionNotTakenFileUnavailable = response.StatusCode Then
+                        Return False
+                    End If
+                End Try
+            End If
+            Return True
+        End If
+
+
+
     End Function
 
     Private Sub txtSuche_KeyDown(sender As Object, e As KeyEventArgs) Handles txtSuche.KeyDown