وبلاگ تخصصی دلفی

uses
  ComObj;

function CompactAndRepair(DB: string): Boolean; {DB = Path to Access Database}
var 
  v: OLEvariant;
begin
  Result := True;
  try
    v := CreateOLEObject('JRO.JetEngine');
    try
      V.CompactDatabase('Provider=Microsoft.Jet.OLEDB.4.0;Data Source='+DB,
                        'Provider=Microsoft.Jet.OLEDB.4.0;Data Source='+DB+'x;Jet OLEDB:Engine Type=5');
      DeleteFile(DB);
      RenameFile(DB+'x',DB);
    finally
      V := Unassigned;
    end;
  except
    Result := False;
  end;
end;

procedure TLocal.CreateTables(WindowsSecurity: Boolean; Username, Password: String);
var
  ConnectionString: String;
begin
  if WindowsSecurity then
    ConnectionString := 'Provider=SQLOLEDB.1;' +
                        'Integrated Security=SSPI;' +
                        'Persist Security Info=False;' +
                        'Initial Catalog=test'
  else
    ConnectionString := 'Provider=SQLOLEDB.1;' +
                        'Password=' + Password + ';' +
                        'Persist Security Info=True;' +
                        'User ID=' + Username + ';' +
                        'Initial Catalog=test';
  try

    try
      ADOConnection.ConnectionString := ConnectionString;
      ADOConnection.LoginPrompt := False;
      ADOConnection.Connected := True;

      ADOQuery.Connection := ADOConnection;

      ADOQuery.SQL.Clear;
      with ADOQuery.SQL do
      begin
        Add('create table Klijent(');
        Add('JMBG     char(13) not null,');
        Add('Ime      char(30) not null,');
        Add('Adresa   char(30) not null,');
        Add('Telefon  char(15) not null,');
        Add('Primanja numeric(6,2) not null,');
        Add('primary key (JMBG))');
      end;
      ADOQuery.ExecSQL;

      ADOQuery.SQL.Clear;
      with ADOQuery.SQL do
      begin
        Add('create table Kredit(');
        Add('Sifra    numeric not null,');
        Add('Tip      char(15) unique not null,');
        Add('Kamata   numeric not null,');
        Add('primary key (Sifra))');
      end;
      ADOQuery.ExecSQL;

      ADOQuery.SQL.Clear;
      with ADOQuery.SQL do
      begin
        Add('create table Operator(');
        Add('JMBG     char(13) unique not null,');
        Add('Ime      char(30) not null,');
        Add('Sifra    char(30) not null,');
        Add('Adresa   char(30) not null,');
        Add('Telefon  char(15) not null,');
        Add('Prioritet smallint not null check (Prioritet>0),');
        Add('primary key (JMBG))');
      end;
      ADOQuery.ExecSQL;

      ADOQuery.SQL.Clear;
      with ADOQuery.SQL do
      begin
        Add('create table Kreditiranja (');
        Add('Sifra          numeric not null,');
        Add('Sifra_kredita  numeric not null,');
        Add('Datum          datetime,');
        Add('Iznos_kredita  numeric(10,2) check (Iznos_kredita>0),');
        Add('Broj_rata      numeric,');
        Add('JMBG_klijenta  char(13),');
        Add('JMBG_operatora char(13),');
        Add('primary key(Sifra),');
        Add('foreign key(Sifra_kredita) references Kredit(Sifra) on delete cascade on update cascade,');
        Add('foreign key(JMBG_klijenta) references Klijent(JMBG) on delete cascade on update cascade,');
        Add('foreign key(JMBG_operatora) references Operator(JMBG) on delete cascade on update cascade)');
      end;
      ADOQuery.ExecSQL;

      ADOQuery.SQL.Clear;
      with ADOQuery.SQL do
      begin
        Add('create table Rata (');
        Add('Broj_rate    numeric not null,');
        Add('Broj_sifre   numeric not null,');
        Add('Datum        datetime,');
        Add('Iznos_rate   numeric(10,2) check (Iznos_rate>0),');
        Add('primary key (Broj_rate),');
        Add('foreign key (Broj_sifre) references Kreditiranja(Sifra) on delete cascade on update cascade)');
      end;
      ADOQuery.ExecSQL;

      MessageDlg('Tabele su uspjesno kreirane.', mtInformation, [mbOK], 0);
    except
      on E: Exception do MessageDlg(E.Message, mtWarning, [mbOK], 0);
    end;

  finally
    ADOConnection.Connected := False;
  end;
end;

var
  LastID: Integer;
//  Query: TADOQuery;
//  oder
//  Query: TQuery;
begin
  Query.Active := False;
  Query.SQL.Clear;
  Query.SQL.Append('INSERT INTO Table (Spalte) VALUES (Value)');
  Query.ExecSQL;
  LastID := GetLastID(Query);
end;

function GetLastID(var Query: TADOQuery {or TQuery}): Integer;
begin
  result := -1;
  try
    Query.SQL.clear;
    Query.SQL.Add('SELECT @@IDENTITY');
    Query.Active := True;
    Query.First;
    result := Query.Fields.Fields[0].AsInteger;
  finally
    Query.Active := False;
    Query.SQL.clear;
  end;
end;

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ADODB, DB, DBTables, ComObj;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

function ConnectToADODB(var Query: TADOQuery; ConnectStr: String): Boolean; Overload;
function UpdateBlob(Connection: TADOConnection; Spalte: String; Tabelle: String; Where: String; var ms: TMemoryStream): Boolean;
procedure ShowEOleException(AExc: EOleException; Query: String);

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
  Query: TADOQuery;
  ms: TMemoryStream;
  ConnectStr: String;
begin
  ms := TMemoryStream.Create;
  ms.LoadFromFile('d:\a.txt');
  Query := TADOQuery.Create(nil);

  // You must connect to AccessDB first.
  // See: Query.Connection, TADOConection or Query.ConnectionString

  //my function to connect to DB
  ConnectStr := 'Provider=Microsoft.Jet.OLEDB.4.0;' + // provider for Access2000
                'Data Source=C:\db1.mdb;' + // databasefile
                'Mode=ReadWrite|Share Deny None;' + // set to ReadWrite
                'Persist Security Info=False';
  if not ConnectToADODB(Query, ConnectStr) then
   ShowMessage('Connecting to DB failed.');

  // data is my row and email the table
  UpdateBlob(Query.Connection, 'blobfieldname', 'Tabelle1', 'id=1', ms);
  ms.Free;

  // disconnect from DB
  Query.Connection.Close;

  Query.Free;
end;

function ConnectToADODB(var Query: TADOQuery; ConnectStr: String): Boolean; Overload;
begin
  Query.Connection := TADOConnection.Create(nil);
  Query.Connection.LoginPrompt := True;
  Query.Connection.ConnectionString := ConnectStr;
  Query.Connection.Open;
  result := Query.Connection.Connected;
end;

function UpdateBlob(Connection: TADOConnection; Spalte: String; Tabelle: String; Where: String; var ms: TMemoryStream): Boolean;
var
  BlobField: TBlobField;
  Table: TADOTable;
begin
  result := True;
  try
    ms.Seek(0, soFromBeginning);
    Table := TADOTable.Create(nil);
    Table.Connection := Connection;
    Table.TableName := Tabelle;
    Table.Filtered := False;
    // Set Filter like SQL-Command '... WHERE id=1'
    Table.Filter := Where;
    Table.Filtered := True;
    Table.Open;
    Table.First;

    if not Table.FieldByName(Spalte).IsBlob then
     Raise EOleException.Create('The field ' + Spalte + ' is not a blob-field.', S_FALSE, 'ITSQL.UpdateBlob', '', 0);

    BlobField := TBlobField(Table.FieldByName(Spalte));
    Table.Edit;
    BlobField.LoadFromStream(ms);
    Table.Post;
    Table.Free;
  except
    on E: EOleException do
    begin
      ShowEOleException(E, 'UPDATE BLOB FROM: SELECT ' + Spalte + ' FROM ' + Tabelle + ' WHERE ' + Where);
      result := False;
    end;
  end;
end;

procedure ShowEOleException(AExc: EOleException; Query: String);
var
  ErrShowFrm: TForm;
  Memo: TMemo;
begin
  ErrShowFrm := TForm.Create(nil);
  ErrShowFrm.Position := poScreenCenter;
  ErrShowFrm.Width := 640;
  ErrShowFrm.Height := 480;
  Memo := TMemo.Create(ErrShowFrm);
  Memo.Parent := ErrShowFrm;
  Memo.Align := alClient;

  Memo.Lines.Clear;
  Memo.Lines.Add('Message: ' + AExc.Message);
  Memo.Lines.Add('   Source: ' + AExc.Source);
  Memo.Lines.Add('   ClassName: ' + AExc.ClassName);
  Memo.Lines.Add('   Error Code: ' + IntToStr(AExc.ErrorCode));
  Memo.Lines.Add('   Query: ' + Query);

  ErrShowFrm.ShowModal;
  Memo.Free;
  ErrShowFrm.Free;
end;

end.

property BM1: TBookmark read FBM1 Write SetBM1;

property BM2: TBookmark read FBM2 Write SetBM2;

procedure Markieren(Sender: TObject);
  function Shiftgedr: Boolean;


    procedure TForm1.Markieren(Sender: TObject);
    var
      Richtung: string;
      TempBM: TBookmark;
    begin
      with (Sender as TDBGRID).DataSource.Dataset do 
      begin
        if (BOF and EOF) then
          Exit;
        DisableControls;
        try
          try
            GotoBookmark(BM1);
            case DBGrid1.DataSource.DataSet.CompareBookmarks(BM1, BM2) of
                -1: Richtung := 'Unten';
              1: Richtung    := 'Oben';
              0: Richtung    := 'Gleich';
            end;
            TempBM := DBGrid1.DataSource.DataSet.GetBookmark;
            while DBGrid1.DataSource.DataSet.CompareBookmarks(BM2, TempBM) <> 0 do 
            begin
              DBGrid1.SelectedRows.CurrentRowSelected := True;
              if Richtung = 'Unten' then
                Next
              else
                Prior;
              TempBM := DBGrid1.DataSource.DataSet.GetBookmark;
            end;
          finally
            FreeBookmark(tempbm);
          end;
        finally
          EnableControls;
        end;
      end;
    end;

    function TForm1.Shiftgedr: Boolean;
    var
      State: TKeyboardState;
    begin
      GetKeyboardState(State);
      Result := ((State[VK_SHIFT] and 128) <> 0);
    end;

  begin
    if not Shiftgedr then
      Merke1 := nil;

    if Merke1 = nil then
      Merke1 := DBGrid1.DataSource.DataSet.GetBookmark
    else
      Merke2 := DBGrid1.DataSource.DataSet.GetBookmark;

    if (Merke1 <> nil) and (Merke2 <> nil) then 
    begin
      if Shiftgedr then 
      begin
        Markieren(Sender);
      end;
    end;
  end;

procedure TForm1.Button1Click(Sender: TObject);
var
ms: TMemoryStream;
begin
if OpenPictureDialog1.Execute then
begin
ms := TMemoryStream.Create;
try
ms.LoadFromFile(OpenPictureDialog1.FileName);
with Query1 do
begin
with SQL do
begin
Clear;
Add('INSERT INTO "ImageTbl.db" (ImageFld)');
Add('VALUES (:param0 )');
end;
Query1.ParamByName('param0').SetBlobData(ms.Memory, ms.Size);
ExecSQL;
end;
finally
ms.Free;
end;
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  ADOCommand1.CommandText := 'Create Table MasterTable ' +
    '(FieldName Primary Key);';
  ADOCommand1.Execute;
  ADOCommand1.CommandText := 'Create Table Detailtable ' +
    '(Fieldname Primary Key Refrenced Mastertable(Fieldname));';
  ADOCommand1.Execute;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  ADOQuery1.SQL.Add('Exec SP_Tables');
  ADOQuery1.Active := True;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  ADOQuery1.SQL.Add('Exec SP_DATABASES');
  ADOQuery1.Active := True;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  ADOQuery1.SQL.Add('Exec SP_WHO');
  ADOQuery1.Active := True;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  ADOCommand1.CommandText := 'Use DataBaseName';
  ADOCommand1.Execute;
  ADOCommand1.CommandText := 'Exec SP_DropUser ' + QuotedStr('Username');
  ADOCommand1.Execute;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  ADOCommand1.CommandText := 'Use DataBaseName';
  ADOCommand1.Execute;
  ADOCommand1.CommandText := 'Exec SP_AddUser ' + QuotedStr('Username');
  ADOCommand1.Execute;
end;