Sign in Join
Wiki copytemporary

Base64: what changed

Revision 1 to 2. Removed lines have a minus sign; added lines have a plus sign.

OldNewLine
1-Various code examples to handle Base64 encoded strings.
2-
3-## Contents
4-
5- * 1 Convert Base64 string to picture, 1
6- * 2 Convert Base64 string to picture, 2
7- * 3 Convert Base64 string to picture, using BGRABitmap
1+Various code examples to handle Base64 encoded strings.
82
93# Convert Base64 string to picture, 1
104
11-Example from forum member **wp**.
12-```
5+Example from forum member **wp**.
6+
7+``` pascal
138uses
14- Classes, Base64;
15-
16- procedure DecodeBase64ToStream(AStream: TStream; const s: string; strict: boolean=false);
17- var
18- SD: String;
19- InStream: TStringStream;
20- Decoder: TBase64DecodingStream;
21- begin
22- if Length(s)=0 then
23- Exit;
24- SD := S;
25- while Length(Sd) mod 4 > 0 do
26- SD := SD + '=';
27- InStream:= TStringStream.Create(SD);
28- try
29- if strict then
30- Decoder:=TBase64DecodingStream.Create(InStream, bdmStrict)
31- else
32- Decoder:=TBase64DecodingStream.Create(InStream, bdmMIME);
33- try
34- AStream.CopyFrom(Decoder, Decoder.Size);
35- AStream.Position := 0;
36- finally
37- Decoder.Free;
38- end;
39- finally
40- InStream.Free;
41- end;
42- end;
43-
44- var
45- base64String: String =
46- 'iVBORw0KGgoAAAANSUhEUgAAARIAAAAdCAYAAABmFuNCAAAFPElEQVR4Xu2cy5oiIQyFdaPP'+
47- 'PCt1Nc9sbxyRTlcqJuFAYdvf9HGjllSAQ/grXGR/vV5vO76oABWgAhsU2BMkG9TjrVSACjwU'+
48- 'IEjoCFSACmxWwAXJ4XDY7fe73fX6scpg1nVtNLLZWzPEzqzyM6/3+sasdkT8kHlVlVo+/wSS'+
49- '4/Hv7nY71XBlf7nD5M/j86zruvEimzW/Q8oSDbnMjhiZVX7m9V7fmNWOiB8yr7zvaw3diKQI'+
50- 'WF4CEd0ZZ1y3jahtaoDcgmngEi3JS4ASlTnL6zvrxbyqU7Z0QNLM8k/mtb2Pi4bT50hKCHSP'+
51- 'ZR72Pz6uaVRhfxSIWIDs7+Q4n8+706k+Db8K/wkUOwTrypSJqQAV2KzAVJBoiPSCpEAkikCK'+
52- 'rQKTm5NAohPCZLMv0AAVGFZgGkgsROpkLRaRaIhE0Yet4eVyeUQpAhdvcnhYFd5IBahAlwJT'+
53- 'QLIFIqW0Nhqx0YdEHTog8dIwKulqeyamAtMU2AySGRAptfGGNRUgF1PZU5L2eVlymlI0RAWo'+
54- 'QKgADJIKjDKBWveWWICUaz3DGSmRXmLTpfQhIikimCzL1bbGx+Px65I35Cq/y3WdVm4qv9nr'+
55- '0dAty0vnU6OxJV/9vVVer0Uz217Zo3oi/SXSArmODnmjOuo2yTRE6qHTSNk9P4h8I0ub5Y+2'+
56- 'ldaq1ye89JGNKK3NP2q7Jkg8YHgCjUCkOsGyb2UNkhqJlD0tZT+LvEsa2eti77FL1guw1qDw'+
57- 'GsiK1Or0kaNYKLXykvTRfbYcWb7lN+3c3mcPsr2d2wOvwHaWjq1yat2ieqMw8bRvXfN8ywNb'+
58- 'D/SzBwvaqTOfR+qEpLF1SkHyaohokJTJU728q+HhwWTZNFfXgMukq95Alzkh2mG9RtV2s4gk'+
59- '6sxyf+tJY5+OSIewQPI6u+5wUUfoycvaQJ5siH0UlrrjekBG8/L0jjqUbUMU9LosSETSCw7E'+
60- '5xFIjDxAGyBZhgNRgyzLr9gKzXNla0RSJk8FCOW9QKF+X0ck+rvYEgiNgiSCw4ig2rHRzzad'+
61- 'dTiv83vtEUUJmf3Wb60OjXSqrFxoR880yQDaa18DBYXibJBIm2htRzSMyt9qsxG/D0HyHdFI'+
62- 'FSwe2kQQEcBYJxkFSRT+jwjagscItFBHbT3lkAgK7XhoCO6BCq2PLQuS50gkF7WZV07kGlI/'+
63- 'pC66XCO+2CprFMEhUctT34uOEUBBUgz27mBdP10ikJRUdRPaeo7kfL9+C1Zu+iZbrdN536Mh'+
64- 'SBYlZE8COzmXQcw+OVqdvAUSFGKtfDI46LprjaLrSF5eNGJtbx0G6Cggm1dC6ofON3l+osth'+
65- 'fSxKH2mIgiTKswdeUEQiE6mHw/NQZ3SSVSov/5vwJ08rTAo46qt+9peK61AommztdVimpwJU'+
66- 'AFegCyTFrAeTLRFJpeE6KtGbzerUifxLb4GI3QGbDWtwOZiSClCBEQWgyVYddWzdgOYVUkcl'+
67- '6Bb5B17U/28IkpHm5z1UYI4CwD4SGc7o4cXnQKPj/zSt4mZDHAsNbUtWdzikaSnM36nA6xRo'+
68- 'gkSGM/oMkDJHsXVuxI9MKrT8f/k+HyUgS8bo5NbrZKRlKvC7FYBA8kqJ7BFuembaA4qUxUKk'+
69- 'dRRcBeL7j5CcVQbdJrNsUkMeIdnrS1/90Vv+7TXWm14yz49azDfDrZf7/OMhdWebdWwej1rk'+
70- 'UYu9vvQb/PCtZ7YWgZEjEpGICLEz64g+5rX9iD5q+H9p+PYzWxFIMA0VoAI/W4G3z5H8bHlY'+
71- 'OipABRAFCBJEJaahAlQgVYAgoYNQASqwWYF/o2XhCcA1FYIAAAAASUVORK5CYII=';
72-
73- procedure TForm1.Button1Click(Sender: TObject);
74- var
75- stream: TMemoryStream;
76- begin
77- stream := TMemoryStream.Create;
78- try
79- DecodeBase64ToStream(stream, base64String);
80- Image1.Picture.LoadFromStream(stream);
81- finally
82- stream.Free;
83- end;
9+ Classes, Base64;
10+
11+procedure DecodeBase64ToStream(AStream: TStream; const s: string; strict: boolean=false);
12+var
13+ SD: String;
14+ InStream: TStringStream;
15+ Decoder: TBase64DecodingStream;
16+begin
17+ if Length(s)=0 then
18+ Exit;
19+ SD := S;
20+ while Length(Sd) mod 4 > 0 do
21+ SD := SD + '=';
22+ InStream:= TStringStream.Create(SD);
23+ try
24+ if strict then
25+ Decoder:=TBase64DecodingStream.Create(InStream, bdmStrict)
26+ else
27+ Decoder:=TBase64DecodingStream.Create(InStream, bdmMIME);
28+ try
29+ AStream.CopyFrom(Decoder, Decoder.Size);
30+ AStream.Position := 0;
31+ finally
32+ Decoder.Free;
8433 end;
34+ finally
35+ InStream.Free;
36+ end;
37+end;
38+
39+var
40+ base64String: String =
41+ 'iVBORw0KGgoAAAANSUhEUgAAARIAAAAdCAYAAABmFuNCAAAFPElEQVR4Xu2cy5oiIQyFdaPP'+
42+ 'PCt1Nc9sbxyRTlcqJuFAYdvf9HGjllSAQ/grXGR/vV5vO76oABWgAhsU2BMkG9TjrVSACjwU'+
43+ 'IEjoCFSACmxWwAXJ4XDY7fe73fX6scpg1nVtNLLZWzPEzqzyM6/3+sasdkT8kHlVlVo+/wSS'+
44+ '4/Hv7nY71XBlf7nD5M/j86zruvEimzW/Q8oSDbnMjhiZVX7m9V7fmNWOiB8yr7zvaw3diKQI'+
45+ 'WF4CEd0ZZ1y3jahtaoDcgmngEi3JS4ASlTnL6zvrxbyqU7Z0QNLM8k/mtb2Pi4bT50hKCHSP'+
46+ 'ZR72Pz6uaVRhfxSIWIDs7+Q4n8+706k+Db8K/wkUOwTrypSJqQAV2KzAVJBoiPSCpEAkikCK'+
47+ 'rQKTm5NAohPCZLMv0AAVGFZgGkgsROpkLRaRaIhE0Yet4eVyeUQpAhdvcnhYFd5IBahAlwJT'+
48+ 'QLIFIqW0Nhqx0YdEHTog8dIwKulqeyamAtMU2AySGRAptfGGNRUgF1PZU5L2eVlymlI0RAWo'+
49+ 'QKgADJIKjDKBWveWWICUaz3DGSmRXmLTpfQhIikimCzL1bbGx+Px65I35Cq/y3WdVm4qv9nr'+
50+ '0dAty0vnU6OxJV/9vVVer0Uz217Zo3oi/SXSArmODnmjOuo2yTRE6qHTSNk9P4h8I0ub5Y+2'+
51+ 'ldaq1ye89JGNKK3NP2q7Jkg8YHgCjUCkOsGyb2UNkhqJlD0tZT+LvEsa2eti77FL1guw1qDw'+
52+ 'GsiK1Or0kaNYKLXykvTRfbYcWb7lN+3c3mcPsr2d2wOvwHaWjq1yat2ieqMw8bRvXfN8ywNb'+
53+ 'D/SzBwvaqTOfR+qEpLF1SkHyaohokJTJU728q+HhwWTZNFfXgMukq95Alzkh2mG9RtV2s4gk'+
54+ '6sxyf+tJY5+OSIewQPI6u+5wUUfoycvaQJ5siH0UlrrjekBG8/L0jjqUbUMU9LosSETSCw7E'+
55+ '5xFIjDxAGyBZhgNRgyzLr9gKzXNla0RSJk8FCOW9QKF+X0ck+rvYEgiNgiSCw4ig2rHRzzad'+
56+ 'dTiv83vtEUUJmf3Wb60OjXSqrFxoR880yQDaa18DBYXibJBIm2htRzSMyt9qsxG/D0HyHdFI'+
57+ 'FSwe2kQQEcBYJxkFSRT+jwjagscItFBHbT3lkAgK7XhoCO6BCq2PLQuS50gkF7WZV07kGlI/'+
58+ 'pC66XCO+2CprFMEhUctT34uOEUBBUgz27mBdP10ikJRUdRPaeo7kfL9+C1Zu+iZbrdN536Mh'+
59+ 'SBYlZE8COzmXQcw+OVqdvAUSFGKtfDI46LprjaLrSF5eNGJtbx0G6Cggm1dC6ofON3l+osth'+
60+ 'fSxKH2mIgiTKswdeUEQiE6mHw/NQZ3SSVSov/5vwJ08rTAo46qt+9peK61AommztdVimpwJU'+
61+ 'AFegCyTFrAeTLRFJpeE6KtGbzerUifxLb4GI3QGbDWtwOZiSClCBEQWgyVYddWzdgOYVUkcl'+
62+ '6Bb5B17U/28IkpHm5z1UYI4CwD4SGc7o4cXnQKPj/zSt4mZDHAsNbUtWdzikaSnM36nA6xRo'+
63+ 'gkSGM/oMkDJHsXVuxI9MKrT8f/k+HyUgS8bo5NbrZKRlKvC7FYBA8kqJ7BFuembaA4qUxUKk'+
64+ 'dRRcBeL7j5CcVQbdJrNsUkMeIdnrS1/90Vv+7TXWm14yz49azDfDrZf7/OMhdWebdWwej1rk'+
65+ 'UYu9vvQb/PCtZ7YWgZEjEpGICLEz64g+5rX9iD5q+H9p+PYzWxFIMA0VoAI/W4G3z5H8bHlY'+
66+ 'OipABRAFCBJEJaahAlQgVYAgoYNQASqwWYF/o2XhCcA1FYIAAAAASUVORK5CYII=';
67+
68+procedure TForm1.Button1Click(Sender: TObject);
69+var
70+ stream: TMemoryStream;
71+begin
72+ stream := TMemoryStream.Create;
73+ try
74+ DecodeBase64ToStream(stream, base64String);
75+ Image1.Picture.LoadFromStream(stream);
76+ finally
77+ stream.Free;
78+ end;
79+end;
8580```
8681
8782# Convert Base64 string to picture, 2
8883
89-This unit is from forum member **KodeZwerg**. He created a pretty easy to handle method that supports now all (?) formats that Lazarus Graphics offers. To name them: JPEG, PNG, GIF, BMP, ICO and TIFF.
90-```
84+This unit is from forum member **KodeZwerg**. He created a pretty easy to handle method that supports now all (?) formats that Lazarus Graphics offers. To name them: JPEG, PNG, GIF, BMP, ICO and TIFF.
85+
86+``` pascal
9187unit uBase64Image;
92-
93- {$mode ObjFPC}{$H+}
94-
95- interface
96-
97- uses
98- Classes, SysUtils, Graphics, ExtCtrls, Base64;
99-
100- function FileToBytes(const AFilename: string): TBytes;
101- function BytesToBase64(const AData: TBytes): AnsiString;
102- function Base64ToBytes(const ABase64String: AnsiString): TBytes;
103- function GetGraphicClassFromBytes(const AData: TBytes): TGraphicClass;
104- procedure AssignBase64ToImage(const ABase64String: AnsiString; const AImage: TImage);
105-
106- implementation
107-
108- { convert any file into bytes }
109-
110- function FileToBytes(const AFilename: string): TBytes;
111- var
112- FileStream: TFileStream;
113- begin
114- FileStream := TFileStream.Create(AFileName, fmOpenRead or fmShareDenyWrite);
115- try
116- SetLength(Result, FileStream.Size);
117- FileStream.ReadBuffer(Result[0], FileStream.Size);
118- finally
119- FileStream.Free;
120- end;
121- end;
122-
123- { convert bytes to base64 }
124-
125- function BytesToBase64(const AData: TBytes): AnsiString;
126- var
127- encodedStream: TStringStream;
128- encodingStream: TBase64EncodingStream;
129- begin
130- encodedStream := TStringStream.Create('');
131- try
132- encodingStream := TBase64EncodingStream.Create(encodedStream);
133- try
134- encodingStream.WriteBuffer(AData[0], Length(AData));
135- finally
136- encodingStream.Free;
137- end;
138- Result := encodedStream.DataString;
139- finally
140- encodedStream.Free;
141- end;
142- end;
143-
144- { convert base64 to bytes }
145-
146- function Base64ToBytes(const ABase64String: AnsiString): TBytes;
147- var
148- decodedStream: TBase64DecodingStream;
149- base64stream: TStringStream;
150- begin
151- base64stream := TStringStream.Create(ABase64String);
152- try
153- decodedStream := TBase64DecodingStream.Create(base64stream);
154- try
155- SetLength(Result, decodedStream.Size);
156- decodedStream.ReadBuffer(Result[0], decodedStream.Size);
157- finally
158- decodedStream.Free;
159- end;
160- finally
161- base64stream.Free;
162- end;
88+
89+{$mode ObjFPC}{$H+}
90+
91+interface
92+
93+uses
94+ Classes, SysUtils, Graphics, ExtCtrls, Base64;
95+
96+function FileToBytes(const AFilename: string): TBytes;
97+function BytesToBase64(const AData: TBytes): AnsiString;
98+function Base64ToBytes(const ABase64String: AnsiString): TBytes;
99+function GetGraphicClassFromBytes(const AData: TBytes): TGraphicClass;
100+procedure AssignBase64ToImage(const ABase64String: AnsiString; const AImage: TImage);
101+
102+implementation
103+
104+{ convert any file into bytes }
105+
106+function FileToBytes(const AFilename: string): TBytes;
107+var
108+ FileStream: TFileStream;
109+begin
110+ FileStream := TFileStream.Create(AFileName, fmOpenRead or fmShareDenyWrite);
111+ try
112+ SetLength(Result, FileStream.Size);
113+ FileStream.ReadBuffer(Result[0], FileStream.Size);
114+ finally
115+ FileStream.Free;
116+ end;
117+end;
118+
119+{ convert bytes to base64 }
120+
121+function BytesToBase64(const AData: TBytes): AnsiString;
122+var
123+ encodedStream: TStringStream;
124+ encodingStream: TBase64EncodingStream;
125+begin
126+ encodedStream := TStringStream.Create('');
127+ try
128+ encodingStream := TBase64EncodingStream.Create(encodedStream);
129+ try
130+ encodingStream.WriteBuffer(AData[0], Length(AData));
131+ finally
132+ encodingStream.Free;
163133 end;
164-
165- { determine the image format }
166-
167- function GetGraphicClassFromBytes(const AData: TBytes): TGraphicClass;
168- begin
169- Result := nil;
170- // JPEG
171- if (((Length(AData) >= 8) and (CompareMem(@AData[0], @[$FF, $D8, $FF, $DB], 4)
172- or CompareMem(@AData[0], @[$FF, $D8, $FF, $E0, $00, $10, $4A, $46], 8)
173- or CompareMem(@AData[0], @[$49, $46, $00, $01], 4)
174- or CompareMem(@AData[0], @[$FF, $D8, $FF, $EE], 4)
175- or (CompareMem(@AData[0], @[$FF, $D8, $FF, $E1], 4) and CompareMem(@AData[6], @[$45, $78], 2))
176- or CompareMem(@AData[0], @[$69, $66, $00, $00], 4)
177- or CompareMem(@AData[0], @[$FF, $D8, $FF, $E0], 4)))) then
178- Result := TJPEGImage
179- else
180- // PNG
181- if ((Length(AData) >= 8) and CompareMem(@AData[0], @[$89, $50, $4E, $47, $0D, $0A, $1A, $0A], 8)) then
182- Result := TPortableNetworkGraphic
183- else
184- // GIF
185- if ((Length(AData) >= 6) and (CompareMem(@AData[0], @[$47, $49, $46, $38, $37, $61], 6)
186- or CompareMem(@AData[0], @[$47, $49, $46, $38, $39, $61], 6))) then
187- Result := TGIFImage
188- else
189- // BMP
190- if ((Length(AData) >= 2) and CompareMem(@AData[0], @[$42, $4D], 2)) then
191- Result := TBitmap
192- else
193- // ICON
194- if ((Length(AData) >= 4) and CompareMem(@AData[0], @[$00, $00, $01, $00], 4)) then
195- Result := TIcon
196- else
197- // TIFF
198- if ((Length(AData) >= 4) and (CompareMem(@AData[0], @[$49, $49, $2A, $00], 4)
199- or CompareMem(@AData[0], @[$4D, $4D, $00, $2A], 6))) then
200- Result := TTiffImage
201- else
202- raise Exception.Create('Unknown Graphic Type!');
134+ Result := encodedStream.DataString;
135+ finally
136+ encodedStream.Free;
137+ end;
138+end;
139+
140+{ convert base64 to bytes }
141+
142+function Base64ToBytes(const ABase64String: AnsiString): TBytes;
143+var
144+ decodedStream: TBase64DecodingStream;
145+ base64stream: TStringStream;
146+begin
147+ base64stream := TStringStream.Create(ABase64String);
148+ try
149+ decodedStream := TBase64DecodingStream.Create(base64stream);
150+ try
151+ SetLength(Result, decodedStream.Size);
152+ decodedStream.ReadBuffer(Result[0], decodedStream.Size);
153+ finally
154+ decodedStream.Free;
203155 end;
204-
205- { analyze and display a found image format into a TImage }
206-
207- procedure AssignBase64ToImage(const ABase64String: AnsiString; const AImage: TImage);
208- var
209- bytes: TBytes;
210- graphic: TGraphic;
211- stream: TStream;
212- begin
213- AImage.Picture.Clear;
214- bytes := Base64ToBytes(ABase64String);
215- graphic := GetGraphicClassFromBytes(bytes).Create;
216- try
217- stream := TBytesStream.Create(bytes);
218- try
219- graphic.LoadFromStream(stream);
220- finally
221- stream.Free;
222- end;
223- AImage.Picture.Assign(graphic);
224- finally
225- graphic.Free;
226- end;
156+ finally
157+ base64stream.Free;
158+ end;
159+end;
160+
161+{ determine the image format }
162+
163+function GetGraphicClassFromBytes(const AData: TBytes): TGraphicClass;
164+begin
165+ Result := nil;
166+ // JPEG
167+ if (((Length(AData) >= 8) and (CompareMem(@AData[0], @[$FF, $D8, $FF, $DB], 4)
168+ or CompareMem(@AData[0], @[$FF, $D8, $FF, $E0, $00, $10, $4A, $46], 8)
169+ or CompareMem(@AData[0], @[$49, $46, $00, $01], 4)
170+ or CompareMem(@AData[0], @[$FF, $D8, $FF, $EE], 4)
171+ or (CompareMem(@AData[0], @[$FF, $D8, $FF, $E1], 4) and CompareMem(@AData[6], @[$45, $78], 2))
172+ or CompareMem(@AData[0], @[$69, $66, $00, $00], 4)
173+ or CompareMem(@AData[0], @[$FF, $D8, $FF, $E0], 4)))) then
174+ Result := TJPEGImage
175+ else
176+ // PNG
177+ if ((Length(AData) >= 8) and CompareMem(@AData[0], @[$89, $50, $4E, $47, $0D, $0A, $1A, $0A], 8)) then
178+ Result := TPortableNetworkGraphic
179+ else
180+ // GIF
181+ if ((Length(AData) >= 6) and (CompareMem(@AData[0], @[$47, $49, $46, $38, $37, $61], 6)
182+ or CompareMem(@AData[0], @[$47, $49, $46, $38, $39, $61], 6))) then
183+ Result := TGIFImage
184+ else
185+ // BMP
186+ if ((Length(AData) >= 2) and CompareMem(@AData[0], @[$42, $4D], 2)) then
187+ Result := TBitmap
188+ else
189+ // ICON
190+ if ((Length(AData) >= 4) and CompareMem(@AData[0], @[$00, $00, $01, $00], 4)) then
191+ Result := TIcon
192+ else
193+ // TIFF
194+ if ((Length(AData) >= 4) and (CompareMem(@AData[0], @[$49, $49, $2A, $00], 4)
195+ or CompareMem(@AData[0], @[$4D, $4D, $00, $2A], 6))) then
196+ Result := TTiffImage
197+ else
198+ raise Exception.Create('Unknown Graphic Type!');
199+end;
200+
201+{ analyze and display a found image format into a TImage }
202+
203+procedure AssignBase64ToImage(const ABase64String: AnsiString; const AImage: TImage);
204+var
205+ bytes: TBytes;
206+ graphic: TGraphic;
207+ stream: TStream;
208+begin
209+ AImage.Picture.Clear;
210+ bytes := Base64ToBytes(ABase64String);
211+ graphic := GetGraphicClassFromBytes(bytes).Create;
212+ try
213+ stream := TBytesStream.Create(bytes);
214+ try
215+ graphic.LoadFromStream(stream);
216+ finally
217+ stream.Free;
227218 end;
228-
229- end.
219+ AImage.Picture.Assign(graphic);
220+ finally
221+ graphic.Free;
222+ end;
223+end;
224+
225+end.
230226```
231227
232228# Convert Base64 string to picture, using BGRABitmap
233229
234-This unit is from forum member **KodeZwerg**. You must install the [[BGRABitmap]] component. But you can also use this unit without BGRABitmap, if you disable the define "UseBGRA" in the top of the "interface" part.
235-```
230+This unit is from forum member **KodeZwerg**. You must install the [[BGRABitmap]] component. But you can also use this unit without BGRABitmap, if you disable the define "UseBGRA" in the top of the "interface" part.
231+
232+``` pascal
236233unit ubase64image;
237-
238- (* ************************* *)
239- (* * Base64 to Image * *)
240- (* ************************* *)
241- { Created: 2023 by KodeZwerg }
242- { Dialect: FreePascal }
243- { Type: Helper unit }
244- { License: Unlicensed }
245-
246- { This unit can convert a Base64 encoded string into a TImage }
247- { Additional you can do the opposite, create from a file a Base64 }
248-
249- { Thank you Remy for teaching me about TGraphicClass usage! }
250- { Thank you paweld for beta testing and fixing a transparency bug! }
251- { Thank you wp for teaching me more about TGraphicClass usage! }
252- { Thank you wp for complaining about my original names, critism help! }
253-
254- {$mode ObjFPC}{$H+}
255-
256- interface
257-
258- // remove the dot to utilize BGRABitmap package
259- // put a dod infront of $ to deactivate BGRABitmap support
260- {$DEFINE UseBGRA}
261-
262- uses
263- Classes, SysUtils, Graphics, ExtCtrls, Dialogs, Types, LCLType, Controls,
264- Base64
265- {$If defined(UseBGRA)},BGRABitmap, BGRABitmapTypes, BGRAGraphics, BGRASVG, BGRAOpenRaster, BGRAPhoxo, BGRAPaintNet{$EndIf};
266-
267- // this method creates a stream from a file, additional it can throw a warning if a certain mb limit is exceeded
268- function CreateStreamFromFile(const AFilename: string; var AStream: TStream; const AFileSizeWarningInMegabyte: Integer = 1): Boolean;
269- // this method convert a stream into a base64 string
270- function CreateBase64FromStream(const AStream: TStream): string;
271- // this method convert a base 64 into a stream
272- function CreateStreamFromBase64(const ABase64String: AnsiString): TStream;
273- // depending what mode you selected you having either this or that method available to display out of a base64 a timage
274- {$If defined(UseBGRA)}
275- // this method convert base64 into a timage, additional you can choose between a faster bitmap conversation or a slower png compressed variant
276- procedure AssignBase64ToImage(const ABase64String: AnsiString; const AImage: TImage; const AFastMode: Boolean = False);
277- {$Else}
278- // this method convert a base64 into a timage
279- procedure AssignBase64ToImage(const ABase64String: AnsiString; const AImage: TImage);
280- {$EndIf}
281- implementation
282-
283- function CreateStreamFromFile(const AFilename: string; var AStream: TStream; const AFileSizeWarningInMegabyte: Integer = 1): Boolean;
284- function SizeToString(const ASize: UInt64; const oneKB: Integer = {$IFDEF MSWINDOWS}1024{$ELSE}1000{$ENDIF}): string;
285- var
286- Calc: Extended;
287- Sign: String;
288- SizeLength: Integer;
234+
235+(* ************************* *)
236+(* * Base64 to Image * *)
237+(* ************************* *)
238+{ Created: 2023 by KodeZwerg }
239+{ Dialect: FreePascal }
240+{ Type: Helper unit }
241+{ License: Unlicensed }
242+
243+{ This unit can convert a Base64 encoded string into a TImage }
244+{ Additional you can do the opposite, create from a file a Base64 }
245+
246+{ Thank you Remy for teaching me about TGraphicClass usage! }
247+{ Thank you paweld for beta testing and fixing a transparency bug! }
248+{ Thank you wp for teaching me more about TGraphicClass usage! }
249+{ Thank you wp for complaining about my original names, critism help! }
250+
251+{$mode ObjFPC}{$H+}
252+
253+interface
254+
255+// remove the dot to utilize BGRABitmap package
256+// put a dod infront of $ to deactivate BGRABitmap support
257+{$DEFINE UseBGRA}
258+
259+uses
260+ Classes, SysUtils, Graphics, ExtCtrls, Dialogs, Types, LCLType, Controls,
261+ Base64
262+ {$If defined(UseBGRA)},BGRABitmap, BGRABitmapTypes, BGRAGraphics, BGRASVG, BGRAOpenRaster, BGRAPhoxo, BGRAPaintNet{$EndIf};
263+
264+// this method creates a stream from a file, additional it can throw a warning if a certain mb limit is exceeded
265+function CreateStreamFromFile(const AFilename: string; var AStream: TStream; const AFileSizeWarningInMegabyte: Integer = 1): Boolean;
266+// this method convert a stream into a base64 string
267+function CreateBase64FromStream(const AStream: TStream): string;
268+// this method convert a base 64 into a stream
269+function CreateStreamFromBase64(const ABase64String: AnsiString): TStream;
270+// depending what mode you selected you having either this or that method available to display out of a base64 a timage
271+{$If defined(UseBGRA)}
272+// this method convert base64 into a timage, additional you can choose between a faster bitmap conversation or a slower png compressed variant
273+procedure AssignBase64ToImage(const ABase64String: AnsiString; const AImage: TImage; const AFastMode: Boolean = False);
274+{$Else}
275+// this method convert a base64 into a timage
276+procedure AssignBase64ToImage(const ABase64String: AnsiString; const AImage: TImage);
277+{$EndIf}
278+implementation
279+
280+function CreateStreamFromFile(const AFilename: string; var AStream: TStream; const AFileSizeWarningInMegabyte: Integer = 1): Boolean;
281+ function SizeToString(const ASize: UInt64; const oneKB: Integer = {$IFDEF MSWINDOWS}1024{$ELSE}1000{$ENDIF}): string;
282+ var
283+ Calc: Extended;
284+ Sign: String;
285+ SizeLength: Integer;
286+ begin
287+ SizeLength := 0;
288+ Calc := ASize;
289+ while (Calc > oneKB) do
289290 begin
290- SizeLength := 0;
291- Calc := ASize;
292- while (Calc > oneKB) do
293- begin
294- Calc := Calc / oneKB;
295- Inc(SizeLength);
296- end;
297- case SizeLength of
298- 0: Sign := ' byte';
299- 1: Sign := ' kb'; // Kilo Byte
300- 2: Sign := ' mb'; // Mega Byte
301- 3: Sign := ' gb'; // Giga Byte
302- 4: Sign := ' tb'; // Tera Byte
303- 5: Sign := ' pb'; // Peta Byte
304- 6: Sign := ' eb'; // Exa Byte
305- 7: Sign := ' zb'; // Zetta Byte
306- 8: Sign := ' yb'; // Yotta Byte
307- 9: Sign := ' rb'; // Ronna Byte
308- 10:Sign := ' qb'; // Quetta Byte
309- else
310- Sign :=' (' + IntToStr(SizeLength) + ')';
311- end;
312- Result := FormatFloat('#,##0.00', Calc) + Sign;
313- end;
314- const
315- oneKB = Integer({$IFDEF MSWINDOWS}1024{$ELSE}1000{$ENDIF});
316- oneMB = Integer(oneKB * oneKB);
317- var
318- FileStream: TFileStream;
319- begin
320- FileStream := TFileStream.Create(AFileName, fmOpenRead or fmShareDenyWrite);
321- try
322- Result := False;
323- if (FileStream.Size > (oneMB * AFileSizeWarningInMegabyte)) then
324- if QuestionDlg('Filesize Warning!',
325- Format('Filesize is bigger than %dmb (%s)!', [AFileSizeWarningInMegabyte, SizeToString(FileStream.Size)])
326- + LineEnding + 'Continue loading?',
327- mtWarning, [mrYes, mrNo], 0) = mrNo then
328- Exit;
329- AStream := TMemoryStream.Create;
330- try
331- AStream.CopyFrom(FileStream, FileStream.Size);
332- finally
333- AStream.Position := 0;
334- Result := True;
335- end;
336- finally
337- FileStream.Free;
291+ Calc := Calc / oneKB;
292+ Inc(SizeLength);
338293 end;
294+ case SizeLength of
295+ 0: Sign := ' byte';
296+ 1: Sign := ' kb'; // Kilo Byte
297+ 2: Sign := ' mb'; // Mega Byte
298+ 3: Sign := ' gb'; // Giga Byte
299+ 4: Sign := ' tb'; // Tera Byte
300+ 5: Sign := ' pb'; // Peta Byte
301+ 6: Sign := ' eb'; // Exa Byte
302+ 7: Sign := ' zb'; // Zetta Byte
303+ 8: Sign := ' yb'; // Yotta Byte
304+ 9: Sign := ' rb'; // Ronna Byte
305+ 10:Sign := ' qb'; // Quetta Byte
306+ else
307+ Sign :=' (' + IntToStr(SizeLength) + ')';
339308 end;
340-
341- function CreateBase64FromStream(const AStream: TStream): string;
342- var
343- EncodedStream: TStringStream;
344- Encoder: TBase64EncodingStream;
345- begin
346- Result := '';
347- EncodedStream := TStringStream.Create('');
348- Encoder := TBase64EncodingStream.Create(EncodedStream);
349- try
350- AStream.Position := 0;
351- Encoder.CopyFrom(AStream, AStream.Size);
352- Encoder.Flush;
353- Result := EncodedStream.DataString;
354- AStream.Position := 0;
355- finally
356- Encoder.Free;
357- EncodedStream.Free;
358- end;
309+ Result := FormatFloat('#,##0.00', Calc) + Sign;
310+ end;
311+const
312+ oneKB = Integer({$IFDEF MSWINDOWS}1024{$ELSE}1000{$ENDIF});
313+ oneMB = Integer(oneKB * oneKB);
314+var
315+ FileStream: TFileStream;
316+begin
317+ FileStream := TFileStream.Create(AFileName, fmOpenRead or fmShareDenyWrite);
318+ try
319+ Result := False;
320+ if (FileStream.Size > (oneMB * AFileSizeWarningInMegabyte)) then
321+ if QuestionDlg('Filesize Warning!',
322+ Format('Filesize is bigger than %dmb (%s)!', [AFileSizeWarningInMegabyte, SizeToString(FileStream.Size)])
323+ + LineEnding + 'Continue loading?',
324+ mtWarning, [mrYes, mrNo], 0) = mrNo then
325+ Exit;
326+ AStream := TMemoryStream.Create;
327+ try
328+ AStream.CopyFrom(FileStream, FileStream.Size);
329+ finally
330+ AStream.Position := 0;
331+ Result := True;
359332 end;
360-
361- function CreateStreamFromBase64(const ABase64String: AnsiString): TStream;
362- var
363- DecodedStream: TBase64DecodingStream;
364- Base64Stream: TStringStream;
365- begin
366- Base64Stream := TStringStream.Create(ABase64String);
333+ finally
334+ FileStream.Free;
335+ end;
336+end;
337+
338+function CreateBase64FromStream(const AStream: TStream): string;
339+var
340+ EncodedStream: TStringStream;
341+ Encoder: TBase64EncodingStream;
342+begin
343+ Result := '';
344+ EncodedStream := TStringStream.Create('');
345+ Encoder := TBase64EncodingStream.Create(EncodedStream);
346+ try
347+ AStream.Position := 0;
348+ Encoder.CopyFrom(AStream, AStream.Size);
349+ Encoder.Flush;
350+ Result := EncodedStream.DataString;
351+ AStream.Position := 0;
352+ finally
353+ Encoder.Free;
354+ EncodedStream.Free;
355+ end;
356+end;
357+
358+function CreateStreamFromBase64(const ABase64String: AnsiString): TStream;
359+var
360+ DecodedStream: TBase64DecodingStream;
361+ Base64Stream: TStringStream;
362+begin
363+ Base64Stream := TStringStream.Create(ABase64String);
364+ try
365+ DecodedStream := TBase64DecodingStream.Create(base64stream);
366+ try
367+ Result := TMemoryStream.Create;
367368 try
368- DecodedStream := TBase64DecodingStream.Create(base64stream);
369- try
370- Result := TMemoryStream.Create;
371- try
372- Result.CopyFrom(DecodedStream, DecodedStream.Size);
373- finally
374- Result.Position := 0;
375- end;
376- finally
377- DecodedStream.Free;
378- end;
369+ Result.CopyFrom(DecodedStream, DecodedStream.Size);
379370 finally
380- Base64Stream.Free;
371+ Result.Position := 0;
381372 end;
373+ finally
374+ DecodedStream.Free;
382375 end;
383-
384- {$IfNDef UseBGRA}
385- function GetGraphicClassFromStream(const AStream: TStream): TGraphicClass;
386- function HasIconSignature(const AStream: TStream): Boolean;
387- const
388- IconSignature: array[0..3] of Byte = ($00, $00, $01, $00);
389- var
390- SignatureBytes: array[0..3] of Byte;
391- begin
392- AStream.Position := 0;
393- AStream.ReadBuffer(SignatureBytes, SizeOf(SignatureBytes));
394- Result := CompareMem(@SignatureBytes, @IconSignature, SizeOf(SignatureBytes));
395- AStream.Position := 0;
396- end;
397- const
398- REGISTERED: array[0..5] of TGraphicClass = (TBitmap, TJpegImage,
399- TPortableNetworkGraphic, TTiffImage, TGifImage, TPixMap);
400- var
401- i: Integer;
376+ finally
377+ Base64Stream.Free;
378+ end;
379+end;
380+
381+{$IfNDef UseBGRA}
382+function GetGraphicClassFromStream(const AStream: TStream): TGraphicClass;
383+ function HasIconSignature(const AStream: TStream): Boolean;
384+ const
385+ IconSignature: array[0..3] of Byte = ($00, $00, $01, $00);
386+ var
387+ SignatureBytes: array[0..3] of Byte;
388+ begin
389+ AStream.Position := 0;
390+ AStream.ReadBuffer(SignatureBytes, SizeOf(SignatureBytes));
391+ Result := CompareMem(@SignatureBytes, @IconSignature, SizeOf(SignatureBytes));
392+ AStream.Position := 0;
393+ end;
394+const
395+ REGISTERED: array[0..5] of TGraphicClass = (TBitmap, TJpegImage,
396+ TPortableNetworkGraphic, TTiffImage, TGifImage, TPixMap);
397+var
398+ i: Integer;
399+begin
400+ Result := nil;
401+ AStream.Position := 0;
402+ for i := 0 to High(REGISTERED) do
403+ if REGISTERED[i].IsStreamFormatSupported(AStream) then
402404 begin
403- Result := nil;
404- AStream.Position := 0;
405- for i := 0 to High(REGISTERED) do
406- if REGISTERED[i].IsStreamFormatSupported(AStream) then
407- begin
408- Result := REGISTERED[i];
409- AStream.Position := 0;
410- Exit;
411- end;
412- if HasIconSignature(AStream) then
413- Result := TIcon;
405+ Result := REGISTERED[i];
414406 AStream.Position := 0;
407+ Exit;
415408 end;
416-
417- procedure AssignBase64ToImage(const ABase64String: AnsiString; const AImage: TImage);
418- var
419- graphicClass: TGraphicClass;
420- graphic: TGraphic;
421- stream: TStream;
422- size: TSize;
423- begin
424- AImage.Picture.Clear;
425- stream := CreateStreamFromBase64(ABase64String);
426- graphicClass := GetGraphicClassFromStream(stream);
427- if Assigned(graphicClass) then
428- begin
429- graphic := graphicClass.Create;
430- try
431- graphic.LoadFromStream(stream);
432- if (graphicClass.ClassType = TIcon) then
433- begin
434- size.Width := AImage.Width;
435- size.Height := AImage.Height;
436- TIcon(graphic).Current := TIcon(graphic).GetBestIndexForSize(size);
437- end;
438- AImage.Picture.Assign(graphic);
439- finally
440- graphic.Free;
409+ if HasIconSignature(AStream) then
410+ Result := TIcon;
411+ AStream.Position := 0;
412+end;
413+
414+procedure AssignBase64ToImage(const ABase64String: AnsiString; const AImage: TImage);
415+var
416+ graphicClass: TGraphicClass;
417+ graphic: TGraphic;
418+ stream: TStream;
419+ size: TSize;
420+begin
421+ AImage.Picture.Clear;
422+ stream := CreateStreamFromBase64(ABase64String);
423+ graphicClass := GetGraphicClassFromStream(stream);
424+ if Assigned(graphicClass) then
425+ begin
426+ graphic := graphicClass.Create;
427+ try
428+ graphic.LoadFromStream(stream);
429+ if (graphicClass.ClassType = TIcon) then
430+ begin
431+ size.Width := AImage.Width;
432+ size.Height := AImage.Height;
433+ TIcon(graphic).Current := TIcon(graphic).GetBestIndexForSize(size);
441434 end;
442- end;
443- stream.Free;
435+ AImage.Picture.Assign(graphic);
436+ finally
437+ graphic.Free;
444438 end;
445- {$EndIf}
446-
447- {$If defined(UseBGRA)}
448- function BGRABitmapToPNGStream(const ABGRABitmap: TBGRABitmap): TStream;
449- begin
450- Result := TMemoryStream.Create;
451- try
452- ABGRABitmap.SaveToStreamAsPng(Result);
453- finally
454- Result.Position := 0;
455- end;
439+ end;
440+ stream.Free;
441+end;
442+{$EndIf}
443+
444+{$If defined(UseBGRA)}
445+function BGRABitmapToPNGStream(const ABGRABitmap: TBGRABitmap): TStream;
446+begin
447+ Result := TMemoryStream.Create;
448+ try
449+ ABGRABitmap.SaveToStreamAsPng(Result);
450+ finally
451+ Result.Position := 0;
452+ end;
453+end;
454+
455+function BGRABitmapToBitmap(const ABGRABitmap: TBGRABitmap): TBitmap;
456+begin
457+ Result := TBitmap.Create;
458+ try
459+ Result.PixelFormat := ABGRABitmap.Bitmap.PixelFormat;
460+ Result.Transparent := ABGRABitmap.HasTransparentPixels or ABGRABitmap.HasSemiTransparentPixels;
461+ Result.SetSize(ABGRABitmap.Width, ABGRABitmap.Height);
462+ Result.Canvas.Lock;
463+ try
464+ Result.Canvas.Draw(0, 0, ABGRABitmap.Bitmap);
465+ finally
466+ Result.Canvas.Unlock;
456467 end;
457-
458- function BGRABitmapToBitmap(const ABGRABitmap: TBGRABitmap): TBitmap;
468+ finally
469+ end;
470+end;
471+
472+procedure AssignBase64ToImage(const ABase64String: AnsiString; const AImage: TImage; const AFastMode: Boolean = False);
473+var
474+ BGRABitmap: TBGRABitmap;
475+ Stream: TStream;
476+ bmp: TBitmap;
477+begin
478+ AImage.Picture.Clear;
479+ Stream := CreateStreamFromBase64(ABase64String);
480+ if (DetectFileFormat(Stream) <> ifUnknown) then
459481 begin
460- Result := TBitmap.Create;
482+ BGRABitmap := TBGRABitmap.Create;
461483 try
462- Result.PixelFormat := ABGRABitmap.Bitmap.PixelFormat;
463- Result.Transparent := ABGRABitmap.HasTransparentPixels or ABGRABitmap.HasSemiTransparentPixels;
464- Result.SetSize(ABGRABitmap.Width, ABGRABitmap.Height);
465- Result.Canvas.Lock;
466484 try
467- Result.Canvas.Draw(0, 0, ABGRABitmap.Bitmap);
485+ BGRABitmap.LoadFromStream(Stream);
468486 finally
469- Result.Canvas.Unlock;
487+ Stream.Free;
470488 end;
471- finally
472- end;
473- end;
474-
475- procedure AssignBase64ToImage(const ABase64String: AnsiString; const AImage: TImage; const AFastMode: Boolean = False);
476- var
477- BGRABitmap: TBGRABitmap;
478- Stream: TStream;
479- bmp: TBitmap;
480- begin
481- AImage.Picture.Clear;
482- Stream := CreateStreamFromBase64(ABase64String);
483- if (DetectFileFormat(Stream) <> ifUnknown) then
484- begin
485- BGRABitmap := TBGRABitmap.Create;
486- try
489+ if AFastMode then
490+ begin
491+ bmp := BGRABitmapToBitmap(BGRABitmap);
487492 try
488- BGRABitmap.LoadFromStream(Stream);
493+ AImage.Transparent := bmp.Transparent;
494+ AImage.Picture.Assign(bmp);
489495 finally
496+ bmp.Free;
497+ end;
498+ end
499+ else
500+ begin
501+ Stream := BGRABitmapToPNGStream(BGRABitmap);
502+ try
503+ AImage.Transparent := BGRABitmap.HasTransparentPixels or BGRABitmap.HasSemiTransparentPixels;
504+ AImage.Picture.PNG.LoadFromStream(Stream);
505+ finally
490506 Stream.Free;
491507 end;
492- if AFastMode then
493- begin
494- bmp := BGRABitmapToBitmap(BGRABitmap);
495- try
496- AImage.Transparent := bmp.Transparent;
497- AImage.Picture.Assign(bmp);
498- finally
499- bmp.Free;
500- end;
501- end
502- else
503- begin
504- Stream := BGRABitmapToPNGStream(BGRABitmap);
505- try
506- AImage.Transparent := BGRABitmap.HasTransparentPixels or BGRABitmap.HasSemiTransparentPixels;
507- AImage.Picture.PNG.LoadFromStream(Stream);
508- finally
509- Stream.Free;
510- end;
511- end;
512- finally
513- BGRABitmap.Free;
514508 end;
515- end
516- else
517- Stream.Free;
518- end;
519- {$EndIf}
520-
521- initialization
522- {$If defined(UseBGRA)}
523- BGRASVG.RegisterSvgFormat;
524- BGRAOpenRaster.RegisterOpenRasterFormat;
525- BGRAPhoxo.RegisterPhoxoFormat;
526- BGRAPaintNet.RegisterPaintNetFormat;
527- {$EndIf}
528- end.
509+ finally
510+ BGRABitmap.Free;
511+ end;
512+ end
513+ else
514+ Stream.Free;
515+end;
516+{$EndIf}
517+
518+initialization
519+{$If defined(UseBGRA)}
520+ BGRASVG.RegisterSvgFormat;
521+ BGRAOpenRaster.RegisterOpenRasterFormat;
522+ BGRAPhoxo.RegisterPhoxoFormat;
523+ BGRAPaintNet.RegisterPaintNetFormat;
524+{$EndIf}
525+end.
529526```
530527
531528---
532-*From the Free Pascal wiki, page "Base64", as the Internet Archive kept it on 2026-01-15. Copyright stays with the author who wrote it, according to the old wiki's [[Licensing]] page. If you have concerns about this material, [message the admin](/wiki-contact).*
529+*From the Free Pascal wiki, page "Base64", as it stood on 2023-08-15 after a change by Alextpp, out of the wiki's dump of 2024-05-26. Copyright stays with the author who wrote it, according to the old wiki's [[Licensing]] page. If you have concerns about this material, [message the admin](/wiki-contact).*

Back to history