[Lazarus] SQLDb and TSQLQuery usage for MSSQL database...

Bo Berglund bo.berglund at gmail.com
Wed Feb 24 10:35:10 CET 2016


In my previous thread I received help that made it possible for me to
connect from my RPi2 to an MSSQL database server on a Windows server
in the network using the TMSSQLConnection component.
So the connectivity seems fine.
(Using FPC 3.0.0 and Lazarus 1.6)

Now I have a different problem regarding usage of the TSQLQuery
component, which does not currently work as expected:

I have read the tutorial in
http://wiki.freepascal.org/SqlDBHowto#Example:_reading_data_from_a_table
and tried to use it in creating a DB handler class for the
application.
The basics are as follows:

----- Here is the current state of my DB handler class: -------

  TUserDb = class
  private
    FConn: TMSSQLConnection;
    FQuery: TSQLQuery;
    FTrans: TSQLTransaction;
    FDatabase,
    FDBserver,
    FDBLogin,
    FDBPasswd: string;
    FDBSet: boolean;
    FLoginSet: boolean;
    FPwdSet: boolean;
    FServerSet: boolean;
    FLastError: string;
    procedure SetDatabase(AValue: string);
    procedure SetLogin(AValue: string);
    procedure SetPasswd(AValue: string);
    procedure SetServer(AValue: string);
  public
    property Database: string read FDatabase write SetDatabase;
    property Server: string read FDBServer write SetServer;
    property Login: string read FDBLogin write SetLogin;
    property Passwd: string read FDBPasswd write SetPasswd;
    constructor Create;
    destructor Destroy; override;
    function OpenConnection: boolean;
    procedure CloseConnection;
    function GetPasswordFile(var slPWD: TStringList): boolean;
  end;


implementation

{$R *.lfm}

{ TUserDb }

procedure TUserDb.SetDatabase(AValue: string);
begin
  if FDatabase=AValue then Exit;
  FDatabase:=AValue;
  FDBSet := true;
end;

procedure TUserDb.SetLogin(AValue: string);
begin
  if FDBLogin=AValue then Exit;
  FDBLogin:=AValue;
  FLoginSet := true;
end;

procedure TUserDb.SetPasswd(AValue: string);
begin
  if FDBPasswd=AValue then Exit;
  FDBPasswd:=AValue;
  FPwdSet := true;
end;

procedure TUserDb.SetServer(AValue: string);
begin
  if FDBServer=AValue then Exit;
  FDBServer:=AValue;
  FServerSet := true;
end;

constructor TUserDb.Create;
begin
  FConn := TMSSQLConnection.Create(NIL);
  FTrans := TSQLTransaction.Create(NIL);
  FQuery := TSQLQuery.Create(NIL);
  FQuery.DataBase := FConn; // <== Database property set here!!!
  FQuery.Transaction := FTrans;
end;

destructor TUserDb.Destroy;
begin
  FQuery.Free;
  FTrans.Free;
  FConn.Free;
  inherited Destroy;
end;

function TUserDb.OpenConnection: boolean;
begin
  Result := false;
  if not (FDBSet and FServerSet and FLoginSet and FPwdSet) then
  begin
    FLastError := 'Missing connection parameter';
    Exit;
  end;
  if FConn.Connected then
     CloseConnection;
  FConn.DatabaseName := FDatabase;
  FConn.HostName := FDBServer;
  FConn.UserName := FDBLogin;
  FConn.Password := FDBPasswd;
  try
    FConn.Open;
    Result := FConn.Connected;
  except
    on E: Exception do
      FLastError := E.Message;
  end;
end;

procedure TUserDb.CloseConnection;
begin
  if FConn.Connected then
    FConn.Close(true);
end;

function TUserDb.GetPasswordFile(var slPWD: TStringList): boolean;
var
  sSQL,
  sLogin,
  sPwd,
  sCryptPwd,
  sDup: string;
  slCheck, slFile: TStringList;
begin
  Result := false;
  sSQL := 'EXEC SelectPwdEntries';
  slPWD.Clear;
  slCheck := TStringList.Create;
  slFile := TStringList.Create;
  sDup := '';
  try
    try
      if not OpenConnection then
      begin
        Exit;
      end;
      FQuery.SQL.Text := sSQL;
      FQuery.Open; //<== Error exception here!!!
      if not FQuery.EOF then
      begin
        FQuery.First;
        repeat
          sLogin := FQuery.FieldByName('LoginName').AsString;
          sPwd := FQuery.FieldByName('Passwd').AsString;
          sCryptPwd := FQuery.FieldByName('CryptPwd').AsString;
          if (sLogin <> '') and (sPwd <> '') and (sCryptPwd > '') then
          begin
            if slCheck.IndexOf(sLogin)<0 then //no duplicates
            begin
              slCheck.Add(sLogin);
              slFile.Add(sLogin + ':' + sCryptPwd);
            end
            else
              sDup := sDup + #13 + sLogin;
          end;
          FQuery.Next;
        until FQuery.EOF;
        FQuery.Close;
        CloseConnection;
        if sDup <> '' then
          ShowMessage('Duplicated logins!'#13#10 + sDup);
        slPWD.Text := slFile.Text;
        Result := true;
      end;
    except
      on E: Exception do
        FLastError := E.Message;
    end;
  finally
    slCheck.Free;
    slFile.Free;
  end;
end;


---- On the form I have these related functions -------


procedure TForm1.FormClose(Sender: TObject; var CloseAction:
TCloseAction);
begin
  FDBHandler.Free;
end;

procedure TForm1.FormShow(Sender: TObject);
begin
  FDBHandler := TUserDb.Create;
end;

procedure TForm1.btnGetPwdFileClick(Sender: TObject);
var
  slPwd: TStringList;
begin
  FDBHandler.CloseConnection;
  FDBHandler.Database:= '<db name>';
  FDBHandler.Server:= '<server name>';
  FDBHandler.Login:= '<user name>';
  FDBHandler.Passwd:= '<password>';
  slPwd := TStringList.Create;
  try
    FDBHandler.GetPasswordFile(slPwd);
    lbxMsg.Items.Text := slPwd.Text;
  finally
    slPwd.Free;
  end;
end;

What happens is that when I hit the button "btnGetPwdFile" and step
through the code I get past the OpenConnection step and into the
FQuery setup and then on FQuery.Open I get an error message saying
basically that the FQuery.Database is not set!
But that is done already in the object constructor to be the FConn
object!

What gives here? Does FQuery not understand that the database is
provided via the connection object?

The exact error I get is this:

Debugger Exception Notification
Project DBTest raised exception class 'EDatabaseError' with message:
Database not assigned!
At address 2DD4B0
    [Break]   [Continue]


-- 
Bo Berglund
Developer in Sweden





More information about the Lazarus mailing list