stackoverflow exception with htmlagility pack - stack-overflow

I am using the htmlagilitypack to parse an xml document. I use it to load the string as a htmldocument and then use the xmltextreader to parse. I will occasionally get an unhandled stackoverflow exception on htmlagility.dll.
The specific line is
internal Dictionary<string, Htmlattribute> Hashitems = new
Dictionary<string, HtmlAttribute>()
EDIT:
Try
Dim hdoc = New HtmlAgilityPack.HtmlDocument()
hdoc.LoadHtml(xmlsnippet)
Dim nreader As XmlTextReader = New
XmlTextReader(New StringReader(xmlsnippet))
Dim ncount As Integer = 0
While nreader.Read
If Not nreader.Name = "" Then
ncount += 1
If ncount = 18 Then
Exit While
End If
num += 1
nodelist.Add(nreader.Name)
If nreader.Name = "id" Then
statid = nreader.ReadInnerXml
End If
If nreader.Name = "published" Then
contentDate = nreader.ReadInnerXml
contentDate = Regex.Replace(contentDate, "T", " ")
contentDate = Regex.Replace(contentDate, "\+", " ")
contentDate = contentDate.Replace("Z", "")
End If
If nreader.Name = "summary" Then
ctext = nreader.ReadInnerXml
End If
If nreader.Name = "title" Then
csubject = nreader.ReadInnerXml
If csubject.Contains("posted") Then
template = csubject
author = Regex.Replace(template, "posted.*", "")
End If
If csubject.Contains("Keyword -") Then
Dim tip As String = csubject
searchterm =
Regex.Replace(csubject, "xxxxxx.*xxxxxx.*xxxx.*-", "")
searchterm =
Regex.Replace(searchterm, "xxxxx.*xxxxxx.*Search.*-", "")
Trim(searchterm)
End If
End If
End If
End While
Dim mreader As XmlTextReader =
New XmlTextReader(New StringReader(xmlsnippet))
Dim mcount As Integer = 0
While mreader.Read
If Not mreader.Name = "" Then
mcount += 1
If mcount > 15 Then
If mreader.Name = "uri" Then
authorUri = mreader.ReadInnerXml
Trim(authorUri)
If authorUri = "http://www.xxxxxxxx.com/" Then
authorUri = ""
End If
End If
If mreader.Name = "name" Then
author = mreader.ReadInnerXml
If author = "xxxxxx" Then
author = ""
End If
End If
If mreader.Name = "content" Then
htext = mreader.ReadInnerXml
End If
If mreader.Name = "link" Then
Dim address As String
address = mreader.ReadOuterXml
If address.Contains("related") Then
Dim regex12 As Regex =
New Regex("<link.*rel.*href=""(?<Link>.*?)"".*/>", RegexOptions.IgnoreCase)
Dim m12 As Match = regex12.Match(address)
himage = m12.Groups("Link").Value
ElseIf address.Contains("alternate") Then
Dim regex13 As Regex =
New Regex("<link.*rel.*href=""(?<Link>.*?)"".*/>", RegexOptions.IgnoreCase)
Dim m13 As Match = regex13.Match(address)
authorUri = m13.Groups("Link").Value
End If
End If
If mreader.Name = "subtitle" Then
hsubtitle = mreader.ReadInnerXml
End If
End If
End If
End While
Catch ex As Exception
appLogs.constructLog(ex.Message.ToString, True, True)
Exit Sub
End Try
In fact there are different stackoverflow exception errors occurring at different lines but the same error and only while using htmlagilitypack. I am in another method trying to parse the xml using xmldocument, xpathnavigator and it works fine unless I get some bad xml, then I go to this method. I have set up exception catches to just move the bad xml to a folder and then exit this method but I cannot catch these kinds of exceptions or can I?
Another line where error shows:
public string Name
{
get
{
if (_name == null)
{
Name = _ownerdocument.Text.Substring(_namestartindex, _namelength);
}
return _name != null ? _name.ToLower() : string.Empty;
on the last line in the snippet above in the file HtmlNode.cs.
The call stack window shows the top as
HtmlAgilityPack.dll!HtmlAgilityPack.HtmlNode.Name.get() Line 432 + 0x21 bytes

Related

ABCPDF Reading PDF as background image, next page doesnt render

We have 4 Html pages that we are joining together into 1 file.
For the first page, we are reading a blank PDF file (letter head) to add as the background and then add the further 3 pages.
However, all seemed ok in version 8, but now the second page will not show.
thedoc reads the blank pdf and then the html page which overlays the text no issue here.
thedoc1 is the second page which will not load
thedoc1a and thedoc2 load ok.
If I remove the adding of the letter head from thedoc, then all 4 pages load ok, but as soon as I try and use the letter head, the second page doesnt load.
Ive added my script below. What I am doing wrong please
Sub page_load()
Dim rs
Dim strSQLQuery As String
Dim theDoc As Doc = New Doc()
Dim theDoc1 As Doc = New Doc()
Dim theDoc1a As Doc = New Doc()
Dim theDoc2 As Doc = New Doc()
Dim theDoccontents As Doc = New Doc()
theDoc.MediaBox.String = "A4"
theDoc1.MediaBox.String = "A4"
theDoc1a.MediaBox.String = "A4"
theDoc2.MediaBox.String = "A4
theDoc.HtmlOptions.PageCacheEnabled = False
theDoc.HtmlOptions.PageCacheClear()
theDoc.HtmlOptions.ImageQuality = 33
theDoc1.HtmlOptions.ImageQuality = 33
theDoc1a.HtmlOptions.ImageQuality = 33
theDoc2.HtmlOptions.ImageQuality = 33
theDoc.HtmlOptions.AddLinks = True
theDoc1.HtmlOptions.AddLinks = True
theDoc1a.HtmlOptions.AddLinks = True
theDoc2.HtmlOptions.AddLinks = True
theDoc.HtmlOptions.Timeout = 10000000
theDoc1.HtmlOptions.Timeout = 10000000
theDoc1a.HtmlOptions.Timeout = 10000000
theDoc2.HtmlOptions.Timeout = 10000000
Dim rbrandchosen As String
Dim quotenumber As String
Dim rnum As String
Dim cover as string
dim pagex as integer
quotenumber=request("quotenumber")
rbrandchosen=request("rbrandchosen")
response.write(quotenumber)
Dim theURL As String
Dim theID As Integer
Dim strsql as string
Dim theSection as string
Dim theCountDoc1a As Integer
Randomize()
rnum = (CInt(Math.Floor(90 * Rnd())) + 10).ToString
' add covering letter
cover = "c:\\inetpub\\wwwroot\\icopalukintranet\\pnf\\letterhead.pdf"
theDoc.Read(cover)
'theID = theDoc.AddObject("<< >>")
theDoc.HtmlOptions.UseScript = True
theDoc.HtmlOptions.Engine = EngineType.Chrome86
' Render after 2 seconds
theDoc.Rect.SetRect(20, 110, 600, 620)
theDoc.HtmlOptions.OnLoadScript = "(function(){ window.ABCpdf_go = false; setTimeout(function(){ window.ABCpdf_go = true; }, 3000); })();"
theURL = "http://localhost/icopalukintranet/pnf/rooflights/rooflightquotepdfletter.asp?quotenumber="+ quotenumber + "&stridrnd="+rnum
'theDoc.AddImageUrl(theURL)
theID = theDoc.AddImageUrl(theURL)
While True
If Not theDoc.Chainable(theID) Then
Exit While
End If
theDoc.Page = theDoc.AddPage()
theID = theDoc.AddImageToChain(theID)
End While
' add quote
theDoc1.HtmlOptions.Engine = EngineType.Chrome86
theDoc1.HtmlOptions.UseScript = True
theDoc1.Rect.SetRect(0, 0, 600, 820)
' Render after 2 seconds
theDoc1.HtmlOptions.OnLoadScript = "(function(){ window.ABCpdf_go = false; setTimeout(function(){ window.ABCpdf_go = true; }, 2000); })();"
theURL = "http://localhost/icopalukintranet/pnf/rooflights/rooflightquotepdfquote.asp?quotenumber="+ quotenumber + "&stridrnd="+rnum
theDoc1.Page = theDoc1.AddPage()
theID = theDoc1.AddImageUrl(theURL)
While True
If Not theDoc1.Chainable(theID) Then
Exit While
End If
theSection = "Quote"
theDoc1.Page = theDoc1.AddPage()
theID = theDoc1.AddImageToChain(theID)
theDoc1.AddBookmark(theSection, True)
End While
' add notes
theDoc1a.HtmlOptions.Engine = EngineType.Chrome86
theDoc1a.HtmlOptions.UseScript = True
theDoc1a.Rect.SetRect(0, 0, 600, 820)
' Render after 3 seconds
theDoc1a.HtmlOptions.OnLoadScript = "(function(){ window.ABCpdf_go = false; setTimeout(function(){ window.ABCpdf_go = true; }, 1000); })();"
theURL = "http://localhost/icopalukintranet/pnf/rooflights/rooflightquotepdfnotes.asp?quotenumber="+ quotenumber + "&stridrnd="+rnum
theDoc1a.Page = theDoc1a.AddPage()
theID = theDoc1a.AddImageUrl(theURL)
While True
If Not theDoc1a.Chainable(theID) Then
Exit While
End If
theDoc1a.Page = theDoc1a.AddPage()
theID = theDoc1a.AddImageToChain(theID)
End While
' add terms details
theDoc2.HtmlOptions.Engine = EngineType.Chrome86
theDoc2.HtmlOptions.UseScript = True
theDoc2.Rect.SetRect(20, 80, 560, 710)
theDoc2.Transform.Magnify(0.93 ,0.93, 0, 690)
' Render after 1 seconds
theDoc2.HtmlOptions.OnLoadScript = "(function(){ window.ABCpdf_go = false; setTimeout(function(){ window.ABCpdf_go = true; }, 2000); })();"
theURL = "http://localhost/icopalukintranet/pnf/rooflights/rooflightquotepdfterms.asp?quotenumber="+ quotenumber + "&stridrnd="+rnum
theDoc2.Page = theDoc2.AddPage()
theID = theDoc2.AddImageUrl(theURL)
While True
If Not theDoc2.Chainable(theID) Then
Exit While
End If
theSection = "Terms"
theDoc2.Page = theDoc2.AddPage()
theID = theDoc2.AddImageToChain(theID)
theDoc2.AddBookmark(theSection, True)
End While
Dim cst = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & Server.MapPath("rooflightquotes.mdb")
Dim conn = CreateObject("ADODB.Connection")
conn.open(cst)
Session("myConn") = conn
dim rsAddquestion = Server.CreateObject("ADODB.Recordset")
strsql ="select * from pdfs where id=" & quotenumber & " "
rsAddquestion.Open(strsql, conn, 3, 3)
dim n as string
n=rsAddquestion.recordcount
rsAddquestion.AddNew
n=n+1
rsAddquestion("id")=quotenumber
rsAddquestion("pdfname") =quotenumber +"-rev"+n+".pdf"
rsAddquestion("printdate")=now()
rsAddquestion("status")="Printed"
rsAddquestion.update
rsAddquestion = Server.CreateObject("ADODB.Recordset")
strsql ="select * from header where id=" & quotenumber & " "
rsAddquestion.Open(strsql, conn, 3, 3)
rsAddquestion("status")="Printed"
rsAddquestion.update
conn.close
' add the pdf together in selected order
theDoc.Append(theDoc1)
theDoc.Append(theDoc1a)
theDoc.Append(theDoc2)
Dim theCount = theDoc.PageCount
' left bottom width heght
theDoc.Rect.String = "10 10 580 25"
theDoc.HPos = 1.0
theDoc.VPos = 0.5
theDoc.Color.String = "255 255 255"
theDoc.Font = theDoc.AddFont("Arial")
theDoc.FontSize = 10
For i = 1 To theCount
theDoc.PageNumber = i
If i <> 1 Then
theDoc.AddHtml(" Page " + i.ToString() + " of " + theCount.ToString() + "")
theDoc.FrameRect()
End If
Next
dim pdffilenamec = "pdf/"+quotenumber+"-rev"+n+".pdf"
theDoc.Save(Server.MapPath(pdffilenamec))
'response.redirect("rooflightquotepdfmenu.asp?quotenumber="+quotenumber)
End Sub
This used to work find in version 8, but not now using version 12

generate multi parameter by using dictionary for merged String

I'm trying to find a better solution for the integration of a string and generate a new field with the maximum value of the parameter. #AutomatedChaos has helped me with the following code. But I need a better solution for the flexibility of the code.
First string split by * (stars) and I want to merge all items and create a new string with max value.
fString = "projects#dnProjectsPatterning=0|dnProjectsSendReport=1#workplans#dnWorkplansAdd=0|dnWorkplansGrouping=1*projects#dnProjectsPatterning=1|dnProjectsSendReport=3#workplans#dnWorkplansAdd=1|dnWorkplansGrouping=0*projects#dnProjectsPatterning=5|dnProjectsSendReport=1#workplans#dnWorkplansAdd=0|dnWorkplansGrouping=2"
Set dict = CreateObject("Scripting.Dictionary")
Set re = New RegExp
re.Global = True
re.Pattern = "(\w+)=(\d+)"
Set matches = re.Execute(fString)
For Each match In matches
key = match.Submatches(0)
value = CInt(match.Submatches(1))
If dict.Exists(key) Then
If value < dict.Item(key) then
value = dict.Item(key)
End If
End If
dict.Item(key) = value
Next
For Each key In dict
MsgBox key & "=" & dict.Item(key)
Next
' output:
' dnProjectsPatterning=5
' dnProjectsSendReport=3
' dnWorkplansAdd=1
' dnWorkplansGrouping=2
I want to generate this string:
newString = "projects#dnProjectsPatterning=5|dnProjectsSendReport=3#workplans#dnWorkplansAdd=1|dnWorkplansGrouping=2"
Please note for projects# and workplans#, the two are split by #.
Here's another example that will work if the parameters are always ordered as shown.
The following code simply treats all separators except * as part of the keys. You can look at this regexr shot to see how the pattern works.
fString = "projects#dnProjectsPatterning=0|dnProjectsSendReport=1#workplans#dnWorkplansAdd=0|dnWorkplansGrouping=1*projects#dnProjectsPatterning=1|dnProjectsSendReport=3#workplans#dnWorkplansAdd=1|dnWorkplansGrouping=0*projects#dnProjectsPatterning=5|dnProjectsSendReport=1#workplans#dnWorkplansAdd=0|dnWorkplansGrouping=2"
Set params = CreateObject("Scripting.Dictionary")
With (New RegExp)
.Global = True
.Pattern = "([^=*]*)=(\d+)"
For Each match In .Execute(fString)
key = match.Submatches(0)
val = match.Submatches(1)
If params.Exists(key) Then
If val > params(key) Then params(key) = val
Else
params.Add key, val
End If
Next
End With
'temporary str dictionary to generate string
Set str = CreateObject("Scripting.Dictionary")
For Each key In params
'prepend key + "=" into items to generate merged string
str.Add key, key & "=" & params(key)
Next
newString = Join(str.Items, "") 'joining items
WScript.Echo newString
'normalize params' keys
For Each key In params
If Left(key, 1) = "|" Or Left(key, 1) = "#" Then
params.Key(key) = Mid(key, 2)
End If
Next
'lookup for `dnProjectsSendReport` parameter
WScript.Echo params("dnProjectsSendReport") 'must print 3
I find a solution:
'target = "projects#param1={param1}|param2={param2}#workplans#param3={param3}|param4={param4}..."
f_AccessArray = "projects#dnProjectsPatterning=0|dnProjectsSendReport=1#workplans#dnWorkplansAdd=0|dnWorkplansGrouping=1*projects#dnProjectsPatterning=1|dnProjectsSendReport=3#workplans#dnWorkplansAdd=1|dnWorkplansGrouping=0*projects#dnProjectsPatterning=5|dnProjectsSendReport=1#workplans#dnWorkplansAdd=0|dnWorkplansGrouping=2"
arrAccessPack = Split(f_AccessArray,"*")
endString = Split(arrAccessPack(0),"#")
nArrString = ""
for i = 0 to UBound(endString)
if i < UBound(endString) then strHash = "#" else strHash = ""
part1 = Split(endString(i),"#")(0)
part2 = Split(Split(endString(i),"#")(1),"|")
newParams = ""
for j = 0 to UBound(part2)
if j < UBound(part2) then strPipe = "|" else strPipe = ""
param = Split(part2(j),"=")(0)
newParams = newParams & param&"={"&param&"}" & strPipe
next
nArrString = nArrString & part1&"#"&newParams & strHash
next
MergeAccessArray = MergerParams(f_AccessArray,nArrString)
Function MergerParams(fStr,fTarget)
Set dict = CreateObject("Scripting.Dictionary")
Set re = New RegExp
re.Global = True
re.Pattern = "(\w+)=(\d+)"
Set matches = re.Execute(fStr)
for each match in matches
key = match.Submatches(0)
value = cint(match.Submatches(1))
If dict.Exists(key) Then
If value < dict.Item(key) then
value = dict.Item(key)
End If
End If
dict.Item(key) = value
next
target = fTarget
for each key in dict
target = Replace(target, "{" & key & "}", dict.Item(key))
Next
MergerParams = target
End Function

how to rename image file name while uploading on web folder

i m using asp classic. i want to rename image file while i upload image on web folder created by me. please help me out of this issue.
If there is a file in targeted folder with same name (like lokesh.jpg) what i am uploading, than new file should b automatically renamed(like lokesh(1).jpg) instead of overwriting
my code is as below:
upload.asp
<%
Class FileUploader
Public Files
Private mcolFormElem
Private Sub Class_Initialize()
Set Files = Server.CreateObject("Scripting.Dictionary")
Set mcolFormElem = Server.CreateObject("Scripting.Dictionary")
End Sub
Private Sub Class_Terminate()
If IsObject(Files) Then
Files.RemoveAll()
Set Files = Nothing
End If
If IsObject(mcolFormElem) Then
mcolFormElem.RemoveAll()
Set mcolFormElem = Nothing
End If
End Sub
Public Property Get Form(sIndex)
Form = ""
If mcolFormElem.Exists(LCase(sIndex)) Then Form = mcolFormElem.Item(LCase(sIndex))
End Property
Public Default Sub Upload()
Dim biData, sInputName
Dim nPosBegin, nPosEnd, nPos, vDataBounds, nDataBoundPos
Dim nPosFile, nPosBound
biData = Request.BinaryRead(Request.TotalBytes)
nPosBegin = 1
nPosEnd = InstrB(nPosBegin, biData, CByteString(Chr(13)))
If (nPosEnd-nPosBegin) <= 0 Then Exit Sub
vDataBounds = MidB(biData, nPosBegin, nPosEnd-nPosBegin)
nDataBoundPos = InstrB(1, biData, vDataBounds)
Do Until nDataBoundPos = InstrB(biData, vDataBounds & CByteString("--"))
nPos = InstrB(nDataBoundPos, biData, CByteString("Content-Disposition"))
nPos = InstrB(nPos, biData, CByteString("name="))
nPosBegin = nPos + 6
nPosEnd = InstrB(nPosBegin, biData, CByteString(Chr(34)))
sInputName = CWideString(MidB(biData, nPosBegin, nPosEnd-nPosBegin))
nPosFile = InstrB(nDataBoundPos, biData, CByteString("filename="))
nPosBound = InstrB(nPosEnd, biData, vDataBounds)
If nPosFile <> 0 And nPosFile < nPosBound Then
Dim oUploadFile, sFileName
Set oUploadFile = New UploadedFile
nPosBegin = nPosFile + 10
nPosEnd = InstrB(nPosBegin, biData, CByteString(Chr(34)))
sFileName = CWideString(MidB(biData, nPosBegin, nPosEnd-nPosBegin))
oUploadFile.FileName = Right(sFileName, Len(sFileName)-InStrRev(sFileName, "\"))
Dim oFileExtension
If sFileName <> "" then
oFileExtension = (Right(sFileName, Len(sFileName)-InStrRev(sFileName, ".")))
If oFileExtension <> "jpg" AND oFileExtension <> "jpeg" AND oFileExtension <> "gif" AND oFileExtension <> "pdf" then
response.write("<h1>Post New File</h1><p><font color=#ff0000>An error has occurred while processing your request.<br><br>We are sorry, Extensions other than JPG, JPEG, Gif, PDF are not allowed to upload<p><b>Click <a href='javascript:history.go(-1);'>here</a> to go back and address the error.</b></font>")
response.end
Exit Sub
End if
end If
nPos = InstrB(nPosEnd, biData, CByteString("Content-Type:"))
nPosBegin = nPos + 14
nPosEnd = InstrB(nPosBegin, biData, CByteString(Chr(13)))
oUploadFile.ContentType = CWideString(MidB(biData, nPosBegin, nPosEnd-nPosBegin))
nPosBegin = nPosEnd+4
nPosEnd = InstrB(nPosBegin, biData, vDataBounds) - 2
oUploadFile.FileData = MidB(biData, nPosBegin, nPosEnd-nPosBegin)
If sfileName <> "" then
If oUploadFile.FileSize > 10000000 Then
response.write("<h1>Post New Image</h1><p><font color=#ff0000>An error has occurred while processing your request.<br><br>We are sorry, Upload file containing 10000000(10mb) bytes only.<p><b>Click <a href='javascript:window:history.go(-1);'>here</a> to go back and address the error.</b></font>")
response.end
Exit Sub
End if
End if
If oUploadFile.FileSize > 0 Then Files.Add LCase(sInputName), oUploadFile
Else
nPos = InstrB(nPos, biData, CByteString(Chr(13)))
nPosBegin = nPos + 4
nPosEnd = InstrB(nPosBegin, biData, vDataBounds) - 2
If Not mcolFormElem.Exists(LCase(sInputName)) Then mcolFormElem.Add LCase(sInputName), CWideString(MidB(biData, nPosBegin, nPosEnd-nPosBegin))
End If
nDataBoundPos = InstrB(nDataBoundPos + LenB(vDataBounds), biData, vDataBounds)
Loop
End Sub
'String to byte string conversion
Private Function CByteString(sString)
Dim nIndex
For nIndex = 1 to Len(sString)
CByteString = CByteString & ChrB(AscB(Mid(sString,nIndex,1)))
Next
End Function
'Byte string to string conversion
Private Function CWideString(bsString)
Dim nIndex
CWideString =""
For nIndex = 1 to LenB(bsString)
CWideString = CWideString & Chr(AscB(MidB(bsString,nIndex,1)))
Next
End Function
End Class
Class UploadedFile
Public ContentType
Public FileName
Public FileData
Public Property Get FileSize()
FileSize = LenB(FileData)
End Property
Public Sub SaveToDisk(sPath)
Dim oFS, oFile
Dim nIndex
If sPath = "" Or FileName = "" Then Exit Sub
If Mid(sPath, Len(sPath)) <> "\" Then sPath = sPath & "\"
Set oFS = Server.CreateObject("Scripting.FileSystemObject")
If Not oFS.FolderExists(sPath) Then Exit Sub
Set oFile = oFS.CreateTextFile(sPath & FileName, True)
For nIndex = 1 to LenB(FileData)
oFile.Write Chr(AscB(MidB(FileData,nIndex,1)))
Next
oFile.Close
End Sub
Public Sub SaveToDatabase(ByRef oField)
If LenB(FileData) = 0 Then Exit Sub
If IsObject(oField) Then
oField.AppendChunk FileData
End If
End Sub
End Class
%>
submit.asp
<!-- #include file="upload.asp" -->
<%
response.buffer = true
Dim Uploader, File, i, j
Set Uploader = New FileUploader
Uploader.Upload()
Dim brandnm, filename
brandnm = Uploader.form("brandname")
Dim objRSa, objCmda, stra
Set objCmda = server.CreateObject("adodb.connection")
Set Objrsa = Server.CreateObject("ADODB.Recordset")
objCmda.open MM_connDUdirectory_STRING
stra = "SELECT * FROM brand"
Objrsa.Open stra,objCmda,1,2
if Uploader.Files.count <> 0 then
File = Uploader.Files.Items()
File(0).SavetoDisk Server.MapPath("upload/brands") 'Folder path where image will save
filename = File(0).Filename
else
filename = ""
End if
Objrsa.addnew
Objrsa.fields("brand_name") = brandnm
Objrsa.fields("brand_createddt") = now()
if filename <>"" then Objrsa.fields("brand_picpath") = filename
For Each File In Uploader.Files.Items
Objrsa("brand_ctype") = File.ContentType
next
Objrsa.Update
Objrsa.Close
Set Objrsa = Nothing
set objCmda = Nothing
%>
Please help me out of this issue.
If you want to rename it to follow a known pattern as in your example ("filename(number).ext"), you must to use a pseudo-code like this:
let counter = 1
let original = file(0).Filename
let current = file(0).Filename
while(current file exists)
current = original-without-extension + (counter) + original-extension
counter = counter + 1
end
However, I think that would be better to store the user provided filename into your database and choose a random-like filename to store the actual file into the filesystem.
let current = userLogin + (currentTime as yyyyMMddHHmmss) + ".uploaded"
By using a bogus file extension you make your application way more secure, as your file will not be interpretable/executable -- imagine a malicious user uploading an .ASP file and executing it.
If this break the image MIME type, you should consider creating another .ASP page read the database to discover the appropriate MIME type based on the user provided file extension, write that content-type and the binary file content.
TL;DR: don't use the user provided file name, create a new one. This will avoid server hacking.

Excel VBA Copying Pic/Chart to another workbook

I currently have code written to take the fields of one workbook and copy into another workbook. I currently take a range and 'snapshot' it then save that as a separate .bmp file.
I also would like to take this snapshot and attach it into a cell of the workbook I'm copying everything over into. Anybody have any advice, or see here i can add code for this?
Sub Macro4()
'
' Record and File report
Dim Model As String
Dim IssueDate As String
Dim ConcernNo As String
Dim IssuedBy As String
Dim FollowedSEC As String
Dim FollowedBy As String
Dim RespSEC As String
Dim RespBy As String
Dim Timing As String
Dim Title As String
Dim PartNo As String
Dim Block As String
Dim Supplier As String
Dim Other As String
Dim Detail As String
Dim CounterTemp As String
Dim CounterPerm As String
Dim VehicleNo As String
Dim OperationNo As String
Dim Line As String
Dim Remarks As String
Dim ConcernMemosMaster As Workbook
Dim LogData As String
Dim newFile As String
Dim fName As String
Dim Filepath As String
Dim DTAddress As String
Dim pic_rng As Range
Dim ShTemp As Worksheet
Dim ChTemp As Chart
Dim PicTemp As Picture
'Determines if any required cells are empty and stops process if there are. displays error message.
If IsEmpty(Range("c2")) Or IsEmpty(Range("AT3")) Or IsEmpty(Range("BI2")) Or IsEmpty(Range("M7")) Or IsEmpty(Range("C10")) Or IsEmpty(Range("AP14")) Or IsEmpty(Range("C14")) Or IsEmpty(Range("C23")) Or IsEmpty(Range("C37")) Or IsEmpty(Range("J51")) Or IsEmpty(Range("AA51")) Or IsEmpty(Range("C55")) Or IsEmpty(Range("AR51")) Then
MsgBox "Please fill out all required fields and retry.", vbOKOnly
Exit Sub
End If
If Dir("N:\") = "" Then '"N" drive not found, abort sub
MsgBox "Error: Drive, path or file not found. Please email copy of file to: "
Exit Sub
End If
'assigns fields
Worksheets("ConcernMemo").Select
Model = Range("c2")
IssueDate = Range("AT3")
ConcernNo = Range("BC3")
IssuedBy = Range("BI2")
FollowedSEC = Range("BA9")
FollowedBy = Range("BD9")
RespSEC = Range("BG9")
RespBy = Range("BJ9")
Timing = Range("M7")
Title = Range("C10")
PartNo = Range("AP14")
Block = Range("AP16")
Supplier = Range("AP18")
Other = Range("AZ14")
Detail = Range("C14")
CounterTemp = Range("C23")
CounterPerm = Range("C37")
VehicleNo = Range("J51")
OperationNo = Range("AA51")
Remarks = Range("C55")
Line = Range("AR51")
LogData = Format(Now(), "mm_dd_yyyy_hh_mmAMPM")
fName = Range("BC3").Value
newFile = fName & "_" & Format(Now(), "mmddyyyy_hhmmAMPM")
Filepath = "N:\Newell K\Concern_Memo\Concern_Memo_File_Drop\Concern_Memo_Records\" & fName & "_" & Format(Now(), "mmddyyyy_hhmmAMPM")
DTAddress = CreateObject("WScript.Shell").SpecialFolders("Desktop") & Application.PathSeparator
'asks user is they are ready to send to database
If MsgBox("Are you ready to send record to database?", vbYesNo) = vbNo Then Exit Sub
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set pic_rng = Worksheets("ConcernMemo").Range("AK22:BK49")
Set ShTemp = Worksheets.Add
'Takes snapshot of image/sketch and saves to sharedrive
Charts.Add
ActiveChart.Location Where:=xlLocationAsObject, Name:=ShTemp.Name
Set ChTemp = ActiveChart
pic_rng.CopyPicture Appearance:=xlScreen, Format:=xlPicture
ChTemp.Paste
Set PicTemp = Selection
With ChTemp.Parent
.Width = PicTemp.Width + 8
.Height = PicTemp.Height + 8
End With
ChTemp.Export fileName:="N:\Newell K\Concern_Memo\Concern_Memo_File_Drop\Concern_Memo_Images\" & newFile & ".bmp", FilterName:="bmp"
ShTemp.Delete
'opens db file on sharedrive and copies fields over
Set ConcernMemosMaster = Workbooks.Open("N:\Newell K\Concern_Memo\concern_memos_DBMASTER.xlsx")
Worksheets("sheet1").Select
Worksheets("sheet1").Range("a1").Select
RowCount = Worksheets("sheet1").Range("a1").CurrentRegion.Rows.Count
With Worksheets("sheet1")
.Range("a1").Offset(RowCount, 0) = Model
.Range("b1").Offset(RowCount, 0) = IssueDate
.Range("c1").Offset(RowCount, 0) = ConcernNo
.Range("d1").Offset(RowCount, 0) = IssuedBy
.Range("e1").Offset(RowCount, 0) = FollowedSEC
.Range("f1").Offset(RowCount, 0) = FollowedBy
.Range("g1").Offset(RowCount, 0) = RespSEC
.Range("h1").Offset(RowCount, 0) = RespBy
.Range("i1").Offset(RowCount, 0) = Timing
.Range("j1").Offset(RowCount, 0) = Title
.Range("k1").Offset(RowCount, 0) = PartNo
.Range("l1").Offset(RowCount, 0) = Block
.Range("m1").Offset(RowCount, 0) = Supplier
.Range("n1").Offset(RowCount, 0) = Other
.Range("o1").Offset(RowCount, 0) = Detail
.Range("p1").Offset(RowCount, 0) = CounterTemp
.Range("q1").Offset(RowCount, 0) = CounterPerm
.Range("r1").Offset(RowCount, 0) = VehicleNo
.Range("s1").Offset(RowCount, 0) = OperationNo
.Range("t1").Offset(RowCount, 0) = Remarks
.Range("U1").Offset(RowCount, 0) = PicTemp
.Range("V1").Offset(RowCount, 0) = LogData
.Range("w1").Offset(RowCount, 0) = Filepath
.Range("x1").Offset(RowCount, 0) = Line
'saves a copy to of entire file to sharedrive
ThisWorkbook.SaveCopyAs fileName:="N:\Newell K\Concern_Memo\Concern_Memo_File_Drop\Concern_Memo_Records\" & newFile & ".xlsm"
'Saves copy to desktop
Application.DisplayAlerts = True
ThisWorkbook.SaveCopyAs DTAddress & newFile & ".xlsm"
MsgBox "A copy has been saved to your desktop"
ThisWorkbook.SendMail Recipients:="kaitlin.newell#nissan-usa.com", _
Subject:="New Concern Memo"
End With
ConcernMemosMaster.Save
ConcernMemosMaster.Close
Application.DisplayAlerts = True
MsgBox "Please close out file without saving"
End Sub
Try this out :
Range("A1:D4").CopyPicture Appearance:=xlScreen, Format:=xlBitmap
Range("A6").PasteSpecial
It will paste a copy of the "snapshot" of Range("A1:D4") at the cell A6.
EDIT : Since you have already set an object of that "target" workbook, you can use it to easily paste into it. Try this :
ConcernMemosMaster.Worksheets("sheet1").Range("A1:X1").CopyPicture Appearance:=xlScreen, Format:=xlBitmap
ConcernMemosMaster.Worksheets("sheet1").Range("B1").PasteSpecial

Using ItextSharp I am getting Unbalanced begin/end text operators. But they are Matched

I working on a app that uses ItextSharp to generate PDF files for students to print name tags and parking permits... However it keeps throwing: Unbalanced begin/end text operators. at the doc.close()
The blocks appear to be properly openned and closed.. Below is the function:
Function ID_and_Parking(ByVal id As Integer) As ActionResult
Dim _reg_info As reg_info = db.reg_info.Single(Function(r) r.id = id)
Dim _conf_info As conf_info = db.conf_info.Single(Function(f) f.id = 0)
Dim _LastName As String = _reg_info.last_name
Dim _Employer As String = _reg_info.business_name
Dim _Class_1 As String = _reg_info.tues_class
Dim _Class_2 As String = _reg_info.wed_class
Dim _Class_3 As String = _reg_info.thur_class
Dim _Class_4 As String = _reg_info.fri_class
Dim _BeginDate As String = _conf_info.conf_start_date
Dim _endDate As String = _conf_info.conf_end_date
If IsDBNull(_reg_info.tues_class) Then
_Class_1 = ""
End If
If IsDBNull(_reg_info.wed_class) Then
_Class_2 = ""
End If
If IsDBNull(_reg_info.thur_class) Then
_Class_3 = ""
End If
If IsDBNull(_reg_info.fri_class) Then
_Class_4 = ""
End If
'Dim pdfpath As String = Server.MapPath("PDFs")
'Dim imagepath As String = Server.MapPath("Images")
Dim pdfpath As String = "C:\temp\"
Dim imagepath As String = "C:\temp\"
Dim doc As New Document
doc.SetPageSize(iTextSharp.text.PageSize.A4)
doc.SetMargins(0, 0, 2, 2)
Try
Dim writer As PdfWriter = PdfWriter.GetInstance(doc, New FileStream(pdfpath + "/Images.pdf", FileMode.Create))
doc.Open()
Dim cb As PdfContentByte = writer.DirectContent
cb.BeginText()
cb.SetTextMatrix(100, 400)
cb.ShowText(_LastName)
cb.EndText()
doc.Add(New Paragraph("JPG"))
Dim jpg As Image = Image.GetInstance(imagepath + "/Asads_Tags.jpg")
jpg.Alignment = iTextSharp.text.Image.UNDERLYING
jpg.ScaleToFit(576, 756)
doc.Add(jpg)
Catch dex As DocumentException
Response.Write(dex.Message)
Catch ioex As IOException
Response.Write(ioex.Message)
Catch ex As Exception
Response.Write(ex.Message)
Finally
doc.Close()
End Try
Return RedirectToAction("Index")
End Function
Anyone know where I could be going wrong at??????
The Try Catch block is what caused the unbalanced start/end exception.....Once I moved the doc.close() up to the bottom of try the error went away... Oh well maybe someone else will need the insight... –

Resources