{
  SQL Server 數據庫存取文件實例！
  注意：請先連接數據庫！然后打開數據庫表
  Design By Rainey kwbin@Delphi盒子
  E-Mail: kwbin@163.com
}
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, DB, ADODB, Grids, DBGrids, ExtCtrls, ComCtrls;

type
  TForm1 = class(TForm)
    ADOConnection1: TADOConnection;
    edtFileName: TEdit;
    btnBrowse: TButton;
    OpenDialog1: TOpenDialog;
    DataSource1: TDataSource;
    DBGrid1: TDBGrid;
    btnAdd: TButton;
    btnView: TButton;
    ADOTable1: TADOTable;
    Panel1: TPanel;
    edtServer: TEdit;
    edtUser: TEdit;
    edtPwd: TEdit;
    edtDB: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Button1: TButton;
    GroupBox1: TGroupBox;
    Label7: TLabel;
    Label6: TLabel;
    Label5: TLabel;
    Label8: TLabel;
    Label9: TLabel;
    ADOQuery1: TADOQuery;
    Button2: TButton;
    Button3: TButton;
    StatusBar1: TStatusBar;
    procedure btnBrowseClick(Sender: TObject);
    procedure btnAddClick(Sender: TObject);
    procedure btnViewClick(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure ADOConnection1AfterConnect(Sender: TObject);
    procedure ADOTable1AfterOpen(DataSet: TDataSet);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
const SQLCSTR = 'Provider=SQLOLEDB.1;' +
  'Password=%s;' //密碼
  + 'Persist Security Info=True;'
    + 'User ID=%s;' //用戶名
  + 'Initial Catalog=%s;' //數據庫
  + 'Data Source=%s'; //服務器

implementation
uses ShellAPI;
{$R *.dfm}

procedure TForm1.btnBrowseClick(Sender: TObject);
begin
  if OpenDialog1.Execute then
    edtFileName.Text := OpenDialog1.FileName;
end;

procedure TForm1.btnAddClick(Sender: TObject);
var
  fs: TFileStream;
  ext: string;
begin
  if not FileExists(edtFileName.Text) then
  begin
    Application.MessageBox(PChar('找不到文件' + edtFileName.Text), '錯誤', MB_ICONERROR);
    Exit;
  end;
  ext := ExtractFileExt(edtFileName.Text); //取出文件的擴展名
  fs := TFileStream.Create(edtFileName.Text, fmOpenRead);
  ADOTable1.Append;
  try
    ADOTable1.FieldByName('ext').AsString := ext;
    fs.Position := 0;
    TBlobField(ADOTable1.FieldByName('document')).LoadFromStream(fs);
    ADOTable1.Post;
  finally
    fs.Free;
  end;
end;

procedure TForm1.btnViewClick(Sender: TObject);
var filename, dir: string;
begin
  dir := ExtractFilePath(ParamStr(0)) + 'temp';
  if not DirectoryExists(dir) then
    CreateDir(dir);
  try
    fileName := dir + '\temp' + ADOTable1.FieldByName('id').AsString
      + ADOTable1.FieldByName('ext').AsString;
    TBlobField(ADOTable1.FieldByName('document')).SaveToFile(fileName);
    ShellExecute(handle, 'Open', PChar(fileName), nil, nil, SW_NORMAL);
  finally
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  try
    ADOConnection1.ConnectionString := Format(SQLCSTR, [edtPwd.Text, edtUser.Text, edtDB.Text, edtServer.Text]);
    ADOConnection1.Open;
  except
    on E: Exception do
      Application.MessageBox(PChar('無法連接數據庫！請檢查數據庫服務器是否打開以及數據庫名稱是否存在！'
        + #10#13 + '系統錯誤信息：' + E.Message), PChar(Caption), MB_ICONWARNING);
  end;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  try
    //如果表不存在則創建一張表BlobTable
    ADOQuery1.SQL.Text := 'CREATE TABLE [BlobTable] ('
      + '	[id] [smallint] IDENTITY (1, 1) NOT NULL ,'
      + '	[document] [image] NULL ,'
      + '	[ext] [char] (10) COLLATE Chinese_PRC_CI_AS NULL'
      + ') ON [PRIMARY] TEXTIMAGE_ON [PRIMARY] ';
    ADOQuery1.ExecSQL;
    Application.MessageBox('數據表創建成功！', '', MB_ICONINFORMATION);
  except
    Application.MessageBox('數據表創建失敗！請確認數據庫中是否已經存在數據表BlobTable！', '', MB_ICONWARNING);
  end;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  //打開這張表
  ADOTable1.TableName := 'BlobTable';
  ADOTable1.Open;
end;

procedure TForm1.ADOConnection1AfterConnect(Sender: TObject);
begin
  StatusBar1.Panels.Items[0].Text := '數據庫連接成功！'
end;

procedure TForm1.ADOTable1AfterOpen(DataSet: TDataSet);
begin
  StatusBar1.Panels.Items[1].Text := '數據表BlobTeble連接成功！'
end;

end.