Saya baru saja berhasil mencoba mengunggah komponen tanpa komponen, jadi saya memberikan kodenya untuk dibagikan kepada semua orang.
/* menambahkan karyawan.asp */
<html>
<kepala>
<title>Rumah Staf</title>
<meta http-equiv="Jenis Konten" content="teks/html; charset=gb2312">
<link rel="stylesheet" href="../css/site_css.css" type="text/css">
</head>
<skrip bahasa = "javascript">
<!--
//pilih kategori
//////////////////////////////////////////////////// /// ////////////////////////
fungsi pilihsort(txtSubjek){
var returnValue
returnValue=window.showModalDialog("selMode.htm",null,"center:1;status:0;help:0;diubah ukurannya:0;dialogheight:300px;dialogwidth:206px");
if (returnValue!="" && returnValue!=null){
txtSubjek.value=returnValue
}
}
//////////////////////////////////////////////////// /// ////////////////////////
//Pemeriksaan legalitas
fungsi OK(Formulir ini){
var strTemp,strValue,strLen,strExName
if(thisForm.txtTitle.value==""){
alert("Tips: Judul tidak boleh kosong, harap isi dengan benar")
thisForm.txtJudul.fokus()
kembali salah
}
if(thisForm.txtSort.value==""){
alert("Tips: Silakan pilih kategori yang benar")
thisForm.txtSort.fokus()
kembali salah
}
/*Periksa jenis gambar*/
if(Bentuk ini.file.nilai!=""){
strTemp=Bentuk ini.file.nilai
strValue=strTemp.toLowerCase()
strLen=strTemp.panjang
strExName=strValue.substring(strLen-4,strLen)
if (strExName!=".jpg" && strExName!=".gif"){
alert("Silakan pilih file jpg atau gif!")
kembali salah
}
kembali benar
}
}
//-->
</script>
<tubuh bgcolor="#FFFFFF" text="#000000" leftmargin="1" topmargin="1">
<form name="form1" method="post" action="transact1.asp" enctype="multipart/form-data">
<tabel border="0" cellpacing="0" cellpadding="0">
<tr>
<td colspan="2" bgcolor="#006699" height="15"> </td>
</tr>
<tr>
<td class="teksHitam">
<div align="right">Judul:</div>
</td>
<td>
<input type="text" name="txtTitle" size="52" class="textarea">
</td>
</tr>
<tr>
<td class="teksHitam">
<div align="right">Kategori:</div>
</td>
<td>
<input type="text" name="txtSort" size="35" class="textarea">
<input type="button" name="Submit2" class="buttonSkid" onclick="selectsort(txtSort);">
</td>
</tr>
<tr>
<td class="textBlack" valign="atas">
<div align="right">Teks:</div>
</td>
<td>
<textarea name="txtContent" row="15" cols="50" class="textarea"></textarea>
</td>
</tr>
<tr>
<td height="14" class="textBlack" valign="top">
<div align="right">Gambar:</div>
</td>
<td height="14" class="textBlack">
<div align="kiri">
<input type="file" nama="file" size="35" class="textarea">
</div>
</td>
</tr>
<tr>
<td height="42" class="textBlack" valign="top"> </td>
<td height="42" class="textBlack" valign="middle">
<p>1. Harap kontrol ukuran gambar yang Anda unggah dalam <font color="#FF0000"><b>500K</b></font>, jika tidak, unggahan tidak akan diizinkan<br>
2. Gambar yang Anda unggah harus berukuran <font color="#FF0000"><b>150*130 piksel</b></font><br>
3. Unggah gambar yang diunggah dalam format JPG atau GIF</p>
</td>
</tr>
<tr>
<td height="39" class="textBlack"> </td>
<td tinggi="39" valign="tengah">
<div align="center"><img src="../images/save.gif" width="85" height="19" onClick="if(isOK(form1)){form1.submit()}" >
<img src="../images/close.gif" width="85" height="19" onClick="self.close();" ></div>
</td>
</tr>
</tabel>
</bentuk>
</tubuh>
</html>
******************************************************* * ***********************
/* transaksi1.asp*/
<!--#include file="../func/conn.inc"-->
<!--#include file="../func/fupload.inc"-->
<!--#include file="../func/myfunctions.inc"-->
<%
Jika Request.ServerVariables("REQUEST_METHOD") = "POST" Lalu
Bidang Redup
Redupkan strTitle,strSort,strContent
Redupkan rs,sSql
Redupkan iMaxid
Redupkan strMaxid
Redupkan strlen
Setel Bidang = GetUpload()
strTitle=BinaryToString(Bidang("txtTitle").nilai)
strSort=BinaryToString(Bidang("txtSort").nilai)
strContent=BinaryToString(Bidang("txtContent").nilai)
strSort=split(trim(strSort),"-")
jika instr(1,lcase(Fields("file").FileName),".jpg")=0 dan instr(1,lcase(Fields("file").FileName),".gif")=0 maka
respon.write "<script bahasa='javascript'>alert('Gambar yang diupload harus dalam format gif atau jpg')</script>"
respon.tulis "<script bahasa='javascript'>window.location='addemployee.asp';</script>"
Respon.akhir
berakhir jika
jika Bidang("file").Panjang>500000 lalu
respon.write "<script bahasa='javascript'>alert('Hanya gambar yang berukuran tidak lebih dari 500 ribu yang boleh diunggah');</script>"
respon.tulis "<script bahasa='javascript'>window.location='addemployee.asp';</script>"
respon.akhir
berakhir jika
'/*Simpan ke database*/
jika Bidang("file").NamaFile<>"" lalu
Setel rs=Server.CreateObject("ADODB.Recordset")
sSql="pilih * dari pesanan karyawan berdasarkan id desc"
rs.open sSql,sambungan,2,2
jika bukan rs.eof maka
iMaxid=Clng(rs("id"))+1
strlen=4-len(cstr(iMaxid))
strMaxid=string(strlen,"0") & cstr(iMaxid)
kalau tidak
strMaxid="0001"
berakhir jika
rs.tambahkan baru
rs("id")=strMaxid
rs("judul")=strJudul
rs("mengurutkan")=strSort(0)
rs("img").AppendChunk Fields("file").Nilai
rs("konten")=quoteChg(strKonten)
rs("tanggal ini")=tanggal()
rs.update
rs.tutup
respon.tulis "<script bahasa='javascript'>alert('Berhasil menambahkan data')</script>"
berakhir jika
berakhir jika
%>
**************************************************** *************************
/*fupload.inc*/
<SKRIP RUNAT=BAHASA SERVER=VBSCRIPT>
Redupkan UploadSizeLimit
'*************************************** DapatkanUpload ************ *************************
'.Nama nama bidang formulir (<Input Name="..." Type="File,...">)
'.ContentDisposition = Content-Disposition bidang formulir
'.FileName = Nama file sumber untuk <input type=file>
'.ContentType = Tipe Konten untuk <tipe input=file>
'.Value = Nilai biner dari bidang sumber.
'.Length = Len bidang data biner
Fungsi Dapatkan Unggah()
Hasil Redup
Tetapkan Hasil = Tidak Ada
Jika Request.ServerVariables("REQUEST_METHOD") = "POST" Maka 'Metode permintaan harus "POST"
Redupkan CT, PosB, Batas, Panjang, PosE
CT = Request.ServerVariables("HTTP_Content_Type") 'membaca header Tipe Konten
'respons.tulis CT
'aplikasi/x-www-form-urlencoded
Jika LCase(Left(CT, 19)) = "multipart/form-data" Maka 'Header Tipe Konten harus "multipart/form-data"
'Ini adalah permintaan unggahan.
'Dapatkan batas dan panjang dari header Tipe Konten
PosB = InStr(LCase(CT), "boundary=") 'Menemukan batas
Jika PosB > 0 Maka Batas = Tengah(CT, PosB + 9) 'Batas terpisah
Panjang = CLng(Request.ServerVariables("HTTP_Content_Length")) 'Dapatkan header Panjang Konten
jika "" & UploadSizeLimit<>"" lalu
UnggahUkuranBatas = clng(UnggahUkuranBatas)
jika Panjang > UploadSizeLimit lalu
'pada kesalahan lanjutkan berikutnya' 'Menghapus buffer input
' respon.AddHeader "Koneksi", "Tutup"
' pada kesalahan kebagian 0
Permintaan.BinaryRead(Panjang)
Err.Naikkan 2, "GetUpload", "Ukuran unggahan" & FormatNumber(Panjang,0) & "B melebihi batas " & FormatNumber(UploadSizeLimit,0) & "B"
fungsi keluar
berakhir jika
end if
Jika Panjang > 0 Dan Batas <> "" Lalu 'Apakah ada informasi yang diperlukan tentang unggahan?
Batas = "--" & Batas
Redupkan Kepala, Biner
Binary = Request.BinaryRead(Length) 'Membaca data biner dari klien
'Mengambil kolom unggahan dari data biner
Tetapkan Hasil = Bidang Terpisah (Biner, Batas)
Biner = Kosong 'Hapus variabel
Kalau tidak
Err.Naikkan 10, "GetUpload", "Permintaan panjang nol."
Akhiri Jika
Kalau tidak
Err.Raise 11, "GetUpload", "Tidak ada file yang terkirim."
Akhiri Jika
Kalau tidak
Err.Raise 1, "GetUpload", "Metode permintaan buruk."
Akhiri Jika
Setel GetUpload = Hasil
Fungsi Akhir
'********************************** Bidang Terpisah ************ *************************
'Fungsi ini mengambil bidang unggahan dari data biner dan mengembalikan bidang tersebut sebagai array
'Biner adalah safearray dari semua data biner mentah dari input.
Fungsi Bidang Terpisah (Biner, Batas)
Redupkan PosOpenBoundary, PosCloseBoundary, PosEndOfHeader, isLastBoundary
Bidang Redup
Batas = StringToBinary(Batas)
PosOpenBoundary = InstrB(Biner, Batas)
PosCloseBoundary = InstrB(PosOpenBoundary + LenB(Boundary), Binary, Boundary, 0)
Set Fields = CreateObject("Scripting.Dictionary")
Lakukan Sementara (PosOpenBoundary > 0 Dan PosCloseBoundary > 0 Dan Bukan isLastBoundary)
'Data bidang header dan file/sumber
Redupkan HeaderContent, FieldContent
'Bidang tajuk
Redupkan Content_Disposition, FormFieldName, SourceFileName, Content_Type
'Membantu variabel
Bidang Redup, TwoCharsAfterEndBoundary
'Dapatkan akhir tajuk
PosEndOfHeader = InstrB(PosOpenBoundary + Len(Boundary), Binary, StringToBinary(vbCrLf + vbCrLf))
'Memisahkan header bidang
HeaderContent = MidB(Binary, PosOpenBoundary + LenB(Boundary) + 2, PosEndOfHeader - PosOpenBoundary - LenB(Boundary) - 2)
'Memisahkan konten bidang
FieldContent = MidB(Binary, (PosEndOfHeader + 4), PosCloseBoundary - (PosEndOfHeader + 4) - 2)
'Memisahkan kolom header dari header
GetHeadFields BinaryToString(HeaderContent), Content_Disposition, FormFieldName, SourceFileName, Content_Type
'Buat satu bidang dan tetapkan parameter
Setel Bidang = BuatUploadField()
Bidang.Nama = FormFieldName
Bidang.ContentDisposition = Content_Disposition
Bidang.FilePath = SourceFileName
Bidang.NamaFile = GetFileName(SourceFileName)
Bidang.ContentType = Content_Type
Bidang.Nilai = Isi Bidang
Field.Length = LenB(FieldContent)
Fields.Tambahkan FormFieldName, Field
'Apakah ini batas akhir?
TwoCharsAfterEndBoundary = BinaryToString(MidB(Biner, PosCloseBoundary + LenB(Batas), 2))
'Binary.Mid(PosCloseBoundary + Len(Batas), 2).String
isLastBoundary = TwoCharsAfterEndBoundary = "--"
Jika Bukan Batas Terakhir Maka 'Ini bukan batas akhir - lanjutkan ke kolom formulir berikutnya.
PosOpenBoundary = PosCloseBoundary
PosCloseBoundary = InStrB(PosOpenBoundary + LenB(Batas), Biner, Batas )
Akhiri Jika
Lingkaran
Setel SeparateFields = Bidang
Fungsi Akhir
'********************************** Utilitas ************ *************************
Fungsi BinerToString(str)
strto = ""
untuk i=1 hingga lenb(str)
jika AscB(MidB(str, i, 1)) > 127 maka
strto = strto & chr(Ascb(MidB(str, i, 1))*256+Ascb(MidB(str, i+1, 1)))
saya = saya + 1
kalau tidak
strto = strto & Chr(AscB(MidB(str, i, 1)))
berakhir jika
Berikutnya
BinaryToString=strto
Fungsi Akhir
Fungsi StringToBinary(String)
Redupkan aku,B
Untuk I=1 hingga len(String)
B = B & ChrB(Asc(Mid(String,I,1)))
Berikutnya
StringToBinary = B
Fungsi Akhir
'Memisahkan kolom header dari header unggahan
Fungsi GetHeadFields(ByVal Head, Content_Disposition, Nama, Nama File, Content_Type)
Content_Disposition = LTrim(SeparateField(Kepala, "disposisi konten:", ";"))
Nama = (SeparateField(Kepala, "nama=", ";")) 'ltrim
Jika Kiri(Nama, 1) = """" Maka Nama = Tengah(Nama, 2, Len(Nama) - 2)
Nama File = (SeparateField(Kepala, "namafile=", ";")) 'ltrim
Jika Kiri(NamaFile, 1) = """" Maka NamaFile = Tengah(NamaFile, 2, Len(NamaFile) - 2)
Content_Type = LTrim(SeparateField(Kepala, "tipe konten:", ";"))
Fungsi Akhir
'Memisahkan satu file antara sStart dan sEnd
Fungsi SeparateField (Dari, ByVal sStart, ByVal sEnd)
Redupkan PosB, PosE, sFrom
sDari = LCase(Dari)
PosB = InStr(sDari, sMulai)
Jika PosB > 0 Maka
PosB = PosB + Len(sMulai)
PosE = InStr(PosB, sFrom, sEnd)
Jika PosE = 0 Maka PosE = InStr(PosB, sFrom, vbCrLf)
Jika PosE = 0 Maka PosE = Len(sFrom) + 1
SeparateField = Tengah(Dari, PosB, PosE - PosB)
Kalau tidak
SeparateField = Kosong
Akhiri Jika
Fungsi Akhir
'Memisahkan nama file dari jalur lengkap file
Fungsi GetFileName (Path Lengkap)
Redupkan Pos, PosF
PosF = 0
Untuk Pos = Len(FullPath) Ke 1 Langkah -1
Pilih Case Mid (FullPath, Pos, 1)
Huruf "/", "": PosF = Pos + 1: Pos = 0
Pilihan Akhir
Berikutnya
Jika PosF = 0 Maka PosF = 1
GetFileName = Tengah(FullPath, PosF)
Fungsi Akhir
</SKRIP>
<SCRIPT RUNAT=BAHASA SERVER=JSCRIPT>
//Fungsi tersebut membuat objek Bidang.
fungsi CreateUploadField(){ kembalikan uf_Init() baru }
fungsi uf_Init(){
ini.Nama = null
ini.ContentDisposition = null
ini.NamaFile = null
ini.FilePath = nol
ini.ContentType = null
ini.Nilai = nol
ini.Panjangnya = null
}
</SKRIP>