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

推荐订阅源

钛媒体:引领未来商业与生活新知
钛媒体:引领未来商业与生活新知
博客园_首页
Vercel News
Vercel News
Last Week in AI
Last Week in AI
罗磊的独立博客
Cyber Security Advisories - MS-ISAC
Cyber Security Advisories - MS-ISAC
IT之家
IT之家
美团技术团队
U
Unit 42
Google DeepMind News
Google DeepMind News
P
Proofpoint News Feed
J
Java Code Geeks
V
V2EX
量子位
腾讯CDC
S
SegmentFault 最新的问题
The GitHub Blog
The GitHub Blog
G
Google Developers Blog
D
DataBreaches.Net
雷峰网
雷峰网
让小产品的独立变现更简单 - ezindie.com
让小产品的独立变现更简单 - ezindie.com
博客园 - 聂微东
L
LangChain Blog
C
Check Point Blog

博客园 - 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.