IdAttachmentFile.pas 4.1 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158
  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. }
  16. {
  17. Rev 1.4 28.09.2004 21:04:44 Andreas Hausladen
  18. Delphi 5 does not have a Owner property in TCollection
  19. Rev 1.3 24.08.2004 18:01:42 Andreas Hausladen
  20. Added AttachmentBlocked property to TIdAttachmentFile.
  21. Rev 1.2 2004.02.03 5:44:50 PM czhower
  22. Name changes
  23. Rev 1.1 5/9/2003 10:27:20 AM BGooijen
  24. Attachment is now opened in fmShareDenyWrite mode
  25. Rev 1.0 11/14/2002 02:12:42 PM JPMugaas
  26. }
  27. unit IdAttachmentFile;
  28. interface
  29. {$i IdCompilerDefines.inc}
  30. uses
  31. Classes,
  32. IdAttachment,
  33. IdMessageParts;
  34. type
  35. TIdAttachmentFile = class(TIdAttachment)
  36. protected
  37. FTempFileStream: TFileStream;
  38. FStoredPathName: String;
  39. FFileIsTempFile: Boolean;
  40. FAttachmentBlocked: Boolean;
  41. public
  42. constructor Create(Collection: TIdMessageParts; const AFileName: String = ''); reintroduce;
  43. destructor Destroy; override;
  44. function OpenLoadStream: TStream; override;
  45. procedure CloseLoadStream; override;
  46. function PrepareTempStream: TStream; override;
  47. procedure FinishTempStream; override;
  48. procedure SaveToFile(const FileName: String); override;
  49. property FileIsTempFile: Boolean read FFileIsTempFile write FFileIsTempFile;
  50. property StoredPathName: String read FStoredPathName write FStoredPathName;
  51. property AttachmentBlocked: Boolean read FAttachmentBlocked;
  52. end;
  53. implementation
  54. uses
  55. {$IF DEFINED(USE_VCL_POSIX)}
  56. Posix.Unistd,
  57. {$ELSEIF DEFINED(KYLIXCOMPAT)}
  58. Libc,
  59. {$IFEND}
  60. //facilitate inlining only.
  61. {$IF DEFINED(USE_INLINE) AND DEFINED(WINDOWS)}
  62. Windows,
  63. {$IFEND}
  64. IdGlobal, IdGlobalProtocols, IdException, IdResourceStringsProtocols,
  65. IdMessage, SysUtils;
  66. { TIdAttachmentFile }
  67. procedure TIdAttachmentFile.CloseLoadStream;
  68. begin
  69. FreeAndNil(FTempFileStream);
  70. end;
  71. constructor TIdAttachmentFile.Create(Collection: TIdMessageParts; const AFileName: String = '');
  72. begin
  73. inherited Create(Collection);
  74. FFilename := ExtractFileName(AFilename);
  75. FTempFileStream := nil;
  76. FStoredPathName := AFileName;
  77. FFileIsTempFile := False;
  78. if FFilename <> '' then begin
  79. ContentType := GetMimeTypeFromFile(FFilename);
  80. end;
  81. end;
  82. destructor TIdAttachmentFile.Destroy;
  83. begin
  84. if FileIsTempFile then begin
  85. SysUtils.DeleteFile(StoredPathName);
  86. end;
  87. inherited Destroy;
  88. end;
  89. procedure TIdAttachmentFile.FinishTempStream;
  90. var
  91. LMsg: TIdMessage;
  92. begin
  93. FreeAndNil(FTempFileStream);
  94. // An on access virus scanner meight delete/block the temporary file.
  95. FAttachmentBlocked := not FileExists(StoredPathName);
  96. if FAttachmentBlocked then begin
  97. LMsg := TIdMessage(OwnerMessage);
  98. if Assigned(LMsg) and (not LMsg.ExceptionOnBlockedAttachments) then begin
  99. Exit;
  100. end;
  101. raise EIdMessageCannotLoad.CreateFmt(RSTIdMessageErrorAttachmentBlocked, [StoredPathName]);
  102. end;
  103. end;
  104. function TIdAttachmentFile.OpenLoadStream: TStream;
  105. begin
  106. FTempFileStream := TIdReadFileExclusiveStream.Create(StoredPathName);
  107. Result := FTempFileStream;
  108. end;
  109. function TIdAttachmentFile.PrepareTempStream: TStream;
  110. var
  111. LMsg: TIdMessage;
  112. begin
  113. LMsg := TIdMessage(OwnerMessage);
  114. if Assigned(LMsg) then begin
  115. FStoredPathName := MakeTempFilename(LMsg.AttachmentTempDirectory);
  116. end else begin
  117. FStoredPathName := MakeTempFilename;
  118. end;
  119. FTempFileStream := TIdFileCreateStream.Create(FStoredPathName);
  120. FFileIsTempFile := True;
  121. Result := FTempFileStream;
  122. end;
  123. procedure TIdAttachmentFile.SaveToFile(const FileName: String);
  124. begin
  125. if not CopyFileTo(StoredPathname, FileName) then begin
  126. raise EIdException.Create(RSTIdMessageErrorSavingAttachment); // TODO: create a new Exception class for this
  127. end;
  128. end;
  129. initialization
  130. // MtW: Shouldn't be neccessary??
  131. // RegisterClass(TIdAttachmentFile);
  132. end.