純pascal實現的isapi文件上傳程序 (2001年1月30日) 

網友更新  分類:Internet   作者:lwm8246  推薦:lwm8246   閱讀次數:452  
(http://www.codesky.net)  

--------------------------------------------------------------------------------
//部份代碼來自 WWW 歡迎大家指教 lwm8246@fm365.com
環境: Server:delphi5.0 +NT4.0+IIS4.0
Client:486/16M win98
Client:









PATH:



FILE:







//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 +
'' + crlf +
'' + crlf +
'' + crlf +
'' + crlf +
'
ISAPI "By Hand" - Default Page
' + crlf +
'
'+ FormatDateTime('dddd dd mmm yyyy hh:nn:ss' , Now) + '
' + crlf +
'
Total=  '+IntToStr( Totalbytes)+
'

Avable=  '+intTostr(Avablebytes)+
'

path=  '+GetFieldValue('path',filebuf,djs)+
'

filename=  '+GetFileName('file',filebuf,djs)+
'

SaveToFile=  '+'c:\'+extractfileName(GetFileName('file',filebuf,djs))+
'' + crlf +
'' + crlf +
'' + 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 +
'' + crlf +
'' + crlf +
'' + crlf +
'' + crlf +
'

' + E.ClassName + ': ' + E.Message + '
' + crlf +
'' + crlf +
'' + crlf +
'' + 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.

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