unit WebPrice;
   
   interface
   
   uses
     Windows, Messages, SysUtils, Classes, HTTPApp, ComObj, Db, DBTables,Dialogs,
     ExtCtrls, ADODB, Psock, NMsmtp;
   
   type
     TWebModule1 = class(TWebModule)
       ADOConnection: TADOConnection;
       ADOQueryImageType: TADOQuery;
       procedure WebModule1aiInsertFileAction(Sender: TObject;
         Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
     private
       { Private declarations }
       V:        Variant;
       FCritSect: TRTLCriticalSection;
       PCntnt:   PChar;     {Указатель на буфер для Content}
       lBufCnt:  integer;  {Длина буфера для Content}
       nCntnt:   integer;  {Номер активного элемента буфера}
       lCntnt:   integer;  {Число реально загруженных символов в буфер}
       lenHTTP:  integer;  {Число не дочитанных от клиента символов}
       SeekRzd:  Boolean;  {True - разделитель найден}
       function GetFld(Rzd: string; var nf: integer): string;
     public
       { Public declarations }
     end;
   
   var
     WebModule1: TWebModule1;
   
   implementation
   
   {$R *.DFM}
   
   { -----------------------------------------------------------------}
 
   {Загрузка файла рисунка от клиента
    Параметры (метод POST):
               Path       - директория для записи файла рисунка
                            Пример - Path=C:\InePub\Wroute\Price\Images
                PriceID   - номер наименования товара (для формирования имени файла)
                FileName  - Полное имя файла на машине клиента
                Return     - Куда перейти после выполнения (опция)
                            в форме должен быть задан ENCTYPE= "multipart/form-data" }
   procedure TWebModule1.WebModule1aiInsertFileAction(Sender: TObject;
     Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
   var HTML,RzdHTTP,ErrStr,name,param,z,zType: string;
   var Path,PriceID,FileName,Return: string;
   var k,nf: integer;
   var F: file of char;
   Const CRCN=Chr( 13 )+Chr( 10 );  {\r\n}
   begin
     InitializeCriticalSection(FCritSect);
     EnterCriticalSection(FCritSect);
     try
       Path:='';  PriceID:='';  Return:='';
       nCntnt:=- 1 ;  lCntnt:=Length(Request.Content);
       PCntnt:=@Request.Content[ 1 ];  lBufCnt:=lCntnt;
       LenHTTP:=Request.ContentLength;
   ErrStr:='Чтение строки-разделителя HTTP';
       nf:= 1 ;  RzdHTTP:=GetFld(CRCN,nf);
       if NOT SeekRzd then Raise Exception.Create('Ошибка определения конца поля');
       while lCntnt> 0  do
         begin
   ErrStr:='Чтение поля name в HTTP';
           nf:= 1 ;   GetFld('name="',nf);
           if lCntnt<= 0  then break;      {достигнут конец HTTP}
           nf:= 1 ;   name:=HTTPDecode(GetFld('"',nf));
   ErrStr:='Разбор параметра name="' + name + '" в HTTP';
           nf:= 1 ;   param:=GetFld(CRCN,nf);
           name:=AnsiUpperCase(name);
           if Length(param)= 0  then       {обычный параметр}
             begin
                nf:= 1 ;   GetFld(CRCN,nf);
                nf:= 1 ;   param:=GetFld(CRCN+RzdHTTP,nf);
               if name='PATH'then Path:=HTTPDecode(param)
               else
               if name='PRICEID' then PriceID:=HTTPDecode(param)
               else
               if name='RETURN' then Return:=HTTPDecode(param)
               else
                  Raise Exception.Create('Неверное имя параметра "'+name+'"');
             end
           else                          {параметр - файл}
             begin
               if NOT (name='FILENAME') then
                  Raise Exception.Create('Неверное имя параметра "'+name+'"');
               if (Path='') OR (PriceID='')then
                  Raise Exception.Create('Неверны параметры Path и(или) PriceID');
                z:='filename="';   nf:=Pos(z,param)+Length(z);
                k:=Pos('"',Copy(param,nf,Length(param)-nf+ 1 ));
               if k< 1  then k:=Length(param)-nf+ 2 ;
                FileName:=HTTPDecode(Copy(param,nf,k- 1 ));
               if Length(Trim(FileName))= 0  then
                  Raise Exception.Create('Не задано имя файла-рисунка');
                nf:= 1 ;   GetFld('Content-Type: ',nf);
                nf:= 1 ;   param:=GetFld('/',nf);
                nf:= 1 ;   zType:=GetFld(CRCN,nf);
               if zType='pjpeg' then zType:='jpg';
               if NOT ((param='image') AND ((zType='gif') OR (zType='jpg'))) then
                  Raise Exception.Create('Загружаемый файл не рисунок GIF или JPEG');
   ErrStr:='Удаление файла с рисунками';
                name:=Path+'\f'+PriceID+'.';
               if zType='gif' then name:=name+'jpg' else name:=name+'gif';
               if FileExists(name) then
                  begin
                    AssignFile(f,name);   Reset(f);  CloseFile(f);  Erase(f);
                  end;
   ErrStr:='Запись файла с рисунком';
                name:=Path+'\f'+PriceID+'.'+zType;
                AssignFile(f,name);   Rewrite(f);
                nf:= 1 ;   GetFld(CRCN,nf);  nf:= 1 ;
               while True do
                  begin
                    param:=GetFld(CRCN+RzdHTTP,nf);
                    for k:= 1  to Length(param) do Write(f,param[k]);
                    if SeekRzd OR (lCntnt<= 0 ) then break;
                  end;
                CloseFile(f);
            end;
         end;
       if NOT (LenHTTP= 0 ) then
         Raise Exception.Create('Ошибка чтения информации с машины клиента');
   ErrStr:='Запись в базу данных расширения файла с рисунком';
       ADOConnection.Open;
       WITH ADOQueryImageType DO
         begin
           SQL.Clear;
           SQL.Add('SELECT ImageTypeID FROM ImageType '
                   +'WHERE ImageType=''' + zType + '''');
           Close;
           if NOT EOf then
             Raise Exception.Create('Не определен тип расширения изображения в БД');
           Open;
            z:=IntToStr(FieldByName('ImageTypeID').Value);
           Close;
           SQL.Clear;
           SQL.Add('UPDATE Price SET ImageTypeID=' + z
                  + ' WHERE PriceID=' + PriceID);
           Close; {Запись расширения файла с рисунком}
           ExecSQL;
           Close;
         end;
       HTML:=HTMLOk('Изображение из файла "'+FileName+'" загружено на сервер',
                     Request.Host,Return);
     except
     On E: Exception do
       begin
         while lCntnt> 0  do     {Дочитать HTTP до конца иначе клиент неадекватен}
           begin
             nf:= 1 ;   GetFld(CRCN,nf);
           end;
         HTML:=HTMLNo('Не удалось сохранить файл изображения',ErrStr,E.Message,
                       Request.Host,Return);
       end;
     end;
     ADOConnection.Close;
     LeaveCriticalSection(FCritSect);
     DeleteCriticalSection(FCritSect);
     Response.Content:=HTML;
   end;
   
   { Считывает поле из Content
     Rzd      - искомая строка-разделитель (ограничитель)
     nf       - номер текущего символа Rzd для сравнения
     Возвращает прочитанное поле длиной не более  255  байт
     nf=Length(Rzd) - разделитель найден, иначе считана только часть поля
     lCntnt<= 0  - обработан весь Content}
   function TWebModule1.GetFld(Rzd: string; var nf: integer): string;
   var n,k: integer;
   const LMAX= 1024 ;
   begin
     k:=Length(Rzd);  Result:='';  n:= 0 ;   SeekRzd:=False;
     While True do
       begin
         if lCntnt<= 0  then break;        {Все обработано}
         nCntnt:=nCntnt+ 1 ;
         if nCntnt=lCntnt then       {Считать следующую порцию}
           begin
             nCntnt:= 0 ;   LenHTTP:=LenHTTP-lCntnt;  lCntnt:=LenHTTP;
             if lCntnt>lBufCnt then lCntnt:=lBufCnt;
             if lCntnt> 0  then
                lCntnt:=Request.ReadClient(Pointer(PCntnt)^,lCntnt);
             if lCntnt<= 0  then break;    {Все обработано или отключен клиент}
           end;
         if (PCntnt+nCntnt)^=Rzd[nf] then
           if nf=k then     {Найден разделитель}
             begin
                SeekRzd:=True;   break;
             end
           else nf:=nf+ 1 
         else
           begin
             if nf> 1  then            {разделитель не подтвердился}
               begin
                  Result:=Result+Copy(Rzd, 1 ,nf- 1 );   nf:= 1 ;
               end;
              Result:=Result+(PCntnt+nCntnt)^;
           end;
         if n=LMAX then break;       {ограничение строки}
         n:=n+ 1 ;
       end;
   end;
   
   end.