Programalama > ASP

Etiketler: asp, upload

Ort. 0
Puan ver:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
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>


Yorumlar                 Yorum Yaz
byhayalci (1) Sakıncalı Yorum 13 March 12:36
105 satırda tanımsız değişken "Instr" hatası veriyor.
KATEGORİLER
ASP - 240
ASP.NET - 24
C# - 75
C++ - 174
CGI - 8
DELPHI - 247
FLASH - 49
HTML - 536
PASCAL - 246
PERL - 11
PHP - 160
WML - 9
XML - 2
Copyright © 2002 - 2025 Hazır Kod - Tüm Hakları Saklıdır.
Siteden yararlanırken gizlilik ilkelerini okumanızı tavsiye ederiz.
hazirkod.com bir İSOBİL projesidir.