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.