Snitz Forums 2000
Snitz Forums 2000
Home | Profile | Register | Active Topics | Members | Search | FAQ
Username:
 Password:
Save Password
Forgot your Password?

 All Forums
 Community Forums
 Code Support: ASP (Non-Forum Related)
 anyone know aspimage?		  New Topic  Topic Locked
 Printer Friendly
Author Previous Topic Topic Next Topic  

tribaliztic
Senior Member

Sweden
1532 Posts
Posted - 11 September 2007 :  07:08:27  Show Profile  Visit tribaliztic's Homepage  Send tribaliztic an ICQ Message
I've fixed thumbgeneration and rename with an imager.dll-script I found somewhere on the net. Now when I upload the site to the live server they (offcourse) don't support that .dll...

They have the aspimage component on the server. Can anyone help me find info on how to create thumbs AND rename the thumbs with that component?

This is the code used now:

If Trim(Request.QueryString("action")) = "upld" Then
if "" & FileCount -1 & "" > 3 then

Err_Msg = "<span class=""text"">Du har " & FileCount -1 & " filer, max antal är 4 filer.</span>"

end if
Set Upload = Server.CreateObject("Persits.Upload.1")

Upload.ProgressID = Request.QueryString("PID")

msg = ""

Upload.SaveVirtual SKF_strDir & folder

For each File in Upload.Files
FName = fileExt(File.Path)

If allwExt(FName) = True Then
File.SaveAsVirtual SKF_strDir & Folder & "/" & FName
msg = msg + "<strong>" & FName & ":</strong> laddades upp!<br>"
dim xml, strImagerDLL, bData, FileName, Width, Height
FileName = "" & FName & ""
FileCat = "" & SKF_strDIR & "" & Folder & ""
Width = 90
Height = 90

strImagerDLL = "http://media.gotlandrace.se/auktionpics/Imager.dll"
Set xml = Server.CreateObject("Microsoft.XMLHTTP") ' Creates an instance of MSXML4, if this fails, create a "MSXML2.ServerXMLHTTP" instead and remove False from the end of next line
xml.Open "GET", strImagerDLL & "?Image=" & Server.Mappath(FileCat & "/" & FileName) & "&Width=" & Width & "&Height=" & Height, False
xml.Send()
bData = xml.ResponseBody
Set xml = nothing
Response.Write "<br>" & FileCat & "" & FileName & "" & vbNewLine
dim oStream, fulltextlength, fullslashtext, strQString
Set oStream = Server.CreateObject("ADODB.Stream")
oStream.type = 1 'adTypeBinary
oStream.mode = 3 'adModeReadWrite
oStream.open
oStream.write bData
oStream.Position = 0
FileName = Left(FileName, Len(FileName)-4) & "_mt.jpg"
Response.Write "<br><br>" & FileCat & "/" & FileName & "" & vbNewLine
oStream.SaveToFile server.mappath(FileCat & "/" & FileName)
oStream.Close
Set oStream = Nothing
Else
msg = msg + "<strong>" & FName & ":</strong> är inte i tillåtet filformat!<br>"
File.Delete
End If
Next

Response.Redirect "itemupload.asp?itemid=" & Folder & "&msg=" & msg

Upload.Close

Set Upload = Nothing

Elseif Trim(Request.QueryString("action")) = "delete" Then
Set objFSO = CreateObject("Scripting.FileSystemObject")
For each SKF_Item in Request.Form
objFSO.DeleteFile SKF_strSaveFile&"\"&Request.Form(SKF_Item).Item
SKF_Item2 = Left(Request.Form(SKF_Item), Len(Request.Form(SKF_Item))-4) & "_mt.jpg"
objFSO.DeleteFile SKF_strSaveFile&"\"& SKF_Item2
Next

Response.Redirect "itemupload.asp?itemid=" & Folder & "&auktion=" & Auktion & ""

objFSO.Close
Set objFSO = Nothing
End If
/Tribaliztic
- www.gotlandrace.se -

MaD2ko0l
Senior Member

United Kingdom
1053 Posts
Posted - 11 September 2007 :  09:24:07  Show Profile  Visit MaD2ko0l's Homepage
hiya,
i use this code to do what u want, this is from the latest project i am working on. this will rename the file to a member number that is passed from the upload page and then the date/time so that it is unique and then it will resize and ad "tn_" to the start of the file.

it may need some tweaking to get how u want it but its a start


<%
function doublenum(fNum)
	if fNum > 9 then 
		doublenum = fNum 
	else 
		doublenum = "0" & fNum
	end if
end function

function DateToStr(dtDateTime)
	if not isDate(dtDateTime) then
		dtDateTime = strToDate(dtDateTime)
	end if
	DateToStr = year(dtDateTime) & doublenum(Month(dtdateTime)) & doublenum(Day(dtdateTime)) & doublenum(Hour(dtdateTime)) & doublenum(Minute(dtdateTime)) & doublenum(Second(dtdateTime)) & ""
end function
%>
<HTML>
<BODY>
<%
Set Upload = Server.CreateObject("Persits.Upload")
Set Jpeg = Server.CreateObject("Persits.Jpeg")
On Error Resume Next
Upload.Save

'###################
'## User Settings ##
'###################

'## Set Max File Size For Each File Uploaded In Bytes
'## 2mb = 2097152 bytes
'## 1mb = 1048576 bytes - Default

'## http://javascript.internet.com/math-related/byte-converter.html
'## Site Above Will Convert Files Sizes For You
Upload.SetMaxSize 1048576, True

'## Resize Image So Its Squareish
jpeg.PreserveAspectRatio = True

'## Size Of the Thumbnails
thumbSize = 100

'## Allowed File Types (Seperate With Commas)
'strValidFileType = jpg, gif

'#######################
'## DO NOT EDIT Below ##
'#######################
'## Uploaded Image To Directory Specified By User
subdir = Upload.Form("subdir")
'## Gets MemberID From Forum
MemberID = Upload.Form("MemberID")
'## Builds Path To where Image Will Be Uploaded
Path = "e:/domains/m/mad2kool.co.uk/user/htdocs/gallery/" & subdir
'## Sets Number Of Each File Uploaded
i = 0

If Err <> 0 Then
   Response.Write "An error occurred: " & Err.Description
Else

   For Each File in Upload.Files

      If File.ImageType = "UNKNOWN" Then
         Response.Write "An error occurred<br><br>File is not an image<br>If this is a mistake the Administrator Will Be Notified."
      Else

         NewFileName = DateToStr(NOW())
         File.SaveAs Path & "/" & MemberID & "_" & NewFileName & "" & i & "" & File.Ext

         Jpeg.Open Path & "/" & File.FileName

         If jpeg.OriginalWidth > jpeg.OriginalHeight Then
            jpeg.Width = thumbSize
         Else
            jpeg.Height = thumbSize
         End If

         Jpeg.Save Path & "/TN_" & MemberID & "_" & NewFileName & "" & i & "" & File.Ext


         Response.Write "Success!<br><br>"
         Response.Write "File saved as " & File.Path & "<BR>"

      End If

   i = i + 1
   Next
End If

set File = Nothing
%>
</BODY>
</HTML>
© 1999-2010 MaD2ko0l
Go to Top of Page

tribaliztic
Senior Member

Sweden
1532 Posts
Posted - 11 September 2007 :  16:06:47  Show Profile  Visit tribaliztic's Homepage  Send tribaliztic an ICQ Message
MaD2ko0l: I'll have a look at that code =)

MarshalMix: Isn't that just for .NET?
/Tribaliztic
- www.gotlandrace.se -
Go to Top of Page

MaD2ko0l
Senior Member

United Kingdom
1053 Posts
Posted - 11 September 2007 :  16:42:26  Show Profile  Visit MaD2ko0l's Homepage
also, http://www.aspjpeg.com/ that site has the documentation and other things that will help u.
© 1999-2010 MaD2ko0l
Go to Top of Page

tribaliztic
Senior Member

Sweden
1532 Posts
Posted - 11 September 2007 :  16:47:10  Show Profile  Visit tribaliztic's Homepage  Send tribaliztic an ICQ Message
Is aspjpeg the same as aspimage?
/Tribaliztic
- www.gotlandrace.se -
Go to Top of Page

pdrg
Support Moderator

United Kingdom
2897 Posts
Posted - 11 September 2007 :  16:59:17  Show Profile  Send pdrg a Yahoo! Message
quote:
Originally posted by tribaliztic

Is aspjpeg the same as aspimage?



http://www.aspjpeg.com/
http://www.robjects.com/ASPImage.htm

The clue's in the question ;-)
Go to Top of Page

tribaliztic
Senior Member

Sweden
1532 Posts
Posted - 11 September 2007 :  17:09:38  Show Profile  Visit tribaliztic's Homepage  Send tribaliztic an ICQ Message
Ok, as I suspected then =)
Means that the above examples/links won't work, or?
/Tribaliztic
- www.gotlandrace.se -
Go to Top of Page

weeweeslap
Senior Member

USA
1077 Posts
Posted - 11 September 2007 :  17:40:42  Show Profile  Visit weeweeslap's Homepage  Send weeweeslap an AOL message  Send weeweeslap a Yahoo! Message
http://www.serverobjects.com/comp/Aspimage.htm
I use aspimage on my server. I did not code the use for it so I am no help but there's the link to the documentation of that component.
coaster crazy
Go to Top of Page

tribaliztic
Senior Member

Sweden
1532 Posts
Posted - 14 September 2007 :  15:55:15  Show Profile  Visit tribaliztic's Homepage  Send tribaliztic an ICQ Message
Well, this host is a cheap low budget piece of cr-p host and they don't support more than they really have to =)
I think I've found a solution using aspimage, will keep you updated...
/Tribaliztic
- www.gotlandrace.se -
Go to Top of Page

tribaliztic
Senior Member

Sweden
1532 Posts
Posted - 16 September 2007 :  02:14:41  Show Profile  Visit tribaliztic's Homepage  Send tribaliztic an ICQ Message
Well, it's not free... If it was free I hadn't had any problem with their limited support/components and so on =)
/Tribaliztic
- www.gotlandrace.se -
Go to Top of Page

tribaliztic
Senior Member

Sweden
1532 Posts
Posted - 21 September 2007 :  18:29:37  Show Profile  Visit tribaliztic's Homepage  Send tribaliztic an ICQ Message
Okay, I got this working.. Kinda..

This is the code:

<%
'###########################################
Call createthumbnail("physicalpathblaha","name of the file","90","90")

Function createthumbnail(strPath, strFilename, maxX, maxY)
Set image = server.createobject("aspimage.image")
if image.loadimage(strPath & "\" & strFilename) then
intWidth = image.MaxX
intHeight = image.MaxY
'Response.Write maxY
'Response.Write maxX
'Response.Write intHeight
'Response.Write intWidth
if (intWidth<MaxX) and (intHeight<MaxY) then
if intWidth>intHeight then
intRatio=(maxX/intWidth)
image.resizeR intWidth*intRatio, intHeight*intRatio
else
intRatio=(maxY/intHeight)
image.resizeR intWidth*intRatio, intHeight*intRatio
end if
end if

'Optimised for JPEG thumbnails - generally better than GIFs
Image.ImageFormat = 1
Image.PixelFormat = 6
strSfilename=split(strFilename,".")
Image.Filename=strPath & "\" & strSfilename(0) & "_mt"
picture= strSfilename(0) & "_mt"
if Image.SaveImage then
response.write "<img src=""itempics/98/" & picture & ".jpg"">"
Set Image = nothing
else
'You may want to put some kind of error handler in here
Set Image = nothing
end if
else
'Error while loading, abort
Set Image = nothing
exit function
end if
end function

Test=createthumbnail(""& Server.MapPath("bilder") &"", ""& NewName & Ext &"", "86", "100")

'##################################### thumbnail ****
%>


I get error on this line:
intRatio=(maxY/intHeight)

Microsoft VBScript runtime error '800a000b'

Division by zero

It's because intHeight is 0, but why?
/Tribaliztic
- www.gotlandrace.se -
Go to Top of Page

tribaliztic
Senior Member

Sweden
1532 Posts
Posted - 22 September 2007 :  01:04:42  Show Profile  Visit tribaliztic's Homepage  Send tribaliztic an ICQ Message
Sorry, I was really tired last night when I posted this =)

I called the function twice in the code.. *doh*
/Tribaliztic
- www.gotlandrace.se -
Go to Top of Page
  Previous Topic Topic Next Topic  
 New Topic  Topic Locked
 Printer Friendly
Jump To:
Snitz Forums 2000 © 2000-2021 Snitz™ Communications Go To Top Of Page
This page was generated in 3.01 seconds. Powered By: Snitz Forums 2000 Version 3.4.07