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

推荐订阅源

Y
Y Combinator Blog
Cyber Security Advisories - MS-ISAC
Cyber Security Advisories - MS-ISAC
博客园 - 司徒正美
Blog — PlanetScale
Blog — PlanetScale
博客园 - 聂微东
月光博客
月光博客
量子位
大猫的无限游戏
大猫的无限游戏
Stack Overflow Blog
Stack Overflow Blog
奇客Solidot–传递最新科技情报
奇客Solidot–传递最新科技情报
The Cloudflare Blog
P
Proofpoint News Feed
B
Blog RSS Feed
美团技术团队
腾讯CDC
C
Check Point Blog
Engineering at Meta
Engineering at Meta
F
Fortinet All Blogs
N
Netflix TechBlog - Medium
Recent Announcements
Recent Announcements
J
Java Code Geeks
S
SegmentFault 最新的问题
WordPress大学
WordPress大学
宝玉的分享
宝玉的分享

博客园 - delphi中间件

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 MCP服务器 RTTI对性能的影响 频繁地创建和销毁对象
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.