base64编码和解码代码， 可以对字符串和图像进行编码和解码。(300)

{不过Base64Encode 的效率好低， 不知道那位大侠帮忙修改修改， 提升一下效率。 特别是在转换图像为字符串的时候， 真的好慢！ 也大家测试看看有什么问题， 谢谢大家！} unit uMain;interfaceuses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, DB, ADODB, ExtCtrls, typInfo, ComCtrls, jpeg;type TForm1 = class(TForm) ADOQuery1: TADOQuery; Button1: TButton; ADOConnection1: TADOConnection; Button2: TButton; Image1: TImage; Button3: TButton; Image2: TImage; Button4: TButton; Edit1: TEdit; Edit2: TEdit; Edit3: TEdit; Memo1: TMemo; procedure Button2Click(Sender: TObject); procedure FormCreate(Sender: TObject); procedure FormClose(Sender: TObject; var Action: TCloseAction); procedure Button1Click(Sender: TObject); procedure Button3Click(Sender: TObject); procedure Button4Click(Sender: TObject); private FPicStream: TMemoryStream; function SavePic: Boolean; function Base64Encode(Ptr: Pointer; ASize: Integer): String; function Base64Decode(base64Code: String; Ptr: Pointer): integer; public { Public declarations } end;var Form1: TForm1;implementationconst EnMap: array [0..63] of char =( 'A', 'B', 'C', 'D', 'E', 'F', 'G', 'H', 'I', 'J', 'K', 'L', 'M', 'N', 'O', 'P', 'Q', 'R', 'S', 'T', 'U', 'V', 'W', 'X', 'Y', 'Z', 'a', 'b', 'c', 'd', 'e', 'f', 'g', 'h', 'i', 'j', 'k', 'l', 'm', 'n', 'o', 'p', 'q', 'r', 's', 't', 'u', 'v', 'w', 'x', 'y', 'z', '0', '1', '2', '3', '4', '5', '6', '7', '8', '9', '+', '/'); DeMap: array[Char] of Byte = ( 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 62, 0, 0, 0, 63, 52, 53, 54, 55, 56, 57, 58, 59, 60, 61, 0, 0, 0, 0, 0, 0, 0, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 0, 0, 0, 0, 0, 0, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, 48, 49, 50, 51, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0);{$R *.dfm}procedure TForm1.Button2Click(Sender: TObject);var bmp: TBitmap;begin bmp := TBitmap.Create; try bmp.Width := 500; bmp.Height:= 500; bmp.Canvas.StretchDraw(rect(0, 0, 500, 500), Image1.Picture.Graphic); Image1.Picture.Graphic := nil; bmp.PixelFormat := pf24bit; SetStretchBltMode(bmp.Canvas.Handle, STRETCH_HALFTONE); Image1.Width := 500; Image1.Height := 500; Image1.Canvas.StretchDraw(rect(0, 0, 500, 500), bmp); finally bmp.Free; end;end;function TForm1.SavePic: Boolean;var jpg: TJPEGImage;begin //图片调用样例， 把图片转为字符串 jpg := TJPEGImage.Create; try jpg.Assign(Image1.Picture.Bitmap); jpg.SaveToStream(FPicStream); FPicStream.Position := 0; Memo1.Lines.Text := Base64Encode(FPicStream.Memory, FPicStream.Size); finally jpg.free; end;end;procedure TForm1.FormCreate(Sender: TObject);begin FPicStream := TMemoryStream.Create;end;procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);begin FPicStream.Free;end;procedure TForm1.Button1Click(Sender: TObject);begin SavePic;end;procedure TForm1.Button3Click(Sender: TObject);var os: String; jpg: TJPEGImage;begin //图片调用样例， 把字符串转为图片 jpg := TJPEGImage.Create; try os := Trim(Memo1.Lines.Text); FPicStream.Clear; FPicStream.SetSize(length(os) div 4 * 3); Base64Decode(os, FPicStream.Memory); FPicStream.Position := 0; jpg.LoadFromStream(FPicStream); Image2.Width := jpg.Width; Image2.Height := jpg.Height; Image2.Picture.Bitmap.Assign(jpg); finally jpg.Free; end; end;function TForm1.Base64Encode(Ptr: Pointer; ASize: Integer): String;var a1, a2, a3, a4: Integer;begin //$3F低6位保持不变, 高两位置零 while ASize >= 3 do begin a1 := (byte(Ptr^) shr 2) and $3F; //取低6位 a2 := (((byte(Ptr^) shl 6) shr 2) or (byte(Pointer((integer(Ptr) + 1))^) shr 4)) and $3F; a3 := (((byte(Pointer((integer(Ptr) + 1))^) shl 4) shr 2) or (byte(Pointer((integer(Ptr) + 2))^) shr 6)) and $3F; a4 := (byte(Pointer((integer(Ptr) + 2))^) shl 2 shr 2) and $3F; Result := Result + EnMap[a1] + EnMap[a2] + EnMap[a3] + EnMap[a4]; ASize := ASize - 3; Ptr := pointer(integer(Ptr) + 3); end; if ASize = 1 then begin a1 := (byte(Ptr^) shr 2) and $3F; //取低6位 a2 := (byte(Ptr^) shl 6) shr 2 and $3F; Result := Result + EnMap[a1] + EnMap[a2] + '=='; end else if ASize = 2 then begin a1 := (byte(Ptr^) shr 2) and $3F; //取低6位 a2 := (((byte(Ptr^) shl 6) shr 2) or (byte(Pointer((integer(Ptr) + 1))^) shr 4)) and $3F; a3 := (byte(Pointer((integer(Ptr) + 1))^) shl 4) shr 2 and $3F; Result := Result + EnMap[a1] + EnMap[a2] + EnMap[a3] + '='; end;end;function TForm1.Base64Decode(base64Code: String; Ptr: Pointer): integer;var P: PChar; I6: Cardinal; I, Count:Integer;begin Count := 0; P := PChar(base64Code); I := Length(base64Code); while I > 0 do begin if I < 4 then break; I6 := DeMap[P^]; Inc(P); if I < 3 then break; I6 := (I6 shl 6) + DeMap[P^]; Inc(P); if I < 2 then break; if P^ = '=' then Dec(Count); I6 := (I6 shl 6) + DeMap[P^]; Inc(P); if I < 1 then break; if P^ = '=' then Dec(Count); I6 := (I6 shl 6) + DeMap[P^]; Inc(P); Byte(Ptr^) := Byte(I6 shr 16); Ptr := Pointer(integer(Ptr) + 1); Inc(Count); Byte(Ptr^) := Byte((I6 shr 8) and $ff); Ptr := Pointer(integer(Ptr) + 1); Inc(Count); Byte(Ptr^) := Byte(I6 and $ff); Ptr := Pointer(integer(Ptr) + 1); Inc(Count); Dec(I,4); end; Result := Count;end;procedure TForm1.Button4Click(Sender: TObject);var s, os: String; vSize: Integer;begin //字符串调用样例 s := Trim(Edit1.Text); vSize := length(s); Edit2.Text := Base64Encode(Pointer(s), vSize); s := Trim(Edit2.Text); SetLength(os, length(s) div 4 * 3); Base64Decode(s, Pointer(os)); Edit3.Text := os;end;end.

不知你试过Delphi自带的base64编码没？在EncdDecd单元的如果你是用cnpack的可能会存在一些问题，我试过的问题是先压缩，再base64Encode,接下来base64decode再解压缩时不正确，解压时提示格式不对，但用delphi自带的没问题，你试一下它的效率吧！

估计是一些特殊字符的问题！ 比如＃10和#13没有处理！ 谢谢楼上.

用StringStream 处理吧， delphi自带的一组件，里面有base64编码方式的。查查资料。

Google关键字：base64 最快你上面的base64代码不慢，慢的地方在于Memo显示

我自已编了一个BASE64，比标准的快，因为没有按标准的方法组织，映射的字符不一样，而且代码也更简洁优美。

to 我爱PASCAL自己写，牛！我是比较懒的，只会拿来用。

多人接受答案了。