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.