惯性聚合 高效追踪和阅读你感兴趣的博客、新闻、科技资讯
阅读原文 在惯性聚合中打开

推荐订阅源

G
Google Developers Blog
阮一峰的网络日志
阮一峰的网络日志
IT之家
IT之家
人人都是产品经理
人人都是产品经理
freeCodeCamp Programming Tutorials: Python, JavaScript, Git & More
博客园 - 【当耐特】
WordPress大学
WordPress大学
Hugging Face - Blog
Hugging Face - Blog
博客园 - 叶小钗
罗磊的独立博客
宝玉的分享
宝玉的分享
月光博客
月光博客
V
V2EX
博客园 - 司徒正美
Vercel News
Vercel News
量子位
Y
Y Combinator Blog
美团技术团队
Cyber Security Advisories - MS-ISAC
Cyber Security Advisories - MS-ISAC
T
Tailwind CSS Blog
博客园 - Franky
小众软件
小众软件
I
InfoQ
A
About on SuperTechFans

博客园 - delphi中间件

postgresql建库建表脚本 ubuntu配置postgresql远程访问 ubuntu安装postgresql数据库 delphi 面向模型编程 array of TVarRec core.recordModel.pas 使用泛型序列结构体 DDD建模指导 rabbitMQ VS mqtt redis流的应用场景 redis消费者组 redis流的操作命令 领域服务与领域事件 业务规则和模型 限界上下文与统一语言 领域驱动 mqtt即时通讯 ActiveRecord ORM RAD(速成应用开发) unigui插件框架 工厂流水线式自动生产UNIGUI WEB软件 delphi cs\web一种统一的界面风格 - delphi中间件 - 博客园 动态生成unidbgrid 单据工厂 用json元数据填充模板 mormot2 ORM rest vs jsonrpc SSE技术详解:使用 HTTP 做服务端数据推送应用的技术 http持久连接 json-rpc 2.0
TMultiPartFormData
delphi中间件 · 2026-01-31 · via 博客园 - delphi中间件

TMultiPartFormData

unit form.data;
//cxg 2025
interface

uses
  core.firedac, core.global, core.firedacpool, core.router, core.log, core.json,
  core.datasetHelp, core.encoding,
  DB, Classes, SysUtils, System.Net.Mime, Net.CrossHttpParams;

type
  TFormDataService = record
    procedure DownloadFile(const ARequest: THttpRequest;
      const AResponse: THttpResponse);
    procedure UploadFile(const ARequest: THttpRequest;
      const AResponse: THttpResponse);

    procedure Select(const ARequest: THttpRequest;
      const AResponse: THttpResponse);
  end;

implementation

function DownloadPath: string;
begin
  Result := ExtractFilePath(ParamStr(0)) + 'download' + PathDelim;
end;

procedure TFormDataService.DownloadFile(const ARequest: THttpRequest;
  const AResponse: THttpResponse);
var
  LRequestData: THttpMultiPartFormData;
  LResponseData: TMultiPartFormData;
begin
  LResponseData := TMultiPartFormData.Create;
  try
    try
      TRequestFunc.UnMarshal(ARequest, LRequestData);
      LResponseData.AddField('success', 'true');
      LResponseData.AddField('message', '下载成功');
      LResponseData.AddField('filename', LRequestData.Fields['filename'].AsString);
      LResponseData.AddFile('file', DownloadPath + LRequestData.Fields['filename'].AsString);
      TResponseFunc.Send(AResponse, LResponseData);
    except
      on E: Exception do
      begin
        LResponseData.AddField('success', 'false');
        LResponseData.AddField('message', E.Message);
        TResponseFunc.Send(AResponse, LResponseData);
        WriteLog('TFormDataService.DownloadFile()' + E.Message);
      end;
    end;
  finally
    LRequestData.Free;
  end;
end;

function UploadPath: string;
begin
  Result := ExtractFilePath(ParamStr(0)) + 'upload' + PathDelim;
end;

procedure TFormDataService.Select(const ARequest: THttpRequest;
  const AResponse: THttpResponse);
var LDB: TDB;
  LPool: TDBPool;
  LRequestData: THttpMultiPartFormData;
  LResponseData: TMultiPartFormData;
  i: Integer;
  LStream: TStream;
begin
  LResponseData := TMultiPartFormData.Create;
  try
    try
      TRequestFunc.UnMarshal(ARequest, LRequestData);
      LPool := GetDBPool(LRequestData.Fields['dbid'].AsString);
      LDB := LPool.Lock;
      for i := 0 to LRequestData.Fields['count'].AsString.ToInteger - 1 do
      begin
        LStream := LDB.select3(LRequestData.Fields['sql' + i.ToString].AsString);
        LStream.Position := 0;
        LResponseData.AddStream(TConst.Data + i.ToString, LStream);
        LStream.Free;
      end;
      LResponseData.AddField(TConst.Success, 'true');
      TResponseFunc.Send(AResponse, LResponseData);
    except
      on E: Exception do
      begin
        LResponseData.AddField(TConst.Success, 'false');
        LResponseData.AddField('message', E.Message);
        TResponseFunc.Send(AResponse, LResponseData);
        WriteLog('TFormDataService.Select()' + E.Message);
      end;
    end;
  finally
    LPool.Unlock(LDB);
    LRequestData.Free;
  end;
end;

procedure TFormDataService.UploadFile(const ARequest: THttpRequest;
  const AResponse: THttpResponse);
var
  LRequestData: THttpMultiPartFormData;
  LResponseData: TMultiPartFormData;
  LMemoryStream: TMemoryStream;
begin
  LResponseData := TMultiPartFormData.Create;
  LMemoryStream := TMemoryStream.Create;
  try
    try
      TRequestFunc.UnMarshal(ARequest, LRequestData);
      LMemoryStream.CopyFrom(LRequestData.Fields['file'].Value);
      LMemoryStream.SaveToFile(UploadPath + LRequestData.Fields['filename'].AsString);
      LResponseData.AddField('success', 'true');
      LResponseData.AddField('message', '上传成功');
      TResponseFunc.Send(AResponse, LResponseData);
    except
      on E: Exception do
      begin
        LResponseData.AddField('success', 'false');
        LResponseData.AddField('message', E.Message);
        TResponseFunc.Send(AResponse, LResponseData);
        WriteLog('TFormDataService.DownloadFile()' + E.Message);
      end;
    end;
  finally
    LRequestData.Free;
  end;
end;

var
  FormDataService: TFormDataService;

initialization
  //multipart/form-data api
  TRouter.Add('/formdata/downloadfile', FormDataService.DownloadFile);
  TRouter.Add('/formdata/uploadfile', FormDataService.UploadFile);
  TRouter.Add('/formdata/select', FormDataService.Select);

end.
unit server.api;

// cxg 2025
interface

uses Net.CrossHttpParams,
  Net.Mime, IdHTTP, System.Net.HttpClientComponent, Net.HttpClient,
  IniFiles, SysUtils, Classes;

var
  url: string;

type
  THttpClient = TNetHTTPClient;

  TRpc = record // remote-procedure-call(multipart/form-data)
    class function UploadFile(const AData: TMultipartFormData): Boolean; static;
    class function DownloadFile(const AData: TMultipartFormData)
      : THttpMultiPartFormData; static;
  end;

implementation

function Newhttp: THttpClient;
begin
  Result := THttpClient.Create(nil);
  Result.HandleRedirects := True;
end;

{ TRpc }

class function TRpc.DownloadFile(const AData: TMultipartFormData)
  : THttpMultiPartFormData;
var
  LHttp: THttpClient;
  LResponseStream: TMemoryStream;
  LBoundary: string;
begin
  if AData = nil then
    Exit;
  LHttp := THttpClient.Create(nil);
  LResponseStream := TMemoryStream.Create;
  Result := THttpMultiPartFormData.Create;
  try
    LHttp.CustomHeaders['Boundary'] := AData.Boundary;
    LBoundary := LHttp.Post(url + '/formdata/downloadfile', AData.Stream,
      LResponseStream).HeaderValue['Boundary'];
    Result.InitWithBoundary(LBoundary);
    LResponseStream.Position := 0;
    Result.Decode(LResponseStream);
  finally
    LHttp.Free;
    LResponseStream.Free;
  end;
end;

class function TRpc.UploadFile(const AData: TMultipartFormData): Boolean;
var
  LHttp: THttpClient;
  LResponseStream: TMemoryStream;
  LPart: THttpMultiPartFormData;
  LBoundary: string;
begin
  if AData = nil then
    Exit;
  LHttp := THttpClient.Create(nil);
  LResponseStream := TMemoryStream.Create;
  LPart := THttpMultiPartFormData.Create;
  try
    LHttp.CustomHeaders['Boundary'] := AData.Boundary;
    LBoundary := LHttp.Post(url + '/formdata/uploadfile', AData.Stream,
      LResponseStream).HeaderValue['Boundary'];
    LPart.InitWithBoundary(LBoundary);
    LResponseStream.Position := 0;
    LPart.Decode(LResponseStream);
    Result := LPart.Fields['success'].AsString = 'true';
  finally
    LHttp.Free;
    LResponseStream.Free;
    LPart.Free;
  end;
end;

procedure ReadConf;
var
  LIni: TIniFile;
begin
  LIni := TIniFile.Create(ExtractFilePath(ParamStr(0)) + 'client.ini');
  url := LIni.ReadString('config', 'url', '');
  LIni.Free;
end;

initialization

ReadConf;

end.