Classic ASP which folder does a file belong to - asp-classic

I have a folder structure which stores images by the thousand, take for example the following folder names;
00001-01000
01001-02000
02001-03000
03001-04000
04001-05000
05001-06000
06001-07000
I am then dynamically rendering a page to display all sorts of images. In the page i am trying to build a link to the image, but what i need is to figure out what folder an image belongs to. For instance, i am using the following to get the image id from the database
<%= rs.Fields("imageid") %>
If that were to return '04232' the folder name that would belong to would be '04001-05000'.
Is there any way that i could figure out what the folder name would be, by only having the imageid in classic asp?

For this you need two small methods. First, padding a string:
Function PadLeft(str, padChar, desiredLength)
Dim result
result = CStr(str)
Do Until Len(result)>=desiredLength
result = padChar & result
Loop
PadLeft = result
End Function
And the method to find the folder name:
Function ExtractFolderName(imageFileName)
Dim numericValue, rangeStart, rangeEnd
numericValue = CInt(imageFileName)
rangeStart = (Fix((numericValue / 1000)) * 1000) + 1
rangeEnd = (Fix((numericValue / 1000)) + 1) * 1000
ExtractFolderName = PadLeft(rangeStart, "0", 5) & "-" & PadLeft(rangeEnd, "0", 5)
End Function
To use it:
folderName = ExtractFolderName(rs("imageid"))
Basically, the method performs some math on the name to find the desired range. Note this will throw error in case of a non numeric value in the database.

Related

How to autofill OpenOffice Math formula editor in OOo Calc?

I am using OpenOffice Calc spreadsheet formulas with psuedo-random numbers to generate arrays of arithmetic problems which I can easily update to creating new worksheets (I'm a teacher)
Problems are output as formula mark-ups in string form. OOo Math formulas use these string commands typed into the editor to display nicely formatted maths expressions.
I can do this next step manually:
1) go to source cell and copy string mark-up to clipboard
2) select target cell and clear existing contents and objects
3) create new Math object anchored to target cell
4) open Math editor window and paste in mark-up string
5) exit Math editor window and return cursor to source cell
Result: a nice maths expression of given arithmetic problem.
I need to be able to do this for entire columns of source cells on various sheets.
...even better, to then add a listener to dynamically update as sources are updated.
I found code here: Cell content inside formula that achieves this for a fixed pair of cells, but despite all my best efforts, I have had to admit defeat - generalising this code is simply beyond my expertise!
The absolute ideal would be a macro function that I could call like a spreadsheet function; with input arguments (sourceCell, targetCell, listenerON/OFF) that could run the above algorithm and dynamically update if required.
Can anybody help me? A solution like this, or any kind of workaround would be immensely helpful.
UPDATE 2016/10/27
Thank you Jim K, that did work, but use of the dispacher comes with a whole host of difficulties I hadn't foreseen.
I just found Charlie Young's post in the OpenOffice forum which makes use of the API. I have included my adaptation of his code below.
Can anybody help me to integrate it into a function in a similar way as I've described? I don't know how to solve placement of the Math object in to the target cell.
The API code is great as it will create a new Math object each time the code is updated. Existing ones do need to be deleted though.
I think the limitation of not being able to delete existing objects from within a function is going to persist. Would this be the case even if done by a subroutine called by the function?
function InsertFormula(paraFromCell, paraToCell)
Dim oDoc As Object
Dim oSheet As Object
Dim oShape As Object
oDoc = ThisComponent
oSheet = oDoc.Sheets(0)
oShape = oDoc.createInstance("com.sun.star.drawing.OLE2Shape")
oShape.CLSID = "078B7ABA-54FC-457F-8551-6147e776a997"
oSheet.Drawpage.Add(oShape)
oShape.Model.Formula = paraFromCell
oShape.setSize(oShape.OriginalSize)
end function
NEXT UPDATE
I've been managing to solve my own problems quite quickly now...
I've decided to go with a sub, not a function, so I can access the sheet to delete existing objects. Code is attached - Source cells are in Column C and target cells in matching rows of Column A. So far I am only able to send objects to $A$1.
How do I anchor each new object to a specific cell?
REM ***** BASIC *****
Sub InsertThisFormula
Dim oDoc As Object
Dim oSheet As Object
Dim oShape As Object
Dim sourceCell As Object
Dim targetCell As Object
oDoc = ThisComponent
oSheet = oDoc.Sheets(1)
Dim n As Integer
n = 1 'number of rows of formulas
for i = 0 To n-1
rem loop through cells
sourceCell = oSheet.getCellByPosition(2, i)
targetCell = oSheet.getCellByPosition(0, i)
rem clear target cell object/s
targetCell.ClearContents(128)
oShape = oDoc.createInstance("com.sun.star.drawing.OLE2Shape")
oShape.CLSID = "078B7ABA-54FC-457F-8551-6147e776a997"
oSheet.Drawpage.Add(oShape)
oShape.Model.Formula = sourceCell.string
oShape.setSize(oShape.OriginalSize)
Next i
End Sub
Starting from Mifeet's example, add this to My Macros:
rem ----------------------------------------------------------------------
rem Creates a math formula from text
Function InsertFormulaFromCell(paramCellFrom, paramCellTo)
dim document as object
dim dispatcher as object
document = ThisComponent.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
rem go to cell containing markup and copy it
dim fromCellArgs(0) as new com.sun.star.beans.PropertyValue
fromCellArgs(0).Name = "ToPoint"
fromCellArgs(0).Value = paramCellFrom
dispatcher.executeDispatch(document, ".uno:GoToCell", "", 0, fromCellArgs())
dispatcher.executeDispatch(document, ".uno:Copy", "", 0, Array())
rem go to cell where I want the formula displayed
dim toCellArgs(0) as new com.sun.star.beans.PropertyValue
toCellArgs(0).Name = "ToPoint"
toCellArgs(0).Value = paramCellTo
dispatcher.executeDispatch(document, ".uno:GoToCell", "", 0, toCellArgs())
rem open Star.Math
oDesk = createUnoService ("com.sun.star.frame.Desktop")
dispatcher.executeDispatch(document, ".uno:InsertObjectStarMath", "", 0, Array())
document = ThisComponent.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
rem paste clipboard using Array() as place-holder for variable name
dispatcher.executeDispatch(document, ".uno:Paste", "", 0, Array())
rem exit Star.Math
dispatcher.executeDispatch( _
document, ".uno:TerminateInplaceActivation", "", 0, Array())
InsertFormulaFromCell = "Math Formula updated " & Now()
End Function
To run it, put this formula in cell C5:
=INSERTFORMULAFROMCELL("$C$3","$C$20")
Now when the values get updated, it creates another formula.
Note: I could not get the .uno:Delete section of Mifeet's code to work, perhaps because functions are not supposed to access other cells. This may require manually deleting the formulas before creating new ones.
(Posted solution on behalf of the OP).
This is now solved. After a lot of searching, I found what I needed! Simple really. Future improvements might be to resize cells appropriately. Happy for now. Thanks to Jim K and the rest of the Stack Overflow community!
Complete macro below:
REM ***** BASIC *****
Sub InsertThisFormula
Dim oDoc As Object
Dim oSheet As Object
Dim oShape As Object
Dim sourceCell As Object
Dim targetCell As Object
oDoc = ThisComponent
oSheet = oDoc.Sheets(1)
Dim n As Integer
n = 6 'number of rows of formulas
for i = 0 To n-1
rem loop through cells
sourceCell = oSheet.getCellByPosition(2, i)
targetCell = oSheet.getCellByPosition(3, i)
rem clear target cell object/s
targetCell.ClearContents(128)
oShape = oDoc.createInstance("com.sun.star.drawing.OLE2Shape")
oShape.CLSID = "078B7ABA-54FC-457F-8551-6147e776a997"
oSheet.Drawpage.Add(oShape)
oShape.Model.Formula = sourceCell.string
oShape.setSize(oShape.OriginalSize)
oShape.Anchor = targetCell
oShape.MoveProtect = True
Next i
End Sub

Getting internal server error when trying to list top 100 newest files in folder

I have a folder with 114,000 files in it (not under my control) and I want to list only the latest 100 of them that have been modified. So I hobbled together an ASP script from different sources, but it's giving me an internal server error when I run it.
<%
Function SortFiles(files)
ReDim sorted(files.Count - 1)
Dim file, i, j
i = 0
For Each file in files
Set sorted(i) = file
i = i + 1
Next
For i = 0 to files.Count - 2
For j = i + 1 to files.Count - 1
If sorted(i).DateLastModified < sorted(j).DateLastModified Then
Dim tmp
Set tmp = sorted(i)
Set sorted(i) = sorted(j)
Set sorted(j) = tmp
End If
Next
Next
SortFiles = sorted
End Function
dim fileserver,files,file,i
set fileserver=Server.CreateObject("Scripting.FileSystemObject")
set files=fileserver.GetFolder(Server.MapPath(".")).Files
i = 0
For Each file in SortFiles(files)
Response.write(x.Name & "\t" & x.Size & "\n")
i = i + 1
If i > 100 Then
Exit For
End If
Next
set fo=nothing
set files=nothing
%>
The files I want listed just need to have their name and size separated by new lines. I am new to ASP so I'm not sure how to debug this.
Move the code from aspx to aspx.cs (code behind) and you can debug it by adding breakpoint, and F10/F11 to step over/step into. I don't know if you can debug inline code, looks like you can by some SO answer.
At first glance, SortFiles does not return a list of file, so it can not be used in a For Each loop.
For Each file in SortFiles(files) //exception
And what is this for?
SortFiles = sorted
I don't know VB, but you can debug yourself.

Check to see if file name exists in directory and rename if it does before completing upload?

I am creating a application that allows users to upload an image to the server of my site. But I want to allow users to upload multiple files with the same name by renaming the new file.
But I don't know what methods to use to perform this check.
I am thinking about trying to put all of the filenames into an arraylist individually and creating a loop to check the new filename against the rest and if there is a match then I would randomly generate a string of letters to tag onto the new filename.
But I haven't figured out how to populate the arraylist yet and this is the code I have for checking for repeats against the arraylist:
Dim i As Integer = 0
For i = 0 To arrayFileNames.Count
If (fileName = arrayFileNames(i)) Then
Dim random As Random = New Random()
random.Next(1, 100000)
fileName = fileName & random.ToString
End If
i = i + 1
Next
But this code throws the following error:
Index was out of range. Must be non-negative and less than the size of the collection.
Parameter name: index
Any help would be appreciated, thank you.
If you're creating a For loop, you don't need to manually increase the counter. Remove the line i = i + 1.
Dim i As Integer = 0
For i = 0 To arrayFileNames.Count
If (fileName = arrayFileNames(i)) Then
Dim random As Random = New Random()
random.Next(1, 100000)
fileName = fileName & random.ToString
End If
Next
The for loop already takes care of increasing i.
You'll have a problem if you get a new fileName that is equal to a previous index.
When you create a new instance of random, you'll get the same value.
random.ToString() doesn't return what you think it does (check the output).
You might get a very big filename if you keep appending a big number.
You'll have to change your logic (I haven't tested this code, it's an example to help you out).
Dim random As Random = New Random()
Do While arrayFileNames.Contains(fileName)
fileName = fileName & random.Next(1, 9).ToString
Loop

How do I delete characters in a string up to a certain point in classic asp?

I have a string that at any point may or may not contain one or more / characters. I'd like to be able to create a new string based on this string. The new string would include every character after the very last / in the original string.
Sounds like you're wanting the file name from a URL. In any case, it's the same function. The key is using the InStrRev function to find the first / char, but starting from the right. Here's the function:
Function GetFilename(URL)
Dim I
I = InStrRev(URL, "/")
If I > 0 Then
GetFilename = Mid(URL, I + 1)
Else
GetFilename = URL
End If
End Function
Split it up into parts and get the last part:
a = split("my/string/thing", "/")
wscript.echo a(ubound(a))
note: Not safe when the string is empty.

Displaying a value as an image in vb

In my aspx page I have a gridview which displays the value from my database as "*". So if a value in my database table is 5, it will be displayed as "*****" in the gridview.
code in aspx:
<asp:TemplateField HeaderText="Rating" SortExpression="Rating">
<ItemTemplate><h1><%# getrating(Eval("Rating"))%></h1></ItemTemplate>
</asp:TemplateField>
code in aspx.vb
Protected Function getrating(ByVal rate As Integer)
Dim retval As String
retval = ""
For i = 1 To rate
retval = retval + "*"
Next
Return retval
End Function
What I want to do is change that "*" to a picture, ie star.jpg, so in the gridview it will display the image star.jpg instead of "*".
Any idea on how to do this please? Using MS visual studio 2010
You should be able to just do something like the following:
retval = retval + "<img src=""star.jpg"" alt=""*"">"
You may need some styling to put them all on the same line (float:left should do) but I forget offhand whether that is necessary.
The principle of this is obviously pretty basic. In the outputted HTML you will just have an image tag where before you had a *. A neater way to do it might be to have five images for one to five and then have something like:
Protected Function getrating(ByVal rate As Integer)
Dim retval As String
retval = String.Format("<img src=""Star{0}.jpg"" alt=""{0} stars"">", rate)
Return retval
End Function
This will output an image tag pointing to any of Star1 to Star5. This is nicer in some ways because it allows better control over how they look as well as allowing you to make five identical sized images and know that the space used will always be the same.
Here's an implementation using CSS - http://www.thebroth.com/blog/119/css-rating-stars - does require additional divs and two images to create effect but seems to be a neat solution.

Resources