【列表9.6】OctalConv的程序代碼。
unit OctalConvMain

interface
uses
   SysUtils, Types, Classes, Variants, QGraphics, QControls, QForms, QDialog
   QStdCtrls, QMask, Math, QExtCtrls, Libc;
type
   TOctalConvMainForm = class(TForm)
      Panel1: TPanel;
      Label1: TLabel;
      Label2: TLabel;
      DecEdit: TEdit;
      OctEdit: TEdit;
      Bevel1: TBevel;
      Label3: TLabel;
      MaskLabel: TLabel;
      procedure DecEditKeyPress(Sender: TObject; var Key: Char);
      procedure OctEditKeyPress(Sender: TObject; var Key: Char);
      procedure OctEditChange(Sender: TObject);
      procedure DecEditChange(Sender: TObject);
   private
       { Private declarations }
    public
       { Public declarations }
    end;

 var
    OctalConvMainForm: TOctalConvMainForm;
 implementation
 {$R *.xfm}
 function CreatePermissionMask(OctStr : String) : String;
 var
   i : Integer;
   OctBits : array[1..3] of Boolean;
   SetUID : Boolean;
   SetGID : Boolean;
   SetSticky : Boolean;
   s : String;
begin
 S :=  '-';
 SetUID := False;
 SetGID := False;
 SetSticky := False;
 if Length(OctStr) <= 4
  then for i := 1 to Length(OctStr) do
          begin
           OctBits[1] := StrToInt(OctStr[i]) and 4 <> 0;
           OctBits[2] := StrToInt(OctStr[i]) and 2 <> 0;
           OctBits[3] := StrToInt(OctStr[i]) and 1 <> 0;
           if i:=1 { Special bits }
            then begin
                     SetUID := OctBits[1];
                     SetGID := OctBits[2];
                     SetSticky := OctBits[3];
                    end
            else begin
                     if OctBits[1]
                       then s := s + 'r'
                       else s := s + '-';
                     if OctBits[2]
                      then s  := s +  'w'
                      else s := s +  '-';
                     case i of
                      2 : if SetUID
                                  then if OctBits[3]
                                           then s  := s + 's'
                                           else s  := s + 'S'
                                  else if OctBits[3]
                                           then s := s + 'x'
                                           else s := s + '-';
                      3 : if SetGID
                                  then if OctBits[3]
                                           then s := s + 's'
                                           else s := s + 'S'
                                  else if OctBits[3]
                                          then s  := s +  'x'
                                          else s  := s +  '-';
                      4 : if SetSticky
                                  then if OctBits[3]
                                           then s := s + 't'
                                           else s := s +  'T'
                                        else if OctBitS[3]
                                            then s  := s +  'x'
                                            else s := s +  '-';
                       end; { case }
                     end;
           end; { for }
 Result := s;
end;

function ConvertDecToOct(DStr : String) : String;
var                                                                                           
  s : array[0..32] of Char;
  v : Longint;
begin                                                             
  if StrToInt(DStr) = 0                                           
    then Result := '0'
    else begin
             v := StrToInt(DStr);
             sprintf(s, '%o', v);
             Result := s;
              if Length(Result) < 4
               then Result := '0' + Result;
            end;
  end;

  function ConvertOctToDec(OStr : String) : String;
  var
    i : Integer;
    Value : Longint;
    Exp : Extended;
   begin
    Value := 0;
     for i := Length(OStr) downto 1 do
      begin
        Exp := Length(OStr) - i;
        Value := Value + (StrToInt(OStr[i]) * Trunc(Power(8,Exp)));
       end; { for }
     Result := intToStr(Value);
    end;
    procedure TOctalConvMainForm. DecEditKeyPress(
      Sender: TObject; var Key: Char);
begin
 if Key in ['0'..'9', Chr(8)]
   then inherited
   else Key := Chr(0);
end;

procedure TOctalConvMainForm. OctEditKeyPress(
 Sender: TObject; var Key: Char);
begin
 if Key in ['0'..'7', Chr(8)]
   then inherited
   else Key := Chr(0);
end;

procedure TOctalConvMainForm.OctEditChange(Sender: TObject);
begin
 if OctEdit. Focused
   then if Length(OctEdit.Text) > 0
        then begin
           DecEdit.Text := ConvertOctToDec(OctEdit.Text);
           if Length(OctEdit. Text)= 4
           then MaskLabel.Caption :=CreatePermissionMask(OctEdit.Text)
          else MaskLabel.Caption := '';
        end
             else begin
                      DecEdit.Text := ";
                      MaskLabel.Caption := ";
                     end;
end;

procedure TOctalConvMainForm. DecEditChange(Sender: TObject);
begin
  if DecEdit. Focused
   then if Length(DecEdit.Text) > 0
              then begin
                       OctEdit. Text := ConvertDecToOct(DecEdit.Text);
                       if Length(OctEdit.Text) = 4
                        then MaskLabel.Caption := 
CreatePermissionMask(OctEdit.Text)
                        else MaskLabel.Caption := '';
                     end
              else begin
                       OctEdit.Text := ":
                       MaskLabel.Caption := ";
                     end;
end;
end.