In my system, I'm using a windows application project. While I'm sending a mail from the project I get an error as "Creating an instance of the COM component with CLSID {20C62CA0-15DA-101B-B9A8-444553540000} from the IClassFactory failed due to the following error:80040112 Class is not licensed for use (Exception from HRResult: 0x800401120).". Can you please help me with the fix for this? I'm using Windows 10 OS.
Dim oMAPSession As New MSMAPI.MAPISession <br/>
Dim MAPIMessages As New MSMAPI.MAPIMessages
Do While J > 0
With MAPIMessages
oMAPSession.SignOn()
.SessionID = oMAPSession.SessionID
.Compose()
If attachbio Then
.AttachmentIndex = 0
If CustomTable.GetCustomNumber("TEPrintPerUser") = 1 Then
.AttachmentPathName = g_fpReportsPath & "\tempbio.pdf"
Else
.AttachmentPathName = Application.StartupPath & "\tempbio.pdf"
End If
.AttachmentName = "techbio.pdf"
End If
strRecip = Trim(rdtxtFldNumber.Text)
i = 0
Do
.RecipIndex = i
.RecipType = 1
If InStr(1, strRecip, ";") > 0 Then
.RecipDisplayName = Microsoft.VisualBasic.Left(strRecip, InStr(1, strRecip, ";") - 1)
strRecip = Mid(strRecip, InStr(1, strRecip, ";") + 1)
i = i + 1
Else
If (strRecip <> "") Then
.RecipDisplayName = strRecip
End If
Exit Do
End If
Loop
GetDispatchForm = New FrmDispatch
If g_sidCustomization = "Nebrasky" And GetDispatchForm.rdddlText.SelectedIndex = 1 Then
.MsgSubject = Replace(rdtxtfpSubject.Text, Chr(10), " ")
Else
.MsgSubject = "Text Message " & Date.Now
End If
If tmpTextCapacity <= 0 Or (Not IsNumeric(Microsoft.VisualBasic.Left(.RecipDisplayName, InStr(1, .RecipDisplayName, "#") - 1))) Then
.MsgNoteText = strText
J = 0
Else
.MsgNoteText = Microsoft.VisualBasic.Left(strText, tmpTextCapacity)
End If
.Send()
End With
strText = Mid(strText, tmpTextCapacity + 1)
J = J - tmpTextCapacity
Loop
When I am adding information to the file it does that all and well. It error checks the fields but at the end, adds blank spaces to the file.
This also happens if the fields are kept blank.
Private Sub btnAdd_Click(sender As Object, e As EventArgs) Handles btnAdd.Click
If Char.IsNumber(txtStudentID.Text) = False Then
MessageBox.Show("Text cannot include letters or be clear, fill in correctly before proceeding",
"User Error", MessageBoxButtons.OK, MessageBoxIcon.Error)
txtStudentID.Clear()
txtStudentID.Focus()
Else
OneMember.StudentID = txtStudentID.Text
End If
Char.IsLetter(txtName.Name)
If Char.IsLetter(txtName.Text) = False Then
MessageBox.Show("Text cannot include number or be clear, fill in correctly before proceeding",
"User Error", MessageBoxButtons.OK, MessageBoxIcon.Error)
txtName.Clear()
txtName.Focus()
Else
'OneMember.NameOfStudent = txtName.Text
End If
Char.IsLetter(txtLesson.Name)
If Char.IsLetter(txtLesson.Text) = False Then
MessageBox.Show("Text cannot include number or be clear, fill in correctly before proceeding",
"User Error", MessageBoxButtons.OK, MessageBoxIcon.Error)
txtLesson.Clear()
txtLesson.Focus()
Else
'OneMember.Lesson = txtLesson.Text
End If
Char.IsNumber(txtPayed.Text)
If Char.IsNumber(txtPayed.Text) = False Then
MessageBox.Show("Text cannot include letters or be clear, fill in correctly before proceeding",
"User Error", MessageBoxButtons.OK, MessageBoxIcon.Error)
txtPayed.Clear()
txtPayed.Focus()
Else
OneMember.AmountPayed = txtPayed.Text
End If
OneMember.NameOfStudent = txtName.Text
OneMember.Lesson = txtLesson.Text
OneMember.DOl = txtDate.Text
OneMember.TOL = txtTime.Text
FileOpen(1, AddLesson, OpenMode.Random, , , Len(OneMember))
NumberOfRecords = LOF(1) / Len(OneMember)
FilePut(1, OneMember, NumberOfRecords + 1)
FileClose()
NumberOfRecords = NumberOfRecords + 1
txtStudentID.Clear()
txtName.Clear()
txtDate.Clear()
txtTime.Clear()
txtLesson.Clear()
txtPayed.Clear()
MsgBox(" Student added to file")
End Sub
Thank you for anyone that helps me with this.
I have written some VBA on a PC, but my copywriters use a mac and the Macros do not work. I get a run time error 13 on the following code:
If Range("Home_EPIC_Flag_Count").Value = 0 Then
is what gets highlighted yellow when I debug
Private Sub Worksheet_Calculate()
' EPIC flag conditional testing macros
If Range("Home_EPIC_Flag_Count").Value = 0 Then
Me.Shapes("Home_EPIC_Flag").Visible = False
Else
Me.Shapes("Home_EPIC_Flag").Visible = True
End If
If Range("Rooms_EPIC_Flag_Count").Value = 0 Then
Me.Shapes("Rooms_EPIC_Flag").Visible = False
Else
Me.Shapes("Rooms_EPIC_Flag").Visible = True
End If
If Range("Dining_EPIC_Flag_Count").Value = 0 Then
Me.Shapes("Dining_EPIC_Flag").Visible = False
Else
Me.Shapes("Dining_EPIC_Flag").Visible = True
End If
If Range("Spa_EPIC_Flag_Count").Value = 0 Then
Me.Shapes("Spa_EPIC_Flag").Visible = False
Else
Me.Shapes("Spa_EPIC_Flag").Visible = True
End If
If Range("Golf_EPIC_Flag_Count").Value = 0 Then
Me.Shapes("Golf_EPIC_Flag").Visible = False
Else
Me.Shapes("Golf_EPIC_Flag").Visible = True
End If
If Range("LocalArea_EPIC_Flag_Count").Value = 0 Then
Me.Shapes("LocalArea_EPIC_Flag").Visible = False
Else
Me.Shapes("LocalArea_EPIC_Flag").Visible = True
End If
If Range("Business_EPIC_Flag_Count").Value = 0 Then
Me.Shapes("Business_EPIC_Flag").Visible = False
Else
Me.Shapes("Business_EPIC_Flag").Visible = True
End If
A little refactoring will make your code more manageable (once you fix the named range issue)
Private Sub Worksheet_Calculate()
Dim arr, x As Long
arr = Array("Home", "Rooms", "Dining", "Spa", "Golf", "LocalArea", "Business")
For x = LBound(arr) To UBound(arr)
Me.Shapes(arr(x) & "_EPIC_Flag").Visible = _
(Range(arr(x) & "_EPIC_Flag_Count").Value > 0)
Next x
End Sub
i am trying to integrate stripe payment gateway in classic ASP using vb script , i am very new to ASP and vb script and trying to learn how it could be done.
meanwhile i have got a great resource : Integrate stripe using Classic ASP
i am just trying to do the same as explained in the above article.
My Folder Structure :
/stripe
-aspJSON1.17.asp
-index.asp
--My index.asp file--
<!–#include virtual="aspJSON1.17.asp" –>
<%
Function GetStripe(url,typ)
Set xml = Server.CreateObject("Microsoft.XMLHTTP")
xml.Open typ, url, False
xml.setRequestHeader "Authorization", "Bearer sk_test_mykey"
xml.Send
GetStripe = xml.responseText
Set xml = Nothing
End Function
var_stripe_token = Request(stripeToken)
var_json = GetStripe("https://api.stripe.com/v1/customers?description=LoremIpsum&card=" & var_stripe_token, "POST")
Set oJSON = New aspJSON
oJSON.loadJSON(var_json)
Response.Write "<pre>JSON returned: " & var_json & "</pre>"
Response.Write "<pre>UserId: " & oJSON.data("id") & "</pre>"
%>
<html>
<head>
<title>Stripe Testing</title>
<script src="//code.jquery.com/jquery-1.11.3.min.js"></script>
<script type="text/javascript" src="https://js.stripe.com/v2/"></script>
<script type="text/javascript">
// This identifies your website in the createToken call below
Stripe.setPublishableKey('My_publishkey');
// ...
</script>
<script type="text/javascript">
jQuery(function($) {
$('#payment-form').submit(function(event) {
var $form = $(this);
// Disable the submit button to prevent repeated clicks
$form.find('button').prop('disabled', true);
Stripe.card.createToken($form, stripeResponseHandler);
// Prevent the form from submitting with the default action
return false;
});
});
function stripeResponseHandler(status, response) {
var $form = $('#payment-form');
$("#stripeToken").val(response.id);
$form.find('button').prop('disabled', false);
$form.get(0).submit();
}
</script>
</head>
<body>
<h3>Stripe Testing</h3>
<form action="" method="POST" id="payment-form">
<span class="payment-errors"></span>
<div class="form-row">
<label>
<span>Card Number</span>
<input type="text" size="20" data-stripe="number"/>
</label>
</div>
<div class="form-row">
<label>
<span>CVC</span>
<input type="text" size="4" data-stripe="cvc"/>
</label>
</div>
<div class="form-row">
<label>
<span>Expiration (MM/YYYY)</span>
<input type="text" size="2" data-stripe="exp-month"/>
</label>
<span> / </span>
<input type="text" size="4" data-stripe="exp-year"/>
</div>
<input type="hidden" name="stripeToken" id="stripeToken" value="" />
<button type="submit">Submit Payment</button>
</form>
</body>
</html>
--My aspJSON1.17.asp --
<%
'Februari 2014 - Version 1.17 by Gerrit van Kuipers
Class aspJSON
Public data
Private p_JSONstring
private aj_in_string, aj_in_escape, aj_i_tmp, aj_char_tmp, aj_s_tmp, aj_line_tmp, aj_line, aj_lines, aj_currentlevel, aj_currentkey, aj_currentvalue, aj_newlabel, aj_XmlHttp, aj_RegExp, aj_colonfound
Private Sub Class_Initialize()
Set data = Collection()
Set aj_RegExp = new regexp
aj_RegExp.Pattern = "\s{0,}(\S{1}[\s,\S]*\S{1})\s{0,}"
aj_RegExp.Global = False
aj_RegExp.IgnoreCase = True
aj_RegExp.Multiline = True
End Sub
Private Sub Class_Terminate()
Set data = Nothing
Set aj_RegExp = Nothing
End Sub
Public Sub loadJSON(inputsource)
inputsource = aj_MultilineTrim(inputsource)
If Len(inputsource) = 0 Then Err.Raise 1, "loadJSON Error", "No data to load."
select case Left(inputsource, 1)
case "{", "["
case else
Set aj_XmlHttp = Server.CreateObject("Msxml2.ServerXMLHTTP")
aj_XmlHttp.open "GET", inputsource, False
aj_XmlHttp.setRequestHeader "Content-Type", "text/json"
aj_XmlHttp.setRequestHeader "CharSet", "UTF-8"
aj_XmlHttp.Send
inputsource = aj_XmlHttp.responseText
set aj_XmlHttp = Nothing
end select
p_JSONstring = CleanUpJSONstring(inputsource)
aj_lines = Split(p_JSONstring, Chr(13) & Chr(10))
Dim level(99)
aj_currentlevel = 1
Set level(aj_currentlevel) = data
For Each aj_line In aj_lines
aj_currentkey = ""
aj_currentvalue = ""
If Instr(aj_line, ":") > 0 Then
aj_in_string = False
aj_in_escape = False
aj_colonfound = False
For aj_i_tmp = 1 To Len(aj_line)
If aj_in_escape Then
aj_in_escape = False
Else
Select Case Mid(aj_line, aj_i_tmp, 1)
Case """"
aj_in_string = Not aj_in_string
Case ":"
If Not aj_in_escape And Not aj_in_string Then
aj_currentkey = Left(aj_line, aj_i_tmp - 1)
aj_currentvalue = Mid(aj_line, aj_i_tmp + 1)
aj_colonfound = True
Exit For
End If
Case "\"
aj_in_escape = True
End Select
End If
Next
if aj_colonfound then
aj_currentkey = aj_Strip(aj_JSONDecode(aj_currentkey), """")
If Not level(aj_currentlevel).exists(aj_currentkey) Then level(aj_currentlevel).Add aj_currentkey, ""
end if
End If
If right(aj_line,1) = "{" Or right(aj_line,1) = "[" Then
If Len(aj_currentkey) = 0 Then aj_currentkey = level(aj_currentlevel).Count
Set level(aj_currentlevel).Item(aj_currentkey) = Collection()
Set level(aj_currentlevel + 1) = level(aj_currentlevel).Item(aj_currentkey)
aj_currentlevel = aj_currentlevel + 1
aj_currentkey = ""
ElseIf right(aj_line,1) = "}" Or right(aj_line,1) = "]" or right(aj_line,2) = "}," Or right(aj_line,2) = "]," Then
aj_currentlevel = aj_currentlevel - 1
ElseIf Len(Trim(aj_line)) > 0 Then
if Len(aj_currentvalue) = 0 Then aj_currentvalue = aj_line
aj_currentvalue = getJSONValue(aj_currentvalue)
If Len(aj_currentkey) = 0 Then aj_currentkey = level(aj_currentlevel).Count
level(aj_currentlevel).Item(aj_currentkey) = aj_currentvalue
End If
Next
End Sub
Public Function Collection()
set Collection = Server.CreateObject("Scripting.Dictionary")
End Function
Public Function AddToCollection(dictobj)
if TypeName(dictobj) <> "Dictionary" then Err.Raise 1, "AddToCollection Error", "Not a collection."
aj_newlabel = dictobj.Count
dictobj.Add aj_newlabel, Collection()
set AddToCollection = dictobj.item(aj_newlabel)
end function
Private Function CleanUpJSONstring(aj_originalstring)
aj_originalstring = Replace(aj_originalstring, Chr(13) & Chr(10), "")
aj_originalstring = Mid(aj_originalstring, 2, Len(aj_originalstring) - 2)
aj_in_string = False : aj_in_escape = False : aj_s_tmp = ""
For aj_i_tmp = 1 To Len(aj_originalstring)
aj_char_tmp = Mid(aj_originalstring, aj_i_tmp, 1)
If aj_in_escape Then
aj_in_escape = False
aj_s_tmp = aj_s_tmp & aj_char_tmp
Else
Select Case aj_char_tmp
Case "\" : aj_s_tmp = aj_s_tmp & aj_char_tmp : aj_in_escape = True
Case """" : aj_s_tmp = aj_s_tmp & aj_char_tmp : aj_in_string = Not aj_in_string
Case "{", "["
aj_s_tmp = aj_s_tmp & aj_char_tmp & aj_InlineIf(aj_in_string, "", Chr(13) & Chr(10))
Case "}", "]"
aj_s_tmp = aj_s_tmp & aj_InlineIf(aj_in_string, "", Chr(13) & Chr(10)) & aj_char_tmp
Case "," : aj_s_tmp = aj_s_tmp & aj_char_tmp & aj_InlineIf(aj_in_string, "", Chr(13) & Chr(10))
Case Else : aj_s_tmp = aj_s_tmp & aj_char_tmp
End Select
End If
Next
CleanUpJSONstring = ""
aj_s_tmp = split(aj_s_tmp, Chr(13) & Chr(10))
For Each aj_line_tmp In aj_s_tmp
aj_line_tmp = replace(replace(aj_line_tmp, chr(10), ""), chr(13), "")
CleanUpJSONstring = CleanUpJSONstring & aj_Trim(aj_line_tmp) & Chr(13) & Chr(10)
Next
End Function
Private Function getJSONValue(ByVal val)
val = Trim(val)
If Left(val,1) = ":" Then val = Mid(val, 2)
If Right(val,1) = "," Then val = Left(val, Len(val) - 1)
val = Trim(val)
Select Case val
Case "true" : getJSONValue = True
Case "false" : getJSONValue = False
Case "null" : getJSONValue = Null
Case Else
If (Instr(val, """") = 0) Then
If IsNumeric(val) Then
getJSONValue = CDbl(val)
Else
getJSONValue = val
End If
Else
If Left(val,1) = """" Then val = Mid(val, 2)
If Right(val,1) = """" Then val = Left(val, Len(val) - 1)
getJSONValue = aj_JSONDecode(Trim(val))
End If
End Select
End Function
Private JSONoutput_level
Public Function JSONoutput()
dim wrap_dicttype, aj_label
JSONoutput_level = 1
wrap_dicttype = "[]"
For Each aj_label In data
If Not aj_IsInt(aj_label) Then wrap_dicttype = "{}"
Next
JSONoutput = Left(wrap_dicttype, 1) & Chr(13) & Chr(10) & GetDict(data) & Right(wrap_dicttype, 1)
End Function
Private Function GetDict(objDict)
dim aj_item, aj_keyvals, aj_label, aj_dicttype
For Each aj_item In objDict
Select Case TypeName(objDict.Item(aj_item))
Case "Dictionary"
GetDict = GetDict & Space(JSONoutput_level * 4)
aj_dicttype = "[]"
For Each aj_label In objDict.Item(aj_item).Keys
If Not aj_IsInt(aj_label) Then aj_dicttype = "{}"
Next
If aj_IsInt(aj_item) Then
GetDict = GetDict & (Left(aj_dicttype,1) & Chr(13) & Chr(10))
Else
GetDict = GetDict & ("""" & aj_JSONEncode(aj_item) & """" & ": " & Left(aj_dicttype,1) & Chr(13) & Chr(10))
End If
JSONoutput_level = JSONoutput_level + 1
aj_keyvals = objDict.Keys
GetDict = GetDict & (GetSubDict(objDict.Item(aj_item)) & Space(JSONoutput_level * 4) & Right(aj_dicttype,1) & aj_InlineIf(aj_item = aj_keyvals(objDict.Count - 1),"" , ",") & Chr(13) & Chr(10))
Case Else
aj_keyvals = objDict.Keys
GetDict = GetDict & (Space(JSONoutput_level * 4) & aj_InlineIf(aj_IsInt(aj_item), "", """" & aj_JSONEncode(aj_item) & """: ") & WriteValue(objDict.Item(aj_item)) & aj_InlineIf(aj_item = aj_keyvals(objDict.Count - 1),"" , ",") & Chr(13) & Chr(10))
End Select
Next
End Function
Private Function aj_IsInt(val)
aj_IsInt = (TypeName(val) = "Integer" Or TypeName(val) = "Long")
End Function
Private Function GetSubDict(objSubDict)
GetSubDict = GetDict(objSubDict)
JSONoutput_level= JSONoutput_level -1
End Function
Private Function WriteValue(ByVal val)
Select Case TypeName(val)
Case "Double", "Integer", "Long": WriteValue = val
Case "Null" : WriteValue = "null"
Case "Boolean" : WriteValue = aj_InlineIf(val, "true", "false")
Case Else : WriteValue = """" & aj_JSONEncode(val) & """"
End Select
End Function
Private Function aj_JSONEncode(ByVal val)
val = Replace(val, "\", "\\")
val = Replace(val, """", "\""")
'val = Replace(val, "/", "\/")
val = Replace(val, Chr(8), "\b")
val = Replace(val, Chr(12), "\f")
val = Replace(val, Chr(10), "\n")
val = Replace(val, Chr(13), "\r")
val = Replace(val, Chr(9), "\t")
aj_JSONEncode = Trim(val)
End Function
Private Function aj_JSONDecode(ByVal val)
val = Replace(val, "\""", """")
val = Replace(val, "\\", "\")
val = Replace(val, "\/", "/")
val = Replace(val, "\b", Chr(8))
val = Replace(val, "\f", Chr(12))
val = Replace(val, "\n", Chr(10))
val = Replace(val, "\r", Chr(13))
val = Replace(val, "\t", Chr(9))
aj_JSONDecode = Trim(val)
End Function
Private Function aj_InlineIf(condition, returntrue, returnfalse)
If condition Then aj_InlineIf = returntrue Else aj_InlineIf = returnfalse
End Function
Private Function aj_Strip(ByVal val, stripper)
If Left(val, 1) = stripper Then val = Mid(val, 2)
If Right(val, 1) = stripper Then val = Left(val, Len(val) - 1)
aj_Strip = val
End Function
Private Function aj_MultilineTrim(TextData)
aj_MultilineTrim = aj_RegExp.Replace(TextData, "$1")
End Function
private function aj_Trim(val)
aj_Trim = Trim(val)
Do While Left(aj_Trim, 1) = Chr(9) : aj_Trim = Mid(aj_Trim, 2) : Loop
Do While Right(aj_Trim, 1) = Chr(9) : aj_Trim = Left(aj_Trim, Len(aj_Trim) - 1) : Loop
aj_Trim = Trim(aj_Trim)
end function
End Class
%>
the problem is that when i run the code it gives the following error:
Microsoft VBScript runtime error '800a01fa'
Class not defined: 'aspJSON'
/stripe/index.asp, line 24
Please let me know what wrong am i doing.thanks
You're gonna hate me for this. :)
Include files need to be in html comment tags, which have two hyphens before/after the angle brackets, not one hyphen like you have.
<!-- #include virtual="/path/to/aspJSON1.17.asp" -->
<!-- #include file="aspJSON1.17.asp" -->
I have the following but would like to have a full list of codes and their detailed descriptions if at all possible.
For example does the username exist? Is the password wrong?
Set oADsObject = oADsNamespace.OpenDSObject(strADsPath, strUserName,strPassword, 0)
Select Case Err.number
Case 0
' Success
Session("Auth") = "YES"
Case -80070775
'Locked
errorMSG = "Account has been locked"
Case -2147943726, -2147023570, -2147024810, -2147023677, -2147022694
' Invalid
Session("Auth") = "NO"
errorMSG="Invalid details"
Case -2147023565
' Disabled
Session("Auth") = "NO"
errorMSG = "Disabled account"
Case -2147022987
'Loceked
Session("Auth") = "NO"
errorMSG = "Locked Account"
Case -2147022989, -2147023541, -2147023688
'Password expired
Session("Auth") = "NO"
errorMSG = "Password Expired"
Case else
'Something else
Session("Auth") = "NO"
errorMSG = Err.Number
end select