تبليغاتX
وبلاگ تخصصی دلفی
وبلاگ تخصصی دلفی
ارائه نکات برنامه نویسی و پاسخ به پرسشهای شما در زمینه برنامه نویسی


نوشته های پیشین
مرداد 1386
مهر 1385
شهریور 1385
اردیبهشت 1384
سلام

این وبلاگ نمونه هایی از مطالب ارائه شده در سایت"مرکز دلفی سوئیس" میباشد که در آن سعی میکنم حدالامکان به پرسش های شما در زمینه های مختلف نویسی و از جمله زبان دلفی پاسخ دهم . همچنین سعی میکنم تکه کدهای مربوط به نکات برنامه نویسی که اکثر برنامه نویسان به آنها احتیاج دارند را هم برای استفاده علاقمندان قرار بدم
برای طرح پرسش از گزینه "نظر بدین" و یا "چند نظر" استفاده کنید
.با تشکر از شما
نوشته شده توسط مهندس نورانی   


چگونه می توان بانک Access را Compact and Repair کرد؟

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;

2 نوشته شده توسط مهندس نورانی  | 

چگونه می توان یک جدول را در SQL Server ایجاد کرد؟

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;

2 نوشته شده توسط مهندس نورانی  | 

چگونه می توان ID آخرین سطر Insert شده را دریافت کرد؟

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;

2 نوشته شده توسط مهندس نورانی  | 

چگونه می توان با استفاده از ADO و بانک Access یک فیلد Blob را مقدار دهی کرد؟

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: Stringvar 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: Stringvar 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.

2 نوشته شده توسط مهندس نورانی  | 

چگونه می توان چندین سطر را با Shift در DBGrid انتخاب کرد؟

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 <> niland (Merke2 <> nilthen 
    begin
      if Shiftgedr then 
      begin
        Markieren(Sender);
      end;
    end;
  end;

2 نوشته شده توسط مهندس نورانی  | 

چگونه می توان یک فیلد Memo را در DBGrid ویرایش کرد؟

function TCustomDBGrid.GetEditLimit: Integer;
begin
  Result := 0;

  if Assigned(SelectedField) and (SelectedField.DataType in [ftString, ftWideString, ftMemo]) then
    Result := SelectedField.Size;
end;

function TCustomDBGrid.GetEditText(ACol, ARow: Longint): string;
begin
  
Result := '';
  if FDatalink.Active then
  with 
Columns[RawToDataColumn(ACol)] do
    if 
Assigned(Field) then
      
Result := Field.AsString;
  FEditText := Result;
end;

2 نوشته شده توسط مهندس نورانی  | 

چگونه می توان یک فایل JEPG را در یک فیلد Blob با SQL بریزیم؟

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;

2 نوشته شده توسط مهندس نورانی  | 

چگونه می توان یک Query را در یک TTable اجرا کرد؟

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Query1: TQuery;
    DataSource1: TDataSource;
    DBGrid1: TDBGrid;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
  InitQuery: TQuery;
  InitTable: TTable;
  InitBatch: TBatchMove;
begin
  InitQuery := TQuery.Create(Application);
  with InitQuery do
  begin
    DatabaseName := 'DBDEMOS';
    Close;
    SQL.Clear;
    SQL.Add('SELECT * ');
    SQL.Add('FROM customer.db');
    SQL.Add('WHERE Country="US"');
    SQL.SaveToFile('mgrInit.sql');
    try
      Open;
      try // Send the SQL result to c:\temp\INIT.DB
        InitTable := TTable.Create(Application);
        with InitTable do 
        begin 
          DatabaseName := 'c:\temp';
          TableName    := 'INIT';
        end;
        InitBatch := TBatchMove.Create(Application);
        with InitBatch do 
        begin
          Destination := InitTable;
          Source      := InitQuery;
          Mode        := batCopy;
          Execute;
        end;
      finally
        InitTable.Free;
        InitBatch.Free;
      end;
    except
      Free;
      Abort;
    end;
    Free;
  end;
end;

end.

2 نوشته شده توسط مهندس نورانی  | 

چگونه می توان جداول Detial/Master را در Sql Server در زمان اجرا کرد؟

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;

2 نوشته شده توسط مهندس نورانی  | 

چگونه می توان لیستی از جداول یک دیتا بیس Sql Server را دریافت کرد؟

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

2 نوشته شده توسط مهندس نورانی  | 

چگونه می توان لیستی دیتا بیس های Sql Server را دریافت کرد؟

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

2 نوشته شده توسط مهندس نورانی  | 

چگونه می توان لیستی از کاربران فعال Sql Server را دریافت کرد؟

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

2 نوشته شده توسط مهندس نورانی  | 

چگونه می توان User را در Sql Server حذف کرد؟

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

2 نوشته شده توسط مهندس نورانی  | 

چگونه می توان User را در Sql Server ایجاد کرد؟

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


2 نوشته شده توسط مهندس نورانی  |