IdMultipartFormData.pas 26 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854
  1. {
  2. $Project$
  3. $Workfile$
  4. $Revision$
  5. $DateUTC$
  6. $Id$
  7. This file is part of the Indy (Internet Direct) project, and is offered
  8. under the dual-licensing agreement described on the Indy website.
  9. (http://www.indyproject.org/)
  10. Copyright:
  11. (c) 1993-2005, Chad Z. Hower and the Indy Pit Crew. All rights reserved.
  12. }
  13. {
  14. $Log$
  15. Prior revision history:
  16. Rev 1.17 2/8/05 6:07:16 PM RLebeau
  17. Removed AddToInternalBuffer() method, using new AppendString() function
  18. from IdGlobal instead
  19. Rev 1.16 10/26/2004 10:29:30 PM JPMugaas
  20. Updated refs.
  21. Rev 1.15 7/16/04 12:02:16 PM RLebeau
  22. Reverted FileName fields to not strip off folder paths anymore.
  23. Rev 1.14 7/5/04 1:19:06 PM RLebeau
  24. Updated IdRead() to check the calculated byte count before copying data
  25. into the caller's buffer.
  26. Rev 1.13 5/31/04 9:28:58 PM RLebeau
  27. Updated FileName fields to strip off folder paths.
  28. Added "Content-Transfer-Encoding" header to file fields
  29. Updated "Content-Type" headers to be the appropriate media types when
  30. applicable
  31. Rev 1.12 5/30/04 7:39:02 PM RLebeau
  32. Moved FormatField() method from TIdMultiPartFormDataStream to
  33. TIdFormDataField instead
  34. Misc. tweaks and bug fixes
  35. Rev 1.11 2004.05.20 11:37:02 AM czhower
  36. IdStreamVCL
  37. Rev 1.10 3/1/04 8:57:34 PM RLebeau
  38. Format() fixes for TIdMultiPartFormDataStream.FormatField() and
  39. TIdFormDataField.GetFieldSize().
  40. Rev 1.9 2004.02.03 5:44:08 PM czhower
  41. Name changes
  42. Rev 1.8 2004.02.03 2:12:16 PM czhower
  43. $I path change
  44. Rev 1.7 25/01/2004 21:56:42 CCostelloe
  45. Updated IdSeek to use new IdFromBeginning
  46. Rev 1.6 24/01/2004 19:26:56 CCostelloe
  47. Cleaned up warnings
  48. Rev 1.5 22/11/2003 12:05:26 AM GGrieve
  49. Get working on both win32 and DotNet after other DotNet changes
  50. Rev 1.4 11/10/2003 8:03:54 PM BGooijen
  51. Did all todo's ( TStream to TIdStream mainly )
  52. Rev 1.3 2003.10.24 10:43:12 AM czhower
  53. TIdSTream to dos
  54. Rev 1.2 10/17/2003 12:49:52 AM DSiders
  55. Added localization comments.
  56. Added resource string for unsupported operation exception.
  57. Rev 1.1 10/7/2003 10:07:06 PM GGrieve
  58. Get HTTP compiling for DotNet
  59. Rev 1.0 11/13/2002 07:57:42 AM JPMugaas
  60. Initial version control checkin.
  61. 2001-Nov-23
  62. changed spelling error from XxxDataFiled to XxxDataField
  63. 2001-Nov Doychin Bondzhev
  64. Now it descends from TStream and does not do buffering.
  65. Changes in the way the form parts are added to the stream.
  66. }
  67. unit IdMultipartFormData;
  68. {
  69. Implementation of the Multipart Form data
  70. Based on Internet standards outlined in:
  71. RFC 1867 - Form-based File Upload in HTML
  72. RFC 2388 - Returning Values from Forms: multipart/form-data
  73. Author: Shiv Kumar
  74. }
  75. interface
  76. {$I IdCompilerDefines.inc}
  77. uses
  78. Classes,
  79. IdGlobal,
  80. IdException,
  81. IdCharsets,
  82. IdCoderHeader,
  83. IdResourceStringsProtocols;
  84. const
  85. sContentTypeFormData = 'multipart/form-data; boundary='; {do not localize}
  86. sContentTypeOctetStream = 'application/octet-stream'; {do not localize}
  87. sContentTypeTextPlain = 'text/plain'; {do not localize}
  88. CRLF = #13#10;
  89. sContentDispositionPlaceHolder = 'Content-Disposition: form-data; name="%s"'; {do not localize}
  90. sFileNamePlaceHolder = '; filename="%s"'; {do not localize}
  91. sContentTypePlaceHolder = 'Content-Type: %s'; {do not localize}
  92. sCharsetPlaceHolder = '; charset="%s"'; {do not localize}
  93. sContentTransferPlaceHolder = 'Content-Transfer-Encoding: %s'; {do not localize}
  94. sContentTransferQuotedPrintable = 'quoted-printable'; {do not localize}
  95. sContentTransferBinary = 'binary'; {do not localize}
  96. type
  97. TIdMultiPartFormDataStream = class;
  98. TIdFormDataField = class(TCollectionItem)
  99. protected
  100. FFileName: string;
  101. FCharset: string;
  102. FContentType: string;
  103. FContentTransfer: string;
  104. FFieldName: string;
  105. FFieldStream: TStream;
  106. FFieldValue: String;
  107. FCanFreeFieldStream: Boolean;
  108. FHeaderCharSet: string;
  109. FHeaderEncoding: Char;
  110. function FormatHeader: string;
  111. function PrepareDataStream(var VCanFree: Boolean): TStream;
  112. function GetFieldSize: Int64;
  113. function GetFieldStream: TStream;
  114. function GetFieldValue: string;
  115. procedure SetCharset(const Value: string);
  116. procedure SetContentType(const Value: string);
  117. procedure SetContentTransfer(const Value: string);
  118. procedure SetFieldName(const Value: string);
  119. procedure SetFieldStream(const Value: TStream);
  120. procedure SetFieldValue(const Value: string);
  121. procedure SetFileName(const Value: string);
  122. procedure SetHeaderCharSet(const Value: string);
  123. procedure SetHeaderEncoding(const Value: Char);
  124. public
  125. constructor Create(Collection: TCollection); override;
  126. destructor Destroy; override;
  127. // procedure Assign(Source: TPersistent); override;
  128. property ContentTransfer: string read FContentTransfer write SetContentTransfer;
  129. property ContentType: string read FContentType write SetContentType;
  130. property Charset: string read FCharset write SetCharset;
  131. property FieldName: string read FFieldName write SetFieldName;
  132. property FieldStream: TStream read GetFieldStream write SetFieldStream;
  133. property FileName: string read FFileName write SetFileName;
  134. property FieldValue: string read GetFieldValue write SetFieldValue;
  135. property FieldSize: Int64 read GetFieldSize;
  136. property HeaderCharSet: string read FHeaderCharSet write SetHeaderCharSet;
  137. property HeaderEncoding: Char read FHeaderEncoding write SetHeaderEncoding;
  138. end;
  139. TIdFormDataFields = class(TCollection)
  140. protected
  141. FParentStream: TIdMultiPartFormDataStream;
  142. function GetFormDataField(AIndex: Integer): TIdFormDataField;
  143. public
  144. constructor Create(AMPStream: TIdMultiPartFormDataStream);
  145. function Add: TIdFormDataField;
  146. property MultipartFormDataStream: TIdMultiPartFormDataStream read FParentStream;
  147. property Items[AIndex: Integer]: TIdFormDataField read GetFormDataField;
  148. end;
  149. TIdMultiPartFormDataStream = class(TStream)
  150. protected
  151. FInputStream: TStream;
  152. FFreeInputStream: Boolean;
  153. FBoundary: string;
  154. FRequestContentType: string;
  155. FCurrentItem: integer;
  156. FInitialized: Boolean;
  157. FInternalBuffer: TIdBytes;
  158. FPosition: Int64;
  159. FSize: Int64;
  160. FFields: TIdFormDataFields;
  161. function GenerateUniqueBoundary: string;
  162. procedure CalculateSize;
  163. procedure SetSize(const NewSize: Int64); override;
  164. public
  165. constructor Create;
  166. destructor Destroy; override;
  167. function AddFormField(const AFieldName, AFieldValue: string; const ACharset: string = ''; const AContentType: string = ''; const AFileName: string = ''): TIdFormDataField; overload;
  168. function AddFormField(const AFieldName, AContentType, ACharset: string; AFieldValue: TStream; const AFileName: string = ''): TIdFormDataField; overload;
  169. function AddFile(const AFieldName, AFileName: String; const AContentType: string = ''): TIdFormDataField;
  170. procedure Clear;
  171. function Read(var Buffer; Count: Longint): Longint; override;
  172. function Write(const Buffer; Count: Longint): Longint; override;
  173. function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; override;
  174. property Boundary: string read FBoundary;
  175. property RequestContentType: string read FRequestContentType;
  176. end;
  177. EIdInvalidObjectType = class(EIdException);
  178. EIdUnsupportedOperation = class(EIdException);
  179. EIdUnsupportedTransfer = class(EIdException);
  180. EIdUnsupportedEncoding = class(EIdException);
  181. implementation
  182. uses
  183. SysUtils,
  184. IdCoderQuotedPrintable,
  185. IdCoderMIME,
  186. IdGlobalProtocols;
  187. const
  188. cAllowedContentTransfers: array[0..4] of String = (
  189. '7bit', '8bit', 'binary', 'quoted-printable', 'base64' {do not localize}
  190. );
  191. cAllowedHeaderEncodings: array[0..2] of String = (
  192. 'Q', 'B', '8' {do not localize}
  193. );
  194. { TIdMultiPartFormDataStream }
  195. constructor TIdMultiPartFormDataStream.Create;
  196. begin
  197. inherited Create;
  198. FSize := 0;
  199. FInitialized := False;
  200. FBoundary := GenerateUniqueBoundary;
  201. FRequestContentType := sContentTypeFormData + FBoundary;
  202. FFields := TIdFormDataFields.Create(Self);
  203. end;
  204. destructor TIdMultiPartFormDataStream.Destroy;
  205. begin
  206. FFields.Free;
  207. inherited Destroy;
  208. end;
  209. function TIdMultiPartFormDataStream.AddFile(const AFieldName, AFileName: String;
  210. const AContentType: string = ''): TIdFormDataField;
  211. var
  212. LStream: TIdReadFileExclusiveStream;
  213. LItem: TIdFormDataField;
  214. begin
  215. LStream := TIdReadFileExclusiveStream.Create(AFileName);
  216. try
  217. LItem := FFields.Add;
  218. except
  219. LStream.Free;
  220. raise;
  221. end;
  222. LItem.FFieldName := AFieldName;
  223. LItem.FFileName := ExtractFileName(AFileName);
  224. LItem.FFieldStream := LStream;
  225. LItem.FCanFreeFieldStream := True;
  226. if AContentType <> '' then begin
  227. LItem.ContentType := AContentType;
  228. end else begin
  229. LItem.FContentType := GetMIMETypeFromFile(AFileName);
  230. end;
  231. LItem.FContentTransfer := sContentTransferBinary;
  232. Result := LItem;
  233. end;
  234. function TIdMultiPartFormDataStream.AddFormField(const AFieldName, AFieldValue: string;
  235. const ACharset: string = ''; const AContentType: string = ''; const AFileName: string = ''): TIdFormDataField;
  236. var
  237. LItem: TIdFormDataField;
  238. begin
  239. LItem := FFields.Add;
  240. LItem.FFieldName := AFieldName;
  241. LItem.FFileName := ExtractFileName(AFileName);
  242. LItem.FFieldValue := AFieldValue;
  243. if AContentType <> '' then begin
  244. LItem.ContentType := AContentType;
  245. end else begin
  246. LItem.FContentType := sContentTypeTextPlain;
  247. end;
  248. if ACharset <> '' then begin
  249. LItem.FCharset := ACharset;
  250. end;
  251. LItem.FContentTransfer := sContentTransferQuotedPrintable;
  252. Result := LItem;
  253. end;
  254. function TIdMultiPartFormDataStream.AddFormField(const AFieldName, AContentType, ACharset: string;
  255. AFieldValue: TStream; const AFileName: string = ''): TIdFormDataField;
  256. var
  257. LItem: TIdFormDataField;
  258. begin
  259. if not Assigned(AFieldValue) then begin
  260. raise EIdInvalidObjectType.Create(RSMFDInvalidObjectType);
  261. end;
  262. LItem := FFields.Add;
  263. LItem.FFieldName := AFieldName;
  264. LItem.FFileName := ExtractFileName(AFileName);
  265. LItem.FFieldStream := AFieldValue;
  266. if AContentType <> '' then begin
  267. LItem.ContentType := AContentType;
  268. end else begin
  269. LItem.FContentType := GetMIMETypeFromFile(AFileName);
  270. end;
  271. if ACharset <> '' then begin
  272. LItem.FCharSet := ACharset;
  273. end;
  274. LItem.FContentTransfer := sContentTransferBinary;
  275. Result := LItem;
  276. end;
  277. procedure TIdMultiPartFormDataStream.Clear;
  278. begin
  279. FInitialized := False;
  280. FFields.Clear;
  281. if FFreeInputStream then begin
  282. FInputStream.Free;
  283. end;
  284. FInputStream := nil;
  285. FFreeInputStream := False;
  286. FCurrentItem := 0;
  287. FPosition := 0;
  288. FSize := 0;
  289. SetLength(FInternalBuffer, 0);
  290. end;
  291. function TIdMultiPartFormDataStream.GenerateUniqueBoundary: string;
  292. begin
  293. // TODO: add a way for a user-defined prefix to be placed in between
  294. // the dashes and the random data, such as 'WebKitFormBoundary'...
  295. Result := '--------' + FormatDateTime('mmddyyhhnnsszzz', Now); {do not localize}
  296. end;
  297. procedure TIdMultiPartFormDataStream.CalculateSize;
  298. var
  299. I: Integer;
  300. begin
  301. FSize := 0;
  302. if FFields.Count > 0 then begin
  303. for I := 0 to FFields.Count-1 do begin
  304. FSize := FSize + FFields.Items[I].FieldSize;
  305. end;
  306. FSize := FSize + 2{'--'} + Length(Boundary) + 4{'--'+CRLF};
  307. end;
  308. end;
  309. // RLebeau - Read() should wrap multiple files of the same field name
  310. // using a single "multipart/mixed" MIME part, as recommended by RFC 1867
  311. function TIdMultiPartFormDataStream.Read(var Buffer; Count: Longint): Longint;
  312. var
  313. LTotalRead, LCount, LBufferCount, LRemaining : Integer;
  314. LItem: TIdFormDataField;
  315. LEncoding: IIdTextEncoding;
  316. begin
  317. if not FInitialized then begin
  318. FInitialized := True;
  319. FCurrentItem := 0;
  320. SetLength(FInternalBuffer, 0);
  321. end;
  322. LTotalRead := 0;
  323. LBufferCount := 0;
  324. while (LTotalRead < Count) and ((FInternalBuffer <> nil) or Assigned(FInputStream) or (FCurrentItem < FFields.Count)) do
  325. begin
  326. if (FInternalBuffer = nil) and (not Assigned(FInputStream)) then
  327. begin
  328. LItem := FFields.Items[FCurrentItem];
  329. EnsureEncoding(LEncoding, enc8Bit);
  330. AppendString(FInternalBuffer, LItem.FormatHeader, -1, LEncoding);
  331. FInputStream := LItem.PrepareDataStream(FFreeInputStream);
  332. if not Assigned(FInputStream) then begin
  333. AppendString(FInternalBuffer, CRLF);
  334. Inc(FCurrentItem);
  335. end;
  336. end;
  337. if FInternalBuffer <> nil then begin
  338. LCount := IndyMin(Count - LBufferCount, Length(FInternalBuffer));
  339. if LCount > 0 then begin
  340. LRemaining := Length(FInternalBuffer) - LCount;
  341. Move(FInternalBuffer[0], Pointer(PtrUInt(@Buffer) + LBufferCount)^, LCount);
  342. if LRemaining > 0 then begin
  343. CopyTIdBytes(FInternalBuffer, LCount, FInternalBuffer, 0, LRemaining);
  344. end;
  345. SetLength(FInternalBuffer, LRemaining);
  346. LBufferCount := LBufferCount + LCount;
  347. FPosition := FPosition + LCount;
  348. LTotalRead := LTotalRead + LCount;
  349. end;
  350. end;
  351. if (LTotalRead < Count) and (FInternalBuffer = nil) and Assigned(FInputStream) then begin
  352. LCount := FInputStream.Read(Pointer(PtrUInt(@Buffer)+(Count-LTotalRead))^, LBufferCount);
  353. if LCount > 0 then begin
  354. LBufferCount := LBufferCount + LCount;
  355. LTotalRead := LTotalRead + LCount;
  356. FPosition := FPosition + LCount;
  357. end
  358. else begin
  359. SetLength(FInternalBuffer, 0);
  360. if FFreeInputStream then begin
  361. FInputStream.Free;
  362. end else begin
  363. FInputStream.Position := 0;
  364. AppendString(FInternalBuffer, CRLF);
  365. end;
  366. FInputStream := nil;
  367. FFreeInputStream := False;
  368. Inc(FCurrentItem);
  369. end;
  370. end;
  371. if (FInternalBuffer = nil) and (not Assigned(FInputStream)) and (FCurrentItem = FFields.Count) then begin
  372. AppendString(FInternalBuffer, '--' + Boundary + '--' + CRLF); {do not localize}
  373. Inc(FCurrentItem);
  374. end;
  375. end;
  376. Result := LTotalRead;
  377. end;
  378. function TIdMultiPartFormDataStream.Seek(const Offset: Int64; Origin: TSeekOrigin): Int64;
  379. begin
  380. Result := 0;
  381. case Origin of
  382. soBeginning: begin
  383. if (Offset = 0) then begin
  384. FInitialized := False;
  385. FPosition := 0;
  386. Result := 0;
  387. end else begin
  388. Result := FPosition;
  389. end;
  390. end;
  391. soCurrent: begin
  392. Result := FPosition;
  393. end;
  394. soEnd: begin
  395. if (Offset = 0) then begin
  396. CalculateSize;
  397. Result := FSize;
  398. end else begin
  399. Result := FPosition;
  400. end;
  401. end;
  402. end;
  403. end;
  404. function TIdMultiPartFormDataStream.Write(const Buffer; Count: Longint): Longint;
  405. begin
  406. raise EIdUnsupportedOperation.Create(RSUnsupportedOperation);
  407. end;
  408. procedure TIdMultiPartFormDataStream.SetSize(const NewSize: Int64);
  409. begin
  410. raise EIdUnsupportedOperation.Create(RSUnsupportedOperation);
  411. end;
  412. { TIdFormDataFields }
  413. function TIdFormDataFields.Add: TIdFormDataField;
  414. begin
  415. Result := TIdFormDataField(inherited Add);
  416. end;
  417. constructor TIdFormDataFields.Create(AMPStream: TIdMultiPartFormDataStream);
  418. begin
  419. inherited Create(TIdFormDataField);
  420. FParentStream := AMPStream;
  421. end;
  422. function TIdFormDataFields.GetFormDataField(AIndex: Integer): TIdFormDataField;
  423. begin
  424. Result := TIdFormDataField(inherited Items[AIndex]);
  425. end;
  426. { TIdFormDataField }
  427. constructor TIdFormDataField.Create(Collection: TCollection);
  428. var
  429. LDefCharset: TIdCharSet;
  430. begin
  431. inherited Create(Collection);
  432. FFieldStream := nil;
  433. FFileName := '';
  434. FFieldName := '';
  435. FContentType := '';
  436. FCanFreeFieldStream := False;
  437. // it's not clear when FHeaderEncoding should be Q not B.
  438. // Comments welcome on atozedsoftware.indy.general
  439. LDefCharset := IdGetDefaultCharSet;
  440. case LDefCharset of
  441. idcs_ISO_8859_1:
  442. begin
  443. FHeaderEncoding := 'Q'; { quoted-printable } {Do not Localize}
  444. FHeaderCharSet := IdCharsetNames[LDefCharset];
  445. end;
  446. idcs_UNICODE_1_1:
  447. begin
  448. FHeaderEncoding := 'B'; { base64 } {Do not Localize}
  449. FHeaderCharSet := IdCharsetNames[idcs_UTF_8];
  450. end;
  451. else
  452. begin
  453. FHeaderEncoding := 'B'; { base64 } {Do not Localize}
  454. FHeaderCharSet := IdCharsetNames[LDefCharset];
  455. end;
  456. end;
  457. end;
  458. destructor TIdFormDataField.Destroy;
  459. begin
  460. if Assigned(FFieldStream) then begin
  461. if FCanFreeFieldStream then begin
  462. FFieldStream.Free;
  463. end;
  464. end;
  465. inherited Destroy;
  466. end;
  467. function TIdFormDataField.FormatHeader: string;
  468. var
  469. LBoundary: string;
  470. begin
  471. LBoundary := '--' + TIdFormDataFields(Collection).MultipartFormDataStream.Boundary; {do not localize}
  472. Result := IndyFormat('%s' + CRLF + sContentDispositionPlaceHolder,
  473. [LBoundary, EncodeHeader(FieldName, '', FHeaderEncoding, FHeaderCharSet)]); {do not localize}
  474. if FileName <> '' then begin
  475. Result := Result + IndyFormat(sFileNamePlaceHolder,
  476. [EncodeHeader(FileName, '', FHeaderEncoding, FHeaderCharSet)]); {do not localize}
  477. end;
  478. Result := Result + CRLF;
  479. if ContentType <> '' then begin
  480. Result := Result + IndyFormat(sContentTypePlaceHolder, [ContentType]); {do not localize}
  481. if CharSet <> '' then begin
  482. Result := Result + IndyFormat(sCharsetPlaceHolder, [Charset]); {do not localize}
  483. end;
  484. Result := Result + CRLF;
  485. end;
  486. if FContentTransfer <> '' then begin
  487. Result := Result + IndyFormat(sContentTransferPlaceHolder + CRLF, [FContentTransfer]);
  488. end;
  489. Result := Result + CRLF;
  490. end;
  491. function TIdFormDataField.GetFieldSize: Int64;
  492. var
  493. LStream: TStream;
  494. LOldPos: Int64;
  495. I: Integer;
  496. begin
  497. Result := Length(FormatHeader);
  498. if Assigned(FFieldStream) then begin
  499. I := PosInStrArray(ContentTransfer, cAllowedContentTransfers, False);
  500. if I <= 2 then begin
  501. // need to include an explicit CRLF at the end of the data
  502. Result := Result + FFieldStream.Size + 2{CRLF};
  503. end else
  504. begin
  505. LStream := TIdCalculateSizeStream.Create;
  506. try
  507. LOldPos := FFieldStream.Position;
  508. try
  509. if I = 3 then begin
  510. TIdEncoderQuotedPrintable.EncodeStream(FFieldStream, LStream);
  511. // the encoded text always includes a CRLF at the end...
  512. Result := Result + LStream.Size {+2};
  513. end else begin
  514. TIdEncoderMime.EncodeStream(FFieldStream, LStream);
  515. // the encoded text does not include a CRLF at the end...
  516. Result := Result + LStream.Size + 2;
  517. end;
  518. finally
  519. FFieldStream.Position := LOldPos;
  520. end;
  521. finally
  522. LStream.Free;
  523. end;
  524. end;
  525. end
  526. else if FFieldValue <> '' then begin
  527. I := PosInStrArray(FContentTransfer, cAllowedContentTransfers, False);
  528. if I <= 0 then begin
  529. // 7bit
  530. I := IndyTextEncoding_ASCII.GetByteCount(FFieldValue);
  531. // need to include an explicit CRLF at the end of the data
  532. Result := Result + I + 2{CRLF};
  533. end
  534. else if (I = 1) or (I = 2) then begin
  535. // 8bit/binary
  536. I := CharsetToEncoding(FCharset).GetByteCount(FFieldValue);
  537. // need to include an explicit CRLF at the end of the data
  538. Result := Result + I + 2{CRLF};
  539. end else
  540. begin
  541. LStream := TIdCalculateSizeStream.Create;
  542. try
  543. if I = 3 then begin
  544. // quoted-printable
  545. TIdEncoderQuotedPrintable.EncodeString(FFieldValue, LStream, CharsetToEncoding(FCharset));
  546. // the encoded text always includes a CRLF at the end...
  547. Result := Result + LStream.Size {+2};
  548. end else begin
  549. // base64
  550. TIdEncoderMIME.EncodeString(FFieldValue, LStream, CharsetToEncoding(FCharset));
  551. // the encoded text does not include a CRLF at the end...
  552. Result := Result + LStream.Size + 2;
  553. end;
  554. finally
  555. LStream.Free;
  556. end;
  557. end;
  558. end else begin
  559. // need to include an explicit CRLF at the end of blank text
  560. Result := Result + 2{CRLF};
  561. end;
  562. end;
  563. function TIdFormDataField.PrepareDataStream(var VCanFree: Boolean): TStream;
  564. var
  565. I: Integer;
  566. begin
  567. Result := nil;
  568. VCanFree := False;
  569. if Assigned(FFieldStream) then begin
  570. FFieldStream.Position := 0;
  571. I := PosInStrArray(FContentTransfer, cAllowedContentTransfers, False);
  572. if I <= 2 then begin
  573. Result := FFieldStream;
  574. end else begin
  575. Result := TMemoryStream.Create;
  576. try
  577. if I = 3 then begin
  578. TIdEncoderQuotedPrintable.EncodeStream(FFieldStream, Result);
  579. // the encoded text always includes a CRLF at the end...
  580. end else begin
  581. TIdEncoderMime.EncodeStream(FFieldStream, Result);
  582. // the encoded text does not include a CRLF at the end...
  583. WriteStringToStream(Result, CRLF);
  584. end;
  585. Result.Position := 0;
  586. except
  587. Result.Free;
  588. raise;
  589. end;
  590. VCanFree := True;
  591. end;
  592. end
  593. else if FFieldValue <> '' then begin
  594. Result := TMemoryStream.Create;
  595. try
  596. I := PosInStrArray(FContentTransfer, cAllowedContentTransfers, False);
  597. if I <= 0 then begin
  598. // 7bit
  599. WriteStringToStream(Result, FFieldValue, IndyTextEncoding_ASCII);
  600. // need to include an explicit CRLF at the end of the data
  601. WriteStringToStream(Result, CRLF);
  602. end
  603. else if (I = 1) or (I = 2) then begin
  604. // 8bit/binary
  605. WriteStringToStream(Result, FFieldValue, CharsetToEncoding(FCharset));
  606. // need to include an explicit CRLF at the end of the data
  607. WriteStringToStream(Result, CRLF);
  608. end else
  609. begin
  610. if I = 3 then begin
  611. // quoted-printable
  612. TIdEncoderQuotedPrintable.EncodeString(FFieldValue, Result, CharsetToEncoding(FCharset));
  613. // the encoded text always includes a CRLF at the end...
  614. end else begin
  615. // base64
  616. TIdEncoderMIME.EncodeString(FFieldValue, Result, CharsetToEncoding(FCharset));
  617. // the encoded text does not include a CRLF at the end...
  618. WriteStringToStream(Result, CRLF);
  619. end;
  620. end;
  621. except
  622. Result.Free;
  623. raise;
  624. end;
  625. Result.Position := 0;
  626. VCanFree := True;
  627. end;
  628. end;
  629. function TIdFormDataField.GetFieldStream: TStream;
  630. begin
  631. if not Assigned(FFieldStream) then begin
  632. raise EIdInvalidObjectType.Create(RSMFDInvalidObjectType);
  633. end;
  634. Result := FFieldStream;
  635. end;
  636. function TIdFormDataField.GetFieldValue: string;
  637. begin
  638. if Assigned(FFieldStream) then begin
  639. raise EIdInvalidObjectType.Create(RSMFDInvalidObjectType);
  640. end;
  641. Result := FFieldValue;
  642. end;
  643. procedure TIdFormDataField.SetCharset(const Value: string);
  644. begin
  645. FCharset := Value;
  646. end;
  647. procedure TIdFormDataField.SetContentTransfer(const Value: string);
  648. begin
  649. if Value <> '' then begin
  650. if PosInStrArray(Value, cAllowedContentTransfers, False) = -1 then begin
  651. raise EIdUnsupportedTransfer.Create(RSMFDInvalidTransfer);
  652. end;
  653. end;
  654. FContentTransfer := Value;
  655. end;
  656. procedure TIdFormDataField.SetContentType(const Value: string);
  657. var
  658. LContentType, LCharSet: string;
  659. begin
  660. if Value <> '' then begin
  661. LContentType := Value;
  662. end
  663. else if FFileName <> '' then begin
  664. LContentType := GetMIMETypeFromFile(FFileName);
  665. end
  666. else begin
  667. LContentType := sContentTypeOctetStream;
  668. end;
  669. FContentType := RemoveHeaderEntry(LContentType, 'charset', LCharSet, QuoteMIME); {do not localize}
  670. // RLebeau: per RFC 2045 Section 5.2:
  671. //
  672. // Default RFC 822 messages without a MIME Content-Type header are taken
  673. // by this protocol to be plain text in the US-ASCII character set,
  674. // which can be explicitly specified as:
  675. //
  676. // Content-type: text/plain; charset=us-ascii
  677. //
  678. // This default is assumed if no Content-Type header field is specified.
  679. // It is also recommend that this default be assumed when a
  680. // syntactically invalid Content-Type header field is encountered. In
  681. // the presence of a MIME-Version header field and the absence of any
  682. // Content-Type header field, a receiving User Agent can also assume
  683. // that plain US-ASCII text was the sender's intent. Plain US-ASCII
  684. // text may still be assumed in the absence of a MIME-Version or the
  685. // presence of an syntactically invalid Content-Type header field, but
  686. // the sender's intent might have been otherwise.
  687. if (LCharSet = '') and (FCharSet = '') and IsHeaderMediaType(FContentType, 'text') then begin {do not localize}
  688. LCharSet := 'us-ascii'; {do not localize}
  689. end;
  690. {RLebeau: override the current CharSet only if the header specifies a new value}
  691. if LCharSet <> '' then begin
  692. FCharSet := LCharSet;
  693. end;
  694. end;
  695. procedure TIdFormDataField.SetFieldName(const Value: string);
  696. begin
  697. FFieldName := Value;
  698. end;
  699. procedure TIdFormDataField.SetFieldStream(const Value: TStream);
  700. begin
  701. if not Assigned(Value) then begin
  702. raise EIdInvalidObjectType.Create(RSMFDInvalidObjectType);
  703. end;
  704. if Assigned(FFieldStream) and FCanFreeFieldStream then begin
  705. FFieldStream.Free;
  706. end;
  707. FFieldValue := '';
  708. FFieldStream := Value;
  709. FCanFreeFieldStream := False;
  710. end;
  711. procedure TIdFormDataField.SetFieldValue(const Value: string);
  712. begin
  713. if Assigned(FFieldStream) then begin
  714. if FCanFreeFieldStream then begin
  715. FFieldStream.Free;
  716. end;
  717. FFieldStream := nil;
  718. FCanFreeFieldStream := False;
  719. end;
  720. FFieldValue := Value;
  721. end;
  722. procedure TIdFormDataField.SetFileName(const Value: string);
  723. begin
  724. FFileName := ExtractFileName(Value);
  725. end;
  726. procedure TIdFormDataField.SetHeaderCharSet(const Value: string);
  727. begin
  728. FHeaderCharset := Value;
  729. end;
  730. procedure TIdFormDataField.SetHeaderEncoding(const Value: Char);
  731. begin
  732. if FHeaderEncoding <> Value then begin
  733. if PosInStrArray(Value, cAllowedHeaderEncodings, False) = -1 then begin
  734. raise EIdUnsupportedEncoding.Create(RSMFDInvalidEncoding);
  735. end;
  736. FHeaderEncoding := Value;
  737. end;
  738. end;
  739. end.