unit Umultiload;
//**************************************************************
//多文件上传文件分割程序-----作者海儿 [email protected] 2002.06.13//
//**************************************************************interfaceuses
SysUtils, Classes, HTTPApp,windows,forms;type
TWebModule1 = class(TWebModule)
procedure WebModule1uuploadAction(Sender: TObject;
Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
private
{ Private declarations }
public
{ Public declarations }
end;
procedure splitSavefiles(Stream:TMemoryStream;sDir:String);
function extractFileNameFromsHeaderdata(headerdata:string):string;//分出文件名
function CreateFilePath(fileName:string;StrDir:string):string;//文件全名生成var
WebModule1: TWebModule1;
const
flags='-----------------------------'; //定界符
implementation{$R *.DFM}procedure TWebModule1.WebModule1uuploadAction(Sender: TObject;
Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
var
TotalBytes :Dword;
AvailableBytes : DWORD;
ExtraBytes : DWORD;
ActualBytesRead : DWORD;
ExtraBytesRead : Integer;
pBuffer : PChar;
extBuffer : PChar;
MyStrm : TMemoryStream;
begin
try
TotalBytes := Request.ContentLength;
GetMem(pBuffer, TotalBytes);
pBuffer^ := Chr(0);
MyStrm := TMemoryStream.Create;
try
AvailableBytes := Length(Request.Content); // Put the contents of Request.Content into pBuffer
pBuffer := PChar(Request.Content);
MyStrm.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 - DWORD(ExtraBytesRead));
myStrm.Write(extBuffer^,ActualBytesRead);
Inc(ExtraBytesRead, ActualBytesRead);
until ((ExtraBytes - Dword(ExtraBytesRead))= 0); end; //Split and save data to files
splitSavefiles(MyStrm,'目标路径id');
finally
MyStrm.Free;
end;
except
on E : Exception do
Response.Content := 'ok';
end;end;//Split and save data to files
procedure splitSavefiles(Stream:TMemoryStream;sDir:String);
var
temMemStream:TMemoryStream;
pBuffer:pchar;
filesize,posStart,posEnd:integer;
sHeaderdata,sDelimiter :String;
Buffer:char;
fileName:string;
begin
temMemStream:=TMemoryStream.Create ;
posEnd:=0;
Stream.Position:=0;
sHeaderdata:='';
Repeat
Stream.Read(Buffer,1);
inc(posEnd);
sHeaderdata:=sHeaderdata+Buffer;
if(copy(sHeaderdata,length(sHeaderdata)-4,4)=#13#10#13#10) then
begin
posStart:=posEnd-1;//正文流的起始位置
fileName:=extractFileNameFromsHeaderdata(sHeaderdata);//获得文件名
if trim(filename)<>'' then
begin
Repeat
Stream.Read(Buffer,1);
inc(posEnd);
sDelimiter:=sDelimiter+Buffer;
Until(Copy(sDelimiter,length(sDelimiter)-29,29)=flags);
filesize:=posEnd-posStart-29;
Stream.Position:=posStart;
temMemStream.Clear;
temMemStream.Position:=0;
//读取分割文件的数据
getmem(pBuffer,filesize);
Stream.Read(pBuffer^,filesize);
temMemStream.Write(pBuffer^,filesize-1);
temMemStream.Position:=0;
temMemStream.SaveToFile(CreateFilePath(filename,sDir)); //恢复读取文件指针
Stream.Position:=posEnd;
end;
sHeaderdata:='';
end;
Until((Stream.Size-posEnd)=0);
temMemStream.Free ;
end;//分出文件名
function extractFileNameFromsHeaderdata(Headerdata:string):string;
begin
Result := Copy(Headerdata,Pos('filename="',Headerdata) + 10,Length(Headerdata));
Result := ExtractFileName(Copy(Result,1,Pos('"',Result)-1));
end;//文件全名生成
function CreateFilePath(fileName:string;StrDir:string):string;
var
dirStr:string;
begin
dirStr:=ExtractFilePath(Application.ExeName)+StrDir;
try
CreateDir(dirStr);
finally
Result:=dirStr+'\'+fileName;
end;
end;end.
//**************************************************************
//多文件上传文件分割程序-----作者海儿 [email protected] 2002.06.13//
//**************************************************************interfaceuses
SysUtils, Classes, HTTPApp,windows,forms;type
TWebModule1 = class(TWebModule)
procedure WebModule1uuploadAction(Sender: TObject;
Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
private
{ Private declarations }
public
{ Public declarations }
end;
procedure splitSavefiles(Stream:TMemoryStream;sDir:String);
function extractFileNameFromsHeaderdata(headerdata:string):string;//分出文件名
function CreateFilePath(fileName:string;StrDir:string):string;//文件全名生成var
WebModule1: TWebModule1;
const
flags='-----------------------------'; //定界符
implementation{$R *.DFM}procedure TWebModule1.WebModule1uuploadAction(Sender: TObject;
Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
var
TotalBytes :Dword;
AvailableBytes : DWORD;
ExtraBytes : DWORD;
ActualBytesRead : DWORD;
ExtraBytesRead : Integer;
pBuffer : PChar;
extBuffer : PChar;
MyStrm : TMemoryStream;
begin
try
TotalBytes := Request.ContentLength;
GetMem(pBuffer, TotalBytes);
pBuffer^ := Chr(0);
MyStrm := TMemoryStream.Create;
try
AvailableBytes := Length(Request.Content); // Put the contents of Request.Content into pBuffer
pBuffer := PChar(Request.Content);
MyStrm.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 - DWORD(ExtraBytesRead));
myStrm.Write(extBuffer^,ActualBytesRead);
Inc(ExtraBytesRead, ActualBytesRead);
until ((ExtraBytes - Dword(ExtraBytesRead))= 0); end; //Split and save data to files
splitSavefiles(MyStrm,'目标路径id');
finally
MyStrm.Free;
end;
except
on E : Exception do
Response.Content := 'ok';
end;end;//Split and save data to files
procedure splitSavefiles(Stream:TMemoryStream;sDir:String);
var
temMemStream:TMemoryStream;
pBuffer:pchar;
filesize,posStart,posEnd:integer;
sHeaderdata,sDelimiter :String;
Buffer:char;
fileName:string;
begin
temMemStream:=TMemoryStream.Create ;
posEnd:=0;
Stream.Position:=0;
sHeaderdata:='';
Repeat
Stream.Read(Buffer,1);
inc(posEnd);
sHeaderdata:=sHeaderdata+Buffer;
if(copy(sHeaderdata,length(sHeaderdata)-4,4)=#13#10#13#10) then
begin
posStart:=posEnd-1;//正文流的起始位置
fileName:=extractFileNameFromsHeaderdata(sHeaderdata);//获得文件名
if trim(filename)<>'' then
begin
Repeat
Stream.Read(Buffer,1);
inc(posEnd);
sDelimiter:=sDelimiter+Buffer;
Until(Copy(sDelimiter,length(sDelimiter)-29,29)=flags);
filesize:=posEnd-posStart-29;
Stream.Position:=posStart;
temMemStream.Clear;
temMemStream.Position:=0;
//读取分割文件的数据
getmem(pBuffer,filesize);
Stream.Read(pBuffer^,filesize);
temMemStream.Write(pBuffer^,filesize-1);
temMemStream.Position:=0;
temMemStream.SaveToFile(CreateFilePath(filename,sDir)); //恢复读取文件指针
Stream.Position:=posEnd;
end;
sHeaderdata:='';
end;
Until((Stream.Size-posEnd)=0);
temMemStream.Free ;
end;//分出文件名
function extractFileNameFromsHeaderdata(Headerdata:string):string;
begin
Result := Copy(Headerdata,Pos('filename="',Headerdata) + 10,Length(Headerdata));
Result := ExtractFileName(Copy(Result,1,Pos('"',Result)-1));
end;//文件全名生成
function CreateFilePath(fileName:string;StrDir:string):string;
var
dirStr:string;
begin
dirStr:=ExtractFilePath(Application.ExeName)+StrDir;
try
CreateDir(dirStr);
finally
Result:=dirStr+'\'+fileName;
end;
end;end.
解决方案 »
免费领取超大流量手机卡,每月29元包185G流量+100分钟通话, 中国电信官方发货