Kontakt til professionel delphi programmør

Jeg er fristet og beæret over selskabet men kan simpelthen ikke afse tid. Beklager.

JEg har en milliard spørgsmål .. Er det muligt du vil ringe mig op
2024 3065

Eller komme på messenger Jens@Borrisholt.com

Min erfaing viser, at du skal prøve at spørge kroning!

friiiis: Er du kommet videre med opgaven?

Hej,

Ja, Borrisholt har lavet en hel klasse med forskellige kald til den databse jeg har problemer med...

Men ellers tak for interessen...

Henrik ... Smid mig lige en mail med en adresse, jeg skal sende det brev til :d

For en god ordens skyld postes koden her :

unit UnitDataConnection;

interface

uses
  ADODB, Classes, DB, Sysutils;

type
  TCustomConnection = class(TADOConnection)
  protected
    procedure SetupConnectionString; virtual; abstract;
    procedure DoConnect; override;
  public
    constructor Create(AOwner: TComponent); override;
  end;

  TSQLServerConnection = class(TCustomConnection)
  private
    FUserName: string;
    FPassWord: string;
    FServerName: string;
    FDatabaseName: string;
    procedure SetDatabaseName(const Value: string);
    procedure SetPassWord(const Value: string);
    procedure SetServerName(const Value: string);
    procedure SetUserName(const Value: string);
  protected
    procedure SetupConnectionString; override;
  public
    constructor Create(AOwner: TComponent); override;
    property UserName: string read FUserName write SetUserName;
    property PassWord: string read FPassWord write SetPassWord;
    property DatabaseName: string read FDatabaseName write SetDatabaseName;
    property ServerName: string read FServerName write SetServerName;
  end;

  TAccessConnection = class(TCustomConnection)
  private
    FPassWord: string;
    FUserName: string;
    FFileName: string;
    procedure SetFileName(const Value: string);
    procedure SetPassWord(const Value: string);
    procedure SetUserName(const Value: string);
  protected
    procedure SetupConnectionString; override;
  public
    constructor Create(AOwner: TComponent); override;
    property UserName: string read FUserName write SetUserName;
    property PassWord: string read FPassWord write SetPassWord;
    property FileName: string read FFileName write SetFileName;
  end;

  THistorianConnection = class(TCustomConnection)
  private
    FDatabaseName: string;
    FPassWord: string;
    FUserName: string;
    FServerName: string;
    procedure SetDatabaseName(const Value: string);
    procedure SetPassWord(const Value: string);
    procedure SetServerName(const Value: string);
    procedure SetUserName(const Value: string);
  protected
    procedure SetupConnectionString; override;
  public
    constructor Create(AOwner: TComponent); override;
    property UserName: string read FUserName write SetUserName;
    property PassWord: string read FPassWord write SetPassWord;
    property DatabaseName: string read FDatabaseName write SetDatabaseName;
    property ServerName: string read FServerName write SetServerName;
  end;

implementation

{ TCustomConnection }

constructor TCustomConnection.Create(AOwner: TComponent);
begin
  inherited;
  LoginPrompt := False;
end;

procedure TCustomConnection.DoConnect;
begin
  SetupConnectionString;
  inherited;
end;

{ TSQLServerConnection }

constructor TSQLServerConnection.Create(AOwner: TComponent);
begin
  inherited;
  FServerName := 'localhost';
  FPassWord := 'masterkey';
  FUserName := 'sysdba';
  FDatabaseName := '';
  ConnectionString := 'Provider=SQLOLEDB.1;Password=%s;Persist Security Info=True;User ID=%s;Initial Catalog=%s;Data Source=%s';
end;

procedure TSQLServerConnection.SetDatabaseName(const Value: string);
begin
  FDatabaseName := Value;
end;

procedure TSQLServerConnection.SetPassWord(const Value: string);
begin
  FPassWord := Value;
end;

procedure TSQLServerConnection.SetServerName(const Value: string);
begin
  FServerName := Value;
end;

procedure TSQLServerConnection.SetupConnectionString;
begin
  ConnectionString := Format(ConnectionString, [FPassword, FUserName, FDatabaseName, FServerName]);
end;

procedure TSQLServerConnection.SetUserName(const Value: string);
begin
  FUserName := Value;
end;

{ TAccessConnection }

constructor TAccessConnection.Create(AOwner: TComponent);
begin
  inherited;
  FPassWord := '';
  FUserName := 'Admin';
  FFileName := '';
  ConnectionString := 'Provider=Microsoft.Jet.OLEDB.4.0;User ID=%s;Data Source=%s;Jet OLEDB:Database Password=%s;';
end;

procedure TAccessConnection.SetFileName(const Value: string);
begin
  FFileName := Value;
end;

procedure TAccessConnection.SetPassWord(const Value: string);
begin
  FPassWord := Value;
end;

procedure TAccessConnection.SetupConnectionString;
begin
  ConnectionString := Format(ConnectionString, [FUserName, FFileName, FPassword]);
end;

procedure TAccessConnection.SetUserName(const Value: string);
begin
  FUserName := Value;
end;

{ THistorianConnection }

constructor THistorianConnection.Create(AOwner: TComponent);
begin
  inherited;
  FDatabaseName := '';
  FPassWord := '';
  FUserName := '';
  FServerName := '';
  ConnectionString := 'Provider=IhOLEDB.iHistorian.1;Persist Security Info=False;User ID="%s";Data Source=%s;Password=%s,Mode=Read';
end;

procedure THistorianConnection.SetDatabaseName(const Value: string);
begin
  FDatabaseName := Value;
end;

procedure THistorianConnection.SetPassWord(const Value: string);
begin
  FPassWord := Value;
end;

procedure THistorianConnection.SetServerName(const Value: string);
begin
  FServerName := Value;
end;

procedure THistorianConnection.SetupConnectionString;
begin
  ConnectionString := Format(ConnectionString, [FPassword, FUserName, FDatabaseName, FServerName]);
end;

procedure THistorianConnection.SetUserName(const Value: string);
begin
  FUserName := Value;
end;

end.


unit DatabaseAcess;

interface
uses
  ADODB, Classes, DB, SysUtils, Graphics, UnitDataConnection;

type
  TTime = type TDateTime;

  TDatabaseConnection = class(TAccessConnection)
  private
    function GetDatabaseName: string;
  public
    function DataBasePath: string;
    constructor Create(AOwner: TComponent); override;
  end;

  TCustomBorrisholtQuery = class(TADOQuery)
  protected
    FOwner: TComponent;
    procedure SetActive(Value: Boolean); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure ReActivate;
    property Active;
  end;

  TBorrisholtQuery = class(TCustomBorrisholtQuery)
  private
    FIncludeMarkAsDeleted: Boolean;
  protected
    FFieldsNames: TStringList;
    FWhereSql: string;
    function GetStringProperty(Index: Integer): string; virtual;
    procedure SetStringProperty(const Index: Integer; const Value: string); virtual;

    function GetIntegerProperty(Index: Integer): Integer; virtual;
    procedure SetIntegerProperty(const Index: Integer; const Value: Integer); virtual;

    function GetFloatProperty(Index: Integer): Double; virtual;
    procedure SetFloatProperty(const Index: Integer; const Value: Double); virtual;

    function GetDateTimeProperty(Index: Integer): TDateTime; virtual;
    procedure SetDateTimeProperty(const Index: Integer; const Value: TDateTime); virtual;

    function GetTimeProperty(Index: Integer): TTime; virtual;
    procedure SetTimeProperty(const Index: Integer; const Value: TTime); virtual;

    function GetBooleanProperty(Index: Integer): Boolean; virtual;
    procedure SetBooleanProperty(const Index: Integer; const Value: Boolean); virtual;

    function GetColorProperty(Index: Integer): TColor; virtual;
    procedure SetColorProperty(const Index: Integer; const Value: TColor); virtual;

    procedure CreateSQL; virtual;
    procedure SetActive(Value: Boolean); override;
  public
    property WhereClause: string read FWhereSql write FWhereSql;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    property IncludeMarkAsDeleted: Boolean read FIncludeMarkAsDeleted write FIncludeMarkAsDeleted;
  end;

var
  DatabaseConnection: TDatabaseConnection;

implementation

procedure TCustomBorrisholtQuery.SetActive(Value: Boolean);
begin
  inherited;

  if (not Value) and (Assigned(Connection)) then
    Connection.Close;
end;

procedure TCustomBorrisholtQuery.ReActivate;
begin
  Active := False;
  Active := True;
end;

constructor TCustomBorrisholtQuery.Create(AOwner: TComponent);
begin
  inherited;

  if DatabaseConnection = nil then
    DatabaseConnection := TDatabaseConnection.Create(nil);

  FOwner := AOwner;

  if AOwner <> nil then
    Connection := DatabaseConnection
  else
    Connection := TDatabaseConnection.Create(nil);
end;

destructor TCustomBorrisholtQuery.Destroy;
begin
  if FOwner = nil then
    Connection.free;

  inherited;
end;

constructor TBorrisholtQuery.Create(AOwner: TComponent);
begin
  inherited;
  FFieldsNames := TStringList.Create;
  FIncludeMarkAsDeleted := False;
end;

procedure TBorrisholtQuery.CreateSQL;
begin
  //do nothing in base class
end;

destructor TBorrisholtQuery.Destroy;
begin
  inherited;
  FreeAndNil(FFieldsNames);
end;

function TBorrisholtQuery.GetBooleanProperty(Index: Integer): Boolean;
begin
  Result := False;
  if Active then
    Result := FieldByName(FFieldsNames[Index]).AsBoolean;
end;

function TBorrisholtQuery.GetColorProperty(Index: Integer): TColor;
begin
  Result := clNone;
  if Active then
    Result := FieldByName(FFieldsNames[Index]).AsInteger;
end;

function TBorrisholtQuery.GetDateTimeProperty(Index: Integer): TDateTime;
begin
  Result := 0;
  if Active then
    Result := FieldByName(FFieldsNames[Index]).AsDateTime;
end;

function TBorrisholtQuery.GetFloatProperty(Index: Integer): Double;
begin
  Result := 0;
  if Active then
    Result := FieldByName(FFieldsNames[Index]).AsFloat;
end;

function TBorrisholtQuery.GetIntegerProperty(Index: Integer): Integer;
begin
  Result := 0;
  if Active then
    Result := FieldByName(FFieldsNames[Index]).AsInteger;
end;

function TBorrisholtQuery.GetStringProperty(Index: Integer): string;
begin
  Result := '';
  if Active then
    Result := FieldByName(FFieldsNames[Index]).AsString;
end;

function TBorrisholtQuery.GetTimeProperty(Index: Integer): TTime;
begin
  Result := 0;
  if Active then
    Result := Frac(FieldByName(FFieldsNames[Index]).AsDateTime);
end;

procedure TBorrisholtQuery.SetActive(Value: Boolean);
begin
  if Value and Active then
    Active := False;
  if Value then
    CreateSQL;
  inherited;
end;

procedure TBorrisholtQuery.SetBooleanProperty(const Index: Integer; const Value: Boolean);
begin
  if Active and (State in [dsEdit, dsInsert]) then
    FieldByName(FFieldsNames[Index]).AsBoolean := Value;
end;

procedure TBorrisholtQuery.SetColorProperty(const Index: Integer; const Value: TColor);
begin
  if Active and (State in [dsEdit, dsInsert]) then
    FieldByName(FFieldsNames[Index]).AsInteger := Value;
end;

procedure TBorrisholtQuery.SetDateTimeProperty(const Index: Integer; const Value: TDateTime);
begin
  if Active and (State in [dsEdit, dsInsert]) then
    FieldByName(FFieldsNames[Index]).AsDateTime := Value;
end;

procedure TBorrisholtQuery.SetFloatProperty(const Index: Integer; const Value: Double);
begin
  if Active and (State in [dsEdit, dsInsert]) then
    FieldByName(FFieldsNames[Index]).AsFloat := Value;
end;

procedure TBorrisholtQuery.SetIntegerProperty(const Index, Value: Integer);
begin
  if Active and (State in [dsEdit, dsInsert]) then
    FieldByName(FFieldsNames[Index]).AsInteger := Value;
end;

procedure TBorrisholtQuery.SetStringProperty(const Index: Integer; const Value: string);
begin
  if Active and (State in [dsEdit, dsInsert]) then
    FieldByName(FFieldsNames[Index]).AsString := Value;
end;

procedure TBorrisholtQuery.SetTimeProperty(const Index: Integer; const Value: TTime);
begin
  if Active and (State in [dsEdit, dsInsert]) then
    FieldByName(FFieldsNames[Index]).AsDateTime := Value;
end;

{ TDatabaseConnection }

constructor TDatabaseConnection.Create(AOwner: TComponent);
begin
  inherited;
  FileName := GetDatabaseName;
end;

function TDatabaseConnection.DataBasePath: string;
begin
  Result := ExtractFilePath(ParamStr(0));
end;

function TDatabaseConnection.GetDatabaseName: string;
var
  Path: string;
begin
  Path := DataBasePath;
  ForceDirectories(Path);
  Result := Path + 'JPPlaner.mdb';
end;

end.

unit DatabaseClasses;

interface
uses
  Classes, Sysutils, DatabaseAcess;

type
  TPostnumre = class(TBorrisholtQuery)
  private
    FPostNummer: string;
    procedure SetPostNummer(const Index: Integer; const Value: string);
  protected
    procedure CreateSQL; override;
  public
    constructor Create(AOwner: TComponent); override;
    property PostNummer: string index 0 read GetStringProperty write SetPostNummer;
    property By: string index 1 read GetStringProperty write SetStringProperty;
  end;

implementation

{ TPostnumre }

constructor TPostnumre.Create(AOwner: TComponent);
begin
  inherited;
  FFieldsNames.Add('Postnummer');
  FFieldsNames.Add('By');
end;

procedure TPostnumre.CreateSQL;
begin
  SQL.Clear;
  SQL.Add('Select * from postnumre ');
  SQL.Add('WHERE (1=1) ');

  if FPostNummer <> '' then
    SQL.ADD(Format('AND [PostNummer] = ''%s''', [FPostNummer]));

  if Trim(FWhereSql) <> '' then
    SQL.ADD(' AND (' + FWhereSql + ')');
end;

procedure TPostnumre.SetPostNummer(const Index: Integer; const Value: string);
begin
  FPostNummer := Value;
  SetStringProperty(Index, Value);
end;

end.


Jens B

hrc_public på hotmail

lukker