Simpan dan Load File dari Database Delphi

Program sederhana ini merupakan contoh cara menyimpan segala macam file berformat sembarang ke dalam database, file bisa diload / diambil lagi dari database kemudian disimpan ke hardisk. Pada contoh program ini ane menggunakan database Firebird 2.0

unit Unit1;<br /><br />interface<br /><br />uses<br />  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,<br />  Dialogs, DB, Grids, DBGrids, IBCustomDataSet, IBDatabase, StdCtrls, ShellAPI;<br /><br />type<br />  TForm1 = class(TForm)<br />    db: TIBDatabase;<br />    tr: TIBTransaction;<br />    DBGrid1: TDBGrid;<br />    ds: TDataSource;<br />    Button1: TButton;<br />    Button2: TButton;<br />    OD: TOpenDialog;<br />    Memo1: TMemo;<br />    Button3: TButton;<br />    tb: TIBDataSet;<br />    tbID: TIntegerField;<br />    tbNAMAFILE: TIBStringField;<br />    tbFILES: TBlobField;<br />    tbUKURAN: TIntegerField;<br />    procedure Button1Click(Sender: TObject);<br />    procedure Button2Click(Sender: TObject);<br />    procedure FormCreate(Sender: TObject);<br />    procedure Button3Click(Sender: TObject);<br />  private<br />    { Private declarations }<br />  public<br />    { Public declarations }<br />  end;<br /><br />var<br />  Form1: TForm1;<br /><br />implementation<br /><br />{$R *.dfm}<br /><br />function GetSize(const AFile:String):Int64;<br />begin<br />//  Result := 0;<br />  with TFileStream.Create(AFile, fmOpenRead) do<br />  begin<br />    try<br />      Result := Size;<br />    finally<br />      Free;<br />    end;<br />  end;<br />end;<br /><br />procedure TForm1.Button1Click(Sender: TObject);<br />begin<br />if OD.Execute then<br />BEGIN<br />  tb.Insert;<br />  tbNAMAFILE.AsString := ExtractFileName(OD.FileName);<br />  tbFILES.LoadFromFile(OD.FileName);<br />  tbUKURAN.AsInteger  := GetSize(OD.FileName);<br />  tb.Post;<br />END;<br />end;<br /><br />procedure TForm1.Button2Click(Sender: TObject);<br />var<br />AStrm : TMemoryStream;<br />d,m,y : Word;<br />s     : string;<br />begin<br /><br />if tb.RecordCount = 0 then<br />begin<br />MessageDlg('Data Kosong',mtInformation,[mbOK],0);<br />Exit;<br />end;<br /><br />if MessageDlg('Load File ?',mtConfirmation,[mbYes,mbNo],0)=mrYes then<br />begin<br /><br />DecodeDate(Date(),y,m,d);<br />s := IntToStr(d)+IntToStr(m)+IntToStr(y)+'-';<br /><br />//download file, jika belum ada folder DOWNLOAD maka buat Foldernya dulu<br />if not DirectoryExists(ExtractFilePath(ParamStr(0))+'Download') then<br />      ForceDirectories(ExtractFilePath(ParamStr(0))+'Download');<br /><br />//mengambil file dari database dan disimpan pada MemoryStream<br />AStrm:=TMemoryStream.Create;<br />TBlobField(tb.FieldByName('FILES')).SaveToStream(AStrm);<br /><br />// jika file sudah ada, maka buat file dengan nama ada tanggalnya<br />if FileExists(ExtractFilePath(ParamStr(0))+'Download\'+tbNAMAFILE.AsString+'') then<br />begin<br />     AStrm.SaveToFile(ExtractFilePath(ParamStr(0))+'Download\'+s+tbNAMAFILE.AsString+'');<br />end<br />else<br />     AStrm.SaveToFile(ExtractFilePath(ParamStr(0))+'Download\'+tbNAMAFILE.AsString+'');<br />     AStrm.Free;<br /><br />MessageDlg('Download Berhasil...!!!'+#13+'File Sudah Tersimpan di Folder '+<br />#13+ExtractFilePath(ParamStr(0))+'Download',mtInformation,[mbOK],0);<br /><br />//buka folder download<br />ShellExecute(handle, 'Open',PChar(ExtractFilePath(ParamStr(0))+'Download'), nil, nil, SW_SHOWNORMAL);<br />end;<br /><br />end;<br /><br />procedure TForm1.Button3Click(Sender: TObject);<br />begin<br />if tb.RecordCount = 0 then<br />begin<br />MessageDlg('Data Kosong',mtInformation,[mbOK],0);<br />Exit;<br />end;<br /><br />  if MessageDlg('Hapus File ?',mtConfirmation,[mbYes,mbNo],0)=mrYes then<br />    tb.Delete;<br />end;<br /><br />procedure TForm1.FormCreate(Sender: TObject);<br />begin<br />if db.Connected = True then db.Connected:=False;<br /><br />  db.DatabaseName :='';<br />  if db.DatabaseName = '' then<br />      db.DatabaseName := ExtractFilePath(ParamStr(0))+'DATA.FDB';<br />      db.Open;<br />      tb.Open;  <br />end;<br /><br />end.

Hasil Screen Shot Program :



Program dan Source Code bisa didownload DISNI