Sinds kort ben ik bezig met een mailing list. BIJNA alles werkt, ik kan een nieuwe member toevoegen en verwijderen. maar wanneer ik een 2e member wil toevoegen loopt de gehele applicatie vast. Dan moet ik eerst weer het record verwijderen en dan loopt ie weer. Maar kan ik nog steeds niet die 2e member (of meer) toevoegen. Kunnen jullie me helpen??
Dit is de code:
Al vast bedankt
p.s. let niet op de comments die kloppen niet altijd
Dit is de code:
code:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
| <% Option Explicit %>
<!-- #include file="Database.asp" -->
<%
'Zet de response buffer omdat we mischien moeten redirechten.
Response.Buffer = True
'Variables
Dim rsNieuwLid
Dim rsVerwijderLid
Dim strEmailadres
Dim strMode
Dim strCode
Dim strBericht
Dim blnError
'Zet de errors actief
blnError = False
'Vraagt de gegenvens uit het formulier
strEmailadres = LCase(Request.Form("email"))
strMode = Request.Form("mode")
'Kijk of het email adres wel goed is
strEmailadres = characterStrip(strEmailadres)
'Kijk of het email adres wel goed is
If Len(strEmailAdres) < 5 OR NOT Instr(1, strEmailadres, " ") = 0 Or Instr(1, strEmailAdres, "@", 1) < 2 Or InStrRev(strEmailadres, ".") < Instr(1, strEmailadres, "@", 1) Then
'Zet een error
strBericht = strBericht & "Vul een geldig email adres in"
'Zet de error actief
blnError = True
End If
'Kijkt naar inschrijven of verwijderen
Select Case strMode
'Als het toevoegen is
Case "toevoegen"
'Maakt een record object
Set rsNieuwLid = Server.CreateObject("ADODB.Recordset")
'Zoek de tabellen op in de database
strSQL = "SELECT Email.* FROM Email;"
'Zet een cursor type
rsNieuwLid.CursorType = 2
'Zet een lock type
rsNieuwLid.LockType = 3
'Nader de database
rsNieuwLid.Open strSQL, adoCon
'Random Timer
Randomize Timer
'Maak een code voor het nieuwe lid
strCode = Left(strEmailadres,2) & (9876989856 * CInt((RND * 32000) + 100))
'Loop door de recordset
Do While NOT rsNieuwLid.EOF
'Als er al een code is voor de lid maak een nieuw en kijk op hij dan bestaat
If strCode = rsNieuwLid("Code") Then
'Random Timer
Randomize Timer
'Schrijf een code
strCode = Left(strEmailAdres,2) & (9876989856 * CInt((RND * 32000) + 100))
'Ga naar het eerste record
rsNieuwLid.MoveFirst
End If
'Als het email adres er al is laat dan een error zien
If strEmailadres = rsNieuwLid("Email") Then
'Error
strBericht = strBericht & "Het e-mail adres bestaat al"
'Set de error active
blnError = True
'Exit voor Loop
Exit Do
End If
'Ga naar het eerste record
rsNieuwLid.MoveFirst
Loop
'Als de error false is dan add het nieuwe lid
If blnError = False Then
'Voeg de nieuw lid toe aan de database
rsNieuwLid.AddNew
rsNieuwLid.Fields("Email") = strEmailadres
rsNieuwLid.Fields("Code") = strCode
rsNieuwLid.Update
End If
rsNieuwLid.Close
Set rsNieuwLid = Nothing
'Als het toevoegen is
Case "verwijderen"
'Maakt een record object
Set rsVerwijderLid = Server.CreateObject("ADODB.Recordset")
'Zoek de tabellen op in de database
strSQL = "SELECT Email.* From Email WHERE Email.Email = '" & strEmailAdres & "';"
'Zet een cursor type
rsVerwijderLid.CursorType = 2
'Zet een lock type
rsVerwijderLid.LockType = 3
'Nader de database
rsVerwijderLid.Open strSQL, adoCon
'Als er geen error is verwijder de lid
If NOT rsVerwijderLid.EOF Then
'Delete de lid
rsVerwijderLid.Delete
End If
rsVerwijderLid.Close
Set rsVerwijderLid = Nothing
End Select
'Reset Server Object
Set adoCon = Nothing
%> |
Al vast bedankt
p.s. let niet op de comments die kloppen niet altijd