نوشته های پیشین مرداد 1386 مهر 1385 شهریور 1385 اردیبهشت 1384 |
سلام
این وبلاگ نمونه هایی از مطالب ارائه شده در سایت"مرکز دلفی سوئیس" میباشد که در آن سعی میکنم حدالامکان به پرسش های شما در زمینه های مختلف نویسی و از جمله زبان دلفی پاسخ دهم . همچنین سعی میکنم تکه کدهای مربوط به نکات برنامه نویسی که اکثر برنامه نویسان به آنها احتیاج دارند را هم برای استفاده علاقمندان قرار بدم برای طرح پرسش از گزینه "نظر بدین" و یا "چند نظر" استفاده کنید .با تشکر از شما
نوشته شده توسط مهندس نورانی
صفحه نخست           پست الکترونیک          آرشیو وبلاگ
|
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;
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;
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;
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.
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;