TidHttpServer - uploading from a web browser (the Revenge)
Vern Baker
found a lot of examples for Indy 9, but nothing yet for 10.
Okay, I'm using Indy 10.1.5 on D6 (Indy 10). I never was able to get
the MIME decoding working on 9.... hence, the move to 10. I see
someone *nearly* had it with the TIdStreamVCL, but the TIdStreamVCL
was removed, and the code example no longer functions
I have tried several code samples from Remy's responses over the
years. With quick modifications to Indy 10, they are all giving:
"Assertion failure (C:\Program Files\Indy 10 for Delphi 6\Source\System
\IdGlobal.pas, line 3181)"
When debugging, I get to...
Decoder.ReadHeader;
// which eventually calls: IdMessageCoderMime (line 598) ...
LLine := ReadLn; // ** Boom... pops the error message here.
I know this one is a cause of frustration. I'm dying to see what I
have have been missing. Cheers! ..V
Remy Lebeau (TeamB)
"Vern Baker" <javak...@gmail.com> wrote in message
news:1171080008.1...@v33g2000cwv.googlegroups.com...
> I have found a lot of examples for Indy 9, but nothing yet for 10.
Then you did not look very hard, because Indy 10 examples have been
posted before.
> I'm using Indy 10.1.5 on D6 (Indy 10).
That is a very old build of Indy 10. You should consider upgrading to
the current 10.1.6 snapshot.
> I never was able to get the MIME decoding working on 9....
Why not?
> I see someone *nearly* had it with the TIdStreamVCL, but the
> TIdStreamVCL was removed, and the code example no longer
> functions
Yes, it does. Simply update it to no longer use TIdStreamVCL anymore.
> I have tried several code samples from Remy's responses over the
> years.
Then you are likely not using them correctly. Please show the code
you are actually using.
> With quick modifications to Indy 10
Why are you modifying Indy at all? What changes are you making?
> they are all giving:
>
> "Assertion failure (C:\Program Files\Indy 10 for Delphi
6\Source\System
> \IdGlobal.pas, line 3181)"
Which tells nothing about the actual problem you are having. What
does line 3181 actually look like?
Gambit
Vern Baker
wrote:
> That is a very old build of Indy 10. You should consider upgrading to
> the current 10.1.6 snapshot.
Got it! Installed, and I have my web server working famously once
again.
Now, as it turns out, I can now get MIME to decode uploaded files.
It's working, but it's slightly scrambling files.
I tested uploading this file:
http://www.teleflowrelay.com/downloads/coffee-original.jpg
and ended up with:
http://www.teleflowrelay.com/downloads/coffee-brundel.jpg
I noticed that small text files will upload fairly intact, but are
getting an extra CR+LF at the end. I wonder if this could be a hint.
Here is the code I have compiled with:
///////////////////////////////
procedure TTFNetHubScreenForm.HTTPServerCommandGetWork(HTTPServer:
TidHTTPServer; AContext: TIdContext;
ARequestInfo: TIdHTTPRequestInfo; AResponseInfo:
TIdHTTPResponseInfo);
begin
mContentType := ARequestInfo.ContentType;
if AnsiSameText(Fetch(mContentType, ';'), 'multipart/form-data')
then
begin
DecodeFormData(mSaveDir, mContentType,
ARequestInfo.PostStream);
end;
end;
procedure DecodeFormData(pUploadDir: String; const Header: String;
ASourceStream: TStream);
var
MsgEnd: Boolean;
Decoder: TIdMessageDecoder;
Tmp: String;
Dest: TStream;
begin
MsgEnd := False;
Decoder := TIdMessageDecoderMIME.Create(nil);
try
TIdMessageDecoderMIME(Decoder).MIMEBoundary :=
TIdMIMEBoundary.FindBoundary(Header);
Decoder.SourceStream := ASourceStream;
Decoder.FreeSourceStream := False;
Decoder.ReadLn;
repeat
Decoder.ReadHeader;
case Decoder.PartType of
mcptUnknown:
begin
// raise Exception('Unknown form data detected');
end;
mcptText:
begin
Tmp := Decoder.Headers.Values['Content-Type'];
Dest := TMemoryStream.Create;
try
Decoder := Decoder.ReadBody(Dest, MsgEnd);
if AnsiSameText(Fetch(Tmp, ';'),'multipart/mixed') then
DecodeFormData(pUploadDir, Tmp, Dest)
else
// use Dest as needed...
finally
FreeAndNil(Dest);
end;
end;
mcptAttachment:
begin
Tmp := ExtractFileName(Decoder.FileName);
if Tmp <> '' then
begin
Tmp := IncludeTrailingPathDelimiter(pUploadDir) + Tmp
end
else
begin
Tmp :=
MakeTempFilename(IncludeTrailingPathDelimiter(pUploadDir));
end;
Dest := TFileStream.Create(Tmp, fmCreate);
try
Decoder := Decoder.ReadBody(Dest, MsgEnd);
finally
FreeAndNil(Dest);
end;
end;
end;
until (Decoder = nil) or MsgEnd;
finally
FreeAndNil(Decoder);
end;
end;
/////////////////////////////
Everything else is working very very well. Cheers! ...Vern
Vern Baker
>
> I noticed that small text files will upload fairly intact, but are
> getting an extra CR+LF at the end. I wonder if this could be a hint.
>
I think I have found it. I used ExamDiff Pro to compare the two jpg
binary files, and found that wherever 0A was encountered, 0D was
inserted. So 0A becomes 0D 0A, and the binary file grows.
How do I turn off the MS text translation for binary file uploads?
Vern Baker
TIdMessageDecoderMIME.ReadBody
tests:
IsBinaryContentTransferEncoding
And performs a:
LLine := ReadLnRFC(VMsgEnd);
This line later on:
WriteStringToStream(ADestStream, LLine);
Does not include the correct End of Line marker for Binary files. It
would appear that
ReadLnRFC
and the calls it makes are unable to correctly determine what split
the read. I have tried EOL, CR, LF and found various results. Each
created a different picture. Unfortunately, I cannot determine how to
solve this problem in Indy at this time.
Current status of MIME in Indy is that it works very well for files
that are not Binary. I have no recommendations as to break out MIME.
Vern Baker
idGlobal.ReadLnFromStream
In it, FindEOL terminate on both LF or CR... not CRLF (nor
specifically CR or LF). Therefor, the MIME Decoder cannot determine
how to rebuild the Binary string. Hence, LF becomes CRLF and CR
becomes CRLF... and the corrupts the MIME file.
To fix the problem, I believe that a special ReadLnFromStream (From
idGlobal) will need to be created for idMessageDecoder to go with its
special ReadLn. A quick solution will make the code messy. In order to
do it right, will require a bit more effort. I don't want to step on
anyone's feet.
Could someone tell me what I should be doing to contribute to Indy?
I'm just guessing here, and honestly, I feel like I am rambling in my
effort to solve a problem, improve the product, and help out the next
guy. Thx.
Vern Baker
// - Feb 27, 2007
// Changes made to account for problem with ReadLnFromStream where
// both CR and LF trigger a line end. Because ReadBody is unaware of
// what caused the EOL, it was adding CRLF for CR, and CRLF for LF.
// Problems yet to be resolved:
// -
// 1) CRLF at end of File (ex: Being treated as a Text file)
// 2) Occasional dropped 2E after 0A
// -
//
// NOTE: In IdMessageCoderMIME replace:
function TIdMessageDecoderMIME.ReadBody(ADestStream: TIdStream; var
VMsgEnd: Boolean): TIdMessageDecoder;
var
LContentTransferEncoding: string;
LDecoder: TIdDecoder;
LLine: string;
LBuffer: string; //Needed for binhex4 because cannot decode line-by-
line.
LIsThisTheFirstLine: Boolean; //Needed for binary encoding
BoundaryStart, BoundaryEnd: string;
IsBinaryContentTransferEncoding: Boolean;
begin
LIsThisTheFirstLine := True;
VMsgEnd := False;
Result := nil;
if FBodyEncoded then begin
LContentTransferEncoding :=
TIdMessage(Owner).ContentTransferEncoding;
end else begin
LContentTransferEncoding := FHeaders.Values['Content-Transfer-
Encoding']; {Do not Localize}
if LContentTransferEncoding = '' then begin
LContentTransferEncoding := FHeaders.Values['Content-Type']; {Do
not Localize}
if TextStartsWith(LContentTransferEncoding, 'application/mac-
binhex40') then begin {Do not Localize}
LContentTransferEncoding := 'binhex40'; {do not localize}
end;
end;
end;
if TextIsSame(LContentTransferEncoding, 'base64') then begin {Do not
Localize}
LDecoder := TIdDecoderMIMELineByLine.Create(nil);
end else if TextIsSame(LContentTransferEncoding, 'quoted-printable')
then begin {Do not Localize}
LDecoder := TIdDecoderQuotedPrintable.Create(nil);
end else if TextIsSame(LContentTransferEncoding, 'binhex40') then
begin {Do not Localize}
LDecoder := TIdDecoderBinHex4.Create(nil);
end else begin
LDecoder := nil;
end;
try
if LDecoder <> nil then begin
LDecoder.DecodeBegin(ADestStream);
end;
BoundaryStart := '--' + MIMEBoundary; {Do not Localize}
BoundaryEnd := BoundaryStart + '--'; {Do not Localize}
BoundaryEnd := BoundaryEnd + CR; // @@@ VB Contribution - Needed
because we are only reading LF
IsBinaryContentTransferEncoding :=
TextIsSame(LContentTransferEncoding, 'binary'); {do not localize}
repeat
if not FProcessFirstLine then begin
if IsBinaryContentTransferEncoding then begin
//For binary, need EOL because the default LF causes
spurious CRs in the output...
LLine := ReadLnRFC(VMsgEnd, EOL);
end else begin
//LLine := ReadLnRFC(VMsgEnd); // @@@ VB Contribution
LLine := ReadLnRFCMIME(VMsgEnd); // @@@ VB Contribution
end;
end else begin
LLine := FFirstLine;
FFirstLine := ''; {Do not Localize}
FProcessFirstLine := False;
// Do not use ADELIM since always ends with . (standard)
if LLine = '.' then begin {Do not Localize}
VMsgEnd := True;
Break;
end;
end;
if VMsgEnd then begin
Break;
end;
// New boundary - end self and create new coder
if MIMEBoundary <> '' then begin
if TextIsSame(LLine, BoundaryStart) then begin
Result := TIdMessageDecoderMIME.Create(Owner);
Break;
// End of all coders (not quite ALL coders)
end
else if TextIsSame(LLine, BoundaryEnd) then begin
// POP the boundary
if Owner is TIdMessage then begin
TIdMessage(Owner).MIMEBoundary.Pop;
end;
Break;
// Data to save, but not decode
end else if LDecoder = nil then begin
if IsBinaryContentTransferEncoding then begin {do not
localize}
//In this case, we have to make sure we dont write out an
EOL at the
//end of the file.
if LIsThisTheFirstLine then begin
WriteStringToStream(ADestStream, LLine);
LIsThisTheFirstLine := False;
end else begin
WriteStringToStream(ADestStream, EOL);
WriteStringToStream(ADestStream, LLine);
end;
end else begin
LLine := LLine + LF; // @@@ VB Contribution
WriteStringToStream(ADestStream, LLine);
end;
// Data to decode
end else begin
// For TIdDecoderQuotedPrintable, we have to make sure all
EOLs are
// intact
if LDecoder is TIdDecoderQuotedPrintable then begin
LDecoder.Decode(LLine + EOL);
end else if LDecoder is TIdDecoderBinHex4 then begin
//We cannot decode line-by-line because lines don't have a
whole
//number of 4-byte blocks due to the : inserted at the
start of
//the first line, so buffer the file...
LBuffer := LBuffer + LLine;
end else if LLine <> '' then begin
LDecoder.Decode(LLine);
end;
end;
end else begin {CC3: Added "else" for QP and base64 encoded
message BODIES}
// For TIdDecoderQuotedPrintable, we have to make sure all
EOLs are
// intact
if LDecoder is TIdDecoderQuotedPrintable then begin
LDecoder.Decode(LLine + EOL);
end else if LDecoder = nil then begin
LLine := LLine + EOL;
WriteStringToStream(ADestStream, LLine);
end else if LLine <> '' then begin
LDecoder.Decode(LLine);
end;
end;
until False;
if LDecoder <> nil then begin
if LDecoder is TIdDecoderBinHex4 then begin
//Now decode the complete block...
LDecoder.Decode(LBuffer);
end;
LDecoder.DecodeEnd;
end;
finally
Sys.FreeAndNil(LDecoder);
end;
end;
// NOTE: in IdMessageCode.pas ADD:
// @@@ VB Contribution - Start
function TIdMessageDecoder.ReadLnFromStreamMIME(AStream: TIdStream;
AMaxLineLength: Integer = -1; AExceptionIfEOF: Boolean = FALSE):
String;
//TODO: Continue to optimize this function. Its performance severely
impacts
// the coders
const
LBUFMAXSIZE = 2048;
var
LBufSize, LStringLen, LResultLen: LongInt;
LBuf: TIdBytes;
// LBuf: packed array [0..LBUFMAXSIZE] of Char;
LStrmPos, LStrmSize: Integer; //LBytesToRead = stream size -
Position
LCrEncountered: Boolean;
function FindEOL(const ABuf: TIdBytes; var VLineBufSize: Integer;
var VCrEncountered: Boolean): Integer;
var
i: Integer;
begin
Result := VLineBufSize; //EOL not found => use all
i := 0;
while i < VLineBufSize do begin
case ABuf[i] of
Ord(LF): begin
Result := i; {string size}
VCrEncountered := TRUE;
VLineBufSize := i+1;
break;
end;//LF
(* VB Contribution - Removed because does not clarify the
break
Ord(CR): begin
Result := i; {string size}
VCrEncountered := TRUE;
inc(i); //crLF?
if (i < VLineBufSize) and (ABuf[i] = Ord(LF)) then begin
VLineBufSize := i+1;
end else begin
VLineBufSize := i;
end;
break;
end;
*)
end;
Inc(i);
end;
end;
begin
Assert(AStream<>nil);
SetLength(LBuf, LBUFMAXSIZE);
if AMaxLineLength < 0 then begin
AMaxLineLength := MaxInt;
end;//if
LCrEncountered := False;
Result := '';
{ we store the stream size for the whole routine to prevent
so do not incur a performance penalty with TStream.Size. It has
to use something such as Seek each time the size is obtained}
{4 seek vs 3 seek}
LStrmPos := AStream.Position;
LStrmSize:= AStream.Size;
if (LStrmSize - LStrmPos) > 0 then begin
while (LStrmPos < LStrmSize) and not LCrEncountered do begin
LBufSize := Min(LStrmSize - LStrmPos, LBUFMAXSIZE);
ReadTIdBytesFromStream(AStream, LBuf, LBufSize);
LStringLen := FindEOL(LBuf, LBufSize, LCrEncountered);
Inc(LStrmPos, LBufSize);
LResultLen := Length(Result);
if (LResultLen + LStringLen) > AMaxLineLength then begin
LStringLen := AMaxLineLength - LResultLen;
LCrEncountered := True;
Dec(LStrmPos, LBufSize);
Inc(LStrmPos, LStringLen);
end;
Result := Result + BytesToString(LBuf, 0, LStringLen);
end;
AStream.Position := LStrmPos;
//end else begin //@@@ VB Contribution - Removed
// EIdEndOfStream.IfTrue(AExceptionIfEOF, Sys.Format(RSEndOfStream,
['', LStrmPos])); //@@@ VB - Removed
end;
end;
function TIdMessageDecoder.ReadLnMIME(const ATerminator: string = LF):
string;
var
LWasSplit: Boolean; //Needed for lines > 16K, e.g. if Content-
Transfer-Encoding is 'binary'
begin
Result := '';
if SourceStream is TIdTCPStream then begin
repeat
Result := Result +
TIdTCPStream(SourceStream).Connection.IOHandler.ReadLnSplit(LWasSplit,
ATerminator);
until (not LWasSplit);
end else begin
Result := ReadLnFromStreamMIME(SourceStream);
end;
end;
function TIdMessageDecoder.ReadLnRFCMIME(var VMsgEnd: Boolean; const
ALineTerminator: String = LF; const ADelim: String = '.'): String;
begin
Result := ReadLnMIME(ALineTerminator);
// Do not use ATerminator since always ends with . (standard)
if Result = ADelim then {do not localize}
begin
VMsgEnd := True;
Exit;
end;
if (Result <> '') and (Result[1] = '.') then begin {do not localize}
IdDelete(Result, 1, 1);
end;
VMsgEnd := False;
end;
// @@@ VB Contribution - End