home *** CD-ROM | disk | FTP | other *** search
/ Prima Shareware 3 / DuCom_Prima-Shareware-3_cd1.bin / PROGRAMO / delphi / TSMTP / UUCODE.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-04-26  |  7.7 KB  |  345 lines
  1. {.$DEFINE UseBits}
  2. unit UUCode;
  3.  
  4. interface
  5.  
  6. uses Classes,SysUtils,Forms,Dialogs;
  7.  
  8. const
  9.   MaxChars = 45;
  10.  
  11. type
  12.   TCodeMethod = (cdUU,cdXX);
  13.  
  14.   T45Bytes = array[1..MaxChars] of byte;
  15.   T60Bytes = array[1..2*MaxChars] of byte;
  16.   TBuffer = array[1..$FFF0] of byte;
  17. {A special class for bitwise operations}
  18. {$IFDEF UseBits}
  19. T24Bits = class
  20. private
  21.   Bits : array[0..MaxChars] of byte;
  22. public
  23.   procedure SetBit(BitNo : word);
  24.   function BitIsOn(BitNo : word) : boolean;
  25.   procedure Clear;
  26. end;
  27. {$ELSE}
  28.   T24Bits = array[0..8*MaxChars] of boolean;
  29. {$ENDIF}
  30.  
  31. EUUInvalidCharacter = class(Exception)
  32.   constructor Create;
  33. end;
  34.  
  35. TUUCode = class
  36. private
  37.   StringList : TStringList;
  38.   Stream : TStream;
  39.   CurSection : byte;
  40.   A24Bits : T24Bits;
  41.   FCodeMethod : TCodeMethod;
  42.   FCheckSums : boolean;
  43.   FOnProgress : TNotifyEvent;
  44.   FOnStart : TNotifyEvent;
  45.   FOnEnd : TNotifyEvent;
  46.   procedure SetCodeMethod(Value : TCodeMethod);
  47.   function Generate60Bytes(tb : T45Bytes; NumOfBytes : byte) : string;
  48.   procedure Generate45Bytes(InS : ShortString; A45Bytes : pointer;
  49.                             var BytesGenerated : word);
  50.   function ByteFromTable(Ch : Char) : byte;
  51.   procedure DoProgress(Sender : TObject);
  52.   procedure DoStart(Sender : TObject);
  53.   procedure DoEnd(Sender : TObject);
  54. public
  55.   Progress : Integer;
  56.   ProgressStep : Integer;
  57.   Canceled : boolean;
  58.   Table : string;
  59.   constructor Create(AStream : TStream; AStringList : TStringList);
  60. {$IFDEF UseBits}
  61.   destructor Destroy; override;
  62. {$ENDIF}
  63.   procedure Encode;
  64.   procedure Decode;
  65.   property CodeMethod : TCodeMethod read FCodeMethod
  66.                            write SetCodeMethod default cdUU;
  67.   property CheckSums : boolean read FCheckSums write FCheckSums
  68.                            default false;
  69.   property OnProgress : TNotifyEvent read FOnProgress
  70.                            write FOnProgress;
  71.   property OnStart : TNotifyEvent read FOnStart write FOnStart;
  72.   property OnEnd : TNotifyEvent read FOnEnd write FOnEnd;
  73. end;
  74.  
  75. implementation
  76.  
  77. {$IFDEF UseBits}
  78. procedure T24Bits.SetBit(BitNo : word);
  79. var
  80.   i : byte;
  81. begin
  82.   i:=BitNo div 8;
  83.   Bits[i]:=Bits[i] or (1 shl (BitNo mod 8));
  84. end;
  85.  
  86. function T24Bits.BitIsOn(BitNo : word) : boolean;
  87. var
  88.   j : byte;
  89. begin
  90.   j:=BitNo mod 8;
  91.   Result:=Bits[BitNo div 8] and (1 shl j)=1 shl j;
  92. end;
  93.  
  94. procedure T24Bits.Clear;
  95. begin
  96.   FillChar(Bits,SizeOf(Bits),0);
  97. end;
  98. {$ENDIF}
  99.  
  100. constructor EUUInvalidCharacter.Create;
  101. begin
  102.   inherited Create('Invalid character in the input file');
  103. end;
  104.  
  105. {TUUCode}
  106. constructor TUUCode.Create(AStream : TStream; AStringList : TStringList);
  107. begin
  108.   inherited Create;
  109.   Stream:=AStream;
  110.   StringList:=AStringList;
  111.   ProgressStep:=10;
  112.   FCodeMethod:=cdUU;
  113.   Table:='`!"#$%&''()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_';
  114.   FCheckSums:=false;
  115. {$IFDEF UseBits}
  116.   A24Bits:=T24Bits.Create;
  117. {$ELSE}
  118.   FillChar(A24Bits,SizeOf(A24Bits),0);
  119. {$ENDIF}
  120. end;
  121.  
  122. {$IFDEF UseBits}
  123. destructor TUUCode.Destroy;
  124. begin
  125.   A24Bits.Free;
  126.   inherited Destroy;
  127. end;
  128. {$ENDIF}
  129.  
  130. procedure TUUCode.SetCodeMethod(Value : TCodeMethod);
  131. begin
  132.   if Value<>FCodeMethod then
  133.   begin
  134.     FCodeMethod:=Value;
  135.     if Value=cdUU then
  136.     begin
  137.       Table:='`!"#$%&''()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_';
  138.     end
  139.     else
  140.     begin
  141.       Table:='+-0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz';
  142.     end;
  143.   end;
  144. end;
  145.  
  146. procedure TUUCode.DoProgress(Sender : TObject);
  147. begin
  148.   if Assigned(FOnProgress) then
  149.     FOnProgress(Sender);
  150. end;
  151.  
  152. procedure TUUCode.DoStart(Sender : TObject);
  153. begin
  154.   if Assigned(FOnStart) then
  155.     FOnStart(Sender);
  156. end;
  157.  
  158. procedure TUUCode.DoEnd(Sender : TObject);
  159. begin
  160.   if Assigned(FOnEnd) then
  161.     FOnEnd(Sender);
  162. end;
  163.  
  164. function TUUCode.Generate60Bytes(tb : T45Bytes; NumOfBytes : byte) : string;
  165. {Converts 45 bytes of binary data to 60 bytes of text}
  166. var
  167.   i,j,k,b,m : word;
  168.   CheckSum : word;
  169.   s : string;
  170. begin
  171.   k:=0;
  172. {$IFDEF UseBits}
  173.   A24Bits.Clear;
  174. {$ELSE}
  175.   FillChar(A24Bits,SizeOf(T24Bits),0);
  176. {$ENDIF}
  177.   for i:=1 to MaxChars do
  178.   begin
  179.     b:=tb[i];
  180.     for j:=7 DownTo 0 do
  181.     begin
  182.       m:=1 shl j;
  183.       if (b and m = m) then
  184. {$IFDEF UseBits}
  185.         A24Bits.SetBit(k);
  186. {$ELSE}
  187.         A24Bits[k]:=true;
  188. {$ENDIF}
  189.       Inc(k);
  190.     end;
  191.   end;
  192.   s:=''; k:=0; m:=4*(MaxChars div 3);
  193.   CheckSum:=0;
  194.   for i:=1 to m do
  195.   begin
  196.     b:=0;
  197.     for j:=5 DownTo 0 do
  198.     begin
  199. {$IFDEF UseBits}
  200.       if A24Bits.BitIsOn(k) then b:= b or (1 shl j);
  201. {$ELSE}
  202.       if A24Bits[k] then b:= b or (1 shl j);
  203. {$ENDIF}
  204.       Inc(k);
  205.     end;
  206.     s:=Concat(s,Table[b+1]);
  207.     if FCheckSums then
  208.       Inc(CheckSum,b);
  209.   end;
  210.   if NumOfBytes=MaxChars then SetLength(s,4*MaxChars div 3)
  211.     else SetLength(s,4*NumOfBytes div 3 + 1);
  212.   if FCheckSums then
  213.     s:=Concat(s,Table[CheckSum mod 64 + 1]);
  214.   Result:=Concat(Table[NumOfBytes+1],s);
  215. end;
  216.  
  217. procedure TUUCode.Encode;
  218. var
  219.   BytesRead : word;
  220.   A45Bytes : T45Bytes;
  221.   Total : LongInt;
  222. begin
  223.   DoStart(Self);
  224.   StringList.Clear;
  225.   Progress:=0; Total:=0; Canceled:=false;
  226.   try
  227.     repeat
  228.       BytesRead:=Stream.Read(A45Bytes,MaxChars);
  229.       Inc(Total,BytesRead);
  230.       StringList.Add(Generate60Bytes(A45Bytes,BytesRead));
  231.       Progress:=100*Total div Stream.Size;
  232.       if Progress mod ProgressStep = 0 then
  233.          DoProgress(Self);
  234.       Application.ProcessMessages;
  235.     until (BytesRead<MaxChars) or Canceled;
  236.   finally
  237.     Progress:=100;
  238.     DoProgress(Self);
  239.     if Canceled then StringList.Clear;
  240.     DoEnd(Self);
  241.   end;
  242. end;
  243.  
  244. function TUUCode.ByteFromTable(Ch : Char) : byte;
  245. var
  246.   i : byte;
  247. begin
  248.   i:=1;
  249.   while (Ch<>Table[i]) and (i<=64) do Inc(i);
  250.   if i>64 then
  251.   begin
  252.     Result:=0;
  253.     if Ch<>' ' then
  254.       raise EUUInvalidCharacter.Create;
  255.   end
  256.   else
  257.    Result:=i-1;
  258. end;
  259.  
  260. procedure TUUCode.Generate45Bytes(InS : ShortString; A45Bytes : pointer;
  261.                           var BytesGenerated : word);
  262. {converts 60 bytes of text to 45 bytes of binary data}
  263. var
  264.   i,j,k,b,m : word;
  265.   InSLen : byte absolute InS;
  266.   ActualLen : byte;
  267. begin
  268.   FillChar(A45Bytes^,MaxChars,0);
  269. {$IFDEF UseBits}
  270.   A24Bits.Clear;
  271. {$ELSE}
  272.   FillChar(A24Bits,SizeOf(T24Bits),0);
  273. {$ENDIF}
  274.   k:=0;
  275.   ActualLen:=4*ByteFromTable(InS[1]) div 3;
  276.   if ActualLen<>(4*MaxChars div 3) then
  277.     ActualLen:=InSLen-1;
  278.   for i:=2 to ActualLen+1 do
  279.   begin
  280.     b:=ByteFromTable(InS[i]);
  281.     for j:=5 DownTo 0 do
  282.     begin
  283.       m:=1 shl j;
  284.       if (b and m = m) then
  285. {$IFDEF UseBits}
  286.         A24Bits.SetBit(k);
  287. {$ELSE}
  288.         A24Bits[k]:=true;
  289. {$ENDIF}
  290.       Inc(k);
  291.     end;
  292.   end;
  293.   k:=0;
  294.   for i:=1 to MaxChars do
  295.   begin
  296.     b:=0;
  297.     for j:=7 DownTo 0 do
  298.     begin
  299. {$IFDEF UseBits}
  300.       if A24Bits.BitIsOn(k) then b:= b or (1 shl j);
  301. {$ELSE}
  302.       if A24Bits[k] then b:= b or (1 shl j);
  303. {$ENDIF}
  304.       Inc(k);
  305.     end;
  306.     TBuffer(A45Bytes^)[i]:=b;
  307.   end;
  308.   BytesGenerated:=ByteFromTable(InS[1]);
  309. end;
  310.  
  311. procedure TUUCode.Decode;
  312. var
  313.   BytesGenerated : word;
  314.   i : LongInt;
  315.   s : ShortString;
  316.   p : pointer;
  317. begin
  318.   DoStart(Self);
  319.   Progress:=0;
  320.   Canceled:=false;
  321.   try
  322.     GetMem(p,MaxChars);
  323.     i:=0;
  324.     repeat
  325.       s:=StringList.Strings[i];
  326.       Generate45Bytes(s,p,BytesGenerated);
  327.       Stream.Write(p^,BytesGenerated);
  328.       Progress:=(100*i) div (StringList.Count-1);
  329.       if Progress mod ProgressStep = 0 then
  330.          DoProgress(Self);
  331.       Application.ProcessMessages;
  332.       if Canceled then break;
  333.       Inc(i);
  334.     until (i=StringList.Count) or (StringList[i]='end')
  335.             or (StringList[i]=Table[1]);
  336.   finally
  337.     Progress:=100;
  338.     DoProgress(Self);
  339.     FreeMem(p,MaxChars);
  340.     DoEnd(Self);
  341.   end;
  342. end;
  343.  
  344. end.
  345.