Copy codeThe Code is as follows: <form action = "insert. asp" method = "post" enctype = "multipart/form-data" name = "form1" onSubmit = "b1_onclick ()">
<Table width = "500" border = "1" align = "center" cellpadding = "0" cellspacing = "0">
<Tr>
<Td colspan = "2" bgcolor = "#999999" class = "t"> select a file
</Td>
</Tr>
<Tr>
<Td colspan = "2" class = "t"> </td>
</Tr>
<Tr>
<Td width = "126" class = "t"> select a file (excel)
</Td>
<Td width = "368" class = "t"> <label>
<Input name = "filexls" type = "file" size = "35">
</Label> </td>
</Tr>
<Tr>
<Td colspan = "2" class = "t">
<Label>
<Input type = "submit" name = "Submit" value = "import data">
</Label>
<A href = "Limit 2.asp" class =" t "> return </a>
</Td>
</Tr>
</Table>
</Form>
<! -- # Include virtual = "/inc/clsdbctrl. asp" -->
<! -- # Include virtual = "/inc/function. asp" -->
<%
Dim upfile_5xSoft_Stream
Class upload_5xSoft
Dim Form, File, Version
Private Sub Class_Initialize
Dim iStart, iFileNameStart, iFileNameEnd, iEnd, vbEnter, iFormStart, iFormEnd, theFile
Dim strDiv, mFormName, mFormValue, mFileName, mFileSize, mFilePath, iDivLen, mStr
Version = "Ren Xiang dedicated upload program"
If Request. TotalBytes <1 then Exit Sub
Set Form = CreateObject ("Scripting. Dictionary ")
Set File = CreateObject ("Scripting. Dictionary ")
Set upfile_5xSoft_Stream = CreateObject ("Adodb. Stream ")
Upfile_5xSoft_Stream.mode = 3
Upfile_5xSoft_Stream.type = 1
Upfile_5xSoft_Stream.open
Upfile_5xSoft_Stream.write Request. BinaryRead (Request. TotalBytes)
VbEnter = Chr (13) & Chr (10)
IDivLen = inString (1, vbEnter) + 1
StrDiv = subString (1, iDivLen)
IFormStart = iDivLen
IFormEnd = inString (iformStart, strDiv)-1
While iFormStart <iFormEnd
IStart = inString (iFormStart, "name = """)
IEnd = inString (iStart + 6 ,"""")
MFormName = subString (iStart + 6, iEnd-iStart-6)
IFileNameStart = inString (iEnd + 1, "filename = """)
If iFileNameStart> 0 and iFileNameStart <iFormEnd then
IFileNameEnd = inString (iFileNameStart + 10 ,"""")
MFileName = subString (iFileNameStart + 10, iFileNameEnd-iFileNameStart-10)
IStart = inString (iFileNameEnd + 1, vbEnter & vbEnter)
IEnd = inString (iStart + 4, vbEnter & strDiv)
If iEnd> iStart then
MFileSize = iEnd-iStart-4
Else
MFileSize = 0
End if
Set theFile = new FileInfo
TheFile. FileName = getFileName (mFileName)
TheFile. FilePath = getFilePath (mFileName)
TheFile. FileSize = mFileSize
TheFile. FileStart = iStart + 4
TheFile. FormName = FormName
File. add mFormName, theFile
Else
IStart = inString (iEnd + 1, vbEnter & vbEnter)
IEnd = inString (iStart + 4, vbEnter & strDiv)
If iEnd> iStart then
MFormValue = subString (iStart + 4, iEnd-iStart-4)
Else
MFormValue = ""
End if
Form. Add mFormName, mFormValue
End if
IFormStart = iformEnd + iDivLen
IFormEnd = inString (iformStart, strDiv)-1
Wend
End Sub
Private Function subString (theStart, theLen)
Dim I, c, stemp
Upfile_5xSoft_Stream.Position = theStart-1
Stemp = ""
For I = 1 to theLen
If upfile_5xSoft_Stream.EOS then Exit
C = ascB (upfile_5xSoft_Stream.Read (1 ))
If c & gt; 127 Then
If upfile_5xSoft_Stream.EOS then Exit
Stemp = stemp & Chr (AscW (ChrB (AscB (upfile_5xSoft_Stream.Read (1) & ChrB (c )))
I = I + 1
Else
Stemp = stemp & Chr (c)
End If
Next
SubString = stemp
End function
Private Function inString (theStart, varStr)
Dim I, j, bt, theLen, str
InString = 0
Str = toByte (varStr)
TheLen = LenB (Str)
For I = theStart to upfile_5xSoft_Stream.Size-theLen
If I> upfile_5xSoft_Stream.size then exit Function
Upfile_5xSoft_Stream.Position = I-1
If AscB (upfile_5xSoft_Stream.Read (1) = AscB (midB (Str, 1) then
InString = I
For j = 2 to theLen
If upfile_5xSoft_Stream.EOS then
InString = 0
Exit
End if
If AscB (upfile_5xSoft_Stream.Read (1) <> AscB (MidB (Str, j, 1) then
InString = 0
Exit
End if
Next
If InString <> 0 then Exit Function
End if
Next
End Function
Private Sub Class_Terminate
Form. RemoveAll
File. RemoveAll
Set form = nothing
Set file = nothing
Upfile_5xSoft_Stream.close
Set upfile_5xSoft_Stream = nothing
End Sub
Private function GetFilePath (FullPath)
If FullPath <> "" Then
GetFilePath = left (FullPath, limit Rev (FullPath ,"\"))
Else
GetFilePath = ""
End If
End function
Private function GetFileName (FullPath)
If FullPath <> "" Then
GetFileName = mid (FullPath, limit Rev (FullPath, "\") + 1)
Else
GetFileName = ""
End If
End function
Private function toByte (Str)
Dim I, iCode, c, iLow, iHigh
ToByte = ""
For I = 1 To Len (Str)
C = mid (Str, I, 1)
ICode = Asc (c)
If iCode <0 Then iCode = iCode + 65535
If iCode> 255 Then
ILow = Left (Hex (Asc (c), 2)
IHigh = Right (Hex (Asc (c), 2)
ToByte = toByte & chrB ("& H" & iLow) & chrB ("& H" & iHigh)
Else
ToByte = toByte & chrB (AscB (c ))
End If
Next
End function
End Class
Class FileInfo
Dim FormName, FileName, FilePath, FileSize, FileStart
Private Sub Class_Initialize
FileName = ""
FilePath = ""
FileSize = 0
FileStart = 0
FormName = ""
End Sub
Public function SaveAs (FullPath)
Dim dr, ErrorChar, I
SaveAs = 1
If trim (fullpath) = "" or FileSize = 0 or FileStart = 0 or FileName = "" then exit function
If FileStart = 0 or right (fullpath, 1) = "/" then exit function
Set dr = CreateObject ("Adodb. Stream ")
Dr. Mode = 3
Dr. Type = 1
Dr. Open
Upfile_5xSoft_Stream.position = FileStart-1
Upfile_5xSoft_Stream.copyto dr, FileSize
Dr. SaveToFile FullPath, 2
Dr. Close
Set dr = nothing
SaveAs = 0
End function
End Class
%>
<%
Function sqlstr (data)
If not isnull (data) then
Sqlstr = "'" & replace (data ,"'","''")&"'"
Else
Sqlstr = "'" & data &"'"
End if
End function
%>
<%
Session. CodePage = 936
Server. ScriptTimeOut = 600000
Set upload = new upload_5xsoft
Set file = upload. file ("filexls ")
%>
<%
If file. fileSize> 0 then
Filename = year (now) & month (now) & day (now) & hour (now) & minute (now) & second (now)
Filename = filename + "."
Filenameend = file. filename
Filenameshow = file. filename
Filenameend = split (filenameend ,".")
If filenameend (1) = "xls" then
Filename = filename & filenameend (1)
File. saveAs Server. mappath ("uploadfiles/" & filename)
Else
Response. write "the data format is incorrect! "
Response. write "<a href = file_upload.asp> return"
Response. end ()
End if
Set file = nothing
Else
Response. write "file cannot be blank! "
Response. write "<a href = file_upload.asp> return"
Response. end ()
End if
Set upload = nothing
'After the XLS file is uploaded, data is read from the uploaded XLS file and written to the SQL database.
StrAddr = server. MapPath ("uploadfiles/" & filename)
Set excelconn = server. createobject ("adodb. connection ")
Excelconn. open "Provider = Microsoft. Jet. OLEDB.4.0; Data Source =" + strAddr + "; Extended Properties = 'excel 8.0; HDR = NO; IMEX = 1 '"
Set rs = server. CreateObject ("adodb. recordset ")
Set rs1 = server. CreateObject ("adodb. recordset ")
SQL = "select * from [Sheet1 $]"
Rs. open SQL, excelconn, 1, 3
If not (rs. bof and rs. eof) then
Rs. movenext
Do while not rs. eof
'Response. Write (rs (1 ))
'Response. End ()
Sql1 = "select * from member"
Rs1.open sql1, conn, 1, 3
Rs1.addnew
Randomize
Username = ""
Do While Len (username) <8' random password count
Num1 = CStr (Chr (57-48) * rnd + 48) '0 ~ 9
'Num2 = CStr (Chr (90-65) * rnd + 65) 'A ~ Z
Num3 = CStr (Chr (122-97) * rnd + 97) 'A ~ Z
Username = username & num1 & num3
Loop
Rs1 ("username") = username
Rs1 ("password") = "bb0391ec1d7bda99" 'bamboo123456
If rs (0) <> "then
Rs1 ("company") = rs (0)
End if
If rs (1) <> "then
Rs1 ("realname") = rs (1)
End if
If rs (2) <> "then
Rs1 ("sex") = sexn (rs (2 ))
End if
If rs (3) <> "then
Rs1 ("prof") = rs (3)
End if
If rs (4) <> "then
Rs1 ("tel") = rs (4)
End if
If rs (5) <> "then
Rs1 ("mobile") = rs (5)
End if
If rs (6) <> "then
Rs1 ("address") = rs (6)
End if
If rs (7) <> "then
Rs1 ("area") = getclassdname (rs (7), "area", "cn ")
End if
If rs (8) <> "then
Rs1 ("city") = getclassdname (rs (8), "area", "cn ")
End if
If rs (9) <> "then
Rs1 ("fax") = rs (9)
End if
If rs (10) <> "then
Rs1 ("comtype") = comtypem (rs (10 ))
End if
If rs (11) <> "then
Rs1 ("operation") = rs (11)
End if
Rs1 ("passed") = 1
Rs1 ("activated") = 1
Rs1 ("lastlogintime") = now ()
Rs1.update
Rs1.close
Rs. movenext
Loop
End if
Rs. close ()
Set rs = nothing
Set rs1 = nothing
Excelconn. Close ()
Set excelconn = nothing
Conn. close ()
Set conn = nothing
Function sexn (str)
Select case str
Case "male"
Sexn = 0
Case "female"
Sexn = 1
End select
End function
Function comtypem (str)
Select case str
Case "bamboo products"
Comtypem = 0
Case "Bamboo machinery"
Comtypem = 1
End select
End function
Function getclassdname (str, tablename, lang)
If Not IsNumeric (id) Then Exit Function
Set rs2logs conn.exe cute ("select top 1 id from" & tablename & "where classname like '%" & str & "% '")
If not rs2.eof Then
If lang <> "" Then
If lang = "cn" Then
Getclassdname = getclassdname & rs2 (0)
ElseIf lang = "en" Then
Getclassdname = getclassdname & rs2 (0)
End If
End If
Else
Getclassdname = 0
End if
Rs2.close
End Function
%>
<Table width = "300" border = "1" align = "center" cellpadding = "0" cellspacing = "0" bordercolor = "# CCCCCC">
<Tr>
<Th bordercolor = "# F1F3F8" bgcolor = "#999999" class = "t" scope = "row"> </th>
</Tr>
<Tr>
<Th class = "t" scope = "row"> file <% response. write (filenameshow) %> imported successfully! </Th>
</Tr>
<Tr>
<Th class = "t" scope = "row"> <a href = "javascript: self. close () "class =" t "> close the window </a> </th>
</Tr>
<Tr>
<Th class = "t" scope = "row"> <a href = "define 2.asp" class =" t "> return </a> </th>
</Tr>
</Table>
