首页 诗词 字典 板报 句子 名言 友答 励志 学校 网站地图
当前位置: 首页 > 教程频道 > .NET > .NET >

UU编码解决方案

2012-02-23 
UU编码哪位有delphi写的UU编码的生成和解析的源码、控件、DLL,都行,急用,谢谢![解决办法]Delphi(Pascal) cod

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

[解决办法]

Delphi(Pascal) code
{********************************************************************}{             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. 

热点排行