TMultiPartFormData

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.