2Pascal-新时代的Pascal

 找回密码
 立即注册
搜索
热搜: fastreport
查看: 1990|回复: 0
打印 上一主题 下一主题

idhttp流上传(文件,图片等)

[复制链接]

29

主题

73

帖子

727

积分

管理员

Rank: 9Rank: 9Rank: 9

积分
727
跳转到指定楼层
楼主
发表于 2018-4-25 00:28:55 | 只看该作者 回帖奖励 |倒序浏览 |阅读模式
京东购书支持本站
[mw_shl_code=delphi,true]unit Unit2;

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs
  ,FMX.MediaLibrary, FMX.Platform, System.Messaging, FMX.Objects,
  FMX.Controls.Presentation, FMX.StdCtrls, IdBaseComponent, IdComponent,
  IdTCPConnection, IdTCPClient, IdHTTP,IdMultipartFormData, FMX.ScrollBox,FMX.Surfaces,
  FMX.Memo;

type
  TForm2 = class(TForm)
    SpeedButton1: TSpeedButton;
    Image1: TImage;
    IdHTTP1: TIdHTTP;
    Button1: TButton;
    Memo1: TMemo;
    procedure SpeedButton1Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
  procedure DoDidFinish(Image: TBitmap);
  procedure DoMessageListener(const Sender: TObject; const M: TMessage);
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form2: TForm2;
  bstream:tmemorystream;

implementation

{$R *.fmx}
procedure TBitmapSaveToJPEGStream(ABitmap:TBitmap; Stream: TStream);
var
  Surf: TBitmapSurface;
  quality1:TBitmapCodecSaveParams;
begin
  if(ABitmap=nil) then exit;
  quality1.Quality:=90;
  Surf := TBitmapSurface.Create;
  try
    Surf.Assign(ABitmap);

    if not TBitmapCodecManager.SaveToStream(Stream, Surf, '.jpg',@quality1) then
      raise EBitmapSavingFailed.Create('');
  finally
    Surf.Free;
  end;
end;


procedure TForm2.Button1Click(Sender: TObject);
var
  postStream : TIdMultiPartFormDataStream;
  respStream : TStringStream;
  astream:tmemorystream;
begin
  //IdHTTP1.HandleRedirects := true;  // 允许重定向,因为这个站点会发生重定向
  IdHTTP1.Request.Referer := 'http://10.144.181.253/'; // 设置来路,此网站要求

  postStream := TIdMultiPartFormDataStream.Create;  // 创建TIdMultiPartFormDataStream类
  respStream := TStringStream.Create('');
  astream:=tmemorystream.Create;
//  image1.Bitmap.SaveToStream(astream);
  tBitmapSaveToJPEGStream(image1.Bitmap,astream);
  postStream.AddFormField('txt', '111'); // 表单参数
// postStream.AddFormField('file', opendialog1.FileName); // 表单参数

//  postStream.AddFile('file', opendialog1.FileName, 'image/jpeg'); // 表单文件
  poststream.AddFormField('file','image/pjpeg','',astream,'333.jpg');


  IdHTTP1.Post('http://10.144.181.253/upload_file.php', postStream, respStream);
    Memo1.Text := Utf8ToAnsi(respStream.DataString);

end;

procedure TForm2.DoDidFinish(Image: TBitmap);
begin
//image.SaveToFile(ExpandFileName('~/Test.jpg'));
Image1.Bitmap.Assign(Image);

end;


procedure TForm2.DoMessageListener(const Sender: TObject;
const M: TMessage);
begin
if M is TMessageDidFinishTakingImageFromLibrary then
Image1.Bitmap.Assign(TMessageDidFinishTakingImageFromLibrary(M).Value);

end;

procedure TForm2.FormCreate(Sender: TObject);
begin
bstream:=tmemorystream.create;
end;

procedure TForm2.SpeedButton1Click(Sender: TObject);
var
Service: IFMXCameraService;
Params: TParamsPhotoQuery;
begin
if
TPlatformServices.Current.SupportsPlatformService(IFMXCameraService,
Service) then
begin
Params.Editable := false;
// Specifies whether to save a picture to devicePhoto Library
Params.NeedSaveToAlbum := true;
Params.RequiredResolution := TSize.Create(2000,2000);
Params.OnDidFinishTaking := DoDidFinish;
Service.TakePhoto(SpeedButton1, Params);
end
else
ShowMessage('This device does not support the camera service');
end;
end.
[/mw_shl_code]

{:soso__3110130392203091378_3:}
回复

使用道具 举报

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

QQ|Archiver|手机版|小黑屋|新时代Pascal论坛

GMT+8, 2024-12-22 21:53 , Processed in 0.054561 second(s), 25 queries .

Powered by Discuz! X3

© 2001-2013 Comsenz Inc.

快速回复 返回顶部 返回列表