ISAPI实现文件上传(ISAPI讨论一）(0分)

我先一点一点的帖一部分文章，以兹共享。
这篇文章，不要试着用这个代码编译她，没这个必要，主要看看流在ISAPI中的应用,以及在delphi中动态生成网页。

unit uUpload;

interface

uses
Windows,SysUtils, Classes, HTTPApp, DBTables, DB, ADODB,Messages,ISAPIApp,
HTTPProd;

type
TWebModule1 = class(TWebModule)
adoqy_main: TADOQuery;
Session1: TSession;
PageProducer1: TPageProducer;
PageProducer2: TPageProducer;
procedure WebModule1WebUploadAction(Sender: TObject;
Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
procedure WebModule1Webupload_successAction(Sender: TObject;
Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
procedure WebModule1WebdelAction(Sender: TObject; Request: TWebRequest;
Response: TWebResponse; var Handled: Boolean);
private
userid : string ;
function ExtractFileNameFromHTTPHeader(sHeaderData: string): string;
procedure RemoveHTTPHeaders(TempStrm : TMemoryStream);
procedure DlgMessage(Msg : string; Caption : string = 'Information');overload;
procedure DlgMessage(IntMsg : Integer; Caption : string = 'Information');overload;
{ Private declarations }
public
{ Public declarations }
end;

var
WebModule1: TWebModule1;

implementation

{$R *.DFM}

procedure TWebModule1.DlgMessage(Msg, Caption: string);
begin
{$IFDEF DEBUG}
MessageBox(0,PChar(Msg),
PChar(Caption), MB_SERVICE_NOTIFICATION or MB_TOPMOST);
{$ENDIF}
end;

procedure TWebModule1.DlgMessage(IntMsg: Integer; Caption: string);
begin
{$IFDEF DEBUG}
MessageBox(0,PChar(IntToStr(IntMsg)),
PChar(Caption), MB_SERVICE_NOTIFICATION or MB_TOPMOST);
{$ENDIF}
end;

function TWebModule1.ExtractFileNameFromHTTPHeader(
sHeaderData: string): string;
begin
Result := Copy(sHeaderData,Pos('filename="',sHeaderData) + 10,Length(sHeaderData));
Result := ExtractFileName(Copy(Result,1,Pos('"',Result)-1));
end;

procedure TWebModule1.RemoveHTTPHeaders(TempStrm: TMemoryStream);
var
sHeaderData : string;
sDelimiter : string;
Buffer : Char;
BinDataStartPos : Integer;
BinDataEndPos : Integer;
FileName : string;
MemStrm : TMemoryStream;
FileSize : LongInt;
DataBuffer : PChar;
begin
BinDataStartPos:= 0;
TempStrm.Position := 0;
repeat
TempStrm.Read(Buffer,1);
Inc(BinDataStartPos);
sHeaderData := sHeaderData + Buffer;
until (Copy(sHeaderData, Length(sHeaderData)-4, 4) = #13#10#13#10);

dec(BinDataStartPos,1);
Delete(sHeaderData,Length(sHeaderData)-1,1);
FileName := ExtractFileNameFromHTTPHeader(sHeaderData);
sDelimiter := Copy(sHeaderData, 1, Pos(#13#10,sHeaderData)-1);
BinDataEndPos := TempStrm.Size - (Length(sDelimiter) + 6);

FileSize := BinDataEndPos - BinDataStartPos;
MemStrm := TMemoryStream.Create;
GetMem(DataBuffer, FileSize);
try
TempStrm.Position := BinDataStartPos;
TempStrm.Read(DataBuffer^,FileSize);
MemStrm.Write(DataBuffer^,FileSize);
MemStrm.SaveToFile('c:/'+filename);
//把稳见路径纪录入库
adoqy_main.Close ;
adoqy_main.SQL.Clear ;
adoqy_main.SQL.Add('insert into image_linshi valuesausername ,:amyimage,:auploaddate)') ;
adoqy_main.Parameters.ParamValues['amyimage'] := 'c:/'+filename ;
adoqy_main.Parameters.ParamValues['ausername'] := userid ;
adoqy_main.Parameters.ParamValues['auploaddate'] := date ;
if not(adoqy_main.Prepared) then adoqy_main.Prepared ;
adoqy_main.ExecSQL ;
finally
MemStrm.Free;
FreeMem(DataBuffer, FileSize);
end;
end;

procedure TWebModule1.WebModule1WebUploadAction(Sender: TObject;
Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
var
list : Tstringlist ;
begin
list := Tstringlist.Create ;
userid := request.QueryFields.Values['userid'] ;
try
list.Add('<TITLE>郑州广电信息港--交友频道</TITLE>'+
'<STYLE type=text/css>BODY {'+
' scrollbar-face-color: #CC3399; scrollbar-shadow-color: ffffff; scrollbar-highlight-color: ffffff; scrollbar-3dlight-color: ffffff; scrollbar-darkshadow-color: ffffff; scrollbar-track-color: ffffff; scrollbar-arrow-color: ffffff'+
'}'+
'P {'+
' FONT-SIZE: 9pt; LINE-HEIGHT: 16pt'+
'}'+
'A {'+
' COLOR: #000000; FONT-SIZE: 9pt; LINE-HEIGHT: 16pt; TEXT-DECORATION: none'+
'}'+
'A:hover {'+
' COLOR: #cc3399; TEXT-DECORATION: underline'+
'}'+
'.drop {'+
' FILTER: dropshadow(color=B8DB6F, offx=1, offy=1, positive=1)'+
'}'+
'.drop2 {'+
' FILTER: dropshadow(color=#99CC33, offx=1, offy=1, positive=1)'+
'}'+
'INPUT {'+
' FONT-SIZE: 9pt'+
'}'+
'SELECT {'+
' FONT-SIZE: 9pt'+
'}'+
'TD {'+
' FONT-SIZE: 9pt; LINE-HEIGHT: 16pt'+
'}'+
'</STYLE>'+
'<META content="text/html; charset=gb2312" http-equiv=Content-Type>'+
'<META content="MSHTML 5.00.3315.2870" name=GENERATOR>'+
'</HEAD>'+
'<BODY bgColor=#ffffff leftMargin=0 text=#000000 topMargin=0 marginwidth="0" '+
'marginheight="0">'+
'<TABLE align=center border=0 cellPadding=0 cellSpacing=0 width=750>'+
' <TBODY>'+
' <TR>'+
' <TD><IMG border=0 height=32 src="../images/yjiaoyou/tit.gif" useMap=#Map2 '+
' width=751><MAP name=Map2><AREA coords=151,15,212,30 '+
' href="http://www.zzcatv.com.cn/" shape=RECT><AREA coords=222,15,264,31 '+
' href="http://news.zzcatv.com.cn/" shape=RECT><AREA coords=282,14,324,32 '+
' href="http://movie.zzcatv.com.cn/" shape=RECT><AREA coords=341,14,387,30 '+
' href="http://mpeg4.zzcatv.com.cn/" shape=RECT><AREA coords=406,14,449,30 '+
' href="http://music.zzcatv.com.cn/" shape=RECT><AREA coords=464,14,508,30 '+
' href="http://game.zzcatv.com.cn/" shape=RECT><AREA coords=526,15,570,32 '+
' href="http://download.zzcatv.com.cn/" shape=RECT><AREA '+
' coords=587,13,630,30 href="http://happy.zzcatv.com.cn/" shape=RECT><AREA '+
' coords=645,13,686,30 href="http://fashion.zzcatv.com.cn/" '+
' shape=RECT></MAP></TD>'+
' </TR></TBODY></TABLE>'+
'<TABLE align=center border=0 cellPadding=0 cellSpacing=0 width=750>'+
' <TBODY>'+
' <TR>'+
' <TD height=60><IMG height=55 src="../images/yjiaoyou/logo.gif" '+
' width=203></TD>'+
' <TD height=60><IMG border=0 height=67 name=e_r1_c2 '+
' src="../images/yjiaoyou/e_r1_c2.gif" width=528></TD>'+
' </TR></TBODY></TABLE>'+
'<DIV align=left> </DIV>'+
'<DIV align=left>'+
' <table align=center border=0 cellpadding=0 cellspacing=0 height=20 width=755>'+
' <tbody> '+
' <tr> '+
' <td width=145><img height=20 src="../images/top1.gif" width=145></td>'+
' <td align=right background=../images/bj_top.gif width=610> '+
' <table border=0 cellpadding=0 cellspacing=0 width=595>'+
' <tbody> '+
' <tr> '+
' <td align=right valign=center width=40><a '+
' href="../index.htm"><font class=text1 '+
' color=#af3060>首页</font></a></td>'+
' <td align=right valign=center width=70><a '+
' href="logon.dll/logon"><font '+
' class=text1 color=#af3060>缘友中心</font></a></td>'+
' <td align=right valign=center width=70> '+
' <div align=right><a '+
' href="../user/userdetail.dll/getuser?userid='+userid+'"><font '+
' class=text1 color=#af3060>缘友查询</font></a></div>'+
' </td>'+
' <td align=right valign=center width=70><a '+
' href="../lovestory/lovestory.dll/tostory?userid='+userid+'"><font '+
' class=text1 color=#af3060>情文作坊</font></a></td>'+
' <td align=right valign=center width=70><a '+
' href="../marriage/marry.dll/getuser?userid='+userid+'"><font '+
' class=text1 color=#af3060>网上红娘</font></a><a '+
' href="http://lovesky.china.com/zh_cn/rose/rose/index.html"></a></td>'+
' <td align=right valign=center width=70><a '+
' href="http://lovesky.china.com/zh_cn/wshn/lmzy/index.html"><font '+
' class=text1 color=#af3060>论坛招亲</font></a></td>'+
' <td align=right valign=center width=70><a '+
' href="http://card.china.com/"><font class=text1 '+
' color=#af3060>浓情贺卡</font></a></td>'+
' <td align=right valign=center width=70><a '+
' href="http://lovesky.china.com/zh_cn/chat/index.html"><font '+
' class=text1 color=#af3060>爱情测试</font></a></td>'+
' <td align=right valign=center width=70><a '+
' href="../star/star.htm"><font '+
' class=text1 color=#af3060>星座奇缘</font></a></td>'+
' <td align=right valign=center width=70> '+
' <div align=right><a '+
' href="../help/helpcenter.htm"><font '+
' class=text1 color=#af3060>在线帮助</font></a><a '+
' href="http://202.84.10.186/lovestory/picture.jsp?male=2&page=1"></a></div>'+
' </td>'+
' <td align=right valign=center '+
' width=40> </td>'+
' </tr>'+
' </tbody> '+
' </table>'+
' </td>'+
' </tr>'+
' </tbody> '+
' </table>'+
' <table align=center border=0 cellpadding=0 cellspacing=0 width=755>'+
' <tbody> '+
' <tr> '+
' <td rowspan=2 valign=top width=145><img border=0 height=46 '+
' src="../images/logon/top2.gif" usemap=#Map width=145><map '+
' name=Map><area coords=11,-8,119,38 '+
' href="http://lovesky.china.com/zh_cn/index.html" shape=RECT></map></td>'+
' <td align=middle rowspan=2 valign=bottom width=470> '+
' <table border=0 cellpadding=0 cellspacing=0 height=33 width=468 name="haitao" align="center" background="../images/logon/bj_center.gif">'+
' <tbody> '+
' <tr> '+
' <td class=text>'+
' <div align="center">　 　　 '+
' <font color="#af3060">上传照片</font></div>'+
' </td>'+
' </tr>'+
' </tbody>'+
' </table>'+
' </td>'+
' <td align=middle width=140 height="36"> '+
' <div align=center></div>'+
' </td>'+
' </tr>'+
' <tr> '+
' <td valign=bottom width=140> </td>'+
' </tr>'+
' </tbody>'+
' </table>'+
' <table border=0 cellpadding=0 cellspacing=0 width=755 align="center">'+
' <tbody> '+
' <tr align=middle valign=top> '+
' <td width="1" bgcolor="#AD3063"> <br>'+
' </td>'+
' <td width="146" bgcolor="#fdf1f5">'+
' <table width="100%" border="0" background="../images/logon/bj0.gif">'+
' <tr> '+
' <td> '+
' <div align="center"><font color="#af3060">缘友个性服务</font></div>'+
' </td>'+
' </tr>'+
' </table>'+
' <table width="85%" border="0" align="center">'+
' <tr> '+
' <td> </td>'+
' </tr>'+
' <tr> '+
' <td> '+
' <div align="left"><a href="logon.dll/logon"><font color="#af3060">·个人空间</font></a></div>'+
' </td>'+
' </tr>'+
' <tr> '+
' <td> '+
' <div align="left"><font color="#af3060"><a href="logon.dll/change"><font color="#AD3063">·建立/修改档案</font></a></font></div>'+
' </td>'+
' </tr>'+
' <tr> '+
' <td> '+
' <div align="left"><font color="#AD3063"><a href="logon.dll/changepsw"><font color="#993366">·更改密码</font></a></font></div>'+
' </td>'+
' </tr>'+
' <tr> '+
' <td><font color="#af3060">·<font color="#ff0000">上传照片</font>/<a href="upload.dll/del?userid='+userid+'"><font color="#af3060">删除照片</font></a></font></td>'+
' </tr>'+
' <tr> '+
' <td><a href="logon.dll/search"><font color="#af3060">·好友检索</font></a></td>'+
' </tr>'+
' <tr> '+
' <td><a href="logon.dll/shoucang"><font color="#af3060">·好友收藏夹</font></a></td>'+
' </tr>'+
' <tr> '+
' <td><a href="message.dll/get?userid='+userid+'"><font color="#af3060">·我收的留言</font></a></td>'+
' </tr>'+
' <tr> '+
' <td><a href="message.dll/post?userid='+userid+'"><font color="#af3060">·我发的留言</font></a></td>'+
' </tr>'+
' <tr> '+
' <td><a href="../index.htm"><font color="#af3060">·退出空间</font></a></td>'+
' </tr>'+
' <tr>'+
' <td> </td>'+
' </tr>'+
' <tr>'+
' <td> </td>'+
' </tr>'+
' <tr>'+
' <td> </td>'+
' </tr>'+
' </table>'+
' </td>'+
' <td width="575"> <br>'+
' <div align="center"> '+
' <table border=0 cellpadding=0 cellspacing=0 width=560>'+
' <tbody> '+
' <tr align=middle valign=top> '+
' <td> '+
' <form '+
' action=upload.dll/upload_success '+
' enctype=multipart/form-data method=post>'+
' <table align=center bgcolor=#fdf1f5 border=1 bordercolor=#af3060 '+
' height=157 width=500>'+
' <tbody> '+
' <tr> '+
' <td height=170> '+
' <table align=center border=0 bordercolor=#cc0000 height=114 '+
' width=480>'+
' <tbody> '+
' <tr valign=top> '+
' <td colspan=3 height=32> '+
' <p><span class=content><span '+
' class=text>1.不要上传明星照，卡通图片和他人的照片，一经查实，立即删除，而由此引起的版权纠纷等法律问题由会员自行承担； '+
' </span></span></p>'+
' <p><span class=text><span class=content>2.<font '+
' color=red><b>不要上传黄色图片，违者将被取消会员资格，不另行通知；对涉嫌违法的行为，我们会将相关资料送交公安机关！</b></font><a '+
' href="mailto:hpn@371.net">点这里举报黄色图片</a> </span><br>'+
' </span></p>'+
' <p><span class=text><span '+
' class=content>3.上传照片时须大小图片同时传送。照片规格：80K以下（尺寸不限）。 </span></span><span class=content><span '+
' class=text>照片格式：GIF、JPG、JPEG</span></span><span '+
' class=text> 。<br>'+
' </span></p>'+
' <p><span class=text><span '+
' class=content>4.经管理员审核后才会显示出来。</span> </span></p>'+
' <p><span class=text><span '+
' class=content>5.如果你上传的图片多次被删除，这说明那是不适宜放在广电网交友频道的，请换用图片，否则你的帐号可能会受到一定的处理。</span> '+
' </span></p>'+
' <br>'+
' </td>'+
' </tr>'+
' <tr> '+
' <td colspan=3 height=50 valign=top> '+
' <p class=text align="center"><br>'+
' <font color="#669900">图片</font> '+
' <input name=UploadedFile '+
' size=25 type=file>'+
' <input type=submit value=开始上传>'+
' <br>'+
' </p>'+
' </td>'+
' </tr>'+
' </tbody>'+
' </table>'+
' </td>'+
' </tr>'+
' </tbody>'+
' </table>'+
' </form>'+
' <br>'+
' </td>'+
' </tr>'+
' </tbody>'+
' </table>'+
' </div>'+
' </td>'+
' <td width="33" background="../images/logon/line00.gif"> </td>'+
' </tr>'+
' </tbody> '+
' </table>'+
' <div align="center"></div>'+
' <div align=left>'+
' <table align=center border=0 '+
'cellpadding=0 cellspacing=0 height=5 width=751>'+
' <tbody> '+
' <tr> '+
' <td height=2> '+
' <hr noshade>'+
' </td>'+
' </tr>'+
' </tbody>'+
' </table>'+
' </div>'+
' <div align=left> '+
' <table align=center bgcolor=#bb2f8d border=0 cellpadding=0 cellspacing=0 '+
'width=751>'+
' <tbody> '+
' <tr bgcolor="#FFFFFF"> '+
' <td height=19>'+
' <div align="center"><font color="#666666"><>版权所有 郑州广电信息网络有限公司 '+
' <> Copyright(C)2000 Zzcatv.com.cn,ZBN Company.All rights reserved.</font></div>'+
' </td>'+
' </tr>'+
' </tbody>'+
' </table>'+
' </div>'+
'</DIV>'+
'</BODY></HTML>') ;
response.Content :=list.Text ;
finally
list.Free ;
end;
end;

procedure TWebModule1.WebModule1Webupload_successAction(Sender: TObject;
Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
var
TotalBytes : DWORD;
AvailableBytes : DWORD;
ExtraBytes : DWORD;
ActualBytesRead : DWORD;
ExtraBytesRead : Integer;
pBuffer : PChar;
extBuffer : PChar;
Strm : TMemoryStream;
begin
try
TotalBytes := Request.ContentLength;
GetMem(pBuffer, TotalBytes);
pBuffer^ := Chr(0);
Strm := TMemoryStream.Create;
try
AvailableBytes := Length(Request.Content);
{ Put the contents of Request.Content into pBuffer }
pBuffer := PChar(Request.Content);
Strm.Write(pBuffer^,AvailableBytes);
{ Check to see if HTTP Content > Request.Content }
if TotalBytes > AvailableBytes then
begin
ExtraBytes := TotalBytes - AvailableBytes;
GetMem(extBuffer, ExtraBytes);
extBuffer^ := Chr(0);
ExtraBytesRead := 0;
repeat
ActualBytesRead := Request.ReadClient(extBuffer^,ExtraBytes - ExtraBytesRead);
Strm.Write(extBuffer^,ActualBytesRead);
Inc(ExtraBytesRead, ActualBytesRead);
until ExtraBytes - ExtraBytesRead = 0;
end; { Larger Than 48K }
{ Remove the Header and footer and save the file }
RemoveHTTPHeaders(Strm);
Response.Content := pageproducer1.Content ;
finally
Strm.Free;
end;
except
on E : Exception do
Response.Content := '<H3>There was an Error</H3><BR>' + E.Message;
end;
end;

procedure TWebModule1.WebModule1WebdelAction(Sender: TObject;
Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
begin
adoqy_main.Close ;
adoqy_main.SQL.Clear ;
adoqy_main.SQL.Add('update user_content set youwuzhaopian=:ayouwu,zhaopian=:azhaopian where nicheng=:anicheng') ;
adoqy_main.Parameters.ParamValues['ayouwu'] := '无' ;
adoqy_main.Parameters.ParamValues['azhaopian'] := 'c:/inetpub/wwwroot/friends/images/logon/baby.gif' ;
adoqy_main.Parameters.ParamValues['anicheng'] := request.QueryFields.Values['userid'] ;
adoqy_main.SQL.Add('delete from image_linshi where username=:ausername') ;
adoqy_main.Parameters.ParamValues['ausername'] := request.QueryFields.Values['userid'] ;
if not(adoqy_main.Prepared) then adoqy_main.Prepared ;
adoqy_main.ExecSQL ;
response.Content := pageproducer2.Content ;
handled := true ;
end;

end.

支持，支持。。[]

可以给一点说明吗？
没有说明看不懂啊！

[8D]我也非常支持！！！加油呀！！！
希望关键地方说明一下!!

有无搞错
在delphi中写这么多 html 代码
你不如替换部分重要标签算了
看到眼都花了

to zilo
你用Delphi的控件加标签其实和这是一样的，只不过代码工作控件帮你做了，我个人觉得
这种方式更灵活，当然了，因为网页原码太多影响模块整体，所以建议把原码封装在外部
文件中，如jsp， 或者像asp中的inc一样。
欢迎帮我指不足，谢谢。^_^

请继续

delphi做得网站，去看看吧
http://love.zzcatv.com.cn

老大 这样头都看晕了
把 HTM 放到外面吧，用的时候，或ISAPI加载的时候再Load

怎么将HTM原码封装在外部？
ISAPI加载的时候怎么再Load？

hpn_cao(小海):
你的代码我改成了一个可用的ISAPI，但现存在一个大问题，如果在一个大点的文件上
传过程中关闭了IE，则服务器的ISAPI处于阻塞状态，CPU被inteinfo用去100%，请问
如何解决比较有用？
我改了程序：如果读的字节为0则跳出循环，但不起作用，好象是readclient一定要读
到东西才中止？是不是IIS的问题？