参考
Delphi 文件转换Base64、Base64转换文件
https://www.cnblogs.com/FKdelphi/p/12290576.html
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, FireDAC.Stan.Intf, FireDAC.Stan.Option,
FireDAC.Stan.Param, FireDAC.Stan.Error, FireDAC.DatS, FireDAC.Phys.Intf,
FireDAC.DApt.Intf, FireDAC.Stan.Async, FireDAC.DApt, FireDAC.UI.Intf, FireDAC.Stan.Def,
FireDAC.Stan.Pool, FireDAC.Phys, FireDAC.Phys.MSSQL, FireDAC.Phys.MSSQLDef,
FireDAC.VCLUI.Wait, Data.DB, FireDAC.Comp.Client, FireDAC.Comp.DataSet, Vcl.StdCtrls,
FireDAC.Phys.MSAcc, FireDAC.Phys.MSAccDef, RzButton, Vcl.Grids, Vcl.DBGrids,
Vcl.DBCtrls, cxGraphics, cxControls, cxLookAndFeels, cxLookAndFeelPainters,
cxContainer, cxEdit, cxImage, RzDBGrid, RzEdit;
type
TForm1 = class(TForm)
btn1: TButton;
fdqry1: TFDQuery;
con1: TFDConnection;
mmo1: TMemo;
edt1: TEdit;
RzButton1: TRzButton;
DataSource1: TDataSource;
DBGrid1: TDBGrid;
FDMemTable1: TFDMemTable;
RzButton2: TRzButton;
edt2: TEdit;
DataSource2: TDataSource;
RzButton3: TRzButton;
cxImage1: TcxImage;
RzButton4: TRzButton;
FDMemTable2: TFDMemTable;
RzDBGrid1: TRzDBGrid;
DataSource3: TDataSource;
RzButton5: TRzButton;
RzMemo1: TRzMemo;
RzButton6: TRzButton;
FDMemTable3: TFDMemTable;
DataSource4: TDataSource;
RzButton7: TRzButton;
RzButton8: TRzButton;
FDMemTable4: TFDMemTable;
RzButton9: TRzButton;
procedure btn1Click(Sender: TObject);
procedure edt1KeyPress(Sender: TObject; var Key: Char);
procedure FormCreate(Sender: TObject);
procedure RzButton1Click(Sender: TObject);
procedure RzButton2Click(Sender: TObject);
procedure RzButton3Click(Sender: TObject);
procedure RzButton4Click(Sender: TObject);
procedure RzButton5Click(Sender: TObject);
procedure RzButton6Click(Sender: TObject);
procedure RzButton7Click(Sender: TObject);
procedure RzButton8Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
uses
EncdDecd, system.json, Vcl.Imaging.jpeg, GY_DataSetAndJSON;
///将Bitmap位图转化为base64字符串
function BitmapToString(img: TBitmap): string;
var
ms: TMemoryStream;
ss: TStringStream;
s: string;
begin
ms := TMemoryStream.Create;
img.SaveToStream(ms);
ss := TStringStream.Create('');
ms.Position := 0;
EncodeStream(ms, ss); //将内存流编码为base64字符流
s := ss.DataString;
ms.Free;
ss.Free;
result := s;
end;
///将base64字符串转化为Bitmap位图
function StringToBitmap(imgStr: string): TBitmap;
var
ss: TStringStream;
ms: TMemoryStream;
bitmap: TBitmap;
begin
ss := TStringStream.Create(imgStr);
ms := TMemoryStream.Create;
DecodeStream(ss, ms); //将base64字符流还原为内存流
ms.Position := 0;
bitmap := TBitmap.Create;
bitmap.LoadFromStream(ms);
ss.Free;
ms.Free;
result := bitmap;
end;
function UnicodeToAnsi(aSubUnicode: string): string;
var
tmpLen, iCount: Integer;
tmpWS: WideString;
begin
tmpWS := '';
iCount := 1;
tmpLen := Length(aSubUnicode);
while iCount <= tmpLen do
try
if (Copy(aSubUnicode, iCount, 1) = '\') and (Copy(aSubUnicode, iCount, 2) = '\u') then
begin
tmpWS := tmpWS + WideChar(StrToInt('$' + Copy(aSubUnicode, iCount + 2, 4)));
iCount := iCount + 6;
end
else
begin
tmpWS := tmpWS + Copy(aSubUnicode, iCount, 1);
iCount := iCount + 1;
end;
except
end;
Result := tmpWS;
end;
// 能将integer 类型的双引号去掉,
// [{"CityId":18,"CityName":"西安"},{"CityId":"53","CityName":"广州"}]
function DataSetToJson(ds: TDataSet): string;
var
vRecord: string;
vField: TField;
i: Integer;
vIn, vOut: TStringStream;
begin
Result := '';
if (not ds.Active) or (ds.IsEmpty) then
Exit;
Result := '[';
ds.DisableControls;
ds.First;
while not ds.Eof do
begin
for i := 0 to ds.FieldCount - 1 do
begin
vField := ds.Fields[i];
if vRecord = '' then
vRecord := '{';
vRecord := vRecord + '"' + vField.FieldName + '":';
if vField.DataType = ftTimeStamp then
// 日期类型处理一下
vRecord := vRecord + '"' + FormatDateTime('yyyy-MM-DD hh:mm:ss', vField.AsDateTime) + '"'
else if (vField.DataType = ftBoolean) then
vRecord := vRecord + vField.AsString.ToLower
else if (vField.DataType = ftBlob) then
begin
vIn := TStringStream.Create(vField.AsBytes);
try
vOut := TStringStream.Create;
try
EncdDecd.EncodeStream(vIn, vOut);
vRecord := vRecord + '"' + vOut.DataString.Replace(#13#10, '\r\n') + '"';
finally
vIn.Free;
vOut.Free;
end;
except
vRecord := vRecord + '""';
end;
end
else if (vField.DataType = ftAutoInc) or (vField.DataType = ftInteger) then
begin // 整型为空时,需要返回null
if vField.IsNull then
vRecord := vRecord + 'null'
else
vRecord := vRecord + vField.AsString
end
else
vRecord := vRecord + '"'
// 字符串中的双引号和换行符需要转义
+ vField.AsString.Replace(#13#10, '\r\n').Replace('"', '\"') + '"';
if i = ds.FieldCount - 1 then
begin
vRecord := vRecord + '}';
if Result = '[' then
Result := Result + vRecord
else
Result := Result + ',' + vRecord;
vRecord := '';
end
else
vRecord := vRecord + ',';
end;
ds.Next;
end;
ds.EnableControls;
Result := Result + ']';
end;
//2)JSON字符串转换为数据集: https://blog.csdn.net/xieyunc/article/details/67068090
procedure JsonToDataSet(AJson: string; ADataset: TDataSet);
var
jDataSet: TJSONArray;
jRecord: TJSONObject;
i, j: Integer;
begin
if (AJson = '') or (ADataset = nil) or (not ADataset.Active) then
Exit;
jDataSet := TJSONObject.Create.ParseJSONValue(AJson, True) as TJSONArray;
while not ADataset.Eof do
ADataset.Delete;
for i := 0 to jDataSet.Size - 1 do
begin
ADataset.Append;
jRecord := jDataSet.Get(i) as TJSONObject;
for j := 0 to ADataset.FieldCount - 1 do
ADataset.Fields[j].Text := StringReplace(jRecord.GetValue(ADataset.Fields[j].FieldName).ToString, '"', '', [rfReplaceAll]);
ADataset.Post;
end;
end;
//1)数据集转换为JSON字符串:
//需USES System.JSON;
// 不能将integer 类型的双引号去掉,
function xlfdDataSetToJson(ADataset: TDataSet): string;
// [{"CityId":"18","CityName":"西安"},{"CityId":"53","CityName":"广州"}]
var
LRecord: string;
LField: TField;
i: integer;
begin
Result := '';
if (not ADataset.Active) or (ADataset.IsEmpty) then
Exit;
Result := '[';
ADataset.DisableControls;
ADataset.First;
while not ADataset.Eof do
begin
for i := 0 to ADataset.FieldCount - 1 do
begin
LField := ADataset.Fields[i];
if LRecord = '' then
LRecord := '{"' + LField.FieldName + '":"' + LField.Text + '"'
else
LRecord := LRecord + ',"' + LField.FieldName + '":"' + LField.Text + '"';
if i = ADataset.FieldCount - 1 then
begin
LRecord := LRecord + '}';
if Result = '[' then
Result := Result + LRecord
else
Result := Result + ',' + LRecord;
LRecord := '';
end;
end;
ADataset.Next;
end;
ADataset.EnableControls;
Result := Result + ']';
end;
//数据集转JSON
procedure TForm1.btn1Click(Sender: TObject);
begin
fdqry1.Close;
fdqry1.Open(edt1.Text);
mmo1.Lines.Text := DataSetToJson(fdqry1);
end;
procedure TForm1.edt1KeyPress(Sender: TObject; var Key: Char);
begin
if Key = #13 then
btn1.Click;
end;
//连接数据库
procedure TForm1.FormCreate(Sender: TObject);
begin
con1.ConnectionString := 'DriverID=MSAcc;Database=' + ExtractFilePath(ParamStr(0)) + 'db.mdb;';
end;
// json转数据集
procedure TForm1.RzButton1Click(Sender: TObject);
var
_str: string;
begin
_str := mmo1.Lines.Text;
ShowMessage(_str);
//建立缓存表
FDMemTable1.Close();
FDMemTable1.FieldDefs.Clear();
// FDMemTable1.FieldDefs.Add('FID', ftInteger, 0, True);
FDMemTable1.FieldDefs.Add('FID', ftString, 20, false);
FDMemTable1.FieldDefs.Add('FUser', ftString, 20, false);
FDMemTable1.FieldDefs.Add('FPwd', ftString, 20, false);
FDMemTable1.FieldDefs.Add('FName', ftString, 20, false);
FDMemTable1.CreateDataSet();
DataSource1.DataSet := FDMemTable1;
//转换json
JsonToDataSet(_str, FDMemTable1);
FDMemTable1.Open;
end;
//
procedure TForm1.RzButton2Click(Sender: TObject);
begin
mmo1.Clear;
fdqry1.Close;
fdqry1.Open(Edt2.Text);
mmo1.Lines.Text := xlfdDataSetToJson(fdqry1);
end;
// 查看数据集图片
procedure TForm1.RzButton3Click(Sender: TObject);
var
MyJPEG: TJPEGImage;
MS: TMemoryStream;
begin
MS := TMemoryStream.Create;
MyJPEG := TJPEGImage.Create;
try
TBlobField(fdqry1.FieldByName('fphoto')).SaveToStream(MS);
MS.Position := 0;
MyJPEG.LoadFromStream(MS);
cxImage1.Picture.Assign(MyJPEG);
finally
MS.Free;
MyJPEG.Free;
end;
end;
procedure TForm1.RzButton4Click(Sender: TObject);
var
_str: string;
begin
_str := mmo1.Lines.Text;
ShowMessage(_str);
//建立缓存表
FDMemTable2.Close();
FDMemTable2.FieldDefs.Clear();
FDMemTable1.FieldDefs.Add('FID', ftInteger, 0, True);
FDMemTable2.FieldDefs.Add('FName', ftString, 20, false);
FDMemTable2.FieldDefs.Add('FSex', ftString, 20, false);
FDMemTable2.FieldDefs.Add('FAge', ftInteger, 0, false);
FDMemTable2.FieldDefs.Add('FPhone', ftString, 0, false);
FDMemTable2.FieldDefs.Add('FAddress', ftString, 0, false);
// FDMemTable2.FieldDefs.Add('FPhoto', ftBlob, 0 ,false);
FDMemTable2.CreateDataSet();
DataSource3.DataSet := FDMemTable2;
//转换json
JsonToDataSet(_str, FDMemTable2);
FDMemTable2.Open;
ShowMessage(FDMemTable2.recordcount.tostring);
end;
// dataset 转数据集方法2
procedure TForm1.RzButton5Click(Sender: TObject);
begin
RzMemo1.Lines.Add(GY_DataSetToJSONStr(fdqry1, false, True));
end;
//json 转数据集方法2
procedure TForm1.RzButton6Click(Sender: TObject);
begin
FDMemTable3.Close();
FDMemTable3.FieldDefs.Clear();
FDMemTable3.FieldDefs.Add('FID', ftInteger, 0, True);
FDMemTable3.FieldDefs.Add('FName', ftString, 20, false);
FDMemTable3.FieldDefs.Add('FSex', ftString, 20, false);
FDMemTable3.FieldDefs.Add('FAge', ftInteger, 0, false);
FDMemTable3.FieldDefs.Add('FPhone', ftString, 0, false);
FDMemTable3.FieldDefs.Add('FAddress', ftString, 0, false);
FDMemTable3.FieldDefs.Add('FPhoto', ftBlob, 0, false);
FDMemTable3.CreateDataSet;
GY_JSONStrToDataSet(RzMemo1.Text, FDMemTable3);
// FDMemTable3.MergeChangeLog;
RzDBGrid1.DataSource := DataSource4;
end;
//查看数据集图片
procedure TForm1.RzButton7Click(Sender: TObject);
var
MyJPEG: TJPEGImage;
MS: TMemoryStream;
begin
MS := TMemoryStream.Create;
MyJPEG := TJPEGImage.Create;
try
TBlobField(FDMemTable3.FieldByName('fphoto')).SaveToStream(MS);
MS.Position := 0;
MyJPEG.LoadFromStream(MS);
cxImage1.Picture.Assign(MyJPEG);
finally
MS.Free;
MyJPEG.Free;
end;
end;
//查看json图片
procedure TForm1.RzButton8Click(Sender: TObject);
var
jarr, jsonArray: TJSONArray;
jo, m_JSONObject: TJSONObject;
_arrstr, _str1, _str2: string;
MyJPEG: TJPEGImage;
sl: TStringList;
_ms: TMemoryStream;
begin
try
jo := TJSONObject.Create;
jarr := TJSONArray.Create;
sl := TStringList.Create;
_ms := TMemoryStream.Create;
MyJPEG := TJPEGImage.Create;
//组合json
_arrstr := '{"results": ' + mmo1.Text + '}';
// 防止乱码
m_JSONObject := TJSONObject.ParseJSONValue(TEncoding.UTF8.GetBytes(_arrstr), 0) as TJSONObject;
// json数组
jsonArray := TJSONArray(m_JSONObject.GetValue('results'));
// 读取results的数据
m_JSONObject := (m_JSONObject.GetValue('results') as TJSONArray).Get(0) as TJSONObject;
// 读取results中的FPhoto
_str1 := m_JSONObject.GetValue('FPhoto').ToString;
//base64默认有一个77字符后换行一次,用TCP发送时不方便,就去掉了回车换行。
// Result := StringReplace(Result, #13, '', [rfReplaceAll]);
// Result := StringReplace(Result, #10, '', [rfReplaceAll]);
_str1 := StringReplace(_str1, '\r\n', '', [rfReplaceAll]);
// web前端展示要加 'data:image/jpg;base64,'
// _str1 := 'data:image/jpg;base64,' + StringReplace(_str1, '"', '', [rfReplaceAll]);
_str1 := StringReplace(_str1, '"', '', [rfReplaceAll]);
_ms.Write(DecodeBase64(_str1), Length(DecodeBase64(_str1)));
_ms.Position := 0;
MyJPEG.LoadFromStream(_ms);
cxImage1.Picture.Assign(MyJPEG);
//建立缓存数据集
FDMemTable4.Close;
FDMemTable4.FieldDefs.Clear();
FDMemTable4.FieldDefs.Add('FID', ftInteger, 0, True);
FDMemTable4.FieldDefs.Add('FName', ftString, 20, false);
FDMemTable4.FieldDefs.Add('FSex', ftString, 20, false);
FDMemTable4.FieldDefs.Add('FAge', ftInteger, 0, false);
FDMemTable4.FieldDefs.Add('FPhone', ftString, 0, false);
FDMemTable4.FieldDefs.Add('FAddress', ftString, 0, false);
FDMemTable4.FieldDefs.Add('FPhoto', ftBlob, 0, false);
FDMemTable4.CreateDataSet;
GY_JSONToDataSet(jsonArray, FDMemTable4);
ShowMessage(FDMemTable4.FieldByName('fphoto').AsString);
DataSource4.DataSet := FDMemTable4;
RzDBGrid1.DataSource := DataSource4;
finally
FreeAndNil(jo);
FreeAndNil(jarr);
MyJPEG.Free;
sl.Free;
_ms.Free;
end;
end;
end.