testmime.dpr

Delphi开发webservice的一套例子

{ Copyright Ralf Junker <[e-mail]> 2000-2001
  http://www.zeitungsjunge.de/delphi/ }

program TestMime;

{$APPTYPE Console}

uses
 Windows,
 SysUtils,
 Classes,
 
 rjMime;

const
 MIN_LENGTH         = 4000;
 MAX_LENGTH         = 5000;
 
function RandomString (const Length: Cardinal): AnsiString;
var
 i                  : Cardinal;
begin
 SetLength (Result, Length);
 for i := 1 to Length do
  Result[i] := Char (Random (255))
end;

procedure InsertRandomSpaces (var s: AnsiString);
var
 i, l               : Cardinal;
begin
 l := Length (s);
 for i := 1 to l div 50 do
  begin
   Insert (StringOfChar (#32, Random (10)), s, Random (l));
   Inc (l);
  end;
end;

procedure StartTest (const TestName: AnsiString);
begin
 WriteLn (TestName, ' Mime Encoding and Decoding.');
 WriteLn ('Generating and testing ', MAX_LENGTH - MIN_LENGTH, ' random ', TestName, 's from ', MIN_LENGTH, ' to ', MAX_LENGTH, ' length...');
 // WriteLn ('This may take a few seconds...');
 //WriteLn;
end;

procedure EndTest (const TimeTest, TimeCode: Int64);
var
 Frequency          : Int64;
begin
 queryperformancefrequency (Frequency);
 WriteLn ('Successfully finnished in ', TimeTest * 1000 div Frequency, ' milliseconds.');
 WriteLn ('Time used for Encoding / Decoding was only ', TimeCode * 1000 div Frequency, ' milliseconds.');
 WriteLn;
 WriteLn;
end;

procedure ReportError (const Original, Encoded, Decoded: AnsiString);
begin
 WriteLn ('Original:');
 WriteLn (Original);
 WriteLn;
 WriteLn ('Encoded:');
 WriteLn (Encoded);
 WriteLn;
 WriteLn ('Decoded:');
 WriteLn (Decoded);
 WriteLn;
 WriteLn ('Test Failed.')
end;

{ ---------------------------------------------------------------------------- }

procedure TestStrings;
var
 i                  : Integer;
 Decoded, Encoded, s: AnsiString;
 tStart, tEnd, tCode, t1, t2: Int64;
begin
 StartTest ('String');
 tCode := 0;
 QueryPerformanceCounter (tStart);
 for i := MIN_LENGTH to MAX_LENGTH do
  begin
   s := RandomString (i);

   QueryPerformanceCounter (t1);
   Encoded := MimeEncodeString (s);
   // Decode original encoded string
   Decoded := MimeDecodeString (Encoded);
   QueryPerformanceCounter (t2);
   Inc (tCode, t2 - t1);

   if Decoded <> s then
    begin
     ReportError (s, Encoded, Decoded);
     Exit;
    end;
   // Decode encoded string with inserted spaces
   InsertRandomSpaces (Encoded);

   QueryPerformanceCounter (t1);
   Decoded := MimeDecodeString (Encoded);
   QueryPerformanceCounter (t2);
   Inc (tCode, t2 - t1);

   if Decoded <> s then
    begin
     ReportError (s, Encoded, Decoded);
     Exit;
    end;
  end;
 QueryPerformanceCounter (tEnd);
 EndTest (tEnd - tStart, tCode);
end;

{ ---------- }

procedure TestStringsNoCRLF;
var
 i                  : Integer;
 Decoded, Encoded, s: AnsiString;
 tStart, tEnd, tCode, t1, t2: Int64;
begin
 StartTest ('StringNoCRLF');
 tCode := 0;
 QueryPerformanceCounter (tStart);
 for i := MIN_LENGTH to MAX_LENGTH do
  begin
   s := RandomString (i);

   QueryPerformanceCounter (t1);
   Encoded := MimeEncodeStringNoCRLF (s);
   // Decode original encoded string
   Decoded := MimeDecodeString (Encoded);
   QueryPerformanceCounter (t2);
   Inc (tCode, t2 - t1);

   if Decoded <> s then
    begin
     ReportError (s, Encoded, Decoded);
     Exit;
    end;
   // Decode encoded string with inserted spaces
   InsertRandomSpaces (Encoded);

   QueryPerformanceCounter (t1);
   Decoded := MimeDecodeString (Encoded);
   QueryPerformanceCounter (t2);
   Inc (tCode, t2 - t1);

   if Decoded <> s then
    begin
     ReportError (s, Encoded, Decoded);
     Exit;
    end;
  end;
 QueryPerformanceCounter (tEnd);
 EndTest (tEnd - tStart, tCode);
end;

{ ---------------------------------------------------------------------------- }

procedure TestStreams;
var
 i                  : Integer;
 Decoded, Encoded, Original: TStringStream;
 s                  : AnsiString;
 tStart, tEnd, tCode, t1, t2: Int64;
begin
 StartTest ('Stream');
 Decoded := TStringStream.Create ('');
 Encoded := TStringStream.Create ('');
 
 tCode := 0;
 QueryPerformanceCounter (tStart);
 
 for i := MIN_LENGTH to MAX_LENGTH do
  begin
   Original := TStringStream.Create (RandomString (i));

   QueryPerformanceCounter (t1);
   MimeEncodeStream (Original, Encoded);
   QueryPerformanceCounter (t2);
   Inc (tCode, t2 - t1);

   Encoded.Seek (0, soFromBeginning);

   QueryPerformanceCounter (t1);
   MimeDecodeStream (Encoded, Decoded);
   QueryPerformanceCounter (t2);
   Inc (tCode, t2 - t1);

   if Decoded.DataString <> Original.DataString then
    begin
     ReportError (Original.DataString, Encoded.DataString, Decoded.DataString);
     Exit;
    end;

   s := Encoded.DataString;
   InsertRandomSpaces (s);

   Decoded.Size := 0;
   Encoded.Size := 0;
   Encoded.WriteString (s);
   Encoded.Seek (0, soFromBeginning);

   QueryPerformanceCounter (t1);
   MimeDecodeStream (Encoded, Decoded);
   QueryPerformanceCounter (t2);
   Inc (tCode, t2 - t1);

   if Decoded.DataString <> Original.DataString then
    begin
     ReportError (Original.DataString, Encoded.DataString, Decoded.DataString);
     Exit;
    end;

   Decoded.Size := 0;
   Encoded.Size := 0;
  end;
 Decoded.Free;
 Encoded.Free;
 
 QueryPerformanceCounter (tEnd);
 EndTest (tEnd - tStart, tCode);
end;

procedure TestStreamsNoCRLF;
var
 i                  : Integer;
 Decoded, Encoded, Original: TStringStream;
 s                  : AnsiString;
 tStart, tEnd, tCode, t1, t2: Int64;
begin
 StartTest ('StreamNoCRLF');
 Decoded := TStringStream.Create ('');
 Encoded := TStringStream.Create ('');
 
 tCode := 0;
 QueryPerformanceCounter (tStart);
 
 for i := MIN_LENGTH to MAX_LENGTH do
  begin
   Original := TStringStream.Create (RandomString (i));

   QueryPerformanceCounter (t1);
   MimeEncodeStream (Original, Encoded);
   QueryPerformanceCounter (t2);
   Inc (tCode, t2 - t1);

   Encoded.Seek (0, soFromBeginning);

   QueryPerformanceCounter (t1);
   MimeDecodeStream (Encoded, Decoded);
   QueryPerformanceCounter (t2);
   Inc (tCode, t2 - t1);

   if Decoded.DataString <> Original.DataString then
    begin
     ReportError (Original.DataString, Encoded.DataString, Decoded.DataString);
     Exit;
    end;

   s := Encoded.DataString;
   InsertRandomSpaces (s);

   Decoded.Size := 0;
   Encoded.Size := 0;
   Encoded.WriteString (s);
   Encoded.Seek (0, soFromBeginning);

   QueryPerformanceCounter (t1);
   MimeDecodeStream (Encoded, Decoded);
   QueryPerformanceCounter (t2);
   Inc (tCode, t2 - t1);

   if Decoded.DataString <> Original.DataString then
    begin
     ReportError (Original.DataString, Encoded.DataString, Decoded.DataString);
     Exit;
    end;

   Decoded.Size := 0;
   Encoded.Size := 0;
  end;
 Decoded.Free;
 Encoded.Free;
 
 QueryPerformanceCounter (tEnd);
 EndTest (tEnd - tStart, tCode);
end;

begin
 Randomize;
 try
  try
   TestStrings;
   TestStringsNoCRLF;
   TestStreams;
   TestStreamsNoCRLF;
  except
   on e: Exception do
    WriteLn (e.message);
  end
 finally
  WriteLn;
  WriteLn ('Press Enter to continue...');
  ReadLn;
 end;
 
end.