mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-09-04 19:10:18 +02:00
* add also new MIME stream stuff (forgotten commit of 0.5.2 -> fppkg)
git-svn-id: trunk@7773 -
This commit is contained in:
parent
20a35f9701
commit
0d80b16e1a
2
.gitattributes
vendored
2
.gitattributes
vendored
@ -8516,7 +8516,9 @@ utils/fppkg/lnet/lfastcgi.pp svneol=native#text/plain
|
||||
utils/fppkg/lnet/lftp.pp svneol=native#text/plain
|
||||
utils/fppkg/lnet/lhttp.pp svneol=native#text/plain
|
||||
utils/fppkg/lnet/lhttputil.pp svneol=native#text/plain
|
||||
utils/fppkg/lnet/lmimestreams.pp svneol=native#text/plain
|
||||
utils/fppkg/lnet/lmimetypes.pp svneol=native#text/plain
|
||||
utils/fppkg/lnet/lmimewrapper.pp svneol=native#text/plain
|
||||
utils/fppkg/lnet/lnet.pp svneol=native#text/plain
|
||||
utils/fppkg/lnet/lprocess.pp svneol=native#text/plain
|
||||
utils/fppkg/lnet/lsmtp.pp svneol=native#text/plain
|
||||
|
190
utils/fppkg/lnet/lmimestreams.pp
Normal file
190
utils/fppkg/lnet/lmimestreams.pp
Normal file
@ -0,0 +1,190 @@
|
||||
unit lMimeStreams;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes;
|
||||
|
||||
const
|
||||
CRLF = #13#10;
|
||||
|
||||
type
|
||||
TStreamNotificationEvent = procedure(const aSize: Integer) of object;
|
||||
|
||||
{ TMimeOutputStream }
|
||||
|
||||
TMimeOutputStream = class(TStream)
|
||||
protected
|
||||
FInputData: string;
|
||||
FNotificationEvent: TStreamNotificationEvent;
|
||||
function GetSize: Int64; override;
|
||||
procedure AddInputData(const s: string);
|
||||
public
|
||||
constructor Create(aNotificationEvent: TStreamNotificationEvent);
|
||||
function Read(var Buffer; Count: Longint): Longint; override;
|
||||
function Write(const Buffer; Count: Longint): Longint; override;
|
||||
function Seek(Offset: Longint; Origin: Word): Longint; overload; override;
|
||||
function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; overload; override;
|
||||
procedure Reset;
|
||||
end;
|
||||
|
||||
{ TBogusStream }
|
||||
|
||||
TBogusStream = class(TStream)
|
||||
protected
|
||||
FData: string;
|
||||
function GetSize: Int64; override;
|
||||
public
|
||||
function Read(var Buffer; Count: Longint): Longint; override;
|
||||
function Write(const Buffer; Count: Longint): Longint; override;
|
||||
function Seek(Offset: Longint; Origin: Word): Longint; overload; override;
|
||||
function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; overload; override;
|
||||
procedure Reset;
|
||||
end;
|
||||
|
||||
function EncodeMimeHeaderText(const s: string): string;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
Math;
|
||||
|
||||
type
|
||||
TByteArray = array of Byte;
|
||||
|
||||
function EncodeMimeHeaderText(const s: string): string;
|
||||
begin
|
||||
Result := s;
|
||||
end;
|
||||
|
||||
{ TMimeOutputStream }
|
||||
|
||||
function TMimeOutputStream.GetSize: Int64;
|
||||
begin
|
||||
Result := Length(FInputData);
|
||||
end;
|
||||
|
||||
procedure TMimeOutputStream.AddInputData(const s: string);
|
||||
|
||||
{ function RightPos(const What, Where: string): Integer;
|
||||
var
|
||||
i, j: Integer;
|
||||
begin
|
||||
Result := 0;
|
||||
|
||||
j := Length(What);
|
||||
for i := Length(Where) downto 1 do
|
||||
if Where[i] = What[j] then begin
|
||||
Dec(j);
|
||||
if j = 0 then Exit(i);
|
||||
end else
|
||||
j := Length(What);
|
||||
end;
|
||||
|
||||
var
|
||||
n: Integer;}
|
||||
begin
|
||||
{ n := RightPos(CRLF, s);
|
||||
if n > 0 then
|
||||
Inc(FLastCRLF, (Length(FInputData) - FLastCRLF) + n);}
|
||||
|
||||
FInputData := FInputData + s;
|
||||
|
||||
{ while Length(FInputData) - FLastCRLF >= 74 do begin
|
||||
Insert(CRLF, FInputData, FLastCRLF + 75);
|
||||
Inc(FLastCRLF, 77);
|
||||
end;}
|
||||
end;
|
||||
|
||||
constructor TMimeOutputStream.Create(aNotificationEvent: TStreamNotificationEvent);
|
||||
begin
|
||||
inherited Create;
|
||||
|
||||
FNotificationEvent := aNotificationEvent;
|
||||
end;
|
||||
|
||||
function TMimeOutputStream.Read(var Buffer; Count: Longint): Longint;
|
||||
begin
|
||||
if Assigned(FNotificationEvent) then
|
||||
FNotificationEvent(Count);
|
||||
|
||||
Result := Min(Count, Length(FInputData));
|
||||
|
||||
if Result <= 0 then
|
||||
Exit(0);
|
||||
|
||||
Move(FInputData[1], Buffer, Result);
|
||||
Delete(FInputData, 1, Result);
|
||||
end;
|
||||
|
||||
function TMimeOutputStream.Write(const Buffer; Count: Longint): Longint;
|
||||
var
|
||||
s: string;
|
||||
begin
|
||||
SetLength(s, Count);
|
||||
Move(Buffer, s[1], Count);
|
||||
AddInputData(s);
|
||||
Result := Count;
|
||||
end;
|
||||
|
||||
function TMimeOutputStream.Seek(Offset: Longint; Origin: Word): Longint;
|
||||
begin
|
||||
Result := Offset;
|
||||
end;
|
||||
|
||||
function TMimeOutputStream.Seek(const Offset: Int64; Origin: TSeekOrigin
|
||||
): Int64;
|
||||
begin
|
||||
Result := Offset;
|
||||
end;
|
||||
|
||||
procedure TMimeOutputStream.Reset;
|
||||
begin
|
||||
FInputData := '';
|
||||
end;
|
||||
|
||||
{ TBogusStream }
|
||||
|
||||
function TBogusStream.GetSize: Int64;
|
||||
begin
|
||||
Result := Length(FData);
|
||||
end;
|
||||
|
||||
function TBogusStream.Read(var Buffer; Count: Longint): Longint;
|
||||
begin
|
||||
Result := Min(Count, Length(FData));
|
||||
|
||||
Move(FData[1], Buffer, Result);
|
||||
Delete(FData, 1, Result);
|
||||
end;
|
||||
|
||||
function TBogusStream.Write(const Buffer; Count: Longint): Longint;
|
||||
var
|
||||
l: Integer;
|
||||
begin
|
||||
l := Length(FData);
|
||||
Result := Count;
|
||||
SetLength(FData, l + Count);
|
||||
Inc(l);
|
||||
Move(Buffer, FData[l], Count);
|
||||
end;
|
||||
|
||||
function TBogusStream.Seek(Offset: Longint; Origin: Word): Longint;
|
||||
begin
|
||||
Result := Offset;
|
||||
end;
|
||||
|
||||
function TBogusStream.Seek(const Offset: Int64; Origin: TSeekOrigin): Int64;
|
||||
begin
|
||||
Result := Offset;
|
||||
end;
|
||||
|
||||
procedure TBogusStream.Reset;
|
||||
begin
|
||||
FData := '';
|
||||
end;
|
||||
|
||||
end.
|
||||
|
828
utils/fppkg/lnet/lmimewrapper.pp
Normal file
828
utils/fppkg/lnet/lmimewrapper.pp
Normal file
@ -0,0 +1,828 @@
|
||||
unit lMimeWrapper;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
SysUtils, Classes, Contnrs, lMimeStreams;
|
||||
|
||||
const
|
||||
MIME_VERSION = 'MIME-version: 1.0' + CRLF;
|
||||
|
||||
type
|
||||
TMimeEncoding = (me8bit, meBase64);
|
||||
TMimeDisposition = (mdInline, mdAttachment);
|
||||
|
||||
{ TMimeSection }
|
||||
|
||||
TMimeSection = class
|
||||
protected
|
||||
FContentType: string;
|
||||
FEncoding: TMimeEncoding;
|
||||
FActivated: Boolean;
|
||||
FDescription: string;
|
||||
FDisposition: TMimeDisposition;
|
||||
FBuffer: string;
|
||||
FEncodingStream: TStream;
|
||||
FOutputStream: TStream;
|
||||
FLocalStream: TBogusStream;
|
||||
function RecalculateSize(const OriginalSize: Integer): Integer;
|
||||
function GetSize: Integer; virtual; abstract;
|
||||
procedure SetDescription(const AValue: string);
|
||||
procedure SetDisposition(const AValue: TMimeDisposition);
|
||||
procedure SetEncoding(const AValue: TMimeEncoding);
|
||||
procedure CreateEncodingStream; virtual;
|
||||
function GetHeader: string; virtual;
|
||||
function ReadBuffer(const aSize: Integer): string;
|
||||
procedure FillBuffer(const aSize: Integer); virtual; abstract;
|
||||
public
|
||||
constructor Create(aOutputStream: TStream);
|
||||
destructor Destroy; override;
|
||||
function Read(const aSize: Integer): Integer;
|
||||
procedure Reset; virtual;
|
||||
public
|
||||
property ContentType: string read FContentType write FContentType;
|
||||
property Encoding: TMimeEncoding read FEncoding write SetEncoding;
|
||||
property Disposition: TMimeDisposition read FDisposition write SetDisposition;
|
||||
property Description: string read FDescription write SetDescription;
|
||||
property Header: string read GetHeader;
|
||||
property Size: Integer read GetSize;
|
||||
end;
|
||||
|
||||
{ TMimeTextSection }
|
||||
|
||||
TMimeTextSection = class(TMimeSection)
|
||||
protected
|
||||
FOriginalData: string;
|
||||
FData: string;
|
||||
function GetSize: Integer; override;
|
||||
procedure SetData(const AValue: string);
|
||||
function GetCharset: string;
|
||||
procedure SetCharset(const AValue: string);
|
||||
procedure FillBuffer(const aSize: Integer); override;
|
||||
public
|
||||
constructor Create(aOutputStream: TStream; const aText: string);
|
||||
procedure Reset; override;
|
||||
public
|
||||
property Charset: string read GetCharset write SetCharset;
|
||||
property Text: string read FData write SetData;
|
||||
end;
|
||||
|
||||
{ TMimeStreamSection }
|
||||
|
||||
TMimeStreamSection = class(TMimeSection)
|
||||
protected
|
||||
FStream: TStream;
|
||||
FOwnsStreams: Boolean;
|
||||
FOriginalPosition: Int64;
|
||||
function GetSize: Integer; override;
|
||||
procedure SetStream(aValue: TStream);
|
||||
procedure FillBuffer(const aSize: Integer); override;
|
||||
public
|
||||
constructor Create(aOutputStream: TStream; aStream: TStream);
|
||||
destructor Destroy; override;
|
||||
procedure Reset; override;
|
||||
public
|
||||
property Stream: TStream read FStream write SetStream;
|
||||
property OwnsStreams: Boolean read FOwnsStreams write FOwnsStreams;
|
||||
end;
|
||||
|
||||
{ TMimeFileSection }
|
||||
|
||||
TMimeFileSection = class(TMimeStreamSection)
|
||||
protected
|
||||
FFileName: string;
|
||||
procedure SetFileName(const AValue: string);
|
||||
procedure SetContentType(const aFileName: string);
|
||||
function GetHeader: string; override;
|
||||
public
|
||||
constructor Create(aOutputStream: TStream; const aFileName: string);
|
||||
property FileName: string read FFileName write SetFileName;
|
||||
end;
|
||||
|
||||
{ TMimeStream }
|
||||
|
||||
TMimeStream = class(TStream)
|
||||
protected
|
||||
FSections: TFPObjectList;
|
||||
FOutputStream: TMimeOutputStream;
|
||||
FBoundary: string;
|
||||
FActiveSection: Integer;
|
||||
FCalledRead: Boolean;
|
||||
FCalledWrite: Boolean;
|
||||
function GetBoundarySize: Integer;
|
||||
function GetSize: Int64; override;
|
||||
function GetCount: Integer;
|
||||
function GetBoundary: string;
|
||||
function GetSections(i: Integer): TMimeSection;
|
||||
function GetMimeHeader: string;
|
||||
procedure SetSections(i: Integer; const AValue: TMimeSection);
|
||||
procedure ActivateFirstSection;
|
||||
procedure ActivateNextSection;
|
||||
procedure DoRead(const aSize: Integer);
|
||||
public
|
||||
constructor Create;
|
||||
destructor Destroy; override;
|
||||
function Seek(Offset: Longint; Origin: Word): Longint; overload; override;
|
||||
function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; overload; override;
|
||||
function Read(var Buffer; Count: Longint): Longint; override;
|
||||
function Write(const Buffer; Count: Longint): Longint; override;
|
||||
procedure AddTextSection(const aText: string; const aCharSet: string = 'UTF-8');
|
||||
procedure AddFileSection(const aFileName: string);
|
||||
procedure AddStreamSection(aStream: TStream; const FreeStream: Boolean = False);
|
||||
procedure Delete(const i: Integer);
|
||||
procedure Remove(aSection: TMimeSection);
|
||||
procedure Reset;
|
||||
public
|
||||
property Sections[i: Integer]: TMimeSection read GetSections write SetSections; default;
|
||||
property Count: Integer read GetCount;
|
||||
property Boundary: string read FBoundary;
|
||||
end;
|
||||
|
||||
{ EAlreadyActivatedException }
|
||||
|
||||
EAlreadyActivatedException = class(Exception)
|
||||
public
|
||||
constructor Create;
|
||||
end;
|
||||
|
||||
{ EAlreadyCalledReadException }
|
||||
|
||||
EAlreadyCalledReadException = class(Exception)
|
||||
public
|
||||
constructor Create;
|
||||
end;
|
||||
|
||||
{ EAlreadyCalledWriteException }
|
||||
|
||||
EAlreadyCalledWriteException = class(Exception)
|
||||
public
|
||||
constructor Create;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
Math, Base64;
|
||||
|
||||
function EncodingToStr(const Encoding: TMimeEncoding): string;
|
||||
begin
|
||||
Result := '';
|
||||
case Encoding of
|
||||
me8bit : Result := '8bit';
|
||||
meBase64 : Result := 'base64';
|
||||
end;
|
||||
end;
|
||||
|
||||
function DispositionToStr(const Disposition: TMimeDisposition): string;
|
||||
begin
|
||||
Result := '';
|
||||
case Disposition of
|
||||
mdInline : Result := 'inline';
|
||||
mdAttachment : Result := 'attachment';
|
||||
end;
|
||||
end;
|
||||
|
||||
{ TMimeSection }
|
||||
|
||||
function TMimeSection.RecalculateSize(const OriginalSize: Integer): Integer;
|
||||
begin
|
||||
Result := 0;
|
||||
|
||||
if OriginalSize = 0 then
|
||||
Exit;
|
||||
|
||||
case FEncoding of
|
||||
me8bit : Result := OriginalSize;
|
||||
meBase64 : if OriginalSize mod 3 = 0 then
|
||||
Result := (OriginalSize div 3) * 4 // this is simple, 4 bytes per 3 bytes
|
||||
else
|
||||
Result := ((OriginalSize + 3) div 3) * 4; // add "padding" trupplet
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TMimeSection.SetDescription(const AValue: string);
|
||||
begin
|
||||
if not FActivated then
|
||||
FDescription := AValue;
|
||||
end;
|
||||
|
||||
procedure TMimeSection.SetDisposition(const AValue: TMimeDisposition);
|
||||
begin
|
||||
if not FActivated then
|
||||
FDisposition := AValue;
|
||||
end;
|
||||
|
||||
procedure TMimeSection.SetEncoding(const AValue: TMimeEncoding);
|
||||
begin
|
||||
if not FActivated then begin
|
||||
FEncoding := aValue;
|
||||
if Assigned(FEncodingStream) then
|
||||
FEncodingStream.Free;
|
||||
|
||||
CreateEncodingStream;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TMimeSection.CreateEncodingStream;
|
||||
begin
|
||||
case FEncoding of
|
||||
me8bit : FEncodingStream := nil;
|
||||
meBase64 : FEncodingStream := TBase64EncodingStream.Create(FLocalStream);
|
||||
end;
|
||||
end;
|
||||
|
||||
function TMimeSection.GetHeader: string;
|
||||
begin
|
||||
Result := 'Content-Type: ' + FContentType + CRLF;
|
||||
Result := Result + 'Content-Transfer-Encoding: ' + EncodingToStr(FEncoding) + CRLF;
|
||||
Result := Result + 'Content-Disposition: ' + DispositionToStr(FDisposition) + CRLF;
|
||||
|
||||
if Length(FDescription) > 0 then
|
||||
Result := Result + 'Content-Description: ' + FDescription + CRLF;
|
||||
|
||||
Result := Result + CRLF;
|
||||
end;
|
||||
|
||||
function TMimeSection.ReadBuffer(const aSize: Integer): string;
|
||||
begin
|
||||
Result := '';
|
||||
|
||||
if aSize >= Length(FBuffer) then
|
||||
FillBuffer(aSize);
|
||||
|
||||
Result := Copy(FBuffer, 1, aSize);
|
||||
end;
|
||||
|
||||
constructor TMimeSection.Create(aOutputStream: TStream);
|
||||
begin
|
||||
FOutputStream := aOutputStream;
|
||||
FEncodingStream := nil;
|
||||
FLocalStream := TBogusStream.Create;
|
||||
end;
|
||||
|
||||
destructor TMimeSection.Destroy;
|
||||
begin
|
||||
if Assigned(FEncodingStream) then
|
||||
FEncodingStream.Free;
|
||||
|
||||
FLocalStream.Free;
|
||||
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
function TMimeSection.Read(const aSize: Integer): Integer;
|
||||
var
|
||||
s: string;
|
||||
begin
|
||||
Result := 0;
|
||||
|
||||
if aSize <= 0 then
|
||||
Exit;
|
||||
|
||||
if not FActivated then begin
|
||||
FActivated := True;
|
||||
FBuffer := GetHeader;
|
||||
end;
|
||||
|
||||
if Length(FBuffer) < aSize then
|
||||
FillBuffer(aSize);
|
||||
|
||||
s := ReadBuffer(aSize);
|
||||
if Length(s) >= aSize then begin
|
||||
Result := FOutputStream.Write(s[1], aSize);
|
||||
Delete(FBuffer, 1, Result);
|
||||
end else if Length(s) > 0 then begin
|
||||
Result := FOutputStream.Write(s[1], Length(s));
|
||||
Delete(FBuffer, 1, Result);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TMimeSection.Reset;
|
||||
begin
|
||||
FActivated := False;
|
||||
FBuffer := '';
|
||||
FLocalStream.Reset;
|
||||
SetEncoding(FEncoding);
|
||||
end;
|
||||
|
||||
{ TMimeTextSection }
|
||||
|
||||
procedure TMimeTextSection.SetCharset(const aValue: string);
|
||||
begin
|
||||
if not FActivated then begin
|
||||
if Length(aValue) > 0 then
|
||||
FContentType := 'text/plain; charset="' + aValue + '"'
|
||||
else
|
||||
FContentType := 'text/plain';
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TMimeTextSection.FillBuffer(const aSize: Integer);
|
||||
var
|
||||
s: string;
|
||||
n: Integer;
|
||||
begin
|
||||
s := Copy(FData, 1, aSize);
|
||||
|
||||
if Length(s) = 0 then
|
||||
Exit;
|
||||
|
||||
n := aSize;
|
||||
|
||||
if Assigned(FEncodingStream) then begin
|
||||
n := FEncodingStream.Write(s[1], Length(s));
|
||||
Delete(FData, 1, n);
|
||||
|
||||
if Length(FData) = 0 then begin
|
||||
FEncodingStream.Free; // to fill in the last bit
|
||||
CreateEncodingStream;
|
||||
FLocalStream.Write(CRLF[1], Length(CRLF));
|
||||
end;
|
||||
|
||||
SetLength(s, FLocalStream.Size);
|
||||
SetLength(s, FLocalStream.Read(s[1], Length(s)));
|
||||
end else begin
|
||||
Delete(FData, 1, n);
|
||||
if Length(FData) = 0 then
|
||||
s := s + CRLF;
|
||||
end;
|
||||
|
||||
FBuffer := FBuffer + s;
|
||||
end;
|
||||
|
||||
function TMimeTextSection.GetSize: Integer;
|
||||
begin
|
||||
if FActivated then
|
||||
Result := Length(FBuffer) + RecalculateSize(Length(FData))
|
||||
else
|
||||
Result := Length(FBuffer) + Length(GetHeader) + RecalculateSize(Length(FData));
|
||||
|
||||
if not FActivated
|
||||
or (Length(FBuffer) > 0)
|
||||
or (Length(FData) > 0) then
|
||||
if Length(FOriginalData) > 0 then
|
||||
Result := Result + Length(CRLF); // CRLF after each msg body
|
||||
end;
|
||||
|
||||
procedure TMimeTextSection.SetData(const AValue: string);
|
||||
begin
|
||||
if not FActivated then begin
|
||||
FOriginalData := aValue;
|
||||
FData := aValue;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TMimeTextSection.GetCharset: string;
|
||||
var
|
||||
n: Integer;
|
||||
begin
|
||||
Result := '';
|
||||
|
||||
n := Pos('=', FContentType);
|
||||
if n > 0 then
|
||||
Result := StringReplace(Copy(FContentType, n + 1, Length(FContentType)),
|
||||
'"', '', [rfReplaceAll]);
|
||||
end;
|
||||
|
||||
constructor TMimeTextSection.Create(aOutputStream: TStream; const aText: string);
|
||||
begin
|
||||
inherited Create(aOutputStream);
|
||||
|
||||
FContentType := 'text/plain; charset="UTF-8"';
|
||||
FOriginalData := aText;
|
||||
FData := FOriginalData;
|
||||
end;
|
||||
|
||||
procedure TMimeTextSection.Reset;
|
||||
begin
|
||||
inherited Reset;
|
||||
FData := FOriginalData;
|
||||
end;
|
||||
|
||||
{ TMimeStreamSection }
|
||||
|
||||
function TMimeStreamSection.GetSize: Integer;
|
||||
begin
|
||||
if FActivated then
|
||||
Result := Length(FBuffer) + RecalculateSize(FStream.Size - FStream.Position)
|
||||
else
|
||||
Result := Length(FBuffer) + Length(GetHeader) + RecalculateSize(FStream.Size - FStream.Position);
|
||||
|
||||
if not FActivated
|
||||
or (Length(FBuffer) > 0)
|
||||
or (FStream.Size - FStream.Position > 0) then
|
||||
if FStream.Size - FOriginalPosition > 0 then
|
||||
Result := Result + Length(CRLF); // CRLF after each msg body
|
||||
end;
|
||||
|
||||
procedure TMimeStreamSection.SetStream(aValue: TStream);
|
||||
begin
|
||||
if Assigned(FStream)
|
||||
and FOwnsStreams then begin
|
||||
FStream.Free;
|
||||
FStream := nil;
|
||||
end;
|
||||
|
||||
FStream := aValue;
|
||||
FOriginalPosition := FStream.Position;
|
||||
end;
|
||||
|
||||
procedure TMimeStreamSection.FillBuffer(const aSize: Integer);
|
||||
var
|
||||
s: string;
|
||||
n: Integer;
|
||||
begin
|
||||
SetLength(s, aSize);
|
||||
SetLength(s, FStream.Read(s[1], aSize));
|
||||
|
||||
if Length(s) <= 0 then
|
||||
Exit;
|
||||
|
||||
if Assigned(FEncodingStream) then begin
|
||||
n := FEncodingStream.Write(s[1], Length(s));
|
||||
|
||||
if n < Length(s) then
|
||||
FStream.Position := FStream.Position - (n - Length(s));
|
||||
|
||||
if FStream.Size - FStream.Position = 0 then begin
|
||||
FEncodingStream.Free; // to fill in the last bit
|
||||
CreateEncodingStream;
|
||||
FLocalStream.Write(CRLF[1], Length(CRLF));
|
||||
end;
|
||||
|
||||
SetLength(s, FLocalStream.Size);
|
||||
SetLength(s, FLocalStream.Read(s[1], FLocalStream.Size));
|
||||
end else if FStream.Size - FStream.Position = 0 then
|
||||
s := s + CRLF;
|
||||
|
||||
FBuffer := FBuffer + s;
|
||||
end;
|
||||
|
||||
constructor TMimeStreamSection.Create(aOutputStream: TStream; aStream: TStream);
|
||||
begin
|
||||
inherited Create(aOutputStream);
|
||||
|
||||
FDisposition := mdAttachment;
|
||||
FStream := aStream;
|
||||
FOriginalPosition := FStream.Position;
|
||||
FContentType := 'application/octet-stream';
|
||||
end;
|
||||
|
||||
destructor TMimeStreamSection.Destroy;
|
||||
begin
|
||||
if FOwnsStreams then
|
||||
FStream.Free;
|
||||
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
procedure TMimeStreamSection.Reset;
|
||||
begin
|
||||
inherited Reset;
|
||||
FStream.Position := FOriginalPosition;
|
||||
end;
|
||||
|
||||
{ TMimeStream }
|
||||
|
||||
function TMimeStream.GetBoundarySize: Integer;
|
||||
var
|
||||
n: Integer;
|
||||
begin
|
||||
Result := 0;
|
||||
|
||||
if FSections.Count > 1 then begin
|
||||
n := Max(FActiveSection, 0);
|
||||
Result := (Length(FBoundary) + 4) * (FSections.Count - n) + 2;
|
||||
// # sections * (boundarylength + --CRLF +) ending --
|
||||
end;
|
||||
end;
|
||||
|
||||
function TMimeStream.GetSize: Int64;
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
Result := 0;
|
||||
|
||||
if FActiveSection > -2 then
|
||||
for i := 0 to Count - 1 do
|
||||
Result := Result + TMimeSection(FSections[i]).Size;
|
||||
|
||||
if FActiveSection = -1 then // not yet active, must add header info
|
||||
Result := Result + Length(GetMimeHeader) + GetBoundarySize;
|
||||
|
||||
Result := Result + FOutputStream.Size;
|
||||
end;
|
||||
|
||||
function TMimeStream.GetCount: Integer;
|
||||
begin
|
||||
Result := FSections.Count;
|
||||
end;
|
||||
|
||||
function TMimeStream.GetBoundary: string;
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
Result := '';
|
||||
for i := 1 to 25 + Random(15) do
|
||||
Result := Result + Char(Random(Ord('9') - Ord('0') + 1) + Ord('0'));
|
||||
end;
|
||||
|
||||
function TMimeStream.GetSections(i: Integer): TMimeSection;
|
||||
begin
|
||||
Result := nil;
|
||||
|
||||
if (i >= 0)
|
||||
and (i < FSections.Count) then
|
||||
Result := TMimeSection(FSections[i]);
|
||||
end;
|
||||
|
||||
function TMimeStream.GetMimeHeader: string;
|
||||
const
|
||||
MIME_HEADER = 'Content-type: multipart/mixed; boundary="';
|
||||
begin
|
||||
Result := MIME_VERSION;
|
||||
|
||||
if FSections.Count > 1 then
|
||||
Result := Result + MIME_HEADER + FBoundary + '"' + CRLF + CRLF +
|
||||
'This is a multi-part message in MIME format.' + CRLF +
|
||||
'--' + FBoundary + CRLF;
|
||||
end;
|
||||
|
||||
procedure TMimeStream.SetSections(i: Integer; const AValue: TMimeSection);
|
||||
begin
|
||||
if (i >= 0)
|
||||
and (i < FSections.Count) then
|
||||
FSections[i] := aValue;
|
||||
end;
|
||||
|
||||
procedure TMimeStream.ActivateFirstSection;
|
||||
var
|
||||
s: string;
|
||||
begin
|
||||
if FActiveSection = -1 then
|
||||
if FSections.Count > 0 then begin
|
||||
FActiveSection := 0;
|
||||
s := GetMimeHeader;
|
||||
FOutputStream.Write(s[1], Length(s));
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TMimeStream.ActivateNextSection;
|
||||
var
|
||||
s: string;
|
||||
begin
|
||||
Inc(FActiveSection);
|
||||
|
||||
if FSections.Count > 1 then begin
|
||||
if FActiveSection >= FSections.Count then
|
||||
s := '--' + FBoundary + '--' + CRLF
|
||||
else
|
||||
s := '--' + FBoundary + CRLF;
|
||||
|
||||
FOutputStream.Write(s[1], Length(s));
|
||||
end;
|
||||
|
||||
if FActiveSection >= FSections.Count then
|
||||
FActiveSection := -2;
|
||||
end;
|
||||
|
||||
procedure TMimeStream.DoRead(const aSize: Integer);
|
||||
var
|
||||
n: Integer;
|
||||
begin
|
||||
ActivateFirstSection;
|
||||
|
||||
if FActiveSection < 0 then
|
||||
Exit;
|
||||
|
||||
TMimeSection(FSections[FActiveSection]).Read(aSize);
|
||||
|
||||
if TMimeSection(FSections[FActiveSection]).Size = 0 then
|
||||
ActivateNextSection;
|
||||
end;
|
||||
|
||||
constructor TMimeStream.Create;
|
||||
begin
|
||||
Randomize;
|
||||
|
||||
FActiveSection := -1;
|
||||
FBoundary := GetBoundary;
|
||||
FSections := TFPObjectList.Create(True);
|
||||
FOutputStream := TMimeOutputStream.Create(@DoRead);
|
||||
end;
|
||||
|
||||
destructor TMimeStream.Destroy;
|
||||
begin
|
||||
FSections.Free;
|
||||
FOutputStream.Free;
|
||||
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
function TMimeStream.Seek(Offset: Longint; Origin: Word): Longint;
|
||||
begin
|
||||
Result := Offset;
|
||||
end;
|
||||
|
||||
function TMimeStream.Seek(const Offset: Int64; Origin: TSeekOrigin): Int64;
|
||||
begin
|
||||
Result := Offset;
|
||||
end;
|
||||
|
||||
function TMimeStream.Read(var Buffer; Count: Longint): Longint;
|
||||
begin
|
||||
if Count <= 0 then
|
||||
Exit(0);
|
||||
|
||||
if FCalledWrite then
|
||||
raise EAlreadyCalledWriteException.Create;
|
||||
|
||||
FCalledRead := True;
|
||||
Result := FOutputStream.Read(Buffer, Count);
|
||||
end;
|
||||
|
||||
function TMimeStream.Write(const Buffer; Count: Longint): Longint;
|
||||
begin
|
||||
if Count <= 0 then
|
||||
Exit(0);
|
||||
|
||||
if FCalledRead then
|
||||
raise EAlreadyCalledReadException.Create;
|
||||
|
||||
Result := 0;
|
||||
FCalledWrite := True;
|
||||
raise Exception.Create('Not yet implemented');
|
||||
end;
|
||||
|
||||
procedure TMimeStream.AddTextSection(const aText: string; const aCharSet: string = 'UTF-8');
|
||||
var
|
||||
s: TMimeTextSection;
|
||||
begin
|
||||
if FActiveSection >= 0 then
|
||||
raise EAlreadyActivatedException.Create;
|
||||
|
||||
s := TMimeTextSection.Create(FOutputStream, aText);
|
||||
|
||||
s.Charset := aCharSet;
|
||||
FSections.Add(s);
|
||||
end;
|
||||
|
||||
procedure TMimeStream.AddFileSection(const aFileName: string);
|
||||
begin
|
||||
if FActiveSection >= 0 then
|
||||
raise EAlreadyActivatedException.Create;
|
||||
|
||||
FSections.Add(TMimeFileSection.Create(FOutputStream, aFileName));
|
||||
end;
|
||||
|
||||
procedure TMimeStream.AddStreamSection(aStream: TStream; const FreeStream: Boolean
|
||||
);
|
||||
var
|
||||
s: TMimeStreamSection;
|
||||
begin
|
||||
if FActiveSection >= 0 then
|
||||
raise EAlreadyActivatedException.Create;
|
||||
|
||||
s := TMimeStreamSection.Create(FOutputStream, aStream);
|
||||
if FreeStream then
|
||||
s.OwnsStreams := True;
|
||||
FSections.Add(s);
|
||||
end;
|
||||
|
||||
procedure TMimeStream.Delete(const i: Integer);
|
||||
begin
|
||||
if (i >= 0) and (i < Count) then
|
||||
FSections.Delete(i);
|
||||
end;
|
||||
|
||||
procedure TMimeStream.Remove(aSection: TMimeSection);
|
||||
begin
|
||||
FSections.Remove(aSection);
|
||||
end;
|
||||
|
||||
procedure TMimeStream.Reset;
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
FCalledRead := False;
|
||||
FCalledWrite := False;
|
||||
|
||||
for i := 0 to FSections.Count - 1 do
|
||||
TMimeSection(FSections[i]).Reset;
|
||||
|
||||
FOutputStream.Reset;
|
||||
FActiveSection := -1;
|
||||
end;
|
||||
|
||||
{ TMimeFileSection }
|
||||
|
||||
procedure TMimeFileSection.SetFileName(const AValue: string);
|
||||
begin
|
||||
if not FActivated then begin
|
||||
FFileName := aValue;
|
||||
Stream := TFileStream.Create(aValue, fmOpenRead);
|
||||
SetContentType(aValue);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TMimeFileSection.SetContentType(const aFileName: string);
|
||||
var
|
||||
s: string;
|
||||
begin
|
||||
s := StringReplace(ExtractFileExt(aFileName), '.', '', [rfReplaceAll]);
|
||||
|
||||
if (s = 'txt')
|
||||
or (s = 'pas')
|
||||
or (s = 'pp')
|
||||
or (s = 'pl')
|
||||
or (s = 'cpp')
|
||||
or (s = 'cc')
|
||||
or (s = 'h')
|
||||
or (s = 'c++') then FContentType := 'text/plain';
|
||||
|
||||
if s = 'html' then FContentType := 'text/html';
|
||||
if s = 'css' then FContentType := 'text/css';
|
||||
|
||||
if s = 'png' then FContentType := 'image/x-png';
|
||||
if s = 'xpm' then FContentType := 'image/x-pixmap';
|
||||
if s = 'xbm' then FContentType := 'image/x-bitmap';
|
||||
if (s = 'tif')
|
||||
or (s = 'tiff') then FContentType := 'image/tiff';
|
||||
if s = 'mng' then FContentType := 'image/x-mng';
|
||||
if s = 'gif' then FContentType := 'image/gif';
|
||||
if s = 'rgb' then FContentType := 'image/rgb';
|
||||
if (s = 'jpg')
|
||||
or (s = 'jpeg') then FContentType := 'image/jpeg';
|
||||
if s = 'bmp' then FContentType := 'image/x-ms-bmp';
|
||||
|
||||
if s = 'wav' then FContentType := 'audio/x-wav';
|
||||
if s = 'mp3' then FContentType := 'audio/x-mp3';
|
||||
if s = 'ogg' then FContentType := 'audio/x-ogg';
|
||||
if s = 'avi' then FContentType := 'video/x-msvideo';
|
||||
if (s = 'qt')
|
||||
or (s = 'mov') then FContentType := 'video/quicktime';
|
||||
if (s = 'mpg')
|
||||
or (s = 'mpeg') then FContentType := 'video/mpeg';
|
||||
|
||||
if s = 'pdf' then FContentType := 'application/pdf';
|
||||
if s = 'rtf' then FContentType := 'application/rtf';
|
||||
if s = 'tex' then FContentType := 'application/x-tex';
|
||||
if s = 'latex' then FContentType := 'application/x-latex';
|
||||
if s = 'doc' then FContentType := 'application/msword';
|
||||
if s = 'gz' then FContentType := 'application/x-gzip';
|
||||
if s = 'zip' then FContentType := 'application/zip';
|
||||
if s = '7z' then FContentType := 'application/x-7zip';
|
||||
if s = 'rar' then FContentType := 'application/rar';
|
||||
if s = 'tar' then FContentType := 'application/x-tar';
|
||||
if s = 'arj' then FContentType := 'application/arj';
|
||||
end;
|
||||
|
||||
function TMimeFileSection.GetHeader: string;
|
||||
begin
|
||||
Result := 'Content-Type: ' + FContentType + CRLF;
|
||||
Result := Result + 'Content-Transfer-Encoding: ' + EncodingToStr(FEncoding) + CRLF;
|
||||
Result := Result + 'Content-Disposition: ' + DispositionToStr(FDisposition) +
|
||||
'; filename="' + FFileName + '"' + CRLF;
|
||||
|
||||
if Length(FDescription) > 0 then
|
||||
Result := Result + 'Content-Description: ' + FDescription + CRLF;
|
||||
|
||||
Result := Result + CRLF;
|
||||
end;
|
||||
|
||||
constructor TMimeFileSection.Create(aOutputStream: TStream; const aFileName: string);
|
||||
begin
|
||||
inherited Create(aOutputStream, TFileStream.Create(aFileName, fmOpenRead));
|
||||
|
||||
SetContentType(aFileName);
|
||||
FDescription := ExtractFileName(aFileName);
|
||||
Encoding := meBase64;
|
||||
FFileName := ExtractFileName(aFileName);
|
||||
FOwnsStreams := True;
|
||||
end;
|
||||
|
||||
{ EAlreadyActivatedException }
|
||||
|
||||
constructor EAlreadyActivatedException.Create;
|
||||
begin
|
||||
inherited Create('The stream or section has already been activated (by Read() or Write())');
|
||||
end;
|
||||
|
||||
{ EAlreadyCalledReadException }
|
||||
|
||||
constructor EAlreadyCalledReadException.Create;
|
||||
begin
|
||||
inherited Create('The stream has already been used for reading');
|
||||
end;
|
||||
|
||||
{ EAlreadyCalledWriteException }
|
||||
|
||||
constructor EAlreadyCalledWriteException.Create;
|
||||
begin
|
||||
inherited Create('The stream has already been used for writing');
|
||||
end;
|
||||
|
||||
end.
|
||||
|
Loading…
Reference in New Issue
Block a user