Konuyu Paylaş : facebook gplus twitter

Konuyu Oyla:
  • Derecelendirme: 5/5 - 1 oy
  • 1
  • 2
  • 3
  • 4
  • 5
Excel Belgesini FireDAC ile JSON Formatına Dönüştürme
#1
Merhaba,
Excel ve benzeri belgelerin açık kaynaklardan son kullanıcılara dağıtımını sağlamak ve bu işlemleri gerçekleştirirken client'lerin sistem kaynaklarını en az kullanacak şekilde yapı veya metodlar kurmak; uygulamanıza ve size olan güvenleri de arttıracağı kuşkusuzdur.
Bu anlamda Web'de gezinirken karşılaştığım bir makaleyi paylaşmak istedim.

Dönüşüm için kullanılacak referans dosya (uExcelToFireDAC.pas);
unit uExcelToFireDAC;

interface
uses
 System.SysUtils, System.Json, Winapi.ActiveX, Winapi.Windows,
 System.Win.ComObj, Variants, System.Classes,
 FireDAC.Stan.Error, FireDAC.UI.Intf, FireDAC.Phys.Intf, FireDAC.Stan.Def,
 FireDAC.Stan.Pool, FireDAC.Stan.Async, FireDAC.Phys, FireDAC.Phys.MySQL,
 FireDAC.Phys.MySQLDef, FireDAC.VCLUI.Wait, Data.DB, FireDAC.Comp.Client,
 FireDAC.Stan.Param, FireDAC.DatS, FireDAC.DApt.Intf, FireDAC.DApt,
 FireDAC.Comp.DataSet;

type
 IExcelToFireDAC = interface(IInterface)
   procedure json_to_fdinsert(cells: TRect; sql_string: String; json_data: TJSONObject);
   procedure OnMessage_(const pro: TGetStrProc);
 end;
 TExcelToFireDAC = class(TInterfacedObject, IExcelToFireDAC)
 private
   FFDConn1:   TFDConnection;
   FFDQuery_:  TFDQuery;
   FOnMessage: TGetStrProc;
   FJsonData:  TJSONObject;
   procedure message_log(const msg_: String);
 public
   constructor Create(const connne: TFDConnection);
   destructor Destroy; override;
   class function ExcelToJson(cells: TRect; excel_filename, sheet_name: String):TJSONObject;
   procedure json_to_fdinsert(cells: TRect; sql_string: String; json_data: TJSONObject);
   property  OnMessage: TGetStrProc  read FOnMessage write FOnMessage;
   procedure OnMessage_(const pro: TGetStrProc);
 end;
implementation

{ TExcelToFireDAC }

constructor TExcelToFireDAC.Create(const connne: TFDConnection);
begin
 inherited Create;
 FJsonData   := nil;
 FOnMessage  := nil;
 FFDConn1    := connne;
 FFDQuery_   := TFDQuery.Create(nil);
end;

destructor TExcelToFireDAC.Destroy;
begin
 if Assigned(FJsonData) then
   FJsonData.DisposeOf;
 FFDQuery_.DisposeOf;
 inherited;
end;

class function TExcelToFireDAC.ExcelToJson(cells: TRect; excel_filename, sheet_name: String): TJSONObject;
const
 def_excel_application = 'Excel.Application';
var
 jres:     TJSONObject;
 jline:    TJSONObject;
 ExcelApp,               //Excel.Application
 excel_book,             //Excel Book
 excel_sheet: Variant;   //Excel Sheet
 s:  String;
 iCol: Integer;
 iRow: Integer;
begin
 ExcelApp  := CreateOleObject(def_excel_application);
 jres      := TJSONObject.Create;
 try
   jres.AddPair('sheet', TJSONArray.Create);
   try
     excel_book  := ExcelApp.Workbooks.Open(excel_filename);
     excel_sheet := excel_book.Worksheets.item[sheet_name];
     for iRow := cells.Top to cells.Bottom do
     begin
       jline := TJSONObject.Create;
       jres.GetValue<TJSONArray>('sheet').Add(jline);
       for iCol := cells.Left to cells.Right do
       begin
         s := excel_sheet.Cells[iRow,iCol];
         //if s.Length = 0 then
         //  s := 'null';
         jline.AddPair(Format('column_%d', [iCol]),s);
       end;
     end;
   finally
     excel_sheet := Unassigned();
     excel_book  := Unassigned();
   end;
 finally
   ExcelApp  := Unassigned();
 end;
 Result  := jres;
end;

procedure TExcelToFireDAC.json_to_fdinsert(cells: TRect; sql_string: String;
 json_data: TJSONObject);
var
 iRow,
 iCol:   Integer;
 jlines: TJSONArray;
 value_:     TJSONValue;
 value_str:  String;
 sql_line:   String;
 stSQL:      String;
begin
 FFDQuery_.Connection  := FFDConn1;
 FJsonData := json_data;
 jlines    := json_data.GetValue<TJSONArray>('sheet');
 for iRow := 0 to jlines.Count-1 do
 begin
   sql_line  := '';
   for iCol := cells.Left-1 to cells.Right-1 do
   begin
     try
       value_ := jlines.Items[iRow].GetValue<TJSONValue>(Format('column_%d', [iCol+1]));
       if SameText(value_.Value, 'null') then
         value_str := 'null,'
       else
         value_str := Format('''%s'',', [value_.Value]);
       sql_line  := sql_line + value_str;
     except

     end;
   end;
   try
     Delete(sql_line, sql_line.Length, 1);
     stSQL   := Format(sql_string, [sql_line]);
     message_log(stSQL);
     FFDQuery_.SQL.Text  := stSQL;
     FFDQuery_.ExecSQL;
   except
     on e: Exception do
       message_log(e.Message);
   end;
 end;
end;

procedure TExcelToFireDAC.message_log(const msg_: String);
begin
 if Assigned(FOnMessage) then
   FOnMessage(msg_);
end;

procedure TExcelToFireDAC.OnMessage_(const pro: TGetStrProc);
begin
 FOnMessage  := pro;
end;

end.

Kullanımı;
procedure TForm1.Button1Click(Sender: TObject);
var
 jbase:    TJSONObject;
 excetofd: IExcelToFireDAC;
 rect:     TRect;
begin
 rect  := TRect.Create(2,2,5,6);//Excel Position(Top, Left, Right, Bottom)
 jbase :=  TExcelToFireDAC.ExcelToJson(rect,'Book1.xlsx','Sheet1');
 Memo1.Lines.Append(  jbase.ToString );

 excetofd  := TExcelToFireDAC.Create(FDConnection1);
 excetofd.OnMessage_(msg_log);
 excetofd.json_to_fdinsert(rect,
   'INSERT INTO `t_MotoGP` (`position`,`racer_name`,`team_name`,`point_sum`) '
     + 'VALUES (%s)',jbase);
end;

Kaynaklar;
Linkleri Görebilmeniz İçin Giriş yap veya Üye Ol
Linkleri Görebilmeniz İçin Giriş yap veya Üye Ol
While true do; Hayat döngüsü, kısır değildir! Yapılan bir yanlış, o döngünün dışına çıkmanızı sağlayacaktır.
WWW
Cevapla
#2
Çok güzel bir paylaşım. Teşekkürler.
There's no place like 127.0.0.1
WWW
Cevapla

Konuyu Paylaş : facebook gplus twitter





Konuyu Okuyanlar: 1 Ziyaretçi