emlak21 Yeni Üye
Kayıt Tarihi: 21-Nisan-2010 Ülke: Turkiye Gönderilenler: 4
|
Gönderen: 21-Nisan-2010 Saat 13:14 | Kayıtlı IP
|
|
|
Merhaba Arkadaşlar
Sitede üye kendi logosunu, ofis resmini ve eklediği ilanların
resimlerini yüklediği zaman resimler yükleniyor, resim yüklendikten
sonra ---Resim Başarıyla Yüklendi.!!--- diye uyarı vermiyor
sadece ilanın id sini gösteriyor, aynısını logo ve ofis resmini
yüklerkende yapıyor, Normalde üyenin eklediği resimler yükleniyor ve
sitede gözüküyor. Burdaki Hatayı tam olarak anlayamadım, bana bu konuda
yardımcı olabilirmisiniz.
Teşekkürler.
Select Case process
Case "loads"
kullanici = session("uyem") &"_"
izinli = 250000
If id="logo" OR id = "firma" Then
Yol = "imag"
sifrele = id
randomcode= ""&sifrele&""
Call angelic
Else
Yol = "image"
Randomize
sifrele = "_"&int (rnd*9999999999)+1
randomcode= ""&sifrele&""
Call angelic
End if
Sub angelic
Dim ImageDir
ImageDir = Yol
ForWriting = 2
adLongVarChar = 201
lngNumberUploaded = 0
noBytes = Request.TotalBytes
binData = Request.BinaryRead (noBytes)
Set RST = CreateObject("ADODB.Recordset" )
LenBinary = LenB(binData)
If LenBinary > 0 Then
RST.Fields.AppEnd "myBinary" , adLongVarChar, LenBinary
RST.Open
RST.AddNew
RST("myBinary" ).AppendChunk BinData
RST.Update
strDataWhole = RST("myBinary" )
End If
strBoundry = Request.ServerVariables ("HTTP_CONTENT_TYPE" )
lngBoundryPos = InStr(1, strBoundry, "boundary=" ) + 8
strBoundry = "--" & Right(strBoundry, Len(strBoundry) -
lngBoundryPos)
lngCurrentBegin = InStr(1, strDataWhole, strBoundry)
lngCurrentEnd = InStr(lngCurrentBegin + 1, strDataWhole,
strBoundry) - 1
Do While lngCurrentEnd > 0
strData = Mid(strDataWhole, lngCurrentBegin, lngCurrentEnd -
lngCurrentBegin)
strDataWhole = Replace(strDataWhole, strData,"" )
lngBeginFileName = InStr(1, strdata, "filename=" ) + 10
lngEndFileName = InStr(lngBeginFileName, strData, Chr(34))
If lngBeginFileName = lngEndFileName and lngNumberUploaded =
0 Then
Response.Write "<script> alert(""Yüklenecek Bir
dosya seçmelisiniz...""); window.close();</script>"
Response.End
End If
If lngBeginFileName <> lngEndFileName Then
strFilename = Mid(strData, lngBeginFileName,
lngEndFileName - lngBeginFileName)
tmpLng = InStr(1, strFilename, "\" )
Do While tmpLng > 0
PrevPos = tmpLng
tmpLng = InStr(PrevPos + 1, strFilename,"\" )
Loop
FileName = Right(strFilename, Len(strFileName) -
PrevPos)
lngCT = InStr(1,strData, "Content-Type:" )
If lngCT > 0 Then
lngBeginPos = InStr(lngCT, strData, Chr(13) &
Chr(10)) + 4
Else
lngBeginPos = lngEndFileName
End If
lngEndPos = Len(strData)
uzanti = Right(FileName,3)
If uzanti="jpg" or uzanti="gif" or uzanti="png" or
uzanti="JPG" or uzanti="GIF" or uzanti="PNG" then
FileName = randomcode + "." & uzanti &""
Else
Response.Write "<script> alert(""Bu tür dosya
yüklenemez \n Sadece .gif .jpg .png uzantili dosyalari
yükleyebilirsiniz..""); window.close();</script>"
Response.End
End If
lngDataLenth = lngEndPos - lngBeginPos
boyut = lngDataLenth
If boyut > izinli then
Response.Write "<script> alert(""Yüklediginiz
dosya Maximum dosya boyutundan büyük!\nLütfen daha küçük boyutta bir
dosya deneyin..""); window.close();</script>"
Response.End
Else
lngDataLenth = "" & boyut &""
End If
Set Klasor = Nothing
Set FSO = Nothing
uzantik1=Right(FileName,4)
IF uzantik1=".jpg" or uzantik1=".JPG" or uzantik1=".Jpg"
or uzantik1=".GIF" or uzantik1=".gif" or uzantik1=".Gif" or
uzantik1=".PNG" or uzantik1=".png" or uzantik1=".Png" THEN
strFileData = Mid(strData, lngBeginPos,
lngDataLenth)
FileName = kullanici&FileName
If id="logo" Then
Conn.Execute("UPDATE uye SET logo='"&
FileName &"' WHERE id="& session("uyem"))
Set fso =
CreateObject("Scripting.FileSystemObject" )
Set f =
fso.OpenTextFile(Server.MapPath(imagedir) & "/" & FileName,
ForWriting, True)
f.Write strFileData
Set f = Nothing
Set fso = Nothing
ElseIf id = "firma" Then
Conn.Execute("UPDATE uye SET ofis_foto='"&
FileName &"' WHERE id="& session("uyem"))
Set fso =
CreateObject("Scripting.FileSystemObject" )
Set f =
fso.OpenTextFile(Server.MapPath(imagedir) & "/" & FileName,
ForWriting, True)
f.Write strFileData
Set f = Nothing
Set fso = Nothing
Else
fit=true:Set myprod=Conn.Execute("SELECT * FROM
ilan WHERE id=" & id)
For i=1 To 10
efe=myprod("resim"&i&"")
If Not myprod("resim10")="" Then
fit=false:Exit For
If Not efe="" Then
Else
Conn.Execute("UPDATE ilan SET
resim"&i&"='"& FileName &"' WHERE id="&
myprod("id")):Exit For
End If
Next
If fit Then
Set fso =
CreateObject("Scripting.FileSystemObject" )
Set f =
fso.OpenTextFile(Server.MapPath(imagedir) & "/" & FileName,
ForWriting, True)
f.Write strFileData
Set f = Nothing
Set fso = Nothing
Response.Write "<script> alert(""Resim
gönderimi basarili...!!""); window.close();</script>"
Else
Response.Write "<script> alert(""En
fazla 10 adet resim gönderebilirsiniz...!!"");
window.close();</script>"
Exit Sub
End If
Set Jpeg = Server.CreateObject("Persits.Jpeg")
Path = Server.MapPath(yol&"/"&FileName)
Jpeg.Open Path
Jpeg.Canvas.Font.Quality = 8
Jpeg.Canvas.Pen.Width = 4
Jpeg.Canvas.Font.BkMode = "Opaque"
Jpeg.Canvas.Font.Color = &000000
Jpeg.Canvas.Font.Family = "ARIAL"
Jpeg.Canvas.Font.Bold = true
Jpeg.Canvas.Print 40, 15, memos("site_adi")
Jpeg.Canvas.Pen.Color = &000000
Jpeg.Canvas.Pen.Width = 0
Jpeg.Canvas.Brush.Solid = FALSE
Jpeg.Canvas.Bar 1, 1, Jpeg.Width, Jpeg.Height
Jpeg.SendBinary
Jpeg.Save
Server.MapPath(yol&"/"&FileName)
End if
Else
Response.Write "<script> alert(""Bu dosya
resim Degil sadece resim türünde dosya yüklenebilir."");
window.close();</script>"
Response.End
End if
lngNumberUploaded = lngNumberUploaded + 1
End If
lngCurrentBegin = InStr(1, strDataWhole, strBoundry)
lngCurrentEnd = InStr(lngCurrentBegin + 1, strDataWhole,
strBoundry) - 1
Loop
End Sub
Conn.Close:Set Conn=Nothing:Response.End
|