Hoşgeldiniz, bugün 21 June 2025

aktif üye 8,903

Yeni Üyelik

Üye Girişi

Şifremi Unuttum

SEN DE YAZ

HazırKod ziyaretçilerinin katkıları bizim için çok önemli!

Sizde hazırkod üyesi olun, ekleyeceğiniz kodlar yapacağınız yorumlarla hazirkod.com'a katkıda bulunun.

ETİKETLER

toplu mesaj toplu mesaj gönderme toplu sms gönderme toplu sms paketleri toplu sms programı toplu mesaj atma sms paketleri başlıklı sms toplu mesaj gönderme programı toplu sms sistemi toplu sms firmaları kurumsal sms paketler

cdonts word asptear browser dosyanin tarih hava access küçük cookie sifre basit büyük email istenilen veritabani göre aspde sayfalama dosyasi formdan server response.redirect döviz renkli database sayfa karakter jmail rastgele text aktif klasörü online dosya adresi türkçe mail klasör için saat güzel deprem hangi sayi veri harf geçersiz response kuru

Programalama > ASP

ASP / Asp Upload

Üçretli Component Kullanmadan Free Upload Kodu

Etiketler: asp, upload

Ort. 0

Puan ver:

hazirkod 27 June 19:34 1

0 kişiden 0 puan aldı

7434

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

<html>
<head>
 <title>Resim Yükle</title>
 <meta http-equiv="Content-Type" content="text/html; charset=windows-1254">
<LINK href="../images/links.css" rel="stylesheet">
<script language="_JavaScript">
function S_im()
{
var tm=new Image();
var o=document.all;
if (o.statu.value=="ok") {
tm.src=o.upi.src;
window.location="Limage.asp?fn="+o.fn.value+"&w="+tm.width+"&h="+tm.height+"&qstr=<%=Request.ServerVariables("QUERY_STRING")%>";
}
}
</script>
</head>
  
<body onfiltered='S_im()'>
<%
 dim ImageType,Ft_Filename
 ImageType=false
    ' This code is needed to "initialize" the retrieved data
    Dim q
    q = Chr(34)
    ' All data
    Dim aAllDataB, aAllData, x, aHdr
    aAllDataB = Request.BinaryRead(Request.TotalBytes)
    ' It comes in as unicode, so convert it to ascii
    For x = 1 To LenB(aAllDataB)
        aAllData = aAllData & Chr(AscB(MidB(aAllDataB, x, 1)))
    Next
    ' The "header" is a unique string generated by the system to indicate
    ' the beginning and end of file data
    aHdr = Left(aAllData, Instr(aAllData,vbCrLf)+1)
  
 'response.write(len(aHdr))
  
 'response.end
%>
  
<%
    ' Here's where your code goes.
    ' In this example, "file1" and "file2" are the field names
    ' specified within the form of the upload submission page.
  '  Response.Write "file1: Filename = " & GetFilename("file1") & "<br>"
 Response.Write GetFileData("file1") & "<br><br>"
  
    'Response.Write "file2: Filename = " & GetFilename("file2") & "<br>"
Response.Write GetFileData("file2") & "<br><br>"
  
    ' Writing out the file data like this only looks okay when
    ' the uploaded file is some kind of text - images and things
    ' like that probably just need to be saved or otherwise
    ' acted upon.
'    Response.Write Replace(aAllData,vbCrLf,"<br>")
  
    Dim aFilename
    ' aFilename equates to the original filename, except saved
    ' in the root path of the server. The root path must have
    ' Change rights for the default internet user.
 Ft_FileName=GetFileName("file1")
    aFilename = Server.MapPath("images/Users") & "/" & Ft_FileName
  
 'response.write("///"&GetFileName("file1")&"///")
 Set FSO1 = server.CreateObject("Scripting.FileSystemObject")
    if FSO1.FileExists(aFilename) then
 Dim tfl
 tfl=Ft_Filename
 x=instr(tfl,".")
 if x>0 then 
 if userId="" then userId=1
 tfl=Mid(tfl,1,x-1)&"_"&Second(time)&"."&Right(tfl,3)
 aFilename = Server.MapPath("images/Users") & "/" & tfl
 'response.write("000-"&tfl&"-000")
 Ft_FileName=tfl
 end if
 end if
 Set FSO1=nothing
  
    Call SaveFile("file1", aFilename)
'    aFilename = Server.MapPath("images/Users") & "\" & GetFileName("file2")
    'Call SaveFile("file2", aFilename)
%>
  
<%
    ' These are functions used to retrieve the data
Function GetFileName(aField)
    Dim x2, i
    x = Instr(aAllData, aHdr & "Content-Disposition: form-data; name=" &q&aField & q)
    x = Instr(x, aAllData, "filename=" & q)
    x2 = Instr(x, aAllData, vbCrLf)
    For i = x2 To x Step -1
        If Mid(aAllData,i,1) = "\" Then
            x = i - 9
            Exit For
        End If
    Next
    GetFileName = Mid(aAllData, x+10, x2-(x+11))
End Function
Function GetFileData(aField)
    Dim x2
 'aHdr="-----------------------------7d21db231008c2 "
    x = Instr(aAllData, aHdr & "Content-Disposition: form-data; name=" & q &aField & q)
    x = Instr(x, aAllData, vbCrLf)
    x = Instr(x+1, aAllData, vbCrLf)
    x = Instr(x+1, aAllData, vbCrLf) + 2
    x2 = Instr(x, aAllData, Left(aHdr,Len(aHdr)-2))
    GetFileData = Mid(aAllData, x+2, x2-x-4)
End Function
Function SaveFile(aField1, aFilename)
 bh=lcase(aFileName)
 if instr(bh,".gif")>0 then  ImageType=true
 if instr(bh,".jpg")>0 then  ImageType=true
 if instr(bh,".png")>0 then  ImageType=true
 if instr(bh,".bmp")>0 then  ImageType=true
  
    Dim FSO, TS
    Set FSO = server.CreateObject("Scripting.FileSystemObject")
    if ImageType then Set TS = FSO.CreateTextFile(aFilename, True, False)
' response.write(afield)
 'response.end
 on error resume next
  if ImageType then  TS.Write GetFileData(aField1)
    TS.Close
if ImageType then  Set TS = Nothing
    Set FSO = Nothing
  
  
End Function
%><% If not ImageType then %>
<input type="Hidden" name="statu" value="badfile">
<div align="center">
Hatalı Dosya formatı.<br>
<a href="_javascript:window.history.go(-1)">Geri Dön</a>
</div>
<% Else  %>
<input type="Hidden" name="statu" value="ok">
<input type="Hidden" name="fn" value="<%=trim(Ft_FileName)%>"> <strong>Lütfen Bekleyiniz...</strong><br>
<IMG name="upi" SRC="images/users/<%=trim(Ft_FileName)%>">
<% End If %>
  
</body></HTML>