PDA

Vollständige Version anzeigen : Spieldatensätze erzeugen


J_Eilers
10.02.2005, 09:40
Hi,

Vielleicht braucht ja jemand mal ein paar Spieldaten, um seine Anwendung ein wenig unter "Druck" zu setzen. Mit 3 einfachen Funktionen kann man sich Zahlen, Datums und Zeichenketten erzeugen. Die Zeichenketten sind nicht logisch und ergeben wohl sehr selten ein tatsächliches Wort.

Die 3 Funktionen gehören in ein globales Modul:

Zahlen erzeugen

'//Benötigt wird ein Minimum, ein Maximumwert und das Zahlenformat

Public Function CreateNumber(Min As Double, Max As Double, _
NumberFormat As String) As Double
CreateNumber = Format(((Max - Min) * Rnd + Min), NumberFormat)
End Function

Datum erzeugen

'//Hier wird nur ein Teil des Datums verändert
Public Function CreateDate(StandardDate As Date, Intervall As String, _
Max As Long, Min As Long) As Date
CreateDate = DateAdd(Intervall, CLng((Max - Min) * Rnd + Min), StandardDate)
End Function

'//Hier wird alles verändert
Public Function CreateDateSerial() As Date
Dim GetDate As String

Start:
GetDate = DateSerial(CLng((2050 - 1889) * Rnd + 1899), _
CLng((12 - 1) * Rnd + 1), CLng((31 - 1) * Rnd + 1))

If IsDate(GetDate) Then
CreateDateSerial = CDate(GetDate)
Else
GoTo Start
End If
End Function

Texte erzeugen
'//Benötigt wird eine Zeichenlänge und ob es sich nur um Text handeln soll
Public Function CreateString(LetterCount As Long, _
AlphaNumeric As Boolean) As String
Dim i As Long
Dim run As String

For i = 0 To LetterCount
If AlphaNumeric = False Then
If CInt(1 * Rnd) = 1 Then
run = run & Chr(((90 - 65) * Rnd + 65))
Else
run = run & Chr(((122 - 97) * Rnd + 97))
End If
Else
run = run & Chr(((122 - 48) * Rnd + 48))
End If
Next i

CreateString = run
End Function

Diese Funktionen kann man dann recht einfach in eine Anfügeabfrage einbauen und sich somit neue sinnlose Datensätze erzeugen:

Dim strSQL As String
Dim i As Integer

For i = 0 To 500
strSQL = "INSERT INTO tbl(Zahlenfeld, Textfeld, Datumsfeld) "
strSQL = strSQL & "VALUES (" & CreateNumber(1000, (-1000), "0") & ",' "
strSQL = strSQL & CreateString(50, False) & "', "
strSQL = strSQL & Format(CreateDateSerial, "\#yyyy\-mm\-dd\#") & ")"
DBEngine(0)(0).Execute strSQL, dbFailOnError
Next i

Oder auch mit der anderen Datumsfunktion:

Dim strSQL As String
Dim i As Integer

For i = 0 To 500
strSQL = "INSERT INTO tbl(Zahlenfeld, Textfeld, Datumsfeld) "
strSQL = strSQL & "VALUES (" & CreateNumber(1000, (-1000), "0") & ",' "
strSQL = strSQL & CreateString(50, False) & "', "
strSQL = strSQL & Format(CreateDate("01.01.01", "m", 12, (-12)), _
"\#yyyy\-mm\-dd\#") & ")"
DBEngine(0)(0).Execute strSQL, dbFailOnError
Next i