Bubblesort på dato/navn med filsystemet
Bubblesort på dato/navn med filsystemetJeg har via et spørgsmål: http://www.eksperten.dk/spm/481998 fået sortering på dato, men jeg
kan ikke nøjes med at udskrive datoen. Jeg vil også gerne have en række andre data med, da det
er et mediegalleri med visning af thumbs og tilhørende data.
Det jeg har er denne testside, der er let at få til at køre:
<html>
<head>
<title>Filsystem test for dato/navn sortering</title>
</head>
<body>
<%
strPhysicalPath = Server.MapPath("testbilleder")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(strPhysicalPath)
Set objFolderContents = objFolder.Files
For Each objFileItem in objFolderContents
fileList0 = fileList0 & "," & objFileItem.DateLastModified
Next
Set objFSO = Nothing
fileList = mid(fileList0,2)
arrFileList = split(fileList,",")
Sub BubbleSort(arrBubbleSort)
changed = true
do while changed
changed = false
for i = 1 to ubound(arrBubbleSort)
if CDate(arrBubbleSort(i-1)) < CDate(arrBubbleSort(i)) then
tmp = arrBubbleSort(i-1)
arrBubbleSort(i-1) = arrBubbleSort(i)
arrBubbleSort(i) = tmp
changed = true
end if
next
loop
End Sub
BubbleSort arrFileList
for each element in arrFileList
response.write element & "<br>"
next
%>
</body>
</html>
Her er mit mediegalleri meget simplificeret:
<!--#include file="imgfunc_inc.asp"-->
<html>
<head>
<title>Filsystem test for dato/navn sortering</title>
</head>
<body>
<%
TnW = 69
TnH = 52
stdSortering = "dato"
strPhysicalPath = Server.MapPath("testbilleder")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(strPhysicalPath)
Set objFolderContents = objFolder.Files
For Each objFileItem in objFolderContents
PicNo = PicNo + 1
response.write "<img name='" & PicNo & "' src='"
response.write objFileItem.Path & "' " & ImageResize(objFileItem.Path, TnW, TnH) & " "
response.write "border='0' ><br>"
response.write "Navn: " & objFileItem.Name & "<br>"
response.write "Dato: " & objFileItem.DateLastModified & ", Størrelse: " &
objFileItem.Size
response.write "<hr>"
Next
Set objFSO = Nothing
%>
</body>
</html>
Include filen imgfunc_inc.asp:
<%
function ImageResize(strImageName, intDesiredWidth, intDesiredHeight)
dim TargetRatio
dim CurrentRatio
dim strResize
dim w, h, c, strType
if gfxSpex(strImageName, w, h, c, strType) = true then
TargetRatio = intDesiredWidth / intDesiredHeight
CurrentRatio = w / h
if CurrentRatio > TargetRatio then ' We'll scale height
strResize = "width=""" & intDesiredWidth & """"
else
strResize = "height=""" & intDesiredHeight & """" ' We'll scale width
end if
else
strResize = ""
end if
ImageResize = strResize
end Function
function GetBytes(flnm, offset, bytes)
Dim objFSO
Dim objFTemp
Dim objTextStream
Dim lngSize
on error resume next
Set objFSO = CreateObject("Scripting.FileSystemObject")
' First, we get the filesize
Set objFTemp = objFSO.GetFile(flnm)
lngSize = objFTemp.Size
set objFTemp = nothing
fsoForReading = 1
Set objTextStream = objFSO.OpenTextFile(flnm, fsoForReading)
if offset > 0 then
strBuff = objTextStream.Read(offset - 1)
end if
if bytes = -1 then ' Get All!
GetBytes = objTextStream.Read(lngSize) 'ReadAll
else
GetBytes = objTextStream.Read(bytes)
end if
objTextStream.Close
set objTextStream = nothing
set objFSO = nothing
end function
':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
'::: :::
'::: Functions to convert two bytes to a numeric value (long) :::
'::: (both little-endian and big-endian) :::
'::: :::
':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
function lngConvert(strTemp)
lngConvert = clng(asc(left(strTemp, 1)) + ((asc(right(strTemp, 1)) * 256)))
end function
function lngConvert2(strTemp)
lngConvert2 = clng(asc(right(strTemp, 1)) + ((asc(left(strTemp, 1)) * 256)))
end function
':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
'::: :::
'::: This function does most of the real work. It will attempt :::
'::: to read any file, regardless of the extension, and will :::
'::: identify if it is a graphical image. :::
'::: :::
'::: Passed: :::
'::: flnm => Filespec of file to read :::
'::: width => width of image :::
'::: height => height of image :::
'::: depth => color depth (in number of colors) :::
'::: strImageType=> type of image (e.g. GIF, BMP, etc.) :::
'::: :::
':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
function gfxSpex(flnm, width, height, depth, strImageType)
dim strPNG
dim strGIF
dim strBMP
dim strType
strType = ""
strImageType = "(unknown)"
gfxSpex = False
strPNG = chr(137) & chr(80) & chr(78)
strGIF = "GIF"
strBMP = chr(66) & chr(77)
strType = GetBytes(flnm, 0, 3)
if strType = strGIF then ' is GIF
strImageType = "GIF"
Width = lngConvert(GetBytes(flnm, 7, 2))
Height = lngConvert(GetBytes(flnm, 9, 2))
Depth = 2 ^ ((asc(GetBytes(flnm, 11, 1)) and 7) + 1)
gfxSpex = True
elseif left(strType, 2) = strBMP then ' is BMP
strImageType = "BMP"
Width = lngConvert(GetBytes(flnm, 19, 2))
Height = lngConvert(GetBytes(flnm, 23, 2))
Depth = 2 ^ (asc(GetBytes(flnm, 29, 1)))
gfxSpex = True
elseif strType = strPNG then ' Is PNG
strImageType = "PNG"
Width = lngConvert2(GetBytes(flnm, 19, 2))
Height = lngConvert2(GetBytes(flnm, 23, 2))
Depth = getBytes(flnm, 25, 2)
select case asc(right(Depth,1))
case 0
Depth = 2 ^ (asc(left(Depth, 1)))
gfxSpex = True
case 2
Depth = 2 ^ (asc(left(Depth, 1)) * 3)
gfxSpex = True
case 3
Depth = 2 ^ (asc(left(Depth, 1))) '8
gfxSpex = True
case 4
Depth = 2 ^ (asc(left(Depth, 1)) * 2)
gfxSpex = True
case 6
Depth = 2 ^ (asc(left(Depth, 1)) * 4)
gfxSpex = True
case else
Depth = -1
end select
else
strBuff = GetBytes(flnm, 0, -1) ' Get all bytes from file
lngSize = len(strBuff)
flgFound = 0
strTarget = chr(255) & chr(216) & chr(255)
flgFound = instr(strBuff, strTarget)
if flgFound = 0 then
exit function
end if
strImageType = "JPG"
lngPos = flgFound + 2
ExitLoop = false
do while ExitLoop = False and lngPos < lngSize
do while asc(mid(strBuff, lngPos, 1)) = 255 and lngPos < lngSize
lngPos = lngPos + 1
loop
if asc(mid(strBuff, lngPos, 1)) < 192 or asc(mid(strBuff, lngPos, 1)) > 195 then
lngMarkerSize = lngConvert2(mid(strBuff, lngPos + 1, 2))
lngPos = lngPos + lngMarkerSize + 1
else
ExitLoop = True
end if
loop
'
if ExitLoop = False then
Width = -1
Height = -1
Depth = -1
else
Height = lngConvert2(mid(strBuff, lngPos + 4, 2))
Width = lngConvert2(mid(strBuff, lngPos + 6, 2))
Depth = 2 ^ (asc(mid(strBuff, lngPos + 8, 1)) * 8)
gfxSpex = True
end if
end if
end function
%>
Hjælp og ideer er meget velkomne. Jeg vil dog anbefale at at sætte sætte det ovenstående op og teste det selv, fremfor vilde gæt ;o)
