home *** CD-ROM | disk | FTP | other *** search
/ Delphi 2 - Developers' Solutions / Delphi 2 Developers' Solutions.iso / dds / chap10 / howto07 / delphi10 / ccuucode.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-06-12  |  29.3 KB  |  849 lines

  1. unit CCUUCode;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  7.   Forms, Dialogs, ExtCtrls, StdCtrls, Buttons, Menus, FileCtrl;
  8.  
  9. const UUDefaultSuffix = '.UUO'; { Use this if no valid output suffix }
  10.       UUDefaultOuputSuffix = '.UUE'; { Use this for all encodings }
  11.       UUCodingOffset = 32; { This is standard offset for UU Coding }
  12.       CDV_ENCODE = 1; { Data vector for encoding }
  13.       CDV_DECODE = 2; { Data vector for decoding }
  14.       CIV_FILE   = 1; { Input vector for file }
  15.       CIV_STREAM = 2; { Input vector for stream }
  16.       CIV_SLIST  = 3; { Input vector for string list }
  17.       COV_FILE   = 1; { Output vector for file }
  18.       COV_STREAM = 2; { Output vector for stream }
  19.       COV_SLIST  = 3; { Output vector for string list }
  20.       CMV_SINGLE = 0; { Multifile vector single file }
  21.       CMV_MULTI  = 1; { Multifile vector multiple files }
  22.       EC_NOBEGIN = -1; { Error code for no Begin found }
  23.       EC_EOF     = -2; { Error code for unexpected end of file }
  24.       EC_EMPTYDATALINE = -3; { Error code for empty line in data }
  25.       EC_UEODL = -4; { Error code for unexpected end of data line }
  26.       EC_INVALIDCHAR = -5; { Error code for invalid char in stream }
  27.       EC_OUTPUTFILEERROR = -6; { Error code for failure on opening output file }
  28.       EC_INPUTFILEERROR = -7; { Error code for failure on opening input file }
  29.  
  30. type
  31.   TUUErrorEvent = procedure( ErrorCode : Integer; ErrorMessage : String )
  32.    of object;
  33.   TUUUpdateEvent = procedure( BytesCompleted , TotalBytes : LongInt )
  34.    of object;
  35.   { This object handles decoding streams, files (multiples), and output }
  36.   { to streams or files.                                                }
  37.   TUUCodingObject = class( TWinControl )
  38.   private { hidden stuff }
  39.     FOnUUErrorOccurred : TUUErrorEvent;
  40.     FOnOutputStatus    : TUUUpdateEvent;
  41.   public { public stuff }
  42.     CurrentInputFileName    : String;
  43.     CurrentOutputFileName   : String;
  44.     TheMultipleFilesList    : TStringList;
  45.     TheInputFile            : TextFile;
  46.     TheOutputFile           : File of Byte;
  47.     CurrentMFInPointer      : Integer;
  48.     CurrentLineNumber       : integer;
  49.     CurrentLine             : string;
  50.     CurrentErrorCode        : Integer;
  51.     CurrentErrorMessage     : String;
  52.     CurrentMultifileVector  : Integer;
  53.     constructor Create( AOwner : TComponent ); override;
  54.     destructor Destroy; override;
  55.     procedure UUError( ECode : Integer; EMsg : String );
  56.     procedure UUUpdate( BSF , BT : LongInt );
  57.     function GetTextFileSize( TheName : String ) : Longint;
  58.     function SetInputFileName( TheName : String ) : Boolean;
  59.     procedure SetMultipleFilesList( TheList : TStringList );
  60.     function DecodeOutputName( TheInputString : String ) : String;
  61.     procedure SetMultiFileVector( TheVector : Integer );
  62.     procedure GetNextInputFileLine( var OutputString : string );
  63.     procedure DecodeLine;
  64.     function StartDecoding : Boolean;
  65.     function Decode : Boolean;
  66.     function DecodeCurrentInputs : Boolean;
  67.     procedure AbortCoding( AbortCode : Integer; AbortMessage : String );
  68.     procedure GetNextSDWord(     TheInputString : String;
  69.                              var WordGotten     : string;
  70.                              var PositionIndex  : integer );
  71.     function GetAUsableSingleExtensionFileName( InputName : String ) : String;
  72.     function ScanLinesforDecodeStartup : String;
  73.     function ScanLinesforBEGINEND( Vector : Integer ) : Boolean;
  74.     function CheckForBEGIN_ENDLine( InputLine : String; Vector : Integer ) : boolean;
  75.     function CheckForValidLine : boolean;
  76.  
  77.     property OnUUErrorOccurred : TUUErrorEvent read FOnUUErrorOccurred
  78.      write FOnUUErrorOccurred;
  79.     property OnOutputStatus : TUUUpdateEvent read FOnOutputStatus
  80.      write FOnOutputStatus;
  81.   end;
  82. var
  83.   TotalBytesSoFar ,
  84.   TotalBytesToDo    : Longint;
  85.  
  86. implementation
  87.  
  88. uses CCICCFRM;
  89.  
  90. { Create call }
  91. constructor TUUCodingObject.Create( AOwner : TComponent );
  92. begin
  93.   { Inherited create }
  94.   inherited Create( AOwner );
  95.   { set all internals to neutral }
  96.   CurrentMFInPointer      := 0;
  97.   CurrentLineNumber       := 0;
  98.   CurrentLine             := '';
  99.   CurrentErrorCode        := 0;
  100.   CurrentErrorMessage     := '';
  101.   CurrentMultifileVector  := CMV_SINGLE;
  102.   FOnUUErrorOccurred := UUError;
  103.   FOnOutputStatus    := UUUpdate;
  104.  
  105. end;
  106.  
  107. { Replacement destroy; currently does nada }
  108. destructor TUUCodingObject.Destroy;
  109. begin
  110.   { call inherited }
  111.   Inherited Destroy;
  112. end;
  113.  
  114. { This is the generic error handler }
  115. procedure TUUCodingObject.UUError( ECode : Integer; EMsg : String );
  116. begin
  117.   { Do generic MessageBox }
  118.   MessageDlg( 'A UUCode error code ' + IntToStr( ECode ) +
  119.    ' has happend with Message ' + EMsg , mtError , [mbOK] , 0 );
  120. end;
  121.  
  122. { This is the generic update procedure }
  123. procedure TUUCodingObject.UUUpdate( BSF , BT : LongInt );
  124. begin
  125.   CCInetCCForm.UpdateUUGauge( BSF , BT );
  126. end;
  127.  
  128. { This is a clever function to get the total bytes of a text file }
  129. function TUUCodingObject.GetTextFileSize( TheName : String ) : Longint;
  130. var TheSR : TSearchRec; { Used for trick }
  131. begin
  132.   { This allows getting the data }
  133.   FindFirst( TheName , faAnyFile , TheSR );
  134.   { And this is the info }
  135.   Result := TheSR.Size;
  136.   { Needed for win32 }
  137.   {FindClose( TheSR )};
  138. end;
  139.  
  140. { This method sets a filename for input of single file data }
  141. function TUUCodingObject.SetInputFileName( TheName : String ) : Boolean;
  142. begin
  143.   { Set the file var to imported name }
  144.   CurrentInputFileName := TheName;
  145.   Result := true;
  146. end;
  147.  
  148. { This method sets up an ordered list of files to send through decoding }
  149. procedure TUUCodingObject.SetMultipleFilesList( TheList : TStringList );
  150. begin
  151.   { Set the multiple files list to imported list }
  152.   TheMultipleFilesList := TheList;
  153. end;
  154.  
  155. { This method obtains the output file name if file-based output }
  156. { If not it still gets the output name and saves it.            }
  157. function TUUCodingObject.StartDecoding : Boolean;
  158. var HoldingString ,
  159.     TempName        : String;
  160.     Counter_1       : Integer;
  161.     Through         : Boolean;
  162. begin
  163.   Result := false;
  164.   case CurrentMultiFileVector of
  165.     CMV_SINGLE : begin { Single Input File }
  166.                    TotalBytesSoFar := 0;
  167.                    TotalBytesToDo := GetTextFileSize( CurrentInputFileName );
  168.                    try
  169.                      AssignFile( TheInputFile ,
  170.                                  CurrentInputFileName );
  171.                      Reset( TheInputFile );
  172.                      HoldingString :=
  173.                       ScanLinesForDecodeStartup;
  174.                      if HoldingString = '' then
  175.                      begin
  176.                        AbortCoding( EC_NOBEGIN ,
  177.                                     'No Begin Found!' );
  178.                        Result := false;
  179.                        exit;
  180.                      end
  181.                      else
  182.                      begin
  183.                        CurrentOutputFileName := NewsPath + '\' +
  184.                         HoldingString;
  185.                        try
  186.                          AssignFile( TheOutputFile ,
  187.                           CurrentOutputFileName );
  188.                          Rewrite( TheOutputFile );
  189.                          result := true;
  190.                        except
  191.                          On EInOutError do
  192.                          begin
  193.                            AbortCoding( EC_OUTPUTFILEERROR ,
  194.                             'Error Opening Output File ' );
  195.                            Result := false;
  196.                            exit;
  197.                          end;
  198.                        end;
  199.                      end;
  200.                    except
  201.                      On EInOutError do
  202.                      begin
  203.                        AbortCoding( EC_INPUTFILEERROR ,
  204.                         'Error Opening Input File ' );
  205.                        Result := false;
  206.                        exit;
  207.                      end;
  208.                    end;
  209.                  end;
  210.     CMV_MULTI  : begin { Multiple Input Files }
  211.                    Counter_1 := 0;
  212.                    Through := false;
  213.                    while not Through do
  214.                    begin
  215.                      if ( Counter_1 + 1 ) > TheMultipleFilesList.Count then
  216.                      begin
  217.                        AbortCoding( EC_NOBEGIN , 'No Begin Found!' );
  218.                        Result := false;
  219.                        exit;
  220.                      end;
  221.                      TempName := TheMultipleFilesList.Strings[ Counter_1 ];
  222.                      CurrentInputFileName := TempName;
  223.                      TotalBytesSoFar := 0;
  224.                      TotalBytesToDo := GetTextFileSize( CurrentInputFileName );
  225.                      AssignFile( TheInputFile ,
  226.                                  CurrentInputFileName );
  227.                      Reset( TheInputFile );
  228.                      HoldingString :=
  229.                       ScanLinesForDecodeStartup;
  230.                      if HoldingString <> '' then
  231.                      begin
  232.                        CurrentMFInPointer := Counter_1;
  233.                        CurrentOutputFileName :=
  234.                         HoldingString;
  235.                        try
  236.                          AssignFile( TheOutputFile ,
  237.                           CurrentOutputFileName );
  238.                          Rewrite( TheOutputFile );
  239.                          Through := true;
  240.                          Result := true;
  241.                        except
  242.                          On EInOutError do
  243.                          begin
  244.                            AbortCoding( EC_OUTPUTFILEERROR ,
  245.                             'Error Opening Output File ' );
  246.                            Result := false;
  247.                            exit;
  248.                          end;
  249.                        end;
  250.                      end
  251.                      else
  252.                      begin
  253.                        CloseFile( TheInputFile );
  254.                        Result := false;
  255.                      end;
  256.                    end;
  257.                  end;
  258.   end;
  259. end;
  260.  
  261. { This function attempts to decode one or more files and output the bytes }
  262. function TUUCodingObject.Decode : Boolean;
  263. var Through   : Boolean;
  264.     Finished  : Boolean;
  265.     TempName  : String;
  266. begin
  267.   Result := false;
  268.   case CurrentMultiFileVector of
  269.     CMV_SINGLE : begin
  270.                    If not StartDecoding then exit;
  271.                    if DecodeCurrentInputs then
  272.                    begin
  273.                      if Assigned( FOnOutputStatus ) then
  274.                       FOnOutputStatus( TotalBytesToDo , TotalBytesToDo );
  275.                      CloseFile( TheInputFile );
  276.                      CloseFile( TheOutputFile );
  277.                      Result := true;
  278.                      exit;
  279.                    end
  280.                    else
  281.                    begin
  282.                      Result := false;
  283.                      exit;
  284.                    end;
  285.                  end;
  286.     CMV_MULTI  : begin
  287.                    if not StartDecoding then exit;
  288.                    Through := false;
  289.                    while not Through do
  290.                    begin
  291.                      if not DecodeCurrentInputs then
  292.                      begin
  293.                        CloseFile( TheInputFile );
  294.                        CloseFile( TheOutputFile );
  295.                        Result := false;
  296.                        exit;
  297.                      end;
  298.                      if CurrentErrorCode = 2 then
  299.                      begin { Still getting data; keep looking }
  300.                        CurrentMFInPointer := CurrentMFInPointer + 1;
  301.                        if CurrentMFInPointer > TheMultipleFilesList.Count then
  302.                        begin
  303.                          Result := false;
  304.                          CloseFile( TheInputFile );
  305.                          CloseFile( TheOutputFile );
  306.                          exit;
  307.                        end
  308.                        else
  309.                        begin
  310.                          CloseFile( TheInputFile );
  311.                          TempName :=
  312.                           TheMultipleFilesList.Strings[ CurrentMFInPointer ];
  313.                          CurrentInputFileName := TempName;
  314.                         TotalBytesSoFar := 0;
  315.                         TotalBytesToDo := GetTextFileSize( CurrentInputFileName );
  316.                          AssignFile( TheInputFile ,
  317.                                      CurrentInputFileName );
  318.                          Reset( TheInputFile );
  319.                          CurrentLineNumber := 0;
  320.                          Finished := false;
  321.                          CurrentErrorCode := 0;
  322.                          while not Finished do
  323.                          begin
  324.                            GetNextInputFileLine( CurrentLine );
  325.                            if CheckForBEGIN_ENDLine( CurrentLine , 1 ) then
  326.                            begin
  327.                              Finished := true;
  328.                            end
  329.                            else
  330.                            begin
  331.                              if CurrentErrorCode <> 0 then
  332.                              begin
  333.                                AbortCoding( EC_NOBEGIN ,
  334.                                 'Multi-File File without BEGIN-' );
  335.                                Result := false;
  336.                                exit;
  337.                              end;
  338.                            end;
  339.                          end;
  340.                        end;
  341.                      end
  342.                      else
  343.                      begin
  344.                        Result := true;
  345.                        CloseFile( TheInputFile );
  346.                        CloseFile( TheOutputFile );
  347.                        Through := true;
  348.                      end;
  349.                    end;
  350.                  end;
  351.   end;
  352. end;
  353.  
  354. { This sets the multiple file vector }
  355. procedure TUUCodingObject.SetMultiFileVector( TheVector : Integer );
  356. begin
  357.   CurrentMultiFileVector := TheVector;
  358. end;
  359.  
  360. { This procedure aborts decoding and shuts down the processing }
  361. procedure TUUCodingObject.AbortCoding( AbortCode : Integer; AbortMessage : string);
  362. begin
  363.   { Save abort code }
  364.   CurrentErrorCode := AbortCode;
  365.   { Save error message }
  366.   CurrentErrorMessage := AbortMessage;
  367.   { If error vector set send data to it }
  368.   if Assigned( FOnUUErrorOccurred ) then
  369.    FOnUUErrorOccurred(  CurrentErrorCode , CurrentErrorMessage );
  370.   { shut down input vector }
  371.   CloseFile( TheInputFile );
  372.   { shut down output vector }
  373.   CloseFile( TheOutputFile );
  374. end;
  375.  
  376. { Read a line of the Input file }
  377. procedure TUUCodingObject.GetNextInputFileLine( var OutputString : string );
  378. begin
  379.   CurrentLineNumber := CurrentLineNumber + 1;
  380.   try
  381.     Readln( TheInputFile , OutputString );
  382.     TotalBytesSoFar := TotalBytesSoFar + Length( OutputString );
  383.     if Assigned( FOnOutputStatus ) then
  384.      FOnOutputStatus( TotalBytesSoFar, TotalBytesToDo );
  385.   except
  386.     OutputString := '';
  387.     AbortCoding( EC_EOF , 'Unexpected End of File' );
  388.   end;
  389. end;
  390.  
  391. { This procedure obtains a space-delimited word from a string }
  392. procedure TUUCodingObject.GetNextSDWord(     TheInputString : String;
  393.                          var WordGotten     : string;
  394.                          var PositionIndex  : integer );
  395. begin
  396.   { Clear output word }
  397.   WordGotten := '';
  398.   { Run along until not at a space }
  399.   while TheInputString[ PositionIndex ] = ' ' do
  400.   begin
  401.     { Increment position index }
  402.     PositionIndex := PositionIndex + 1;
  403.     { if overrun string set error and abort }
  404.     if PositionIndex > length( TheInputString ) then
  405.     begin
  406.       WordGotten := '';
  407.       exit;
  408.     end;
  409.   end;
  410.   { Now run until find a space }
  411.   while TheInputString[ PositionIndex ] <> ' ' do
  412.   begin
  413.     { Add char to the word to get }
  414.     WordGotten := WordGotten + TheInputString[ PositionIndex ];
  415.     { move pointer up }
  416.     PositionIndex := PositionIndex + 1;
  417.     { abort silently if end of line }
  418.     if PositionIndex > length( TheInputString ) then
  419.     begin
  420.       exit;
  421.     end;
  422.   end
  423. end;
  424.  
  425. { This takes care of multiple dot UNIX filenames and fn > 12 or 8.3 }
  426. function TUUCodingObject.
  427.  GetAUsableSingleExtensionFileName( InputName : String ) : String;
  428. var HoldingString ,            { Strings to hold data while working }
  429.     TempString      : String;  { more so.                           }
  430.     BestPosition    : Integer; { Holds last period position for ext }
  431.     Counter_1       : Integer; { Loop counter                       }
  432. begin
  433.   { Set no dots found }
  434.   BestPosition := -1;
  435.   { Run loop to find last dot which marks extension }
  436.   for Counter_1 := 1 to Length( InputName ) do
  437.   begin
  438.     { Move counter to last position }
  439.     if InputName[ Counter_1 ] = '.' then BestPosition := Counter_1;
  440.   end;
  441.   { If not found to have an extension }
  442.   if BestPosition = -1 then
  443.   begin
  444.     { Grab first 8 chars, tack on default and exit }
  445.     HoldingString := Copy( InputName , 1 , 8 ) + UUDefaultSuffix;
  446.     Result := HoldingString;
  447.   end
  448.   else
  449.   begin
  450.     { If dotted filename }
  451.     if BestPosition = 1 then
  452.     begin
  453.       { Grab next 8 chars and put on default extension and exit }
  454.       HoldingString := Copy( InputName , 2 , 8 ) + UUDefaultSuffix;
  455.       Result := HoldingString;
  456.     end
  457.     else
  458.     begin
  459.       { copy to working string }
  460.       HoldingString := InputName;
  461.       { Convert all . but last one to _ }
  462.       For Counter_1 := 1 to BestPosition - 1 do
  463.       begin
  464.         { do the conversion }
  465.         if HoldingString[ Counter_1 ] = '.' then
  466.          HoldingString[ Counter_1 ] := '_';
  467.       end;
  468.       { if main name longer than 8 chars set it to that }
  469.       if BestPosition > 9 then
  470.       begin
  471.         { preserve original extension }
  472.         TempString := Copy( HoldingString , BestPosition , 255 );
  473.         HoldingString := Copy( HoldingString , 1 , 8 ) + TempString;
  474.       end;
  475.       { if remaining string longer than 8.3 then has oversize ext }
  476.       if Length( HoldingString ) > 12 then
  477.       begin
  478.         { So trim off all but first 12 chars }
  479.         HoldingString := Copy( HoldingString , 1 , 12 );
  480.       end;
  481.       { and return a result }
  482.       Result := HoldingString;
  483.     end;
  484.   end;
  485. end;
  486.  
  487. { This function checks for multipart block headers on lines }
  488. function TUUCodingObject.CheckForBEGIN_ENDLine( InputLine : String;
  489.                                                 Vector : Integer ) : boolean;
  490. begin
  491.   Result := false;
  492.   case Vector of
  493.     { BEGIN check }
  494.     1 : begin
  495.           { Do an uppercase; assume standard UU begin-space }
  496.           if Pos( 'BEGIN-' , Uppercase( InputLine )) = 1 then
  497.           begin
  498.             { If find hypenated begin assume cutline }
  499.             Result := true;
  500.           end
  501.           else
  502.           begin
  503.             { Otherwise keep scanning }
  504.             Result := false;
  505.           end;
  506.         end;
  507.     { END check }
  508.     2 : begin
  509.           { Do an uppercase; assume standard UU end only }
  510.           if Pos( 'END-' , Uppercase( InputLine )) = 1 then
  511.           begin
  512.             { If find hyphenated end assume cutline }
  513.             Result := true;
  514.           end
  515.           else
  516.           begin
  517.             if InputLine = '.' then
  518.             begin
  519.               Result := true;
  520.               exit;
  521.             end;
  522.             { Otherwise keep scanning }
  523.             Result := false;
  524.           end;
  525.         end;
  526.   end;
  527. end;
  528.  
  529. { This function returns true or false depending on getting output name }
  530. function TUUCodingObject.DecodeOutputName( TheInputString : String ) : String;
  531. var TheIndex     : Integer; { Index counter for double get }
  532.     ResultString : String;  { final result holder          }
  533. begin
  534.   { Check for begin space startup }
  535.   TheIndex := Pos( 'BEGIN ' , Uppercase( TheInputString ));
  536.   { If not found then set to null and exit; }
  537.   if TheIndex <> 1 then
  538.   begin
  539.     Result := '';
  540.     exit;
  541.   end;
  542.   { Set to start of mode integer }
  543.   TheIndex := 7;
  544.   { Clear return var }
  545.   ResultString := '';
  546.   { Get a mode integer }
  547.   GetNextSDWord( TheInputString , ResultString , TheIndex );
  548.   { throw it away }
  549.   ResultString := '';
  550.   { Get a filename }
  551.   GetNextSDWord( TheInputstring , ResultString , TheIndex );
  552.   if ResultString = '' then Result := '' else
  553.    { Return it through filename filter }
  554.    Result := GetAUsableSingleExtensionFileName( ResultString );
  555. end;
  556.  
  557. { This method scans for the line containing the filename in Decode }
  558. function TUUCodingObject.ScanLinesforDecodeStartup : String;
  559. var TestLine   ,           { Hold result of line get }
  560.     HoldResult   : String; { Hold result of decode   }
  561.     Through      : Boolean;
  562. begin
  563.   { Set flag }
  564.   Through := false;
  565.   { Run loop }
  566.   while not Through do
  567.   begin
  568.     { Get an input line }
  569.     GetNextInputFileLine( TestLine );
  570.     { If null then hit EOF prematurely; exit }
  571.     if EOF( TheInputFile ) then
  572.     begin
  573.       Result := '';
  574.       exit;
  575.     end;
  576.     { Scan for some kind of file name on line }
  577.     HoldResult := DecodeOutputName( TestLine );
  578.     { If no good then will be ''; otherwise got valid }
  579.     if HoldResult <> '' then
  580.     begin
  581.       { Return the result, set flag and exit }
  582.       Result := HoldResult;
  583.       exit;
  584.     end;
  585.   end;
  586. end;
  587.  
  588. { This method scans for the line containing BEGIN- or END- markers }
  589. function TUUCodingObject.ScanLinesforBEGINEND( Vector : Integer ) : Boolean;
  590. var HoldResult   : Boolean; { Hold result of decode   }
  591.     Through      : Boolean;
  592. begin
  593.   Result := false;
  594.   { Set flag }
  595.   Through := false;
  596.   { Run loop }
  597.   while not Through do
  598.   begin
  599.     { Get an input line }
  600.     GetNextInputFileLine( CurrentLine );
  601.     { If null then hit EOF prematurely; exit }
  602.     if CurrentLine = '' then
  603.     begin
  604.       case Vector of
  605.         1 : begin { BEGIN- search }
  606.               Result := false;
  607.               CurrentErrorCode := 1; { File has no data }
  608.               exit;
  609.             end;
  610.         2 : begin { END- search }
  611.               Result := false;
  612.               CurrentErrorCode := 2; { data ended withou END- }
  613.               exit;
  614.             end;
  615.       end;
  616.     end;
  617.     { Scan for some kind of file name on line }
  618.     HoldResult := CheckForBEGIN_ENDLine( CurrentLine , Vector );
  619.     case Vector of
  620.       1 : begin { BEGIN- search }
  621.             if HoldResult then
  622.             begin { BEGIN- found; data will follow }
  623.               Result := true;
  624.               CurrentErrorCode := 0;
  625.               exit;
  626.             end
  627.             else
  628.             begin
  629.               { Keep looking until found or run out of data }
  630.             end;
  631.           end;
  632.       2 : begin { END- search }
  633.             if HoldResult then
  634.             begin  { END- found; need to switch to next file }
  635.               Result := true;
  636.               CurrentErrorCode := 0;
  637.               exit;
  638.             end
  639.             else
  640.             begin  { END- not found; assume data still flowing }
  641.               Result := false;
  642.               CurrentErrorCode := 0;
  643.               exit;
  644.             end;
  645.           end;
  646.     end;
  647.   end;
  648. end;
  649.  
  650. { This functin makes sure an input line is not empty or the end symbol }
  651. function TUUCodingObject.CheckForValidLine : boolean;
  652. begin
  653.  { If empty line then signal error and abort }
  654.  if CurrentLine = '' then
  655.  begin
  656.    { Signal abort code and exit }
  657.    AbortCoding( EC_EMPTYDATALINE , 'Empty line in data' );
  658.    Result := false;
  659.    exit;
  660.  end;
  661.  { otherwise check for a space or pseudo-space indicating a 0 line }
  662.  CheckForValidLine := not ( CurrentLine[ 1 ] in [ ' ' , '`' ])
  663. end;
  664.  
  665. { Decode a complete line of input text }
  666. procedure TUUCodingObject.DecodeLine;
  667. var LineIndex          ,
  668.     CurrentByteNumber  ,
  669.     ByteCount          ,
  670.     Counter_1            : integer;
  671.     CharactersToDecode   : array [ 0 .. 3 ] of byte;
  672.     BinaryDataToOutput   : array [ 0 .. 2 ] of byte;
  673.  
  674.   { This internal function gets the next character in the input line }
  675.   function GetNextCharacter : Char;
  676.   begin
  677.     { Increment current character pointer }
  678.     LineIndex := LineIndex + 1;
  679.     { if overrun line then signal error and abort }
  680.     if LineIndex > Length( CurrentLine ) then
  681.     begin
  682.       AbortCoding( EC_UEODL , 'Unexpected End of Character Data in Line');
  683.       Result := Chr( 0 );
  684.       exit;
  685.     end;
  686.     { If hit invalid character then signal error and abort }
  687.     if not ( CurrentLine[ LineIndex ] in [ ' ' .. '`' ]) then
  688.     begin
  689.       AbortCoding( EC_INVALIDCHAR , 'Invalid Character in Data Line');
  690.       Result := Chr( 0 );
  691.       exit;
  692.     end;
  693.     { Do conversion on ' to space and return valid character }
  694.     if CurrentLine[LineIndex] = '`' then
  695.      GetNextCharacter := ' ' else
  696.       GetNextCharacter := CurrentLine[ LineIndex ]
  697.   end;
  698.  
  699.   { This is an internal procedure to write out a single byte of decoded data }
  700.   procedure DecodeByte;
  701.  
  702.     { This is an internal procedure to do the decoding and get new data when out }
  703.     procedure GetNextDataGroup;
  704.     var Counter_1 : integer; { Loop Counter }
  705.         Value1    : integer;
  706.     begin
  707.       { Read in }
  708.       for Counter_1 := 0 to 3 do
  709.       begin
  710.         Value1 := Ord( GetNextCharacter ) - UUCodingOffset;
  711.         if Value1 < 0 then exit;
  712.         CharactersToDecode[ Counter_1 ] := Value1;
  713.       end;
  714.       { Do binary bit shifts and additions to create real binary data }
  715.       BinaryDataToOutput[ 0 ] := ( CharactersToDecode[ 0 ] shl 2 ) +
  716.         ( CharactersToDecode[ 1 ] shr 4 );
  717.       BinaryDataToOutput[ 1 ] := ( CharactersToDecode[ 1 ] shl 4 ) +
  718.         ( CharactersToDecode[ 2 ] shr 2 );
  719.       BinaryDataToOutput[ 2 ] := ( CharactersToDecode[ 2 ] shl 6 ) +
  720.         CharactersToDecode[ 3 ];
  721.       CurrentByteNumber := 0;
  722.     end;
  723.  
  724.   { Begin DecodeByte procedure }
  725.   begin
  726.     { Clear error flag }
  727.     CurrentErrorCode := 0;
  728.     { If at end of current data get next group }
  729.     if CurrentByteNumber = 3 then GetNextDataGroup;
  730.     { If any error occurs exit at once }
  731.     if CurrentErrorCode <> 0 then exit;
  732.     { Write output bytes }
  733.     Write( TheOutputFile , BinaryDataToOutput[ CurrentByteNumber ]);
  734.     { Increment current byte number (note that it resets to 0 so won't overrun end}
  735.     CurrentByteNumber := CurrentByteNumber + 1;
  736.   end;
  737.  
  738. { Begin decode line procedure }
  739. begin
  740.   { Set start of data to 0; will be pre-incremented }
  741.   LineIndex := 0;
  742.   { Signal need for new data }
  743.   CurrentByteNumber := 3;
  744.   { Determine how many bytes on current line by  }
  745.   { Getting first character's ordinal value - 32 }
  746.   ByteCount := ( Ord( GetNextCharacter ) - UUCodingOffset );
  747.   { Run that many characters through the decode byte procedure }
  748.   { Which writes out bytes to output streams and gets new data }
  749.   { every three bytes. If less than 3 output bytes in last set }
  750.   { padding will be ignored.                                   }
  751.   for Counter_1 := 1 to ByteCount do DecodeByte
  752. end;
  753.  
  754. { This is the core decoding procedure for a current input stream }
  755. function TUUCodingObject.DecodeCurrentInputs : Boolean;
  756.  
  757.   { This is an internal function to get an input line }
  758.   function GetAnInputLine : Boolean;
  759.   begin
  760.     Result := true;
  761.     case CurrentMultiFileVector of
  762.       0 : begin { Single file decode; no END- issues }
  763.             CurrentErrorCode := 0;
  764.             GetNextInputFileline( CurrentLine );
  765.             if CurrentErrorCode <> 0 then exit;
  766.             result := true;
  767.             exit;
  768.           end;
  769.       1 : begin { Multiple file decode; must check for END- }
  770.             if ScanLinesForBEGINEND( 2 ) then
  771.             begin { END found; exit }
  772.               CurrentErrorCode := 2;
  773.               Result := true;
  774.               exit;
  775.             end
  776.             else
  777.             begin { END not found; check for end of file }
  778.               if CurrentErrorCode = 2 then
  779.               begin { Premature EOF; accept in multifile OK }
  780.                 Result := true;
  781.                 exit;
  782.               end
  783.               else
  784.               begin  { Either fatal error or OK line }
  785.                 if CurrentErrorCode < 0 then
  786.                 begin { Fatal error; abort }
  787.                   Result := false;
  788.                   exit;
  789.                 end
  790.                 else
  791.                 begin
  792.                   Result := true;
  793.                   exit;
  794.                 end;
  795.               end;
  796.             end;
  797.           end;
  798.     end;
  799.   end;
  800.  
  801. { Begin DecodeCurrentInputs function }
  802. begin
  803.   { If can't get valid input line then exit; }
  804.   if not GetAnInputLine then
  805.   begin
  806.     Result := false;
  807.     exit;
  808.   end;
  809.   { If hit end of data in multiline environment then exit OK }
  810.   if (( CurrentMultiFileVector = CMV_MULTI ) and ( CurrentErrorCode = 2 )) then
  811.   begin
  812.     Result := true;
  813.     exit;
  814.   end;
  815.   { If hit end of data in single file environment signal error }
  816.   if CurrentErrorCode = 2 then
  817.   begin
  818.     Result := false;
  819.     exit;
  820.   end;
  821.   Result := true;
  822.   { Run a check for a non-zero line; when hit zero line exit OK }
  823.   while CheckForValidLine do
  824.   begin
  825.     { Decode entire line to appropriate output vector }
  826.     DecodeLine;
  827.     { If can't get valid input line then exit; }
  828.     if not GetAnInputLine then
  829.     begin
  830.       Result := false;
  831.       exit;
  832.     end;
  833.     { If hit end of data in multiline environment then exit OK }
  834.     if (( CurrentMultiFileVector = CMV_MULTI ) and ( CurrentErrorCode = 2 )) then
  835.     begin
  836.       Result := true;
  837.       exit;
  838.     end;
  839.     { If hit end of data in single file environment signal error }
  840.     if CurrentErrorCode = 2 then
  841.     begin
  842.       Result := false;
  843.       exit;
  844.     end;
  845.   end;
  846. end;
  847.  
  848. end.
  849.