Asp fso upload Problem

Kodla Büyü

AsilTurk

Seçkin Üye
Seçkin Üye
Mesajlar
465
Fso (FileSystemObject) ile çalışabilen ilçe mem de kullanabileceğim bir upload scritti lazım arkadaşlar (haber resim ekleme için) yardımlarınız olursa minnettar olurum...

Başka bir bileşenle çalışanlar olmuyor arkadaşlar mümkünse sadece ...
 
Gerekli yerleri kendi sisteminize göre doldurun.

İvrindi İlçe Mem. in sitesinde kullanıyorum daha doğrusu tüm asp uygulamalarımda kullanıyorum. Script çalışmaktadır.

Bunu bir alt rutin olarak ayarla ve resim upload formunun altında kullan veya ayrı bir
sayfada forumdan gelen değerleri bunda işle

<%


ForWriting = 2
adLongVarChar = 201
lngNumberUploaded = 0

'Get binary data from form
noBytes = Request.TotalBytes
binData = Request.BinaryRead (noBytes)
if noBytes>100000 then %>
<script language="vbscript">
msgbox "100 KB büyük boyutlu resimler eklenemez."
window.close
</script>
<% else
'convery the binary data to a string
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

'Get the data between current boundry and remove it from the whole.
strData = mid(strDataWhole, lngCurrentBegin, lngCurrentEnd - lngCurrentBegin)
strDataWhole = replace(strDataWhole, strData,"")

'Get the full path of the current file.
lngBeginFileName = instr(1, strdata, "filename=") + 10
lngEndFileName = instr(lngBeginFileName, strData, chr(34))

'There could be an empty file box.
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)

'Calculate the file size.
lngDataLenth = lngEndPos - lngBeginPos
'Get the file data
strFileData = mid(strData, lngBeginPos, lngDataLenth)
'Create the file.

'Buraya her resim için random ad ekleteceğiz böylece bir resim diğerinin üzerine yazılmayacak...


Set fs=Server.CreateObject("Scripting.FileSystemObject")

'Ben haber resimlerinin üst üste gelmemesi için
'bunlara herseferinde haber1,haber2,... gibi ad veririm
'bunu yapmak için de total.txt diye bir sayaç text ini okuturum
'Request.ServerVariables("APPL_PHYSICAL_PATH") uygulamamdaki yeri
'siz bunu server.MapPath metodu ile sağlayabilirsiniz...

if fs.FileExists(Request.ServerVariables("APPL_PHYSICAL_PATH") & "total.txt") then
'Resim numarasını okuyoruz


Set oku=fs.OpenTextFile(Request.ServerVariables("APPL_PHYSICAL_PATH") & "total.txt",1,false)
do while oku.AtEndOfStream <>True
x=oku.ReadLine
Loop
oku.close


Set uzerine = fs.OpenTextFile(Request.ServerVariables("APPL_PHYSICAL_PATH") & "total.txt", ForWriting, True)
x=x+1
uzerine.Write x
uzerine.close
else
Set yaz=fs.CreateTextFile(Request.ServerVariables("APPL_PHYSICAL_PATH") & "total.txt",false)
yaz.Writeline(1)
x=1
yaz.Close
end if

dim noktaYer
noktaYer=instr(FileName,".")
dim uzanti
uzanti=right(FileName,len(FileName)-noktaYer)

'
dosya="haber_" & x & "." & uzanti
'xxxx yazan yere resimlerin upload edileceği klasör adını yaz.
Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.OpenTextFile(Request.ServerVariables("APPL_PHYSICAL_PATH") & "\xxxxxxxxx\" & dosya, ForWriting, True)
f.Write strFileData
Set f = nothing
Set fso = nothing

End if

lngCurrentBegin = instr(1, strDataWhole, strBoundry)
lngCurrentEnd = instr(lngCurrentBegin + 1, strDataWhole, strBoundry) - 1
'dosya adını başkabir forma gönderiyorum bunda tamam tuşuna basılınca text e değer geri gidiyor. Bu formunda adı son olsun...
Response.Redirect "uploadtamamdir.asp?kontrol=" & request.QueryString("kontrol") & "&" & "dosya=" & dosya
end if
%>

son.asp için

<%
siteAdresi="localhost/haber"
%>
<HTML><HEAD><TITLE>Resim Yükle</TITLE>
<META http-equiv=Content-Type content="text/html; charset=windows-1254">
<META content="MSHTML 6.00.2900.3020" name=GENERATOR></HEAD>
<BODY bgColor=#ece9d8>
<H5>
<CENTER><FONT face="Verdana, Arial, Helvetica" color=midnightblue
size=2><BR>Resim Yükleme İşlemi Tamamlandı.</H5>
<%
Dim dosya
dosya = Request.QueryString("dosya")
%>
<input type="button" onClick="gonderim('<%=dosya%>')" value="İşlemi Tamamla">
<SCRIPT LANGUAGE="JavaScript">
<!--

function gonderim(dosya)
{
if (window.opener && !window.opener.closed)
//unutmayın form1 yerine sizin resmi upload ettiğiniz dorm adı
//resim yerine oradaki kontrol adınız.
window.opener.form1.resim.value =dosya; window.close();
}

// -->
</SCRIPT>
</body></html>

kolay gelsin.
 
tşk.ler hocam şimdi kurs olayı çıktığı için cevap yazamadım bir kaç gün hemen deneme yapmaya başlıyorum
 
BBNET
Geri
Üst