纯Pascal实现的isapi文件上传程序,欢迎指教.

lwm8246 2001-01-29 04:51:00
希望各位高手指教.希望能将其改成CGI程序。并把源码贴出。
程序写的很匆忙，bug多多.分少了些,但系统只让给120分
...全文
198 3 打赏 收藏 转发到动态 举报
写回复
用AI写文章
3 条回复
切换为时间正序
请发表友善的回复…
发表回复
Tense 2001-09-18
  • 打赏
  • 举报
 回复
up.
或许去问下做网页的上面提问比较好。
lwm8246 2001-09-17
  • 打赏
  • 举报
 回复
重贴
lwm8246 2001-01-29
  • 打赏
  • 举报
 回复
//部份代码来自 WWW
环境: Server:delphi5.0 +NT4.0+IIS4.0
Client:486/16M win98
Client:

<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">
<HTML><HEAD><TITLE>upload</TITLE>
<META content="text/html; charset=gb2312" http-equiv=Content-Type>
<META content="MSHTML 5.00.2314.1000" name=GENERATOR></HEAD>
<BODY>
<FORM action=ByHand.dll encType=multipart/form-data method=post>
<P>PATH:<INPUT name=path></P>
<P>FILE:<INPUT name=file type=file></P>
<P><INPUT type=submit value=Submit></P></FORM></BODY></HTML>

//Server

library ByHand; //2001-01-29

uses
SysUtils,
Classes,
ISAPI2,
byHand_Tools in 'byHand_Tools.pas';

{$R *.RES}



var Totalbytes,Avablebytes:integer;
filebuf:string;
Djs:string;

function GetDefaultPage : string;
begin
Result :=
'HTTP/1.0 200 OK' + crlf + crlf +
'<html>' + crlf +
'<head>' + crlf +
'<title>ISAPI By Hand</title>' + crlf +
'<body>' + crlf +
'<h2>ISAPI "By Hand" - Default Page</h2>' + crlf +
'<h3>'+ FormatDateTime('dddd dd mmm yyyy hh:nn:ss' , Now) + '</h3>' + crlf +
'<p> Total=  '+IntToStr( Totalbytes)+
'<p> Avable=  '+intTostr(Avablebytes)+
'<p> path=  '+GetFieldValue('path',filebuf,djs)+
'<p> filename=  '+GetFileName('file',filebuf,djs)+
'<p> SaveToFile=  '+'c:\'+extractfileName(GetFileName('file',filebuf,djs))+
'</body>' + crlf +
'</head>' + crlf +
'</html>' + crlf;
end;




{==============================================================================}
{=============================Export functions=================================}
{==============================================================================}

function GetExtensionVersion(var Ver : THSE_VERSION_INFO): Boolean; stdcall;
begin
Ver.dwExtensionVersion := 1;
Ver.lpszExtensionDesc := 'ISAPI By Hand Example 2.0';
Result := True;
end;

function HttpExtensionProc(var ECB : TEXTENSION_CONTROL_BLOCK): LongInt; stdcall;
var
WriteClient : TWriteClientProc;
Content : string;
ContentLength : Cardinal;
ReadClient: TReadClientProc;
intTemp:Integer;
ActualReadCount:cardinal;
Str:string; intS,intE:Integer;
Curpos:integer;
begin
Totalbytes:=ECB.cbTotalBytes;
Avablebytes:=ECB.cbAvailable;
//=====================Read binary data to filebuf================================
Setlength(Filebuf,ECB.cbTotalBytes);
Move(ECB.lpbData^,Filebuf[1],ECB.cbAvailable);
@ReadClient:=@Ecb.ReadClient;
intTemp:=Totalbytes-Avablebytes;
curPos:=Avablebytes;
if TotalBytes>AvableBytes then
repeat
ActualReadCount:=ECB.cbAvailable;
ReadClient(ECB.ConnID,@filebuf[curpos+1],ActualReadCount);
curPos:=curPos+ActualReadCount;
intTemp:=intTemp-ActualReadCount;
if intTemp<1 then break;
Until false;

//=================SaveToFile======================================
Str:=crLf+'Content-Type:'+char($20);
intS:=strPos(str,filebuf,0);
intS:=strPos(crLf+crLf,filebuf,intS);
intS:=intS+4;
intE:=strPos(crLf+DJS,Filebuf,Length(filebuf)-100);
str:=byHand_tools.GetFileName('file',FileBuf,Djs);
str:=extractfileName(str);
SaveToFile('c:\'+str,Filebuf,intE-intS,intS);

//==============================================================


{ Get the callback function }
@WriteClient := @ECB.WriteClient;

try
Content := GetDefaultPage;
ContentLength := Length(Content);
{ Send To Client }
WriteClient(ECB.ConnID, PChar(Content), ContentLength, 0);
Result := HSE_STATUS_SUCCESS;
except
on E: Exception do
begin
Content := SendErrorPage(E);
ContentLength := Length(Content);
WriteClient(ECB.ConnID, PChar(Content), ContentLength, 0);
Result := HSE_STATUS_ERROR;
end;
end;
end;

exports
GetExtensionVersion,
HttpExtensionProc;

begin
end.

//============================================================

unit byHand_Tools;

interface
uses SysUtils,Classes;

const
crlf = #13#10;

Function SaveToFile(const FileName:string;const Buf:string;
Count:Integer;startPos:integer=1):boolean;//2001-01-29
function SendErrorPage(E: Exception) : string;
function StrPos(const FindString, SourceString: string; StartPos: Integer): Integer;
function GetFieldValue(const Name,Filebuf,DJS:string):string;
function GetFileName(const Name,Filebuf,DJS:string):string;



implementation

Function SaveToFile(const FileName:string;const Buf:string;
Count:Integer;startPos:integer=1):boolean;//2001-01-29
var F:File;
begin
Result:=false;
if FileName='' then exit;
if (count<1) or (startPos<1) or (startPos>length(buf)) then exit;
try
try
Result:=true;
AssignFile(F,FileName);
ReWrite(F,1);
if (startPos+Count)>Length(buf) then Count:=Length(Buf)-StartPos;
BlockWrite(F,Buf[startPos],Count);
except
result:=false;
end;
finally
closeFile(F);
end;
End;


function SendErrorPage(E: Exception) : string;
begin
Result :=
'HTTP/1.0 200 OK' + crlf + crlf +
'<html>' + crlf +
'<head>' + crlf +
'<title>ISAPI ERROR</title>' + crlf +
'<body>' + crlf +
'<h2>' + E.ClassName + ': ' + E.Message + '</h2>' + crlf +
'</body>' + crlf +
'</head>' + crlf +
'</html>' + crlf;
end;

function StrPos(const FindString, SourceString: string; StartPos: Integer): Integer;
asm //find http://www......
PUSH ESI
PUSH EDI
PUSH EBX
PUSH EDX
TEST EAX,EAX
JE @@qt
TEST EDX,EDX
JE @@qt0
MOV ESI,EAX
MOV EDI,EDX
MOV EAX,[EAX-4]
MOV EDX,[EDX-4]
DEC EAX
SUB EDX,EAX
DEC ECX
SUB EDX,ECX
JNG @@qt0
XCHG EAX,EDX
ADD EDI,ECX
MOV ECX,EAX
JMP @@nx
@@fr: INC EDI
DEC ECX
JE @@qt0
@@nx: MOV EBX,EDX
MOV AL,BYTE PTR [ESI]
@@lp1: CMP AL,BYTE PTR [EDI]
JE @@uu
INC EDI
DEC ECX
JE @@qt0
CMP AL,BYTE PTR [EDI]
JE @@uu
INC EDI
DEC ECX
JE @@qt0
CMP AL,BYTE PTR [EDI]
JE @@uu
INC EDI
DEC ECX
JE @@qt0
CMP AL,BYTE PTR [EDI]
JE @@uu
INC EDI
DEC ECX
JNE @@lp1
@@qt0: XOR EAX,EAX
@@qt: POP ECX
POP EBX
POP EDI
POP ESI
RET
@@uu: TEST EDX,EDX
JE @@fd
@@lp2: MOV AL,BYTE PTR [ESI+EBX]
CMP AL,BYTE PTR [EDI+EBX]
JNE @@fr
DEC EBX
JE @@fd
MOV AL,BYTE PTR [ESI+EBX]
CMP AL,BYTE PTR [EDI+EBX]
JNE @@fr
DEC EBX
JE @@fd
MOV AL,BYTE PTR [ESI+EBX]
CMP AL,BYTE PTR [EDI+EBX]
JNE @@fr
DEC EBX
JE @@fd
MOV AL,BYTE PTR [ESI+EBX]
CMP AL,BYTE PTR [EDI+EBX]
JNE @@fr
DEC EBX
JNE @@lp2
@@fd: LEA EAX,[EDI+1]
SUB EAX,[ESP]
POP ECX
POP EBX
POP EDI
POP ESI
end;

function GetFieldValue(const Name,Filebuf,DJS:string):string;
const bjstr='Content-Disposition:'+char($20)+'form-data;'+char($20)+'name=';
var Str:string;intS,intE:Integer;
begin
Str:=DJS+crLf+bjstr+'"'+Name+'"';
intS:=strPos(str,filebuf,0);
if intS>0 then
begin
intS:=intS+Length(str)+4;
intE:=strPos(crlf+djs,filebuf,intS);
if (intE-intS)>0 then
begin
setLength(Result,intE-intS);
Move(filebuf[intS],Pointer(Result)^,intE-intS);
end;
end;
End;

function GetFileName(const Name,Filebuf,DJS:string):string;
const bjstr='Content-Disposition:'+char($20)+'form-data;'+char($20)+'name=';
var Str:string;intS,intE:Integer;
begin
Str:=DJS+crLf+bjstr+'"'+Name+'"';
intS:=strPos(str,filebuf,0);
Result:='';
if intS>0 then
begin
intS:=strPos('"',filebuf,intS+Length(str));
intE:=strPos('"',filebuf,intS+1);
if (intE-IntS)>0 then
begin
setLength(Result,intE-intS);
Move(filebuf[intS+1],Pointer(Result)^,intE-intS-1);
intS:=Pos('"',Result);
Result:=copy(Result,intS+1,Length(Result)-1);
end;
end;
End;



END.

//====================================================

小型Pascal编译器
带源程序的免费软件小型Pascal编译器
Object Pascal 编程指南
Object Pascal 编程指南
快速实现YOLO格式.txt文件转换为PascalVOC格式.xml文件
标注数据的时候格式选择错了但又不想...其实就是将.txt中的坐标转换一下，再对照着PascalVOC格式产生的.xml文件加入相应的标签生成.xml文件就OK了。 先看一下我的.txt文件格式 转换完成后的.xml文件格式 下面是完整
利用文件保存数据（c语言）
.doc（Word文件）、.txt（文本文件）、.dat（数据文件）、.c（C语言源程序文件）、.cpp（C++源程序文件）、.for（FORTRAN语言源程序文件）、.pas（Pascal语言源程序文件）、.obj（目标文件）、.exe（可执行文件）、....
【一天一门编程语言】Pascal 语言程序设计极简教程
Pascal语言（Pascal language）是著名的科学家和数学家康托尔·贝尔（Blaise Pascal）在17世纪中叶设计的程序语言。它最初是由贝尔开发的一种用于计算的语言，后来被用于编写计算机程序。Pascal语言曾经是计算机编程...
Windows SDK/API

1,183

社区成员

22,335

社区内容

发帖
与我相关
我的任务
社区描述
Delphi Windows SDK/API
社区管理员
  • Windows SDK/API社区
加入社区
  • 近7日
  • 近30日
  • 至今

加载中

查看更多榜单
社区公告
暂无公告

试试用AI创作助手写篇文章吧

+ 用AI写文章