UU编码

Question

哪位有delphi写的UU编码的生成和解析的源码、控件、DLL，都行，急用，谢谢！ 

Answer 1

{********************************************************************}
{          HSoftware Components Collection                    }
{                                                                    }
{            Copyright (C) 1996 by Artem A. Berman              }
{                                                                    }
{********************************************************************}unit UUCode;interfaceuses
   WinTypes, SysUtils, Messages, Classes, Forms;type
   TUUNotifyEvent = procedure (Sender: TObject; Percent: LongInt) of Object;   EUUError = class(Exception);   TUUCode = class(TComponent)
   private
     fUUEncode,
     fUUDecode: TUUNotifyEvent;
   public
     procedure UUEncode(aSource, aDest: TStream; fSource: TFileName);
     procedure UUDecode(aSource, aDest: TStream; fDestination: TFileName);
   published
     property OnEncode: TUUNotifyEvent read fUUEncode write fUUEncode;
     property OnDecode: TUUNotifyEvent read fUUDecode write fUUDecode;
   end;procedure Register;implementationprocedure TUUCode.UUEncode(aSource, aDest: TStream; fSource: TFileName);
const
   FileStart: string[6] = 'begin ';
   FileEnd: string[5] = 'end';function Enc(Sym: Integer): Char;
begin
  if Sym = 0 then Enc := '`' else Enc := Chr((Sym  AND 63) + Ord(' '));
end;procedure OutEnc(buf: PChar; var aDest: TStream);
var
   c1, c2, c3, c4: Char;
begin
  c1 := Enc( word(buf^) SHR 2 );
  c2 := Enc( ( (word(buf^) SHL 4) and 48 )  or
       ( (word(buf[1]) SHR 4) and 15) );
  c3 := Enc( ( (word(buf[1]) SHL 2) and 60 )  or
       ( (word(buf[2]) SHR 6) and 3) );
  c4 := Enc( word(buf[2]) and 63 );  with aDest do
  begin
    Write(c1, 1);
    Write(c2, 1);
    Write(c3, 1);
    Write(c4, 1);
  end;
end;var
  buf: array [0..79] of Char;
  Status: string[5];
  c: Char;
  i: Integer;
  Readed, Percent: LongInt;begin
  if fSource <> '' then  if FileGetAttr(fSource) = faReadOnly then
  Status := '444 ' else Status := '644 ';  if aSource.Size = 0 then raise EUUError.Create('Empty source stream');  with aDest do
  begin
    for i := 1 to Length(FileStart) do Write(FileStart[i], 1);
    for i := 1 to Length(Status) do Write(Status[i], 1);    if fSource <> '' then
    for i := 1 to Length(fSource) do Write(fSource[i], 1);
    c := #10;
    Write(c, 1);
    c := #13;
    Write(c, 1);
  end;  while True do
  begin
    Readed := aSource.Read(buf, 45);
    c := Enc(Readed);
    aDest.Write(c, 1);    i := 0;
    while i < Readed do
    begin
       OutEnc(@buf[i], aDest);
       i := i + 3;
    end;    Percent := aSource.Position*100 div aSource.Size;
    if Assigned(fUUEncode) then fUUEncode(Self, Percent);    c := #10;
    aDest.Write(c, 1);
    c := #13;
    aDest.Write(c, 1);    Application.ProcessMessages;
    if Readed = 0 then break;
  end;  with aDest do
  begin
    for i := 1 to Length(FileEnd) do Write(FileEnd[i], 1);
    c := #10;
    Write(c, 1);
    c := #13;
    Write(c, 1);
  end;
end;procedure TUUCode.UUDecode(aSource, aDest: TStream; fDestination: TFileName);function Dec(Sym: Char): Word;
begin
   Dec := (Ord(Sym) - Ord(' ')) AND $3F;
end;procedure OutDec(buf: PChar; n: Integer; aDest: TStream);
var
   c1, c2, c3: Char;
begin
  c1 := Chr( (word(Dec(buf^)) SHL 2) or (word(Dec(buf[1])) SHR 4) );
  c2 := Chr( (word(Dec(buf[1])) SHL 4) or (word(Dec(buf[2])) SHR 2) );
  c3 := Chr( (word(Dec(buf[2])) SHL 6) or (word(Dec(buf[3]))) );  with aDest do
  begin
    if n >= 1 then Write(c1, 1);
    if n >= 2 then Write(c2, 1);
    if n >= 3 then Write(c3, 1);
  end;
end;const
  FoundBegin: Boolean = False;var
  buf: string[80];
  fmask: string[3];
  bp: PChar;
  ch: Char;
  i, n: Integer;
  Percent: LongInt;begin
  if aSource.Size = 0 then raise EUUError.Create('Empty source stream');  while True do
  begin
    buf := '';
    repeat
      aSource.Read(ch, 1);
      if (ch <> #13) AND (ch <> #10) then buf := buf + ch;
    until ch = #10;    ch := #10;
    aSource.Write(ch, 1);
    ch := #80;
    aSource.Write(ch, 1);    n := DEC(buf[1]);
    if n <= 0 then break;    if not FoundBegin then
    begin
      if Pos('begin', buf) <> 0 then
      begin
         FoundBegin := True;
         FillChar(fmask, SizeOf(fmask), #32);
         fmask := Copy(buf, 7, 10);
         Continue;
      end else Continue;
    end;    Percent := aSource.Position*100 div aSource.Size;
    if Assigned(fUUDecode) then fUUDecode(Self, Percent);    bp := @buf[2];
    repeat
      OutDec(bp, n, aDest);
      n := n - 3;
      bp := bp + 4;
    until n <= 0;    Application.ProcessMessages;
  end;  if not FoundBegin then raise EUUError.Create('No begin line');  if (fmask = '444') AND (fDestination <> '') then FileSetAttr(fDestination, faReadOnly);
  FoundBegin := False;
end;procedure Register;
begin
  RegisterComponents('Samples', [TUUCode]);
end;
end.

Answer 2

to:hongqi162你给的代码不太好用啊！

Answer 3

我自己写了一套函数：
function TThread_Socket.UUBuild(strIn:string):string;//生成UU编码
var str,str1,asc,hex:string;
    i:integer;
begin
  try
    hex:='';
    for i:=length(strIn) downto 1 do
      hex:=hex+copy(strIn,i,1);
    hex:=HexToAsc(hex);
    hex:=AnsiReplaceStr(hex,' ','');
    while ((length(hex) div 2) mod 3)<>0 do
      hex:='00'+hex;
    //
    str:='';
    i:=1;
    while i<=length(hex) do
    begin
      str:=str+IntToBin(strtoint('$'+format('%s%s',[hex[i],hex[i+1]])),8);
      i:=i+2;
    end;
    //
    asc:='';
    while str<>'' do
    begin
      str1:=copy(str,length(str)-5,6);
      str1:=StrToHex(inttohex(BinToInt(str1),2));
      str1:=char(byte(str1[1])+$20);
      if byte(str1[1])=$20 then
        str1:=#$60;
      asc:=asc+str1;
      if length(str)>=6 then
        delete(str,length(str)-5,6)
      else
        str:='';
    end;
    result:=asc;
  except
    result:='';
  end;
end;function TThread_Socket.UUParse(strIn:string):string;//解析UU编码
var str,str1,asc,hex:string;
    i:integer;
begin
  try
    hex:='';
    for i:=length(strIn) downto 1 do
      hex:=hex+copy(strIn,i,1);
    asc:='';
    for i:=1 to length(hex) do
    begin
      if byte(hex[i])=$60 then
        asc:=asc+#$00
      else
        asc:=asc+char(byte(hex[i])-$20);
    end;
    //
    hex:=HexToAsc(asc);
    hex:=AnsiReplaceStr(hex,' ','');
    str:='';
    i:=1;
    while i<=length(hex) do
    begin
      str:=str+IntToBin(strtoint('$'+format('%s%s',[hex[i],hex[i+1]])),6);
      i:=i+2;
    end;
    //
    asc:='';
    while str<>'' do
    begin
      str1:=copy(str,length(str)-7,8);
      str1:=StrToHex(inttohex(BinToInt(str1),2));
      asc:=asc+str1;
      if length(str)>=8 then
        delete(str,length(str)-7,8)
      else
        str:='';
    end;
    result:=asc;
  except
    result:='';
  end;
end;散分了！！！！！！！！！！！！！！！！！！！！！