Private Function SearchDB() As Integer
' Open the connection
If myCon.State = ConnectionState.Closed Then myCon.Open()
Dim i As Integer
Dim sPwd As String
Dim bMailSent As Boolean = True
sPwd = clAct.CreateRandomCode(6).ToString
Dim myCmd As New SqlCommand
myCmd.CommandType = CommandType.StoredProcedure
'myCmd.CommandTimeout = 60 '0 '30
myCmd.Connection = myCon
Dim myTrans As SqlTransaction = myCon.BeginTransaction()
With myCmd
.Transaction = myTrans
.CommandText = "up_gGetLogon_Details"
'... add proc params
End With
Dim iCmdResult As Integer
Try
myCmd.ExecuteNonQuery()
iCmdResult = CType(myCmd.Parameters("@Result").Value, Integer) ' Grab the output value
If iCmdResult = 0 Then
Dim iUser_ID As Integer = CType(myCmd.Parameters("@User_ID").Value, Integer)
Dim sUserName As String = CType(myCmd.Parameters("@User_Name").Value, String)
Dim sFName As String = CType(myCmd.Parameters("@First_Name").Value, String)
Dim sLName As String = CType(myCmd.Parameters("@Last_Name").Value, String)
Dim sFullName As String = sFName.ToString & " " & sLName.ToString
Dim sSubject As String = ""
Dim sFrom As String = clAct.GetJnl_Editorial_Email()
Dim iFrom_User_ID As Integer = 0
Dim sTo As String = Me.txtEmail.Text.Trim
Dim sBody As String = ""
Dim sRecipients(2, 1) As String
sRecipients(0, 0) = iFrom_User_ID.ToString
sRecipients(1, 0) = sFrom
sRecipients(2, 0) = "f"
sRecipients(0, 1) = iUser_ID.ToString
sRecipients(1, 1) = sTo
sRecipients(2, 1) = "t"
Dim dr As SqlDataReader = clAct.GetCorrespondenceTemplateByName("Forgot Logon", "Custom")
If dr.HasRows = True Then
dr.Read()
sSubject = clAct.DeNull(dr("Subject"))
sBody = clAct.DeNull(dr("Body"))
dr.Close()
' Merge the Body text
sRet = clAct.TranslateMergeFields(sBody, False, sTo.ToString)
If clAct.DeNull(sRet(1)) <> vbNullString Then
iCmdResult = 7
Me.lblMsg.Visible = True
Me.lblMsg.Text = sRet(1)
End If
sBody = sRet(0).ToString & vbNewLine
Else
iCmdResult = 0 '9
If Not dr Is Nothing Then
If dr.IsClosed = False Then dr.Close()
End If
'... failed to find the template; build default subject and body here
End If
If iCmdResult = 0 Then
' Insert Details into the Correspondence Table
With myCmd
.Parameters.Clear()
.CommandText = "up_gNewCorrespondence"
'... add params
.ExecuteNonQuery()
End With
iCmdResult = CType(myCmd.Parameters("@Result").Value, Integer) ' Grab the output value
If iCmdResult = 0 Then
Dim iCorresp_ID As Integer = CType(myCmd.Parameters("@Corresp_ID").Value, Integer) ' Grab the output value
For i = 0 To UBound(sRecipients, 2)
With myCmd
.Parameters.Clear()
.CommandText = "up_gNewRecipient"
'... add params
.ExecuteNonQuery()
End With
iCmdResult = CType(myCmd.Parameters("@Result").Value, Integer)
If iCmdResult <> 0 Then
Exit For
End If
Next
If iCmdResult = 0 Then
sBody = sBody.Replace("xxxxxx", sPwd.ToString).ToString
' send email here
End If
End If
End If
End If
If iCmdResult = 0 Then
myTrans.Commit() ' If we get here; commit
Else
myTrans.Rollback()
End If
Catch ex As SqlException
myTrans.Rollback()
iCmdResult = ex.Number
Me.lblMsg.Text += ex.Message
Finally
myCon.Close()
End Try
Return iCmdResult
End Function
Public Function TranslateMergeFields(ByVal sText As String, ByVal bRemoveUnMatchedTags As Boolean, ByVal sMLEmail As String) As Array
Dim sOut As String = sText ' OutPut Text
Dim sVal As String = ""
Dim arrRet(1) As String
Dim sErrMsg As String = ""
Dim bUnHandledField As Boolean = False
Dim bNullAllowed As Boolean = False
Dim sSQL As String = ""
arrRet(0) = "" 'Return String
arrRet(1) = "" 'Errors
bRemoveUnMatchedTags = CBool(bRemoveUnMatchedTags)
If InStrCount(sText, "<<", vbBinaryCompare) <> InStrCount(sText, ">>", vbBinaryCompare) Then
sErrMsg = sErrMsg & "<li>Warning text contains unmatched opening(" & InStrCount(sText, "<<", vbBinaryCompare) & ") and closing (" & InStrCount(sText, ">>", vbBinaryCompare) & ") tags</li>"
End If
If Me.DeNull(sText) <> vbNullString Then
'oMatches = RegExpr_ReturnMatch(sText, "<<.*?>>", True)
Dim oMatches As MatchCollection, oMatch As Match
Dim regEx As New Regex("<<.*?>>", RegexOptions.IgnoreCase = True)
oMatches = regEx.Matches(sText)
If oMatches.Count > 0 Then
For Each oMatch In oMatches
Dim dr As SqlDataReader = Nothing
Dim cmd As New SqlCommand
With cmd
.CommandType = CommandType.Text
.Connection = myCon
End With
OpenConnection()
If InStr(1, sOut, oMatch.Value, vbTextCompare) > 0 Then
Select Case LCase(oMatch.Value)
Case LCase("<<RecipientFirstName>>")
sSQL = "SELECT p.First_Name FROM People p WHERE p.Deleted=0"
sSQL += " AND (p.Email='" & sMLEmail & "' OR p.Email2='" & sMLEmail & "')"
Call WriteToFile("Query: " & sSQL & vbNewLine)
Call WriteToFile("Cn State: " & myCon.State.ToString & vbNewLine)
cmd.CommandText = sSQL.ToString
[COLOR="Red"] dr = cmd.ExecuteReader[/COLOR]
If dr.HasRows = True Then
dr.Read()
bNullAllowed = True
sVal = Trim(DeNull(dr(0)))
End If
dr.Close()
'.... removed other cases for brevity
Case Else
bUnHandledField = True
sErrMsg += "<li>Unhandled Field: " & oMatch.Value & "</li>"
End Select
If DeNull(sVal) <> vbNullString Then
sOut = Replace(sOut, oMatch.Value, sVal, 1, -1, vbTextCompare)
sVal = vbNullString
sSQL = vbNullString
Else
If bRemoveUnMatchedTags = True Then
sOut = Replace(sOut, oMatch.Value, "", 1, -1, vbTextCompare)
ElseIf bNullAllowed = True Then ' Allow this field to be empty
sOut = Replace(sOut, oMatch.Value, "", 1, -1, vbTextCompare)
End If
sSQL = vbNullString
End If
If bNullAllowed = True Then bNullAllowed = False
End If
If Not dr Is Nothing Then
If dr.IsClosed = False Then dr.Close()
End If
Me.CloseConnection()
cmd = Nothing
Next ' oMatch
End If
End If
Return arrRet
End Function
