ImageLoader

unit ImageLoader;
{
================ Coded by VANS ================
================ VANS-SOFT.RU  ================
}
interface

uses
  Classes,
  SysUtils,
  SynAUtil,
  HTTPSend,
  SSL_OpenSSL, ssl_openssl_lib; //а вдруг HTTPS ссылка?

type
  TLoader=class
  private
    ImagePath:String;
    Field:string;
    HTTP:THTTPSend;
    Response:TStringList;
    Bound:string;
    Image:TMemoryStream;
    function UrlEncode(Value: Utf8String): string; //кодирование символов или непечатных букв
  public
    EncodeValue:boolean;
    Constructor Create;
    Destructor Free;
    function LoadImageFromFile(Path:string):boolean; //функция загрузки изображения из файлы
    function LoadImageFromMemory(Mem:TMemoryStream):boolean; //и функция загрузки картинки из памяти
    procedure AddField(Param, Value:string); //добавление поля
    procedure AddImage(FieldName, FileName, ContentType:string); //добавление картинки
    function SendFormData(url, check:string):boolean; //Отправка запроса на сервер
  end;

const CRLF=#$0D#$0A;

implementation

{ TLoader }

procedure TLoader.AddField(Param, Value: String);
begin
  //тут формируется так называемое "поле" по типу обычных HTTP запросов
  if not EncodeValue then
    Field:='--'+Bound+CRLF+'Content-Disposition: form-data; name="'+Param+'"'+CRLF+CRLF+Value+CRLF
  else
    Field:='--'+Bound+CRLF+'Content-Disposition: form-data; name="'+Param+'"'+CRLF+CRLF+UrlEncode(Value)+CRLF;

  WriteStrToStream(HTTP.Document, Field); //и добавляем новое поле в HTTPSend
end;

constructor TLoader.Create;
begin
  //Создаём нужные для работы компоненты и переменные
  HTTP:=THTTPSend.Create;
  Image:=TMemoryStream.Create;
  Response:=TStringList.Create;

  Bound:='-----' +IntToHex(Random(65535), 8)+'_boundary'; //Уникальное значение для отделения блоков данных
  HTTP.MimeType:='multipart/form-data; boundary='+Bound; //Выставляем тип данных
  HTTP.UserAgent:='Mozilla/5.0 (Windows NT 5.1; rv:28.0) Gecko/20100101 Firefox/28.0'; //Мой старенький комп
  HTTP.Protocol:='1.1'; //протокол (1.0 или 1.1)
end;

destructor TLoader.Free;
begin
  //уничтожаем переменные
  Response.Free;
  HTTP.Free;
  Image.Free;
end;

function TLoader.LoadImageFromFile(Path:string): boolean; //тут и так всё ясно
begin
  try
    ImagePath:=Path;
    image.LoadFromFile(ImagePath);
    result:=true;
  except
    result:=false;
  end;
end;

function TLoader.LoadImageFromMemory(Mem: TMemoryStream): boolean; // и тут тоже
begin
  try
    image.LoadFromStream(Mem);
    result:=true;
  except
    result:=false;
  end;
end;

procedure TLoader.AddImage(FieldName, FileName, ContentType:string);
var FName, CT:string;
begin
  //что бы не было ошибок при автоматической подстановке имени и типа
  if ((FileName='') or (ContentType='')) and (ImagePath='') then
    raise Exception.Create('Входные данные не указаны!'); //Создаём исключение, не забудь обработать!

  if FileName='' then  //если не указано имя файла
    FName:=ExtractFileName(ImagePath) //устанавливаем исходное
  else
    FName:=FileName; //используем текущее

  if ContentType='' then begin //если не указан ContentType
    CT:=ExtractFileExt(FName); //узнаём расширение файла (*.jpg, *.gif, *.png, etc)
    Delete(CT, 1, 1); //удаляем точку перед расширением
    CT:='image/'+CT; //формируем ContentType
  end else CT:=ContentType; //Используем указанный

  Field:='--'+Bound+CRLF; //отделяем блок данных, а ниже формируем описание этих данных (картинки)
  Field:=Field+'Content-Disposition: form-data; name="'+FieldName+'"; filename="'+FName+'"'+CRLF+'Content-Type: '+CT+CRLF+CRLF;
  WriteStrToStream(HTTP.Document, Field); //Подгружаем сформированные ранее поля в компонент HTTPSend
  HTTP.Document.CopyFrom(Image, 0); //Подгружаем картинку в компонент HTTPSend
  WriteStrToStream(HTTP.Document, CRLF); //отступаем строку
end;

function TLoader.SendFormData(url, check: string): boolean;
var page:string;
begin
  Field:='--'+Bound+'--'+CRLF; //формируем окончание блока
  WriteStrToStream(HTTP.Document, Field); //добавляем сформированное окончание

  if (HTTP.HTTPMethod('POST', url)) then begin //отправляем запрос
    if Length(check)>1 then begin //запрос прошёл удачно, нужно ли что то проверить?
      response:=TStringList.Create;
      response.LoadFromStream(HTTP.Document); //загружаем документ
      page:=Utf8ToAnsi(response.Text); //копируем в переменную и переводим в ANSI кодировку
      response.Free;
      if pos(check, page)>0 then result:=true else result:=false;  //проверяем
    end else result:=true; //если не нужна проверка то всё норм
  end else result:=false; //запрос не прошёл
end;

function TLoader.UrlEncode(Value: Utf8String): string;
var i:integer;
begin
  Result:='';
  for i:=1 to Length(Value) do //цикл по строке
    if Value[i] in ['a'..'z', 'A'..'Z', '0'..'9'] then //игнорируемые символы (диапазоны)
      Result:=Result+Value[i] //просто пишем текущий символ
    else
      Result:=Result+'%'+IntToHex(Ord(Value[i]), 2); //переводим в HEX для URL
end;

end.