unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,
IdHTTP, StdCtrls,IdMultiPartFormData;
type
TForm1 = class(TForm)
Button1: TButton;
IdHTTP1: TIdHTTP;
OpenDialog1: TOpenDialog;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
var
res : String;
ms : TIdMultiPartFormDataStream;
h: TIdhttp;
f:string;
begin
if Opendialog1.Execute then
f:=Opendialog1.FileName;
if f='' then exit;
try
ms := TIdMultiPartFormDataStream.Create;
h := Tidhttp.Create(nil);
ms.AddFile('file1',f,'');
idhttp1.Request.ContentType := 'multipart/form-data' ;
res:=h.Post('oro/Admin/u.asp?menu=up',ms);
if res='上传成功' then
Application.MessageBox('图片上传成功!','提示',MB_OK+MB_ICONASTERISK)
else
Application.MessageBox('图片上传失败!','ERROR',MB_OK+MB_ICONSTOP);
finally
ms.Free;
end;
end;
end.
-----------------------------u.asp
<%
if Request("menu")="up" then
On Error Resume Next
Set upl = Server.CreateObject("SoftArtisans.FileUp")
set FileUP=new Upload_file
FileUP.GetDate(-1)
formPath="../UpLoad/ProImages/BigPicture/"
set file=FileUP.file("file1")
filename=formPath&;year(now)&;month(now)&;day(now)&;hour(now)&;minute(now)&;second(now)&;"."&;file.FileExt
if LCase(file.FileExt) <>"gif" and file.FileExt<>"jpg" and file.FileExt<>"swf" then
response.Write("")
response.End()
end if
select case LCase(file.FileExt)
case "gif"
img="[img]"&;cluburl&;"/"&;filename&;"[/img]"
case "jpg"
img="[img]"&;cluburl&;"/"&;filename&;"[/img]"
case "swf"
img="[flash]"&;cluburl&;"/"&;filename&;"[/flash]"
case else
error2("对不起,本服务器只支持GIF、JPG、SWF格式的文件\n不支持 "&;file.FileExt&;" 格式的文件")
end select
file.SaveToFile Server.mappath(filename)
response.Write("上传成功")
set FileUP=nothing
response.end
else
%>
<%
end if
%>
------------------------------upfile文件,注意这个文件没有扩展名
<%
dim oUpFileStream
Class Upload_file
dim Form,File,Err
Private Sub Class_Initialize
Err=-1
end sub
Private Sub Class_Terminate
'清除变量及对像
if Err < 0 then
oUpFileStream.Close
Form.RemoveAll
File.RemoveAll
set Form=nothing
set File=nothing
set oUpFileStream =nothing
end if
End Sub
Publi
c Sub GetDate(RetSize)
'定义变量
dim RequestBinDate,sStart,bCrLf,sInfo,iInfoStart,iInfoEnd,tStream,iStart,oFileInfo
dim iFileSize,sFilePath,sFileType,sFormvalue,sFileName
dim iFindStart,iFindEnd
dim iFormStart,iFormEnd,sFormName
'代码开始
If Request.TotalBytes < 1 Then
Err=1
Exit Sub
End If
If RetSize > 0 Then
If Request.TotalBytes > RetSize then
Err=2
Exit Sub
End If
End If
set Form = Server.CreateObject("Scripting.Dictionary")
set File = Server.CreateObject