From eba4b00b7fbb9e7b4e9e46645d4d69ec25d446b3 Mon Sep 17 00:00:00 2001 From: Daniel Covington Date: Wed, 22 May 2024 12:12:59 -0400 Subject: [PATCH] File upload working and creating a lib for activeXdepedancies.asp --- .../Jurisdiction/JurisdictionController.asp | 36 ++ App/Views/Jurisdiction/import.asp | 23 + App/Views/Shared/layout.header.asp | 1 + Data/Proofs.rep | 63 +-- MVC/activeXdepedancies.asp | 10 + MVC/lib.Upload.asp | 405 ++++++++++++++++++ MVC/lib.all.asp | 4 +- 7 files changed, 512 insertions(+), 30 deletions(-) create mode 100644 App/Views/Jurisdiction/import.asp create mode 100644 MVC/activeXdepedancies.asp create mode 100644 MVC/lib.Upload.asp diff --git a/App/Controllers/Jurisdiction/JurisdictionController.asp b/App/Controllers/Jurisdiction/JurisdictionController.asp index 6baaa2c..2981170 100644 --- a/App/Controllers/Jurisdiction/JurisdictionController.asp +++ b/App/Controllers/Jurisdiction/JurisdictionController.asp @@ -150,6 +150,42 @@ Class JurisdictionController %> <% End sub + + Public Sub Import + + dim page_size : page_size = 10 + dim page_num : page_num = Choice(Len(Request.Querystring("page_num")) > 0, Request.Querystring("page_num"), 1) + dim page_count, record_count + set Model = new PagedIndex_ViewModel_Class + Model.Title = "Jurisdiction" + set Model.Jurisdiction = JurisdictionRepository.FindPaged(empty, "JCode", page_size, page_num, page_count, record_count) + Model.CurrentPageNumber = page_num + Model.PageSize = page_size + Model.PageCount = page_count + 'Model.RecordCount = record_count + %> <% + + End Sub + + Public Sub ImportPost + + Dim Upload:Set Upload = New FreeASPUpload + Upload.Save(server.mappath("/uploads")) + Chilkat_CSV.LoadFile(Upload.UploadedFiles("filename").path) + set Model = new PagedIndex_ViewModel_Class + + Model.RecordCount = Chilkat_CSV.NumRows + Dim RowNumber + On Error Resume Next + for RowNumber = 1 to Model.RecordCount + + Dim Record: Set Record = JurisdictionRepository.FindByJCode(Chilkat_CSV.GetCell(CLng(RowNumber),0)) + + Next + On Error Goto 0 + %> <% + + End Sub End Class MVC.Dispatch %> diff --git a/App/Views/Jurisdiction/import.asp b/App/Views/Jurisdiction/import.asp new file mode 100644 index 0000000..80f52cc --- /dev/null +++ b/App/Views/Jurisdiction/import.asp @@ -0,0 +1,23 @@ +

Create Jurisdiction

+ +<%= HTML.FormTag("Jurisdiction", "ImportPost", empty, Array("enctype","multipart/form-data")) %> +<%= HTML.Hidden("nonce", HTMLSecurity.GetAntiCSRFToken("JurisdictionImportForm")) %> +
+

This will delete all records and import the new records from the file

+<% if Model.RecordCount <> 0 Then %> +

Records in the CSV: <%= Model.RecordCount %>

+<% End If %> +
+
+
+
+ + +
+
+
+

+ <%= HTML.Button("submit", " Upload", "btn-primary") %> +
+ + diff --git a/App/Views/Shared/layout.header.asp b/App/Views/Shared/layout.header.asp index 0dfbd5c..a80682f 100644 --- a/App/Views/Shared/layout.header.asp +++ b/App/Views/Shared/layout.header.asp @@ -29,6 +29,7 @@
  • <%= Html.LinkTOExt("KitLabels","KitLabels","Index",empty,Array("Class","dropdown-item")) %>
  • <%= Html.LinkTOExt("Settings","Settings","Index",empty,Array("Class","dropdown-item")) %>
  • <%= Html.LinkTOExt("InkjetRecords","InkjetRecords","Index",empty,Array("Class","dropdown-item")) %>
    • +
  • <%= Html.LinkTOExt("Import Jurisdiction File","Jurisdiction","Import",empty,Array("Class","dropdown-item")) %>
    • diff --git a/Data/Proofs.rep b/Data/Proofs.rep index 046e904..3122941 100644 --- a/Data/Proofs.rep +++ b/Data/Proofs.rep @@ -51,6 +51,11 @@ object TRpReport Alias = 'JURISDICTION' DatabaseAlias = 'WEBDATA' SQL = 'SELECT * FROM JURISDICTION WHERE JCode =PBJCODE' + end + item + Alias = 'CONTACTS' + DatabaseAlias = 'WEBDATA' + SQL = 'SELECT * FROM [Contacts] WHERE JURISCODE = PBJCODE' end> DatabaseInfo = < item @@ -91,7 +96,8 @@ object TRpReport AllowNulls = False Value = '34000' Datasets.Strings = ( - 'JURISDICTION') + 'JURISDICTION' + 'CONTACTS') Description = '' Hint = '' Search = '' @@ -160,10 +166,10 @@ object TRpReport Component = TRpExpression3 end item - Component = TRpExpression7 + Component = TRpExpression8 end item - Component = TRpExpression8 + Component = TRpExpression19 end> ExternalTable = 'REPMAN_REPORTS' ExternalField = 'REPORT' @@ -4113,7 +4119,7 @@ object TRpReport object TRpExpression2: TRpExpression Width = 4200 Height = 264 - PosX = 7590 + PosX = 7540 PosY = 6090 Type1Font = poHelvetica AutoExpand = False @@ -4135,7 +4141,7 @@ object TRpReport object TRpExpression3: TRpExpression Width = 4200 Height = 264 - PosX = 7590 + PosX = 7540 PosY = 6555 Type1Font = poHelvetica AutoExpand = False @@ -4157,7 +4163,7 @@ object TRpReport object TRpExpression1: TRpExpression Width = 4200 Height = 264 - PosX = 7590 + PosX = 7540 PosY = 6330 Type1Font = poHelvetica AutoExpand = False @@ -4224,29 +4230,6 @@ object TRpReport AgIniValue = '0' ExportExpression = '' end - object TRpExpression7: TRpExpression - Width = 3600 - Height = 315 - PosX = 7590 - PosY = 5865 - Type1Font = poHelvetica - DataType = rpParamString - AutoExpand = False - AutoContract = False - ExportPosition = 0 - ExportSize = 1 - ExportDoNewLine = False - PrintCondition = '' - DoBeforePrint = '' - DoAfterPrint = '' - WFontName = 'Arial' - LFontName = 'Helvetica' - Expression = #39'CLERK'#39 - DisplayFormat = '' - ExportDisplayFormat = '' - AgIniValue = '0' - ExportExpression = '' - end object TRpExpression12: TRpExpression Width = 1661 Height = 264 @@ -4540,4 +4523,26 @@ object TRpReport AgIniValue = '0' ExportExpression = '' end + object TRpExpression19: TRpExpression + Width = 4200 + Height = 264 + PosX = 7540 + PosY = 5840 + Type1Font = poHelvetica + AutoExpand = False + AutoContract = False + ExportPosition = 0 + ExportSize = 1 + ExportDoNewLine = False + PrintCondition = '' + DoBeforePrint = '' + DoAfterPrint = '' + WFontName = 'Arial' + LFontName = 'Helvetica' + Expression = 'CONTACTS.TITLE' + DisplayFormat = '' + ExportDisplayFormat = '' + AgIniValue = '0' + ExportExpression = '' + end end diff --git a/MVC/activeXdepedancies.asp b/MVC/activeXdepedancies.asp new file mode 100644 index 0000000..25f5021 --- /dev/null +++ b/MVC/activeXdepedancies.asp @@ -0,0 +1,10 @@ + <% + dim m_Chilkat_CSV + Private Function Chilkat_CSV + if not isobject(m_Chilkat_CSV) then + set m_Chilkat_CSV= Server.CreateObject("Chilkat_9_5_0.Csv") + end if + set Chilkat_CSV = m_Chilkat_CSV + End Function + +%> \ No newline at end of file diff --git a/MVC/lib.Upload.asp b/MVC/lib.Upload.asp new file mode 100644 index 0000000..7cf583c --- /dev/null +++ b/MVC/lib.Upload.asp @@ -0,0 +1,405 @@ + + + +<% +' For examples, documentation, and your own free copy, go to: +' http://www.freeaspupload.net +' Note: You can copy and use this script for free and you can make changes +' to the code, but you cannot remove the above comment. + +'Changes: +'Aug 2, 2005: Add support for checkboxes and other input elements with multiple values +'Jan 6, 2009: Lars added ASP_CHUNK_SIZE + +const DEFAULT_ASP_CHUNK_SIZE = 200000 + +Class FreeASPUpload + Public UploadedFiles + Public FormElements + + Private VarArrayBinRequest + Private StreamRequest + Private uploadedYet + Private internalChunkSize + + Private Sub Class_Initialize() + Set UploadedFiles = Server.CreateObject("Scripting.Dictionary") + Set FormElements = Server.CreateObject("Scripting.Dictionary") + Set StreamRequest = Server.CreateObject("ADODB.Stream") + StreamRequest.Type = 2 ' adTypeText + StreamRequest.Open + uploadedYet = false + internalChunkSize = DEFAULT_ASP_CHUNK_SIZE + End Sub + + Private Sub Class_Terminate() + If IsObject(UploadedFiles) Then + UploadedFiles.RemoveAll() + Set UploadedFiles = Nothing + End If + If IsObject(FormElements) Then + FormElements.RemoveAll() + Set FormElements = Nothing + End If + StreamRequest.Close + Set StreamRequest = Nothing + End Sub + + Public Property Get Form(sIndex) + Form = "" + If FormElements.Exists(LCase(sIndex)) Then Form = FormElements.Item(LCase(sIndex)) + End Property + + Public Property Get Files() + Files = UploadedFiles.Items + End Property + +Public Property Get Exists(sIndex) +Exists = false +If FormElements.Exists(LCase(sIndex)) Then Exists = true +End Property + +Public Property Get FileExists(sIndex) +FileExists = false +if UploadedFiles.Exists(LCase(sIndex)) then FileExists = true +End Property + +Public Property Get chunkSize() + chunkSize = internalChunkSize + End Property + + Public Property Let chunkSize(sz) + internalChunkSize = sz + End Property + + 'Calls Upload to extract the data from the binary request and then saves the uploaded files + Public Sub Save(path) + Dim streamFile, fileItem + + if Right(path, 1) <> "\" then path = path & "\" + + if not uploadedYet then Upload + + For Each fileItem In UploadedFiles.Items + Set streamFile = Server.CreateObject("ADODB.Stream") + streamFile.Type = 1 + streamFile.Open + StreamRequest.Position=fileItem.Start + StreamRequest.CopyTo streamFile, fileItem.Length + streamFile.SaveToFile path & fileItem.FileName, 2 + streamFile.close + Set streamFile = Nothing + fileItem.Path = path & fileItem.FileName + Next + End Sub + + public sub SaveOne(path, num, byref outFileName, byref outLocalFileName) + Dim streamFile, fileItems, fileItem, fs + +set fs = Server.CreateObject("Scripting.FileSystemObject") + if Right(path, 1) <> "\" then path = path & "\" + + if not uploadedYet then Upload + if UploadedFiles.Count > 0 then + fileItems = UploadedFiles.Items + set fileItem = fileItems(num) + + outFileName = fileItem.FileName + outLocalFileName = GetFileName(path, outFileName) + + Set streamFile = Server.CreateObject("ADODB.Stream") + streamFile.Type = 1 + streamFile.Open + StreamRequest.Position = fileItem.Start + StreamRequest.CopyTo streamFile, fileItem.Length + streamFile.SaveToFile path & outLocalFileName, 2 + streamFile.close + Set streamFile = Nothing + fileItem.Path = path & filename + end if + end sub + + Public Function SaveBinRequest(path) ' For debugging purposes + StreamRequest.SaveToFile path & "\debugStream.bin", 2 + End Function + + Public Sub DumpData() 'only works if files are plain text + Dim i, aKeys, f + response.write "Form Items:
    " + aKeys = FormElements.Keys + For i = 0 To FormElements.Count -1 ' Iterate the array + response.write aKeys(i) & " = " & FormElements.Item(aKeys(i)) & "
    " + Next + response.write "Uploaded Files:
    " + For Each f In UploadedFiles.Items + response.write "Name: " & f.FileName & "
    " + response.write "Type: " & f.ContentType & "
    " + response.write "Start: " & f.Start & "
    " + response.write "Size: " & f.Length & "
    " + Next + End Sub + + Public Sub Upload() + Dim nCurPos, nDataBoundPos, nLastSepPos + Dim nPosFile, nPosBound + Dim sFieldName, osPathSep, auxStr + Dim readBytes, readLoop, tmpBinRequest + + 'RFC1867 Tokens + Dim vDataSep + Dim tNewLine, tDoubleQuotes, tTerm, tFilename, tName, tContentDisp, tContentType + tNewLine = String2Byte(Chr(13)) + tDoubleQuotes = String2Byte(Chr(34)) + tTerm = String2Byte("--") + tFilename = String2Byte("filename=""") + tName = String2Byte("name=""") + tContentDisp = String2Byte("Content-Disposition") + tContentType = String2Byte("Content-Type:") + + uploadedYet = true + + on error resume next + readBytes = internalChunkSize + VarArrayBinRequest = Request.BinaryRead(readBytes) + VarArrayBinRequest = midb(VarArrayBinRequest, 1, lenb(VarArrayBinRequest)) + for readLoop = 0 to 300000 + tmpBinRequest = Request.BinaryRead(readBytes) + if readBytes < 1 then exit for + VarArrayBinRequest = VarArrayBinRequest & midb(tmpBinRequest, 1, lenb(tmpBinRequest)) + next + if Err.Number <> 0 then + response.write "

    System reported this error:

    " + response.write Err.Description & "

    " + response.write "The most likely cause for this error is the incorrect setup of AspMaxRequestEntityAllowed in IIS MetaBase. Please see instructions in the requirements page of freeaspupload.net.

    " + Exit Sub + end if + on error goto 0 'reset error handling + + nCurPos = FindToken(tNewLine,1) 'Note: nCurPos is 1-based (and so is InstrB, MidB, etc) + + If nCurPos <= 1 Then Exit Sub + + 'vDataSep is a separator like -----------------------------21763138716045 + vDataSep = MidB(VarArrayBinRequest, 1, nCurPos-1) + + 'Start of current separator + nDataBoundPos = 1 + + 'Beginning of last line + nLastSepPos = FindToken(vDataSep & tTerm, 1) + + Do Until nDataBoundPos = nLastSepPos + + nCurPos = SkipToken(tContentDisp, nDataBoundPos) + nCurPos = SkipToken(tName, nCurPos) + sFieldName = ExtractField(tDoubleQuotes, nCurPos) + + nPosFile = FindToken(tFilename, nCurPos) + nPosBound = FindToken(vDataSep, nCurPos) + + If nPosFile <> 0 And nPosFile < nPosBound Then + Dim oUploadFile + Set oUploadFile = New UploadedFile + + nCurPos = SkipToken(tFilename, nCurPos) + auxStr = ExtractField(tDoubleQuotes, nCurPos) +' We are interested only in the name of the file, not the whole path +' Path separator is \ in windows, / in UNIX +' While IE seems to put the whole pathname in the stream, Mozilla seem to +' only put the actual file name, so UNIX paths may be rare. But not impossible. +osPathSep = "\" +if InStr(auxStr, osPathSep) = 0 then osPathSep = "/" + oUploadFile.FileName = Right(auxStr, Len(auxStr)-InStrRev(auxStr, osPathSep)) + + if (Len(oUploadFile.FileName) > 0) then 'File field not left empty + nCurPos = SkipToken(tContentType, nCurPos) + +auxStr = ExtractField(tNewLine, nCurPos) +' NN on UNIX puts things like this in the stream: +' ?? python py type=?? python application/x-python + oUploadFile.ContentType = Right(auxStr, Len(auxStr)-InStrRev(auxStr, " ")) + nCurPos = FindToken(tNewLine, nCurPos) + 4 'skip empty line + + oUploadFile.Start = nCurPos+1 + oUploadFile.Length = FindToken(vDataSep, nCurPos) - 2 - nCurPos + + If oUploadFile.Length > 0 Then UploadedFiles.Add LCase(sFieldName), oUploadFile + End If + Else + Dim nEndOfData + nCurPos = FindToken(tNewLine, nCurPos) + 4 'skip empty line + nEndOfData = FindToken(vDataSep, nCurPos) - 2 + If Not FormElements.Exists(LCase(sFieldName)) Then + FormElements.Add LCase(sFieldName), Byte2String(MidB(VarArrayBinRequest, nCurPos, nEndOfData-nCurPos)) + else +FormElements.Item(LCase(sFieldName))= FormElements.Item(LCase(sFieldName)) & ", " & Byte2String(MidB(VarArrayBinRequest, nCurPos, nEndOfData-nCurPos)) +end if + + End If + + 'Advance to next separator + nDataBoundPos = FindToken(vDataSep, nCurPos) + Loop + StreamRequest.WriteText(VarArrayBinRequest) + End Sub + + Private Function SkipToken(sToken, nStart) + SkipToken = InstrB(nStart, VarArrayBinRequest, sToken) + If SkipToken = 0 then + Response.write "Error in parsing uploaded binary request. The most likely cause for this error is the incorrect setup of AspMaxRequestEntityAllowed in IIS MetaBase. Please see instructions in the requirements page of freeaspupload.net.

    " + Response.End + end if + SkipToken = SkipToken + LenB(sToken) + End Function + + Private Function FindToken(sToken, nStart) + FindToken = InstrB(nStart, VarArrayBinRequest, sToken) + End Function + + Private Function ExtractField(sToken, nStart) + Dim nEnd + nEnd = InstrB(nStart, VarArrayBinRequest, sToken) + If nEnd = 0 then + Response.write "Error in parsing uploaded binary request." + Response.End + end if + ExtractField = Byte2String(MidB(VarArrayBinRequest, nStart, nEnd-nStart)) + End Function + + 'String to byte string conversion + Private Function String2Byte(sString) + Dim i + For i = 1 to Len(sString) + String2Byte = String2Byte & ChrB(AscB(Mid(sString,i,1))) + Next + End Function + + 'Byte string to string conversion + Private Function Byte2String(bsString) + Dim i + dim b1, b2, b3, b4 + Byte2String ="" + For i = 1 to LenB(bsString) + if AscB(MidB(bsString,i,1)) < 128 then + ' One byte + Byte2String = Byte2String & ChrW(AscB(MidB(bsString,i,1))) + elseif AscB(MidB(bsString,i,1)) < 224 then + ' Two bytes + b1 = AscB(MidB(bsString,i,1)) + b2 = AscB(MidB(bsString,i+1,1)) + Byte2String = Byte2String & ChrW((((b1 AND 28) / 4) * 256 + (b1 AND 3) * 64 + (b2 AND 63))) + i = i + 1 + elseif AscB(MidB(bsString,i,1)) < 240 then + ' Three bytes + b1 = AscB(MidB(bsString,i,1)) + b2 = AscB(MidB(bsString,i+1,1)) + b3 = AscB(MidB(bsString,i+2,1)) + Byte2String = Byte2String & ChrW(((b1 AND 15) * 16 + (b2 AND 60)) * 256 + (b2 AND 3) * 64 + (b3 AND 63)) + i = i + 2 + else + ' Four bytes + b1 = AscB(MidB(bsString,i,1)) + b2 = AscB(MidB(bsString,i+1,1)) + b3 = AscB(MidB(bsString,i+2,1)) + b4 = AscB(MidB(bsString,i+3,1)) + ' Don't know how to handle this, I believe Microsoft doesn't support these characters so I replace them with a "^" + 'Byte2String = Byte2String & ChrW(((b1 AND 3) * 64 + (b2 AND 63)) & "," & (((b1 AND 28) / 4) * 256 + (b1 AND 3) * 64 + (b2 AND 63))) + Byte2String = Byte2String & "^" + i = i + 3 + end if + Next + End Function +End Class + +Class UploadedFile + Public ContentType + Public Start + Public Length + Public Path + Private nameOfFile + +' Need to remove characters that are valid in UNIX, but not in Windows +Public Property Let FileName(fN) +nameOfFile = fN +nameOfFile = SubstNoReg(nameOfFile, "\", "_") +nameOfFile = SubstNoReg(nameOfFile, "/", "_") +nameOfFile = SubstNoReg(nameOfFile, ":", "_") +nameOfFile = SubstNoReg(nameOfFile, "*", "_") +nameOfFile = SubstNoReg(nameOfFile, "?", "_") +nameOfFile = SubstNoReg(nameOfFile, """", "_") +nameOfFile = SubstNoReg(nameOfFile, "<", "_") +nameOfFile = SubstNoReg(nameOfFile, ">", "_") +nameOfFile = SubstNoReg(nameOfFile, "|", "_") +End Property + +Public Property Get FileName() +FileName = nameOfFile +End Property + +'Public Property Get FileN()ame +End Class + + +' Does not depend on RegEx, which is not available on older VBScript +' Is not recursive, which means it will not run out of stack space +Function SubstNoReg(initialStr, oldStr, newStr) +Dim currentPos, oldStrPos, skip +If IsNull(initialStr) Or Len(initialStr) = 0 Then +SubstNoReg = "" +ElseIf IsNull(oldStr) Or Len(oldStr) = 0 Then +SubstNoReg = initialStr +Else +If IsNull(newStr) Then newStr = "" +currentPos = 1 +oldStrPos = 0 +SubstNoReg = "" +skip = Len(oldStr) +Do While currentPos <= Len(initialStr) +oldStrPos = InStr(currentPos, initialStr, oldStr) +If oldStrPos = 0 Then +SubstNoReg = SubstNoReg & Mid(initialStr, currentPos, Len(initialStr) - currentPos + 1) +currentPos = Len(initialStr) + 1 +Else +SubstNoReg = SubstNoReg & Mid(initialStr, currentPos, oldStrPos - currentPos) & newStr +currentPos = oldStrPos + skip +End If +Loop +End If +End Function + +Function GetFileName(strSaveToPath, FileName) +'This function is used when saving a file to check there is not already a file with the same name so that you don't overwrite it. +'It adds numbers to the filename e.g. file.gif becomes file1.gif becomes file2.gif and so on. +'It keeps going until it returns a filename that does not exist. +'You could just create a filename from the ID field but that means writing the record - and it still might exist! +'N.B. Requires strSaveToPath variable to be available - and containing the path to save to +Dim Counter +Dim Flag +Dim strTempFileName +Dim FileExt +Dim NewFullPath +dim objFSO, p +Set objFSO = CreateObject("Scripting.FileSystemObject") +Counter = 0 +p = instrrev(FileName, ".") +FileExt = mid(FileName, p+1) +strTempFileName = left(FileName, p-1) +NewFullPath = strSaveToPath & "\" & FileName +Flag = False + +Do Until Flag = True +If objFSO.FileExists(NewFullPath) = False Then +Flag = True +GetFileName = Mid(NewFullPath, InstrRev(NewFullPath, "\") + 1) +Else +Counter = Counter + 1 +NewFullPath = strSaveToPath & "\" & strTempFileName & Counter & "." & FileExt +End If +Loop +End Function +%> \ No newline at end of file diff --git a/MVC/lib.all.asp b/MVC/lib.all.asp index d7b6fde..d70f189 100644 --- a/MVC/lib.all.asp +++ b/MVC/lib.all.asp @@ -12,4 +12,6 @@ - \ No newline at end of file + + + \ No newline at end of file