Imports System.Data.SqlClient Imports System.IO Imports System.Threading Module AtlasAufschubDatenEinlesen Private lockThis As New Object Private lockThis2 As New Object Public Sub initAllFiles(path As String) 'Alle Files im Ordner durchlaufen For Each file As String In IO.Directory.GetFiles(path) initFile(file) Next insertSQL() 'frmMain End Sub Sub writeLineToSqlInsert(brgak_datum, brgak_betrag, brgak_brgaktoId, brgak_filename, brgak_atc, brgak_fileline) SyncLock lockThis Try Using sr As New StreamWriter(AppDomain.CurrentDomain.BaseDirectory & "sql.txt", True) 'Do 'checkfile = FileInUse(AppDomain.CurrentDomain.BaseDirectory & "sql.txt") ' Loop Until checkfile = True Or t.AddSeconds(3) < Now sr.WriteLine(brgak_datum & ";" & brgak_betrag & ";" & brgak_brgaktoId & ";" & brgak_filename & ";" & brgak_atc & ";" & brgak_fileline) sr.Close() End Using Exit Sub Catch ex As Exception MsgBox(ex.Message) End Try End SyncLock writeLog("ERROR", "Fehler beim Schreiben der SQL Datei:!") End Sub Public Sub insertSQL() If System.IO.File.Exists(AppDomain.CurrentDomain.BaseDirectory & "sql.txt") Then Try Using sr As New StreamReader(AppDomain.CurrentDomain.BaseDirectory & "sql.txt") Dim line As String = "" Do While sr.Peek() >= 0 line = sr.ReadLine If line.Contains(";") Then Dim split = line.Split(";") If tryToInsertProgramm(split(0), CDbl(split(1)), split(2), split(3), split(4), split(5)) Then Try Catch ex As Exception End Try End If End If Loop End Using My.Computer.FileSystem.WriteAllText(AppDomain.CurrentDomain.BaseDirectory & "sql.txt", "", False) Catch ex As Exception writeLog("ERROR", "Fehler beim Lesen der SQL Datei: " & ex.Message) End Try End If End Sub Dim POS_head = 0 Dim POS_AbgKto = 6 Dim POS_AbgBetr = 11 Dim POS_ATC = 1 Public Sub initFile(file As String) Dim checkfile As Boolean = False Try Using sr As New StreamReader(file) If Not file.ToLower.EndsWith("tmp") Then Dim t As DateTime = Now Do checkfile = FileInUse(file) Loop Until checkfile = True Or t.AddSeconds(3) < Now Dim line As String = "" Dim rowcnt = 1 Do While sr.Peek() >= 0 line = CStr(sr.ReadLine()) Dim s = line.Split(Chr(29)) 'nach GroupSeperator splitten If s(POS_head) = "ASK" AndAlso s(POS_AbgKto) = "006128" Then Dim filename = cut_file(file) Dim betrag As Double = CDbl(s(POS_AbgBetr).Substring(0, 9) & "," & s(POS_AbgBetr).Substring(9, 2)) ' MsgBox(betrag) Dim fi As New System.IO.FileInfo(file) writeLineToSqlInsert(fi.CreationTime.ToString("dd.MM.yyyy hh:mm:ss"), betrag, "1", filename, s(POS_ATC), rowcnt) 'If rowcnt > 1 Then MsgBox(filename) End If rowcnt += 1 Loop ' writeLogVerarbeitet(cut_file(file)) End If End Using Catch ex As Exception writeLog("ERROR", "Fehler beim Initialisieren der ATLAS-Datei: " & ex.Message) End Try insertSQL() End Sub Private Function cut_file(ByVal file As String) As String ' Funktion zum Entfernen der Backslashs / Ordner While file.Contains("\") file = file.Remove(0, 1) End While Return file End Function While file.Contains("\") file = file.Remove(0, 1) End While Return file End Function Public Function FileInUse(ByVal sFile As String) As Boolean If System.IO.File.Exists(sFile) Then Try Dim F As Short = FreeFile() FileOpen(F, sFile, IO.FileMode.Open, OpenAccess.Read, OpenShare.LockRead) FileClose(F) Catch Return True End Try End If Return False End Function Public Function tryToInsertProgramm(brgak_datum, brgak_betrag, brgak_brgaktoId, brgak_filename, brgak_atc, brgak_fileline) As Boolean Dim sql As String = " begin tran" & " if Not exists (select * from tblBrgAufschub with (updlock,serializable) where brgak_filename = @brgak_filename AND brgak_fileline=@brgak_fileline) " & " begin " & " INSERT INTO tblBrgAufschub " & " (brgak_datum, brgak_betrag, brgak_brgaktoId, brgak_filename, brgak_atc,brgak_fileline) VALUES " & " (@brgak_datum, @brgak_betrag, @brgak_brgaktoId, @brgak_filename, @brgak_atc,@brgak_fileline) " & " End " & " commit tran " '(brgak_fileline='' OR ... ) ' " ELSE " & ' " begin " & ' " UPDATE tblBrgAufschub " & ' " SET brgak_datum=@brgak_datum, brgak_betrag=@brgak_betrag, brgak_brgaktoId=@brgak_brgaktoId, brgak_filename=@brgak_filename, brgak_atc=@brgak_atc,brgak_fileline=@brgak_fileline " & ' " WHERE brgak_filename = @brgak_filename AND (brgak_fileline='' OR brgak_fileline=@brgak_fileline)" & ' " End " & Dim cn As New SqlConnection() cn.ConnectionString = "Data Source=SQLGUIDE01.verag.ost.dmn;Initial Catalog=ADMIN;Integrated Security=false;User ID=sa;Password=BmWr501956;" cn.Open() Using cn Using cmd As New SqlCommand(sql, cn) cmd.Parameters.AddWithValue("@brgak_datum", brgak_datum) cmd.Parameters.AddWithValue("@brgak_betrag", brgak_betrag) cmd.Parameters.AddWithValue("@brgak_brgaktoId", brgak_brgaktoId) cmd.Parameters.AddWithValue("@brgak_filename", brgak_filename) cmd.Parameters.AddWithValue("@brgak_atc", brgak_atc) cmd.Parameters.AddWithValue("@brgak_fileline", brgak_fileline) Try cmd.ExecuteNonQuery() Return True Catch ex As SqlException writeLog("ERROR", "Fehler beim Schreiben in die Datenbank: " & ex.Message) End Try End Using End Using Return False End Function Public Sub writeLog(typ, msg) ' If Not System.IO.Directory.Exists(AppDomain.CurrentDomain.BaseDirectory & "log\") Then 'System.IO.Directory.CreateDirectory(AppDomain.CurrentDomain.BaseDirectory & "log\") 'End If ' Try ' Using sr As New StreamWriter(AppDomain.CurrentDomain.BaseDirectory & "log\err.log", True) MsgBox(typ & ";" & msg) ' End Using ' Catch ex As Exception ' End Try End Sub End Module