Blog Schröder

Sammlung von Codeschnipseln zu Programmierproblemen.
Daten aus fremden Quellen unterliegen deren Rechten.
Siehe auch: Disclaimer auf www.computer-schroeder.de

Freitag, 31. August 2007

Objektklasse und Listenklasse dazu

Public Class Objekt
Private mKey As String
Private mEigenschaft As String
...
Public Property Key() As String
Get
Return mKey
End Get
Set(ByVal value As String)
mKey = value
End Set
End Property

Public Property Eigenschaft() As String
Get
Return mEigenschaft
End Get
Set(ByVal value As String)
mEigenschaft = value
End Set
End Property
...
End Class
-----------------------------------------------
Public Class Liste
'Sammlung der Objekte
Private mListe As Dictionary(Of String, Objekt)

Public Sub New()
mListe = New Dictionary(Of String, Objekt)
...
End Sub

Default Public ReadOnly Property Item(ByVal key As String) As Objekt
' Erlaubt Zugriff auf ein Objekt (und dessen Member)
' Nothing, wenn der Key nicht gefunden wurde
Get
Return mListe(key)
Else
Return Nothing
End If
Catch ex As Exception
MsgBox("(Item.Get) " & key & " liefert folgenden Fehler: " & ex.Message)
Return Nothing
End Try
End Get
End Property

Public ReadOnly Property Count() As Long
Get
Return mListe.Count
End Get
End Property

Public ReadOnly Property Keys() As Dictionary(Of String, Objekt).KeyCollection
Get
Return mListe.Keys
End Get
End Property

Public Sub Clear()
mListe.Clear()
End Sub

Public Sub Add(ByVal key As String, ByVal objekt As Objekt)
Try
If ContainsKey(key) Then
MsgBox("Objekt " & key & " gibt es bereits in der Liste.")
Exit Sub
'Alternativ Remove aufrufen
End If
'füge das Objekt zu
mListe.Add(key, objekt)
Catch ex As Exception
MsgBox("Objekt " & key & " konnte nicht zugefügt werden.")
Exit Sub
End Try
End Sub

Public Function Remove(ByVal key As String) As Boolean
Try
mListe.Remove(key)
Catch ex As Exception
MsgBox(key & " liefert folgenden Fehler: " & ex.Message)
Return False
End Try
Return True
End Function

Public Function ContainsKey(ByVal key As String) As Boolean
If key = "" Then
MsgBox("Key-Parameter darf nicht leer sein")
Return False
End If
If mListe.Count < 1 Then
'msgBox("Es gibt keine Ressourcen in der Liste")
Return True?False 'kann gut oder schlecht sein
End If
If Not mListe.ContainsKey(key) Then
MsgBox("Ressource " & key & " gibt es nicht in der Liste")
Return True?False
End If

Return True
End Function

'Vielleicht auch:
Public Sub Fill()
Dim keyList As List(Of String)
keyList = ... 'aus DB? Datei?
If keyList Is Nothing Then
MsgBox"Keine Objekte gefunden")
Else
For Each key As String In keyList
Dim obj As New Objekt 'Hilfsvariable
obj.Key = key
obj.Eigenschaft = ... 'aus DB? Datei?
...
mListe.Add(key, obj)
Next
End If
End Sub
...usw.
End Class
-------------------------------------------------
'Anwendung in For-Each-Schleife:
Dim Liste As Liste
Liste.Fill()
...
For Each k As String In Liste.Keys
MsbBox(Liste(k).Eigenschaft)
Next
Next
...oder...
For i As Integer = 0 To Liste.Count - 1
Dim Eig As String = Liste(i).Eigenschaft
MsgBox(Eig)
Next
...

Labels: , , , ,

Serverholder

Eine zentrale (Server)-Klasse, die auch unter ASP.NET dank Timer "ewig" lebt.

Public Class ServerHolder
' Enthält die einzige Serverinstanz und kann diese an andere Klassen übergeben
Shared ServerinstanceExists As Boolean = False

' Diese Variable enthält die einzige Serverinstanz
Shared WithEvents mServer As TMServer

' Gibt die (einzige) Instanz der Serverklasse zurück
' Wenn die Serverinstanz nicht existiert, wird Nothing zurückgegeben
Shared Function GetServer() As TMServer
If Not ServerinstanceExists Then
mServer = New Server
ServerinstanceExists = True
End If

Try
Return mServer
Catch ex As Exception
MsgBox("Es konnte keine Serverinstanz übergeben werden" & vbCrLf & ex.Message)
Return Nothing
End Try
End Function
End Class
-----------------------------------------
Public Class Server
Shared serverIsRunning As Boolean = False
Private loopTimer As System.Timers.Timer
'Variablen, Methoden usw.
Private mStatus As ...
Public Property Status() As ...
...
Public Sub New()
If serverIsRunning Then
MsgBox("Server läuft bereits!")
Exit Sub
End If
serverIsRunning = True

'Erzeuge die Timerinstanz
loopTimer = New System.Timers.Timer
'übergib den Behandler für den Timer
AddHandler loopTimer.Elapsed, AddressOf OnTimedEvent
' Setze Interval
loopTimer.Interval = 10000
loopTimer.Enabled = True
' Der Timer lebt bis zum "Ende"
GC.KeepAlive(loopTimer)
...
End Sub
End Class
----------------------------------------------------
'Zugriff auf die einzige Serverinstanz
Class Irgendwas
Shared Server As Server = ServerHolder.GetServer
...
Dim x = Server.PublicVar
Server.PublicMethode()
...
End Class

Labels: , , ,

Dienstag, 28. August 2007

Trigger: Timestamps

ALTER TRIGGER Adressen_Insert
ON dbo.Adressen
AFTER INSERT
AS

UPDATE Adressen
SET ErstVon = user_name()
WHERE ID IN (SELECT ID FROM inserted) AND ErstVon IS NULL

UPDATE Adressen
SET ErstAm = getdate()
WHERE ID IN (SELECT ID FROM inserted) AND ErstAm IS NULL


----------------------------------------------


ALTER TRIGGER dbo.Adressen_Update
ON dbo.Adressen
AFTER UPDATE
AS

UPDATE Adressen
SET ÄndgAm = getdate(),
ÄndgVon = user_name()
WHERE ID IN (SELECT ID FROM inserted)

Freitag, 24. August 2007

Dateisystem

Private Sub deleteOldLogFiles(ByVal logFileStorageDays As Integer)
'alle LogfileInfos holen
Dim logFiles() As IO.FileInfo
Try
'Zugriff auf das Verzeichnis
Dim LogFile As New IO.FileInfo(myLogFilePath & myLogFileName)
logFiles = LogFile.Directory.GetFiles("*" & myLogFileExtension, IO.SearchOption.TopDirectoryOnly)
Catch ex As Exception
MsgBox ("Path not found." & ex.Message)
Exit Sub
End Try

Dim aktCount As Integer = logFiles.Length
Dim x As Integer 'Hilfsindex
Dim fN As IO.FileInfo 'zu löschende Datei
'suche, solange die existierende Anzahl größer als erlaubt ist
Do While aktCount > logFileStorageDays
fN = Nothing
Dim oldest As DateTime = Date.MaxValue
For Each i As IO.FileInfo In logFiles
If Not i Is Nothing Then
If i.CreationTime < oldest Then
fN = i 'ist derzeit die älteste
oldest = i.CreationTime
End If
End If
Next
'If fN Is Nothing Then Exit Sub 'sollte nicht passieren

fN.Delete() 'lösche die älteste Datei
aktCount -= 1
For Each i As IO.FileInfo In logFiles
If Not i Is Nothing Then
If fN.CreationTime = i.CreationTime Then
x = Array.IndexOf(logFiles, fN)
logFiles(x) = Nothing 'auch aus dem Array nehmen
Exit For
End If
End If
Next
Loop
End Sub

Labels: , , , ,

SqlDataReader

Dim tdReader As Data.SqlClient.SqlDataReader = DBGetDataReader("SELECT * FROM Tabelle")
mTabDatas.Clear()
'lies jetzt die Zeilen der Reihe nach ein und übernimm sie in die Liste
While tdReader .Read()
Dim c As New TabData'Hilfsobjekt
c.Feld1 = tdReader ("Feld1")
c.Feld2= tdReader ("Feld1")
c.NochNeSpalte= tdReader("NochNeSpalte")
'zur Liste zufügen
mTabDatas.Add(c)
End While
tdReader .Close()

XML schreiben/lesen

Try
Dim settings As New Xml.XmlWriterSettings()
settings.Indent = True
settings.IndentChars = " "
Using writer As Xml.XmlWriter = Xml.XmlWriter.Create(myLogFilePath & "/" & myApplicationName & ".xml", settings)
' Write XML data.
writer.WriteStartElement("root")
writer.WriteElementString("Value", CStr(Value))

'Schreibe die variablen Applikationswerte
For Each k As String In Other.Keys
writer.WriteStartElement("ApplicationValue")
writer.WriteAttributeString("Description", k)
writer.WriteAttributeString("Value", Other(k))
writer.WriteEndElement()
Next
writer.WriteEndElement()
writer.Flush()
End Using
Catch ex As Exception
MsgBox("Die XML-Datei konnte nicht geschrieben werden." & vbCrLf & ex.Message)
End Try
-----------------------------------------------------

<?xml version="1.0" encoding="utf-8" ?>
<root>
<Value>1000</Value>
<ApplicationValue Description="Other" Value="8/24/2007 8:53:11 AM" />
</root>
-----------------------------------------------------

Try
Dim settings As New Xml.XmlReaderSettings()
settings.ConformanceLevel = Xml.ConformanceLevel.Fragment
settings.IgnoreWhitespace = True
settings.IgnoreComments = True
Using reader As Xml.XmlReader = Xml.XmlReader.Create(myPath & "/" & myXMLFileName & ".xml", settings)
reader.Read()
reader.ReadStartElement("root")
reader.ReadStartElement("Value")
Value = CInt(reader.ReadString())
reader.ReadEndElement()

'Sonstige Werte laden
Do
Try
reader.ReadEndElement()
If reader.Name <> "ApplicationValue" Then Exit Do
Catch ex As Exception
Exit Do
End Try
'Lies die Attribute
Dim k As String = "" 'Hilfsvariable für Key
Dim v As String = "" 'Hilfsvariable für Value
'If reader.HasAttributes Then
While reader.MoveToNextAttribute()
If reader.Name = "Description" Then
k = reader.Value
End If
If reader.Name = "Value" Then
v = reader.Value
End If
End While
' Move the reader back to the element node.
reader.MoveToElement()
'End If
If k > "" Then Other.Add(k, v)
Loop
reader.Close()
End Using
Catch ex As Exception 'Die XML-Datei scheint noch nicht zu existieren
MsgBox(ex.Message)
End Try

Labels:

Donnerstag, 23. August 2007

Key-Spalte aus DB lesen

' übergibt eine Key-Spalte
'keyName: Die zurückzuliefernde Schlüsselspalte (Default:ID)
'whereClause: Optionale WHERE-Klausel
'returns: List(Of String)

Public Function DBGetKeys(ByVal table As String, Optional ByVal keyName As String = "ID", Optional ByVal whereClause As String = "") As List(Of String)

Dim sqlStatement As String
sqlStatement = "SELECT " & keyName & " FROM [" & table & "] " & whereClause
Dim result As List(Of String)
result = doSql(sqlStatement, QueryReturns.Keys)
If result Is Nothing Then
log.Fault("DBGetKeys", "Es konnten keine Keys aus Tabelle " & table & " gelesen werden.")
Return Nothing
End If
Return result
End Function

Globale Fehlermeldung in Global.asax

Sub Application_Error(ByVal sender As Object, ByVal e As EventArgs)
' Code, der bei einem nicht behandelten Fehler ausgeführt wird.
log.Fault("Global.asax.Application_Error", "Ein nicht behandelter Fehler ist aufgetreten. " & vbCrLf & Server.GetLastError.ToString)
End Sub

Trigger: Wert ändern

Wichtig: Die IF-Abfrage, damit nicht ein Überlauf von sich selbst aufrufendem Trigger passiert.

ALTER TRIGGER XXXtable
ON dbo.XXXtable
AFTER UPDATE, INSERT
AS
BEGIN
IF EXISTS (SELECT ID FROM inserted
WHERE XXXfield IS NULL)
BEGIN
UPDATE XXXtable
SET XXXfield = - 1
WHERE XXXfield IS NULL
END
END

Mittwoch, 22. August 2007

Funktion IIF für SQL Server

IIF wird in T-SQL nicht unterstützt, sondern muss mit Case ersetzt werden.

Case
When @var = 123 Then 'OK'
Else 'Pech'
End

iFrame und Parent-Fenster

print "<script type='text/javascript'>\n";
print "parent.document.getElementById('Tabelle').height
  = document.getElementById('Tabellenzeilen').offsetHeight;\n";
print "</script>\n";

Geht nicht... Kann es vielleicht sein, dass www.domainname.de nicht mit deiner Domain identisch ist, unter der das Javascript ausgeführt wird?
Dann macht dir die Same Origin Policy einen Strich durch die Rechnung.


ich habe 2 Dateien, in Datei1.htm ist auch ein Iframe
<iframe name="fra" id="fra" src="datei2.htm" height ......></iframe>
dort gibt es ein <input name="vorname" value="Horst">.
Wie kann ich von Datei1.htm diesen Horst auslesen?

Parent sollte immer das Frameset sein. Frames ist ein Array. Du kannst über den nummerischen Index (beginnend bei Null) oder über den Namen des Frames drauf zugreifen, so, wie es auch dort steht:
parent.frames[1].document.forms[0].elements[0].value = "Stefan";
Das parent kannst Du hierbei weglassen, da Du bereits "ganz oben" bist.


Eigenschaft "contentWindow" von Frames, die für den Zugriff auf das im iFrame befindliche HTML zwingend benötigt wird:
<body>
    <ElementXYZ>....
    <iframe id="meinIframe" src="irgend/so/ein/dokument.htm" />
    ....

Javascript-Zugriff auf beispielsweise das erste Bild im iFrame:
var erstesIFrameBild = document.getElementById("meinIframe").contentWindow.document.images[0];


formularvariablen zwischen iframes übergeben:
Mehrere Möglichkeiten:

1.) Variablen mit GET Methode Übergeben
Variablen kannst du per query string übergeben. Ein Query String wird an die Url angehängt und hat die Form: http://domain.de/datei.html?name1=value1&name2=value2
Den Query String müstest du mit javascript an die Url anhängen: frame.location.href= "datei.html?name=" +urlEncode(oInput.value)+ " [...]
Wichtig ist das Texte die du über gibst "URLEncoded" sind. Im Grunde werden leer und sonderzeichen durch komische konstrukte ersetzt ^^ (leerzeichen ist %20 zumbeispiel)
2.) Variablen mit POST Methode übergeben
Du kannst ein Formular direkt an einen anderen Frame abschicken:
<form method="post" action="datei.html" target="framename">[...]
Auf der Seite kannst du die Variablen dann per z.B. PHP auslesen.
3.) Variablen per DOM Übergeben
Du kannst dich auch ausschließlich auf JavaScript verlassen und die Variablen client seitig zwischen den einzelen DOMs übergeben:
<frame1>
function myEventHandler(str)
{
 oFrame = [...]
 oFrame.document.myVariable = str;
<frame2>
function test()
{
 alert(window.document.myVariable);
}
4.) UserData Store
Im IE gibt es einen CLient Seitigen User Data Store, eine XML Datei irgendwo im IE Verzeichnis in die du per javascript schreiben und lesen kannst. Das ding ist persistent und überlebt auch sessions - eine art client seitiger cookie ;) Mehr dazu findest du sicher im msdn..
5.) Verzichte auf die Frames
Frames braucht kein mensch mehr. schmeiß die dinger raus und benutze server side includes um document teile auszulagern. frames machen aggressiv - mich zumindest :)

Montag, 20. August 2007

DB-Tabelle aus Listbox füllen

Private Sub btnNeu_Click()
On Error GoTo Er

Dim i As Integer
For i = 0 To lstXXX.ListCount - 1
DoCmd.RunSQL "INSERT INTO dbo.XXX (xxx) VALUES ('" & lstXXX.Column(0, i) & "');"
Next i

Ex: Exit Sub
Er: MsgBox Err.Description
Resume Ex
End Sub

Donnerstag, 16. August 2007

Intellisense in Skin Files

1. Tools -> Options auswählen
2. Im linken Bereich wählt man Text Editor -> File Extension
3. In folgendem Dialogfenster fügt man die Endung skin in das Extension Feld ein und wählt aus dem DropDownMenü Editor den Eintrag User Control Editor.
4. Per Klick auf den Button Add den Eintrag hinzufügen und das Skin File erneut öffnen

Enum-Werte per Databinding an ComboBoxen binden

Möchte man einen enum-Wert an eine ComboBox binden, dann muss man hier einen kleinen Trick anwenden. Ich habe das mal am Beispiel mit dem UltraComboEditor aus der Infragistics-Bibliothek realisiert. Man brauch zunächst einen Parse_Event auf dem Binding:

this.ultraComboEditor1.DataBindings0.Parse += new ConvertEventHandler(ValueInputEnum_Parse);

Dann kann man in dem Eventhandler den Wert in den Enum konvertieren:

void ValueInputEnum_Parse(object sender, ConvertEventArgs e)
{
e.Value = Enum.Parse(typeof(ePeriodInterval), e.Value.ToString());
}

by Thomas Schissler

externen Wert an INSERT oder UPDATE übergeben

Der Trick: einen normalen Parameter durch einen ControlParameter ersetzen!

<asp:SqlDataSource ID="SqlDataSource2" runat="server"...
...
<InsertParameters>

<asp:ControlParameter Name="IDDevice" ControlID="GridView1" PropertyName="SelectedValue"
Type="String" />
<asp:Parameter Name="IDMediaKind" Type="Int32" />
<asp:Parameter Name="MatrixPlugIsInput" Type="Boolean" />

<asp:Parameter Name="MatrixChannel" Type="Int32" />
<asp:Parameter Name="DeviceChannel" Type="Int32" />
</InsertParameters>

Buttonclick zuvor abfragen (JavaScript)

Legen Sie im Webserversteuerelement der ASP.NET-Schaltfläche, dem Sie Clientskript hinzufügen möchten (einem Button-Steuerelement, LinkButton-Steuerelement oder ImageButton-Steuerelement), die OnClientClick-Eigenschaft auf das auszuführende Clientskript fest.
Wenn Sie über die Möglichkeit zum Abbrechen der Übermittlung verfügen möchten, legen Sie die OnClientClick-Eigenschaft auf die Zeichenfolge "Return" und den Funktionsnamen fest. Das Clientskript kann dann die Übermittlung abbrechen, indem es false zurückgibt.
Im folgenden Codebeispiel wird veranschaulicht, wie einem Button-Steuerelement ein Clientskript mit einem Klickereignis hinzugefügt wird.

<%@ Page Language="VB" %>
<script runat="server">
Sub Button1_Click(ByVal sender As Object, _
ByVal e As System.EventArgs)
Label1.Text = "Server click handler called."
End Sub
</script>

<body>
<form id="form1" runat="server">
<asp:Button ID="Button1" Runat="server"
OnClick="Button1_Click"

OnClientClick="return confirm('Ready to submit.')"
Text="Test Client Click" />
<br />
<asp:Label ID="Label1" Runat="server" text="" />
</form>

</body>
</html>

SqlDataReader

Dim con As SqlConnection = GetConnection()
Dim sql As String
sql = "SELECT AnredeID, Anrede FROM dbo.Anreden"
Dim cdo As New SqlCommand(sql, con)

Dim sdr As SqlDataReader = cdo.ExecuteReader()
Do While sdr.Read
txtResult.Text = txtResult.Text & sdr.GetInt32(0).ToString & " " & sdr.GetString(1) & vbNewLine
Loop
sdr.Close()

Private Function GetConnection() As SqlConnection
Dim conString As String
conString = "Server=BEVPC
SQLExpress;database=MSDNSolve;Integrated Security=true"
Dim con As SqlConnection = Nothing
Try
con = New SqlConnection(conString)
con.Open()
Catch ex As Exception
Throw (ex)
End Try
Return con
End Function

Mit clientseitigen Events serverseite Events auslösen

Will man ein serverseitiges Event (ASP.NET) clientseitig (JavaScript) auslösen, ist folgender Code notwendig - am Beispiel einer GridView-Row, die per Klick selektierbar sein soll. Dazu muß sich in der Row z.B. ein ImageButton (der vorher noch per FindControl in der GridView gesucht wurde) für den Select befinden, dessen Postback-Argument dann dem Client-Event zugewiesen wird:

e.Row.Attributes.Add("onclick", Page.GetPostBackEventReference(mySelectButton));

Hi :)
Ich wollte das mal ausprobieren, scheitere aber am elementarem Verständnis, bei folgender Situation

asp:GridView ID="MyGrid" .....
asp:TemplateField
ItemTemplate asp:ImageButton id="Imagebutton1" runat ....

im .CS File dann:

if (e.Row.RowType == DataControlRowType.DataRow)
{
e.Row.Attributes.Add("onclick", Page.GetPostBackEventReference(this.MyGrid.FindControl("Imagebutton1")));

Das kann er nicht finden, da immer NULL... wo ist mein Fehler?

Hi ;-)
probier mal e.Row.FindControl("ImageButton1");

Word 2007 und Visual Basic 2005

http://msdn2.microsoft.com/de-de/library/bb407305(VS.80).aspx

Labels:

Text in Word-Dokument (Bookmark) einfügen


Hier wird die Vorgehensweise so gewählt, dass das Word-Dokument dynamisch gehalten wird. Zu diesem Zweck werden Bookmarks (Textmarker) in das Dokument eingefügt. Dies wird im folgenden Code-Ausschnitt gezeigt.

Dim wordRange As Word.Range
Dim newBookmark As Microsoft.Office.Tools.Word.Bookmark

With Globals.ThisDocument
.Range.InsertAfter(" ")
wordRange = .Range(.Range.End - 2, .Range.End - 1)
newBookmark = .Controls.AddBookmark(wordRange,
"BookmarkName")
End With

Mit dem nächsten Code-Ausschnitt wird ein Text in dieses Bookmark geschrieben.

newBookmark.Text = "angezeigter Text"

Neben normalem Text können auch Bilder, Tabellen etc. in Bookmarks eingefügt werden.

Die vorgestellte Methode bietet den Vorteil, dass beim Erstellen eines neuen Word-Dokumentes die Struktur des Dokumentes noch gar nicht vorliegen muss. Mit den selbst erstellten Bookmarks kann zur Laufzeit die Struktur festgelegt und auch dynamisch angepasst werden. Außerdem bleibt der Inhalt der Bookmarks leicht zugreifbar und auch änderbar.

Es somit auch denkbar, dass die Eingabe eines Anwenders in ein Bookmark ausgelesen und weiter verarbeitet werden kann. Der Benutzer würde somit überhaupt nichts von komplexen Prozessen, die im Hintergrund laufen, mitbekommen. Er bedient nach wie vor sein Word-Dokument und wird von einer komplexen Anwendung verschont.
(s. https://www.microsoft.com/germany/msdn/solve
/suche/default.mspx?g=typ&o=&f=&s=&showmore=&
technology=&thema=&typ=&presenter=&q=Wie+f%C3%BC
ge+ich+automatisiert+Text+in+ein+Microsoft+Word-Dokument+ein%3F)

Zeile aus DB löschen

''' <summary>
''' Löscht die Zeile der angegebenen ID aus der DB
''' </summary>
''' <param name="tableName">Aus welcher Tabelle ist zu löschen?</param>
''' <param name="ID">Wie lautet der Wert der ID?</param>
''' <returns>Erfolgsmitteilung (wahr oder falsch).</returns>
''' <remarks>Eventuelles CASCADE beachten!</remarks>

Public Function DBDeleteRow(ByVal table As String, ByVal ID As String) As Boolean
If ID = "" Then
log.Fault("", "Parameter ID darf nicht leer sein.")
Exit Function
End If

Dim sqlStatement As String = "DELETE FROM " & table & " WHERE ID ='" & ID & "'"
Dim result As Integer = doSql(sqlStatement, QueryReturns.Count)

If result <> 1 Then
log.Fault("DBDeleteRow", "Es konnte keine Zeile gelöscht werden werden."")
Return False
End If
Return True
End Function

Zeile in DB-Tabelle zufügen

''' <summary>
''' fügt einer Tabelle eine neue Zeile zu und trägt die ID ein
''' </summary>
''' <param name="table">Die Tabelle</param>
''' <param name="ID">Wert des Schlüsselfeldes ID</param>
''' <param name="values">Datenwerte je nach Tabelle in der Feldreihenfolge der Tabelle</param>
''' <remarks>Dies ist nur möglich für Tabellen mit dem Feldnamen ID</remarks>
Public Sub DBInsert(ByVal tablename As String, ByVal ID As String, ByVal ParamArray values() As Object)

'baue die Werteliste und erkenne, wie viele Werte hineingehören
Dim valueList As New StringBuilder
For i As Integer = 0 To UBound(values, 1)
valueList.Append("'" & values(i) & "', ")
Next i
valueList.Remove(valueList.Length - 1, 2) 'schneide letztes Komma ab

'Erzeuge die Abfrage (Einfügen: ID, Werte, Pseudo-_TimeStamp)
Dim sqlText As String = String.Format("INSERT INTO [{0}] VALUES ('{1}', {2})", tableName, ID, values.ToString)
Dim acceptedRows As Integer
Try
acceptedRows = doSql(sqlText, QueryReturns.Value) 'Einfügen der Zeile
Catch ex As Exception
f = Format("Einfügen in Tabelle {0} fehlgeschlagen" & vbCrLf, tableName)
MsgBox(sqlText & vbCrLf & ex.Message)
Exit Sub
End Try
If acceptedRows = 0 Then
f = String.Format("Es konnte keine Zeile in Tabelle {0} eingefügt werden." & vbCrLf, tableName)
MsgBox( f & String.Format("Nicht eingefügte Werte für Key {0}: {1}", ID, values.ToString))
Exit Sub
End If
End Sub


--- alt ---

''' <summary>
''' fügt einer Tabelle eine neue Zeile zu und trägt die ID ein
''' </summary>
''' <param name="table">Die Tabelle</param>

''' <param name="ID">Wert des Schlüsselfeldes ID</param>
''' <param name="value1">und folgende: Datenwerte
''' je nach Tabelle in der Reihenfolge der Tabelle.
''' Für NULL-Wert Argument auslassen (nur Komma schreiben)</param>

''' <remarks>Dies ist nur möglich für Tabellen mit dem Feldnamen ID.</remarks>

Public Sub DBAddRow(ByVal table As TMserverDBTables, ByVal ID As String, _
Optional ByVal value1 As Object = Nothing, Optional ByVal value2 As Object = Nothing, _
Optional ByVal value3 As Object = Nothing, Optional ByVal value4 As Object = Nothing, _
Optional ByVal value5 As Object = Nothing, Optional ByVal value6 As Object = Nothing, _
Optional ByVal value7 As Object = Nothing, Optional ByVal value8 As Object = Nothing)

Dim f As String 'Hilfsstring
'Schließe die falschen Tabellen aus
Dim tableName As String = Enum.GetName(GetType(TMserverDBTables), table)
'erlaubte Tabelle?
If (table And 1) Or (table And 2) Then
f = "Tabelle " & tableName & " nicht als Argument zugelassen"
log.Fault("DBAddRow", f)
Exit Sub
End If

'baue die Werteliste
Dim values As New StringBuilder
values.Append(IIf(value1 Is Nothing, " NULL", " '" & value1 & "'"))
values.Append(IIf(value2 Is Nothing, ", NULL", ", '" & value2 & "'"))
values.Append(IIf(value3 Is Nothing, ", NULL", ", '" & value3 & "'"))
values.Append(IIf(value4 Is Nothing, ", NULL", ", '" & value4 & "'"))
values.Append(IIf(value5 Is Nothing, ", NULL", ", '" & value5 & "'"))
values.Append(IIf(value6 Is Nothing, ", NULL", ", '" & value6 & "'"))
values.Append(IIf(value7 Is Nothing, ", NULL", ", '" & value7 & "'"))
values.Append(IIf(value8 Is Nothing, ", NULL", ", '" & value8 & "'"))
'Erzeuge die Abfrage
Dim sqlText As String = "INSERT INTO '" & tableName & "' VALUES ('" & ID & "', " & values.ToString & ")"

Dim acceptedRows As Integer
Try
acceptedRows = doSql(sqlText, QueryReturns.Value) 'Einfügen der Zeile
Catch ex As Exception
f = Format("Einfügen in Tabelle {0} fehlgeschlagen", tableName) & vbCrLf
log.Fault("DBAddRow", f &amp; "ID: " & ID & " Values: " & values.ToString & vbCrLf & ex.Message)
Exit Sub
End Try
If acceptedRows = 0 Then
f = "Es konnte keine Zeile in Tabelle " &amp; tableName & " eingefügt werden." & vbCrLf
log.Fault("DBAddRow", f & String.Format("Nicht eingefügte Werte für Key {0}: {1}", ID, values))
End If
'fertig
log.Test("DBAddRow", String.Format("Eingefügte Werte für Key {0}: {1}", ID, values))
End Sub

Labels: ,

Tabelle aus DB lesen

Public Function DBGetResultSet(ByVal sqlStatement As String) As SqlDataReader
Dim ResultSet As SqlDataReader 'DBColumn enthält die Werte einer Datenspalte
'Abruf der Daten
Try
ResultSet = doSql(sqlStatement, QueryReturns.Reader)
Catch ex As Exception
log.Fault("DBGetResultSet", "Datenbankzugriff fehlgeschlagen. SQL-Befehl: " & _
vbCrLf & sqlStatement & vbCrLf & ex.Message)
Return Nothing
End Try
'fertig
Return ResultSet
End Function

Spalte aus DB lesen

''' <summary>
''' übergibt eine Key-Spalte
''' </summary>
''' <param name="table"></param>
''' <param name="keyName">Die zurückzuliefernde Schlüsselspalte (Default:ID)</param>
''' <param name="whereClause">Optionale WHERE-Klausel (mit WHERE !)</param>
''' <returns>List(Of String)</returns>
Public Function DBGetKeys(ByVal tablename As String, Optional ByVal keyName As String = "ID" _
, Optional ByVal whereClause As String = "") As List(Of String)
Dim sqlStatement As String
sqlStatement = "SELECT " & keyName &amp; " FROM [" & tableName & "] " & whereClause
Dim result As List(Of String)
result = doSql(sqlStatement, QueryReturns.Keys)
If result Is Nothing Then
MsgBox("Es konnten keine Keys aus Tabelle " & tableName & " gelesen werden.")
Return Nothing
End If
Return result
End Function

Wert aus DB lesen

''' <summary>
''' Liest ungeprüft den Wert eines Datenfeldes aus der DB
''' </summary>
''' <param name="table">Aus welcher Tabelle ist zu lesen?</param>

''' <param name="ID">Wie lautet die ID?</param>
''' <param name="field">Welches Datenfeld ist zu lesen?</param>
''' <returns>Gelesener Wert oder Nothing</returns>

''' <remarks>Nur für Tabellen, die ID enthalten, wird die Zeilenangabe ausgewertet; ID muß angegeben werden.
''' Bei ID="" wird die erste Zeile gelesen.</remarks>
Public Function DBGetValue(ByVal table As TMserverDBTables, ByVal field As String, Optional ByVal ID As String = "") As Object
Dim tableName As String = NameOfTable(table)


Dim sqlStatement As String
If ID = "" Then
sqlStatement = "SELECT TOP 1 " & field & "a> FROM " & tableName & "a> "
Else
sqlStatement = "SELECT " &amp;amp; field & "a> FROM " & tableName & "a> WHERE ID = '" & ID & "'"
End If

Dim result As Object
result = doSql(sqlStatement, QueryReturns.Value)

If result Is Nothing Then
log.Fault("DBGetValue", "Es konnte kein korrekter Wert aus der Datenbank gelesen werden." &amp;amp; vbCrLf _
& "Tabelle: " & tableName & " ID: " & ID & " Feld: " & field & " Rückgabe: " & result)
Return Nothing
End If
Return result
End Function

Wert in DB schreiben

'''' <summary>
''' Schreibt ungeprüft den Wert eines Datenfeldes in die DB
''' </ summary>
''' <param name="table">In welche Tabelle ist zu schreiben? </ param>

''' <param name="field">In welches Datenfeld ist zu schreiben? </ param>
''' <param name="value">Welcher Wert ist in dieses Feld zu schreiben? </ param>
''' <param name="ID">Nur wenn ID- Spalte existiert: Wie lautet die ID? </ param>

''' <returns>Erfolgsmitteil ung (wahr oder falsch). </ returns>
''' <remarks>Nur für Tabellen, die ID enthalten, wird die Zeilenangabe ausgewertet; ID muß angegeben werden.
''' Bei ID="" wird in die _Saveguard- True- Zeile geschrieben. </ remarks>

Public Function DBSetValue( _
ByVal table As TMserverDBTables, ByVal field As String, ByVal value As String, Optional ByVal ID As String = "") _
As Boolean
Dim tableName As String = NameOfTable(table)
'If table Is Nothing Then
' log. Fault("DBSetValue", "Ungültiger Tabellenname")

' Return Nothing
'End If
Dim sqlStatement As String
If ID = "" Then
'Schließe die falschen Tabellen aus
If (table And 1) = 0 Then

log. Fault("DBSetValue", "Tabelle " & tableName & " nicht als Argument zugelassen")
Exit Function
End If
sqlStatement = "UPDATE " &amp; tableName & " SET " &amp;amp; field & " = '" & value & "' WHERE _LineGuard = 'True'"

Else
sqlStatement = "UPDATE " &amp;amp; tableName & " SET " &amp;amp; field & " = '" & value & "' WHERE ID = " & ID & ""

End If
'log. Test("DBSetValue", sqlStatement)
Dim result As Integer = doSql(sqlStatement, QueryReturns. Count)
'log. Test("DBSetValue", result. ToString)
If result <> 1 Then

log. Fault("DBSetValue", "Der Wert konnte nicht in die Datenbank geschrieben werden. " _
& vbCrLf & "Tabelle: " & tableName & " ID: " & ID & " Feld: " & field & "Wert: " & value _

& vbCrLf & result & " Zeilen wurden geändert. ")
Return False
End If
Return True

End Function

Funktion doSQL zum Ausführen SQL

''' <summary>
''' Art einer auszuführenden SQL-Anweisung
''' </summary>
''' <remarks>SQL-Anweisung liefert einen Stringwert,
''' eine Anzahl von behandelten Zeilen,
''' eine Liste der Key-Werte oder
''' einen SQLDataReader mit einem Resultset</remarks>
Enum QueryReturns
Value
Count
Keys
Reader
End Enum

''' <summary>
''' Führt eine SQL-Anweisung aus
''' </summary>
''' <param name="queryReturns">mittels der Enum QueryReturns wird bestimmt,
''' welche Art von SQL-Anweisung auszuführen ist</param>
''' <param name="sqlStatement">Die vollständige SQL-Anweisung als String</param>
''' <returns>Zeilenanzahl, einzelner Stringwert oder SqlDataReader</returns>
''' <remarks>Dies passiert direkt in der Datenbank - nicht im Dataset!</remarks>
Private Function doSql(ByVal sqlStatement As String, ByVal queryReturns As QueryReturns) As Object
Dim returnValue As Object = Nothing

Try
'Vorbereitungen
sqlCmd.CommandType = CommandType.Text
sqlCmd.CommandText = sqlStatement
sqlCmd.Connection = New SqlConnection(SqlConnectionString)

'führe die Anweisung je nach Art aus
sqlCmd.Connection.Open()
Select Case queryReturns
Case queryReturns.Value 'liefert erste Spalte der ersten Zeile
returnValue = sqlCmd.ExecuteScalar().ToString
Case queryReturns.Count 'liefert Anzahl der Zeilen
returnValue = sqlCmd.ExecuteNonQuery()

Case DataAccess.QueryReturns.Keys
Dim list As New List(Of String)
returnValue = sqlCmd.ExecuteReader

'übernimm die SQLDataReader-Daten in die Liste
While returnValue.Read()
list.Add(returnValue(0))
End While
sqlCmd.Connection.Close()

Return list
Case queryReturns.Reader 'liefert den Reader
returnValue = sqlCmd.ExecuteReader
'log.Test("doSql.GetReader", returnValue.RecordsAffected & " Datensätze wurden zurückgegeben")

End Select
sqlCmd.Connection.Close()
'fertig
Return returnValue
Catch ex As Exception

log.Fault("doSqlGetValue", "Die Anweisung wurde nicht korrekt ausgeführt: " & vbCrLf _
& queryReturns.ToString & ": " & sqlStatement & vbCrLf & ex.Message)

Return Nothing
End Try
End Function

ConnectionString aus web.config lesen

Private ReadOnly Property SqlConnectionString() As String
Get
If mSqlConnectionString > "" Then Return mSqlConnectionString

' Get the connectionStrings section.
Dim connectionStringsSectio
n As ConnectionStringsSection = WebConfigurationManager.GetSection("connectionStrings")
' Get the connectionStrings key,value pairs collection.
Dim connectionStrings As ConnectionStringSettingsCollection = connectionStringsSection.ConnectionStrings
'speichern (in Common.vb)
mSqlConnectionString = connectionStrings(CONNSTRINGname).ConnectionString

'log.Test("getConnectionString", "Der ConnectionString lautet: " & mSqlConnectionString)
Return mSqlConnectionString
End Get
End Property

DetailsView Eingabe validieren

Protected Sub DetailsView_ItemInserting(ByVal sender As Object, ByVal e As System.Web.UI.WebControls.DetailsViewInsertEventArgs) Handles DetailsView.ItemInserting
errorFound = True
txtMeldung.Text = ""
If e.Values(0) = "" Then
txtMeldung.Text = "ID darf nicht leer sein"
e.Cancel = True
Exit Sub
End If
If e.Values(1) = "" Then
txtMeldung.Text = "Beschreibung darf nicht leer sein"
e.Cancel = True
Exit Sub
End If
'Liste aller bisherigen Einträge
Dim l As New List(Of String)
l = DBGetKeys(TMserverDBTables.Devices)
If l.Contains(e.Values(0)) Then
txtMeldung.Text = "Diese ID gibt es bereits"
e.Cancel = True
End If
errorFound = False
End Sub

Neu-DetailsView per Button ein, nach Eing/Cancel aus

Protected Sub btnNewDevice_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles btnNewDevice.Click
DetailsView.Visible = True
btnNewDevice.Visible = False
DetailsView.DataBind()
End Sub

Protected Sub DetailsView_ItemCommand(ByVal sender As Object, ByVal e As System.Web.UI.WebControls.DetailsViewCommandEventArgs) _
Handles DetailsView.ItemCommand
DetailsView.Visible = False
Me.btnNewDevice.Visible = True
End Sub