I have just started on a new project, which is mysql backed - beginning with a 
fairly abstract unit which a large number of different lazarus programs will 
use to communicate with the DB.

But I ran into a very strange problem quite early on, I can connect to the DB 
without hassles, but as soon as I try to do a query - I get a crash, and I 
have no idea why... :S

My current test calls look like this:

ZC_DBConnect;
ZC_Settings : TZC_Settings.Create;
        Writeln(ZC_Settings.GetPricePerUnit);

TraceBack says it's crashing on line 96:
  if (mysql_query(socket,pchar(Query)) < 0) then


The unit in full goes:
unit libzybacafe;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils,dialogs,mysql4;

procedure ZC_DBConnect;
Function ZC_DBQuery(Query:String):PMYSQL_RES;

type
  TZC_Settings = class
  private
   {Private Declarations}
         FCurrencySymbol : String;
         FUnitLength : Integer;
         FPricePerUnit : Real;
         FResult : PMySQL_RES;
         FRow: MYSQL_ROW;
         Procedure LoadFromDB;
         Procedure SaveToDB;
    public
    { public declarations }
         Function GetCurrencySymbol : String;
         Function GetUnitLength : Integer;
         Function GetPricePerUnit: Real;
         Procedure SetCurrencySymbol(NewSymbol:String);
         Procedure SetUnitLength(NewLength:Integer);
         Procedure SetPricePerUnit(NewPrice : Real);
  end;
  
Var
 Socket : PMysQL;

implementation

procedure ZC_DBConnect;
Var
    DBCFG : TSTringList;
    I : Integer;
    H,U,P,D : String;
  qmysql : TMYSQL;
  alloc : PMYSQL;

Begin
DBCFG := TSTringList.Create;
Try
{$IFDEF Unix}
   DBCFG.LoadFromFile('/etc/zybacafe.cfg');
{$ENDIF}
{$IFDEF Win32}
   DBCFG.LoadFromFile('C:\Program Files\ZybaCafe\zybacafe.cfg');
{$ENDIF}
except
      ShowMessage ('Error Loading database configuration !');
      Halt;
end;
For I := 0 to DBCFG.Count -1 do
begin
     If pos('HOST=',uppercase(DBCFG[I])) <> 0 then
        begin
             H := DBCFG[I];
             Delete(H,1,pos('=',H));
        end;
     If pos('USERNAME=',uppercase(DBCFG[I])) <> 0 then
        begin
             U := DBCFG[I];
             Delete(U,1,pos('=',U));
        end;
     If pos('PASSWORD=',uppercase(DBCFG[I])) <> 0 then
        begin
             P := DBCFG[I];
             Delete(P,1,pos('=',P));
        end;
     If pos('DATABASE=',uppercase(DBCFG[I])) <> 0 then
        begin
             D := DBCFG[I];
             Delete(D,1,pos('=',D));
        end;

end;
 alloc := mysql_init(PMYSQL(@qmysql));
  socket :=  mysql_real_connect(alloc, pchar(h), pchar(u), pchar(p),pchar(d), 
0, nil, 0);
  if socket=Nil then
    begin
         ShowMessage('Error connecting to 
database:'+LineEnding+StrPas(mysql_error(@qmysql)));
         halt;
    end;
end;

Function ZC_DBQuery(Query:String):PMYSQL_RES;
Var RecBuf : PMYSQL_RES;
Begin
  if (mysql_query(socket,pchar(Query)) < 0) then
     begin
       ShowMessage('Query failed '+ StrPas(mysql_error(socket)));
     end
else
     begin
       recbuf := mysql_store_result(socket);
       if RecBuf=Nil then
       begin
         ShowMessage('Query returned nil result.');
       end else
        ZC_DBQuery := RecBuf;
     end;
end;

Procedure TZC_Settings.LoadFromDB;
Var Result : PMYSQL_RES;
    Q : String;
Begin
    FResult := ZC_DBQuery('SELECT * FROM settings;');
    FRow := Mysql_Fetch_Row(FResult);
     If FRow = Nil then
     begin
        showMessage('You have no stored site-settings.'+LineEnding+'Setting 
all to defaults');
        FCurrencySymbol := '$';
        FUnitLength := 1;
        FPricePerUnit := 1.0;
         Q := 'INSERT INTO settings VALUES("","'+FCurrencySymbol;
         Q := 
Q+'","'+IntToStr(FUnitLength)+'","'+FloatToStr(FPricePerUnit)+'");';
         Result := ZC_DBQuery(Q);
     end else
     begin
       FCurrencySymbol := FRow[1];
       FUnitLength := StrToInt(FRow[2]);
       FPricePerUnit := StrToFloat(FRow[3]);
     end;
     
end;

Procedure TZC_Settings.SaveToDB;
Var
Query : String;
Begin
   Query := 'UPDATE TABLE settings SET currencysymbol="'+FCurrencySymbol;
   Query := Query+'",unitlength="'+IntToStr(FUnitLength);
   Query := Query+'",priceperunit="'+FloatToStr(FPricePerUnit)+';';
   FResult := ZC_DBQuery(Query);
end;

Function TZC_Settings.GetCurrencySymbol : String;
Begin
     LoadFromDB;
     GetCurrencySymbol := FCurrencySymbol;
end;

Function TZC_Settings.GetUnitLength : Integer;
Begin
     LoadFromDB;
     GetUnitLength := FUnitLength;
end;

Function TZC_Settings.GetPricePerUnit: Real;
Begin
     LoadFromDB;
     GetPricePerUnit := FPricePerUnit;
end;

Procedure TZC_Settings.SetCurrencySymbol(NewSymbol:String);
Begin
     FCurrencySymbol := NewSymbol;
     SaveToDB;
end;

Procedure TZC_Settings.SetUnitLength(NewLength:Integer);
Begin
     FUnitLength := NewLength;
     SaveToDB;
end;

Procedure TZC_Settings.SetPricePerUnit(NewPrice : Real);
Begin
    FPricePerUnit := NewPrice;
    SaveToDB;
end;

initialization


end.


-- 
"80% Of a hardware engineer's job is application of the uncertainty principle.
80% of a software engineer's job is pretending this isn't so."
A.J. Venter
Chief Software Architect
OpenLab International           | +27 83 455 99 78 (South Africa) 
http://www.getopenlab.com       | 086 654 2898 (Fax)
http://www.silentcoder.co.za    | +55 118 162 2079 (Brazil)
GPG Key: http://pgp.mit.edu:11371/pks/lookup?op=get&search=0x27CFFE5A

Attachment: pgpvms27XizSW.pgp
Description: PGP signature

Reply via email to