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
pgpvms27XizSW.pgp
Description: PGP signature
