Guest User

ImageLoader

a guest
Nov 14th, 2014
248
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. unit ImageLoader;
  2. {
  3. ================ Coded by VANS ================
  4. ================ VANS-SOFT.RU  ================
  5. }
  6. interface
  7.  
  8. uses
  9.   Classes,
  10.   SysUtils,
  11.   SynAUtil,
  12.   HTTPSend,
  13.   SSL_OpenSSL, ssl_openssl_lib; //а вдруг HTTPS ссылка?
  14.  
  15. type
  16.   TLoader=class
  17.   private
  18.     ImagePath:String;
  19.     Field:string;
  20.     HTTP:THTTPSend;
  21.     Response:TStringList;
  22.     Bound:string;
  23.     Image:TMemoryStream;
  24.     function UrlEncode(Value: Utf8String): string; //кодирование символов или непечатных букв
  25.   public
  26.     EncodeValue:boolean;
  27.     Constructor Create;
  28.     Destructor Free;
  29.     function LoadImageFromFile(Path:string):boolean; //функция загрузки изображения из файлы
  30.     function LoadImageFromMemory(Mem:TMemoryStream):boolean; //и функция загрузки картинки из памяти
  31.     procedure AddField(Param, Value:string); //добавление поля
  32.     procedure AddImage(FieldName, FileName, ContentType:string); //добавление картинки
  33.     function SendFormData(url, check:string):boolean; //Отправка запроса на сервер
  34.   end;
  35.  
  36. const CRLF=#$0D#$0A;
  37.  
  38. implementation
  39.  
  40. { TLoader }
  41.  
  42. procedure TLoader.AddField(Param, Value: String);
  43. begin
  44.   //тут формируется так называемое "поле" по типу обычных HTTP запросов
  45.   if not EncodeValue then
  46.     Field:='--'+Bound+CRLF+'Content-Disposition: form-data; name="'+Param+'"'+CRLF+CRLF+Value+CRLF
  47.   else
  48.     Field:='--'+Bound+CRLF+'Content-Disposition: form-data; name="'+Param+'"'+CRLF+CRLF+UrlEncode(Value)+CRLF;
  49.  
  50.   WriteStrToStream(HTTP.Document, Field); //и добавляем новое поле в HTTPSend
  51. end;
  52.  
  53. constructor TLoader.Create;
  54. begin
  55.   //Создаём нужные для работы компоненты и переменные
  56.   HTTP:=THTTPSend.Create;
  57.   Image:=TMemoryStream.Create;
  58.   Response:=TStringList.Create;
  59.  
  60.   Bound:='-----' +IntToHex(Random(65535), 8)+'_boundary'; //Уникальное значение для отделения блоков данных
  61.   HTTP.MimeType:='multipart/form-data; boundary='+Bound; //Выставляем тип данных
  62.   HTTP.UserAgent:='Mozilla/5.0 (Windows NT 5.1; rv:28.0) Gecko/20100101 Firefox/28.0'; //Мой старенький комп
  63.   HTTP.Protocol:='1.1'; //протокол (1.0 или 1.1)
  64. end;
  65.  
  66. destructor TLoader.Free;
  67. begin
  68.   //уничтожаем переменные
  69.   Response.Free;
  70.   HTTP.Free;
  71.   Image.Free;
  72. end;
  73.  
  74. function TLoader.LoadImageFromFile(Path:string): boolean; //тут и так всё ясно
  75. begin
  76.   try
  77.     ImagePath:=Path;
  78.     image.LoadFromFile(ImagePath);
  79.     result:=true;
  80.   except
  81.     result:=false;
  82.   end;
  83. end;
  84.  
  85. function TLoader.LoadImageFromMemory(Mem: TMemoryStream): boolean; // и тут тоже
  86. begin
  87.   try
  88.     image.LoadFromStream(Mem);
  89.     result:=true;
  90.   except
  91.     result:=false;
  92.   end;
  93. end;
  94.  
  95. procedure TLoader.AddImage(FieldName, FileName, ContentType:string);
  96. var FName, CT:string;
  97. begin
  98.   //что бы не было ошибок при автоматической подстановке имени и типа
  99.   if ((FileName='') or (ContentType='')) and (ImagePath='') then
  100.     raise Exception.Create('Входные данные не указаны!'); //Создаём исключение, не забудь обработать!
  101.  
  102.   if FileName='' then  //если не указано имя файла
  103.     FName:=ExtractFileName(ImagePath) //устанавливаем исходное
  104.   else
  105.     FName:=FileName; //используем текущее
  106.  
  107.   if ContentType='' then begin //если не указан ContentType
  108.     CT:=ExtractFileExt(FName); //узнаём расширение файла (*.jpg, *.gif, *.png, etc)
  109.     Delete(CT, 1, 1); //удаляем точку перед расширением
  110.     CT:='image/'+CT; //формируем ContentType
  111.   end else CT:=ContentType; //Используем указанный
  112.  
  113.   Field:='--'+Bound+CRLF; //отделяем блок данных, а ниже формируем описание этих данных (картинки)
  114.   Field:=Field+'Content-Disposition: form-data; name="'+FieldName+'"; filename="'+FName+'"'+CRLF+'Content-Type: '+CT+CRLF+CRLF;
  115.   WriteStrToStream(HTTP.Document, Field); //Подгружаем сформированные ранее поля в компонент HTTPSend
  116.   HTTP.Document.CopyFrom(Image, 0); //Подгружаем картинку в компонент HTTPSend
  117.   WriteStrToStream(HTTP.Document, CRLF); //отступаем строку
  118. end;
  119.  
  120. function TLoader.SendFormData(url, check: string): boolean;
  121. var page:string;
  122. begin
  123.   Field:='--'+Bound+'--'+CRLF; //формируем окончание блока
  124.   WriteStrToStream(HTTP.Document, Field); //добавляем сформированное окончание
  125.  
  126.   if (HTTP.HTTPMethod('POST', url)) then begin //отправляем запрос
  127.     if Length(check)>1 then begin //запрос прошёл удачно, нужно ли что то проверить?
  128.       response:=TStringList.Create;
  129.       response.LoadFromStream(HTTP.Document); //загружаем документ
  130.       page:=Utf8ToAnsi(response.Text); //копируем в переменную и переводим в ANSI кодировку
  131.       response.Free;
  132.       if pos(check, page)>0 then result:=true else result:=false;  //проверяем
  133.     end else result:=true; //если не нужна проверка то всё норм
  134.   end else result:=false; //запрос не прошёл
  135. end;
  136.  
  137. function TLoader.UrlEncode(Value: Utf8String): string;
  138. var i:integer;
  139. begin
  140.   Result:='';
  141.   for i:=1 to Length(Value) do //цикл по строке
  142.     if Value[i] in ['a'..'z', 'A'..'Z', '0'..'9'] then //игнорируемые символы (диапазоны)
  143.       Result:=Result+Value[i] //просто пишем текущий символ
  144.     else
  145.       Result:=Result+'%'+IntToHex(Ord(Value[i]), 2); //переводим в HEX для URL
  146. end;
  147.  
  148. end.
RAW Paste Data