unit liboutkafe;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils,postgres,util,md5,lclproc
{$IFDEF Win32}
,windows
{$ENDIF}
;
{Global unclassed methods
These methods are kept outside classes although they do work
with the database since virtually all the classes and many of the
application-calls will need them, often directly
}
Function ZC_DBConnect(MyRunType :String):Boolean;
{Runtype = 'server'/'client'/'web'/'daemon'}
Function ZC_DBQuery(Query:String):PPGResult;
procedure ZC_DBDisconnect;
Procedure GetServerHooks(Trigger:String; var commands : TStringList);
Procedure GetClientHooks(Trigger:String; var urls : TStringList);
Procedure OpenInBrowser(URL :String);
Function GoodPW(PW1,PW2:String):Boolean;
Function DoQuote(S:STring):String;
procedure runPlugins(Trigger,params:String);
{Classes
Here we define just about every other database handling aspect through
proper object classes, thus fully abstracting the actual database
}
type
TZC_DBCFG = Class
Private
FHost : String;
FUser : String;
FPassword : String;
FDataBase : string;
public
Constructor create;
Procedure Load;
Procedure Save;
Function GetHost:String;
Function GetUser:String;
Function GetPassword : String;
Function GetDataBase : String;
Procedure SetHost(NewHost:String);
Procedure SetUser(NewUser:STring);
Procedure SetPassword(NewPassword:String);
Procedure SetDataBase(NewDatabase:String);
end;
TZC_PluginThread = Class(TThread)
private
FCommands :TStringList;
FParams :STring;
protected
procedure Execute; override;
public
Constructor Create(isSuspended : boolean; Commands:TStringList;params:String);
end;
TZC_Settings = class
private
{Private Declarations}
FCurrencySymbol : String;
FUnitLength : Integer;
FPricePerUnit : Real;
FResult : PPGResult;
Procedure LoadFromDB;
public
{ public declarations }
Procedure SaveToDB;
Function GetCurrencySymbol : String;
Function GetUnitLength : Integer;
Function GetPricePerUnit: Real;
Procedure SetCurrencySymbol(NewSymbol:String);
Procedure SetUnitLength(NewLength:Integer);
Procedure SetPricePerUnit(NewPrice : Real);
Function ValidatePassword(TestPassword : String):Boolean;
Procedure setPassword(NewPassword:String);
Function NoPassword:Boolean;
end;
TZC_Plugin = class
private
{Private Declarations}
FName : String;
FDescription : String;
FTrigger : String;
FCommand :String;
FTable : String; {Either 'serverplugins' or 'clientplugins'}
FResult : PPGResult;
public
Function GetName : String;
Function GetDescription : String;
Function GetTrigger : String;
Function GetCommand : String;
Function GetTable: String;
Procedure SetName(NewName:String);
Function GetAction :String;
Procedure SetDescription(NewDescription:String);
Procedure SetCommand(NewCommand:String);
Procedure SetTrigger(NewTrigger:STring);
Procedure SetTable(NewTable:String);
Procedure ListNames(Var NewList:TStringList);
Procedure Load;
Procedure Update;
Procedure New;
Procedure Delete;
{ public declarations }
end;
TZC_Login = class
private
{Private Declarations}
FUserName : String;
FResult : PPGResult;
public
{ public declarations }
Procedure AddUnits(NumUnits : Integer; price:Real);
Procedure DelUnits(NumUnits : Integer);
Procedure setPassword(NewPassword:String);
Function GetStatus:String;
Procedure SetStatus(NewStatus:STring);
Procedure SetMachine(NewMachine :String);
Function NoPassword:Boolean;
Function GetUnits:Integer;
Function GetMachine:String;
Function ValidatePassword(TestPassword : String):Boolean;
Constructor Create(UserName:String;var UserExists:Boolean);
Procedure CreateUser;
Procedure DeleteUser;
end;
TZC_Offers = class
private
{Private Declarations}
Fdescription : String;
FExtras : String;
Funits : Integer;
FPrice : Real;
FResult : PPGResult;
public
{ public declarations }
Procedure SetDescription(NewDescription:String);
Procedure SetExtras(NewExtras:String);
Procedure SetUnits(NewUnits:Integer);
Procedure SetPrice(NewPrice:Real);
Function GetDescription:String;
Function GetExtras:String;
Function GetUnits:Integer;
Function GetPrice:Real;
Procedure ListOffers(Var NewList:TStringList);
Procedure CreateOffer;
Procedure DeleteOffer;
Function Load:Boolean;
Procedure Update;
end;
Var
Socket : PPGconn;
ServerHooks : TSTringList;
ClientHooks : TStringList;
RunType : String;
BrowserCMD : String;
Const
{Hooks declared here - mostly for easy refference - Parameters listed where applicable}
OnInitSettings='oninitsettings';
OnLoadSettings='onloadsettings';
OnSaveSettings='onsavesettings';
OnNewUser='onnewuser'; //Username
OnDeleteUser='ondeleteuser';//Username
OnValidPassword='onvalidpassword'; //Username
OnLogin='onlogin'; //Username
OnKick='onkick'; //UserName
OnLogOut='onlogout';//UserName
OnPause='onpause';//UserName
OnChangePassword='onchangepassword'; // UserName
OnAddUnits='onaddunits' ; //UserName NumUnits Ammount;
OnDelUnits='ondelunits'; //UserName NumUnits;
OnSetAdminPassword='onsetadminpassword';
OnAdminLogin='onadminlogin';
{User Status strings}
LoggedOut='Logged out';
LoggedIn='Logged in';
Kicked='Kicked';
Paused='Paused';
StaffUser='Staff user account';
{Where to find the About page}
{$IFDEF Linux}
AboutURL = 'file:///usr/share/outkafe/about.html';
{$ENDIF}
{$IFDEF Win32}
AboutURL = 'C:\Program Files\OutKafe\about.html';
{$ENDIF}
implementation
Function DoQuote(S:STring):String;
Begin
DoQuote := QS(S);
end;
Function GoodPW(PW1,PW2:String):Boolean;
Begin
GoodPW := (length(PW1) >= 6) and (PW1 = PW2);
end;
Function MakeURL(Command,Params:String):String;
Var
S,Param : String;
P : Array [1 .. 5] of string;
I : Integer;
Begin
I := 0;
Param := Params;
While (I <= 4) and (pos(' ',param) <> 0) do
begin
inc(I);
P[I] := Copy (param,1,pos(' ',param) -1);
Delete (param,1,pos(' ',param));
end;
inc(I);
P[I] := Param;
S := Command;
S := SwapString('%PARAMETER1%',S,P[1]);
S := SwapString('%PARAMETER2%',S,P[2]);
S := SwapString('%PARAMETER3%',S,P[3]);
S := SwapString('%PARAMETER4%',S,P[4]);
S := SwapString('%PARAMETER5%',S,P[5]);
MakeURL := S;
end;
Procedure OpenInBrowser(URL :String);
Begin
{$IFDEF Unix}
Util.Execute(BrowserCommand+' '+URL);
{$ENDIF}
{$IFDEF Win32}
{$ENDIF}
end;
Constructor TZC_PluginThread.Create(isSuspended : boolean; Commands:TStringList;params:String);
begin
FCommands := TStringList.Create;
FCommands.Assign(Commands);
FParams := Params;
inherited Create(isSuspended);
end;
Procedure TZC_PluginThread.Execute;
Var I : integer;
Begin
For I := 0 to FCommands.Count -1 do
begin
If RunType = 'server' then
Util.Execute(MakeURL(FCommands[I],FParams));
If (RunType = 'client') then
begin
OpenInBrowser(MakeURL(FCommands[I],FParams));
end;
end;
end;
Procedure TZC_DBCFG.Load;
Var
DBCFG : TSTringList;
I : Integer;
Begin
DBCFG := TSTringList.Create;
Try
{$IFDEF Unix}
DBCFG.LoadFromFile('/etc/outkafe.cfg');
{$ENDIF}
{$IFDEF Win32}
DBCFG.LoadFromFile('C:\outkafe\outkafe.cfg');
{$ENDIF}
except
Debugln ('Error Loading database configuration !');
Halt;
end;
For I := 0 to DBCFG.Count -1 do
begin
If pos('HOST=',uppercase(DBCFG[I])) <> 0 then
begin
FHost := DBCFG[I];
Delete(FHost,1,pos('=',FHost));
end;
If pos('USERNAME=',uppercase(DBCFG[I])) <> 0 then
begin
FUser := DBCFG[I];
Delete(FUser,1,pos('=',FUser));
end;
If pos('PASSWORD=',uppercase(DBCFG[I])) <> 0 then
begin
FPassword := DBCFG[I];
Delete(FPassword,1,pos('=',FPassword));
end;
If pos('DATABASE=',uppercase(DBCFG[I])) <> 0 then
begin
FDatabase := DBCFG[I];
Delete(FDatabase,1,pos('=',FDatabase));
end;
end;
DBCFG.Free;
end;
Constructor TZC_DBCFG.create;
Begin
Load;
end;
Procedure TZC_DBCFG.Save;
Var
DBCFG : TSTringList;
Begin
DBCFG := TSTringList.Create;
DBCFG.Add('HOST='+FHost);
DBCFG.Add('USERNAME='+FUser);
DBCFG.Add('PASSWORD='+FPassword);
DBCFG.Add('DATABASE='+FDataBase);
Try
{$IFDEF Unix}
DBCFG.SaveToFile('/etc/zybacafe.cfg');
{$ENDIF}
{$IFDEF Win32}
DBCFG.SaveToFile('C:\Program Files\ZybaCafe\zybacafe.cfg');
{$ENDIF}
except
debugln ('Error saving database configuration !');
end;
end;
Function TZC_DBCFG.GetHost:String;
Begin
Load;
GetHost := FHost;
end;
Function TZC_DBCFG.GetUser:String;
Begin
Load;
GetUser := FUser;
end;
Function TZC_DBCFG.GetPassword : String;
Begin
Load;
GetPassword := FPassword;
end;
Function TZC_DBCFG.GetDataBase : String;
Begin
Load;
GetDatabase := FDataBase;
end;
Procedure TZC_DBCFG.SetHost(NewHost:String);
Begin
FHost := NewHost;
Save;
end;
Procedure TZC_DBCFG.SetUser(NewUser:STring);
Begin
FUser := NewUser;
Save;
end;
Procedure TZC_DBCFG.SetPassword(NewPassword:String);
Begin
FPassword := NewPassword;
Save;
end;
Procedure TZC_DBCFG.SetDataBase(NewDatabase:String);
Begin
FDatabase := NewDatabase;
Save;
End;
Procedure ZC_DBDisconnect;
Begin
PQfinish(Socket);
end;
Function ZC_DBConnect(MyRunType : String):Boolean;
Var
ConnString : String;
DBCFG : TZC_DBCFG;
Begin
DBCFG := TZC_DBCFG.Create;
DBCFG.Load;
{$IFDEF Unix}
BrowserCMD := BrowserCommand;
{$ENDIF}
RunType := MyRunType;
ConnString := 'host = '+DBCFG.GetHost+' dbname = '+DBCFG.GetDatabase+' user = '+DBCFG.GetUser+' password = '+DBCFG.GetPassword;
Socket := PQConnectDB (pchar(ConnString));
if (Socket=nil) or (PQstatus(socket) = CONNECTION_BAD) then
ZC_DBConnect := False;
DBCFG.Free;
end;
Function ZC_DBQuery(Query:String):PPGResult;
Var Res : PPGResult;
Begin
If RunType <> 'web' then
debugln(Pchar(Query));
Res := PQExec(socket,pchar(Query));
If RunType <> 'web' then
debugln(PQerrorMessage(Socket));
if Res = nil then
begin
debugln('FATAL ERROR '+ StrPas(PQerrorMessage(Socket)));
halt;
end;
if runtype <> 'web' then
debugln(IntToStr(PqNtuples(Res))+' rows returned');
ZC_DBQuery := Res;
end;
Procedure GetServerHooks(Trigger:String; var commands : TStringList);
Var Result : PPGResult;
I : Integer;
Begin
Commands.Clear;
Result := ZC_DBQuery('SELECT command FROM serverplugins WHERE trigger = '+QS(Trigger)+';');
For I := 0 to PQntuples(Result) -1 do
Commands.Add(AnsiString(PQgetvalue(Result,I,0)));
end;
Procedure GetClientHooks(Trigger:String; var urls : TStringList);
Var Result : PPGResult;
I : Integer;
Begin
urls.Clear;
Result := ZC_DBQuery('SELECT url FROM clientplugins WHERE trigger= '+QS(Trigger)+';');
For I := 0 to PQntuples(Result) -1 do
urls.Add(AnsiString(PQgetvalue(Result,I,0)));
end;
procedure runPlugins(Trigger,params:String);
Var ToRun : TStringList;
PluginThread : TZC_PluginThread;
I :Integer;
URL : String;
Begin
If (RunType <> 'daemon') then
begin
ToRun := TStringList.Create;
If RunType = 'server' then
GetServerHooks(Trigger,ToRun) else
GetClientHooks(Trigger,ToRun);
If RunType <> 'web' then
begin
PluginThread := TZC_PluginThread.Create(True,ToRun,params);
PluginThread.Execute;
end else
For I := 0 to ToRun.Count -1 do
begin
URL:=MakeURL(ToRun[I],Params);
Writeln('<script language="Javascript">');
writeln('window.open("',URL,'");');
Writeln('</script>');
end;
ToRun.Free;
end;
End;
Function TZC_Plugin.GetName : String;
Begin
GetName := FName;
end;
Function TZC_Plugin.GetDescription : String;
Begin
GetDescription := FDescription;
end;
Function TZC_Plugin.GetTrigger : String;
Begin
GetTrigger := FTrigger;
end;
Function TZC_Plugin.GetCommand : String;
Begin
GetCommand := FCommand;
end;
Function TZC_Plugin.GetAction:String;
Begin
if FTable = 'serverplugins' then
GetAction := 'command' else
GetAction := 'url';
end;
Function TZC_Plugin.GetTable: String;
Begin
GetTable := FTable;
end;
Procedure TZC_Plugin.SetName(NewName:String);
Begin
FName := NewName;
end;
Procedure TZC_Plugin.SetDescription(NewDescription:String);
Begin
FDescription := NewDescription;
end;
Procedure TZC_Plugin.SetCommand(NewCommand:String);
Begin
FCommand := NewCommand;
end;
Procedure TZC_Plugin.SetTrigger(NewTrigger:String);
Begin
FTrigger := NewTrigger;
end;
Procedure TZC_Plugin.SetTable(NewTable:String);
Begin
FTable := NewTable;
end;
Procedure TZC_Plugin.ListNames(Var NewList:TStringList);
Var I : Integer;
Begin
NewList.Clear;
If (Length(FTable) <> 0) then
begin
FResult := ZC_DBquery('SELECT name FROM '+FTable+';');
For I := 0 to PqNTuples(FResult) -1 do
NewList.Add(AnsiString(PQGetValue(FResult,I,0)));
end;
end;
Procedure TZC_Plugin.Load;
Begin
SetCommand('');
SetTrigger('');
SetDescription('');
If (Length(FName) <> 0) and (Length(FTable) <> 0) then
begin
FResult := ZC_DBQuery('SELECT '+GetAction+',trigger,description FROM '+ftable+' WHERE name = '+QS(FName)+' ;');
If PQnTuples(Fresult) > 0 then
begin
SetCommand(AnsiString(PQGetValue(FResult,0,0)));
SetTrigger(AnsiString(PQGetValue(FResult,0,1)));
SetDescription(AnsiString(PQGetValue(FResult,0,2)));
end;
end;
end;
Procedure TZC_Plugin.Update;
Var
Q : String;
Begin
If (Length(FName) <> 0) and (Length(FTable) <> 0) then
begin
Q := 'UPDATE '+ftable+' SET description = '+QS(FDescription)+' , trigger = '+QS(Ftrigger);
Q := Q+ ' , '+GetAction+' = '+QS(FCommand)+' WHERE name = '+QS(FName)+' ;';
FResult := ZC_DBQuery(Q);
end;
end;
Procedure TZC_Plugin.New;
Var
Q : String;
Begin
If (Length(Fname) <> 0) and (Length(FTable) <> 0) then
begin
Q := 'INSERT INTO '+ftable+' VALUES('+QS(Fname)+','+QS(FDescription)+','+QS(FTrigger)+','+QS(FCommand)+');';
FResult := ZC_DBQuery(Q);
end;
end;
Procedure TZC_Plugin.Delete;
Var
Q : String;
Begin
If (Length(Fname) <> 0) and (Length(FTable) <> 0) then
begin
Q := 'DELETE FROM '+ftable+' WHERE name = '+QS(FName)+';';
FResult := ZC_DBQuery(Q);
SetName('');
SetTable('');
end;
end;
Procedure TZC_Settings.LoadFromDB;
Var
Q : String;
PluginThread : TZC_PluginThread;
Begin
FResult := ZC_DBQuery('SELECT * FROM settings;');
If PQntuples(FResult) = 0 then
begin
debugln('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)+','+QS('')+'");';
debugln(Q);
FResult := ZC_DBQuery(Q);
RunPlugins(OnInitSettings,'');
end else
begin
FCurrencySymbol := AnsiString(PQgetvalue(FResult,0,0));
TryStrToInt(AnsiString(PQgetvalue(FResult,0,1)),FUnitLength);
TryStrToFloat(AnsiString(PQgetvalue(FResult,0,2)),FPricePerUnit);
end;
RunPlugins(OnLoadSettings,'');
end;
Procedure TZC_Settings.SaveToDB;
Var
Query : String;
Begin
Query := 'UPDATE settings SET currencysymbol = '+QS(FCurrencySymbol);
Query := Query+',unitlength = '+QS(IntToStr(FUnitLength));
Query := Query+',priceperunit = '+QS(FloatToStr(FPricePerUnit))+';';
FResult := ZC_DBQuery(Query);
RunPlugins(OnSaveSettings,'');
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;
Function TZC_Settings.ValidatePassword(TestPassword : String):Boolean;
Var
TPMD5,UPMD5 : String;
begin
LoadFromDB;
TPMD5 := MD5Print(MD5String(TestPassword));
FResult := ZC_DBQuery('SELECT adminpw FROM settings;');
UPMD5 := PQgetvalue(FResult,0,0);
ValidatePassword := TPMD5 = UPMD5;
If ValidatePassword then
runPlugins(OnAdminLogin,'');
end;
Procedure TZC_Settings.setPassword(NewPassword:String);
Var
Q: String;
MD5PW:String;
begin
MD5PW := MD5Print(MD5String(NewPassword));
Q := 'UPDATE settings SET adminpw = '+QS(MD5PW)+';';
FResult := ZC_DBQuery(Q);
RunPlugins(OnSetAdminPassword,'');
end;
Function TZC_Settings.NoPassword:Boolean;
Begin
LoadFromDB;
FResult := ZC_DBQuery('SELECT adminpw FROM settings;');
NoPassword := Length(AnsiString(PQGetValue(FResult,0,0))) = 0;
end;
Procedure TZC_Login.AddUnits(NumUnits : Integer; price:Real);
Var
Q : String;
CurrentUnits,NewUnits : Integer;
begin
Q := 'SELECT units FROM login WHERE username = '+QS(FUserName)+';';
FResult := ZC_DBQuery(Q);
TryStrToInt(AnsiString(PQgetvalue(FResult,0,0)),CurrentUnits);
NewUnits := CurrentUnits + NumUnits;
Q := 'UPDATE login SET units = '+QS(IntToStr(NewUnits))+' WHERE username = '+QS(FUserName)+';';
FResult := ZC_DBQuery(Q);
RunPlugins(OnAddUnits,FUserName+' '+IntToStr(NumUnits)+' '+FloatToStr(Price));
end;
Procedure TZC_Login.DelUnits(NumUnits : Integer);
Var
Q : String;
CurrentUnits,NewUnits : Integer;
begin
Q := 'SELECT units FROM login WHERE username = '+QS(FUserName)+';';
FResult := ZC_DBQuery(Q);
TryStrToInt(AnsiString(PQgetvalue(FResult,0,0)),CurrentUnits);
NewUnits := CurrentUnits - NumUnits;
Q := 'UPDATE login SET units = '+QS(IntToStr(NewUnits))+' WHERE username = '+QS(FUserName)+';';
FResult := ZC_DBQuery(Q);
RunPlugins(OnDelUnits,FUserName+' '+IntToStr(NumUnits));
end;
Procedure TZC_Login.setPassword(NewPassword:String);
Var
Q: String;
MD5PW:String;
begin
If Length(NewPassworD) > 0 then
MD5PW := MD5Print(MD5String(NewPassword)) else
MD5PW := '';
Q := 'UPDATE login SET password = '+QS(MD5PW)+' WHERE username = '+QS(FUserName)+';';
FResult := ZC_DBQuery(Q);
RunPlugins(OnChangePassword,FUserName);
end;
Function TZC_Login.GetStatus:String;
Var Q : String;
begin
Q := 'SELECT status FROM login WHERE username = '+QS(FUserName)+';';
FResult := ZC_DBQuery(Q);
GetStatus := AnsiString(PQgetvalue(FResult,0,0));
end;
Function TZC_Login.GetMachine:String;
Var Q : String;
begin
Q := 'SELECT machine FROM login WHERE username = '+QS(FUserName)+';';
FResult := ZC_DBQuery(Q);
GetMachine := AnsiString(PQgetvalue(FResult,0,0));
end;
Procedure TZC_Login.SetStatus(NewStatus:STring);
Var Q : String;
begin
Q := 'UPDATE login SET status = '+QS(NewStatus)+' WHERE username = '+QS(FUserName)+';';
FResult := ZC_DBQuery(Q);
If NewStatus = LoggedOut then
RunPlugins(OnLogOut,FUserName);
If NewStatus = LoggedIn then
RunPlugins(OnLogIn,FUserName);
If NewStatus = Paused then
RunPlugins(OnPause,FUserName);
If NewStatus = Kicked then
RunPlugins(OnKick,FUserName);
end;
Procedure TZC_Login.SetMachine(NewMachine:STring);
Var Q : String;
begin
Q := 'UPDATE login SET machine = '+QS(NewMachine)+' WHERE username = '+QS(FUserName)+';';
FResult := ZC_DBQuery(Q);
FResult := ZC_DBQuery('COMMIT;');
end;
Function TZC_Login.NoPassword:Boolean;
Begin
FResult := ZC_DBQuery('SELECT password FROM login WHERE username= '+QS(FUserName)+';');
NoPassword := Length(AnsiString(PQGetValue(FResult,0,0))) = 0;
end;
Function TZC_Login.GetUnits:Integer;
begin
FResult := ZC_DBQuery('SELECT units FROM login WHERE username = '+QS(FUserName)+';');
TryStrToInt(AnsiString(PQgetvalue(FResult,0,0)),GetUnits);
end;
Procedure TZC_Login.CreateUser;
Var Q: String;
Begin
Q := 'INSERT INTO login VALUES('+QS(FuserName)+','+QS('')+','+QS('0')+','+QS(LoggedOut)+','+QS('')+');';
FResult := ZC_DBQuery(Q);
RunPlugins(OnNewUser,FUsername);
end;
Procedure TZC_Login.DeleteUser;
Var Q: String;
Begin
Q := 'DELETE FROM login WHERE username = '+QS(FuserName)+';';
FResult := ZC_DBQuery(Q);
RunPlugins(OnDeleteUser,FUsername);
end;
Function TZC_Login.ValidatePassword(TestPassword : String):Boolean;
Var
TPMD5,UPMD5 : String;
begin
TPMD5 := MD5Print(MD5String(TestPassword));
FResult := ZC_DBQuery('SELECT password FROM login WHERE username = '+QS(FUserName)+';');
UPMD5 := PQgetvalue(FResult,0,0);
ValidatePassword := TPMD5 = UPMD5;
runPlugins(OnValidPassword,FUserName);
end;
Constructor TZC_Login.Create(UserName:STring;var UserExists:Boolean);
Begin
FUserName := UserName;
FResult := ZC_DBQuery('SELECT username FROM login WHERE username = '+QS(UserName)+';');
UserExists := PQnTuples(FResult) > 0;
end;
Procedure TZC_Offers.SetDescription(NewDescription:String);
Begin
FDescription := NewDescription;
end;
Procedure TZC_Offers.SetExtras(NewExtras:String);
Begin
FExtras:=NewExtras;
end;
Procedure TZC_Offers.SetUnits(NewUnits:Integer);
Begin
FUnits := NewUnits;
end;
Procedure TZC_Offers.SetPrice(NewPrice:Real);
Begin
FPrice := NewPrice;
end;
Function TZC_Offers.GetDescription:String;
Begin
GetDescription := FDescription;
end;
Function TZC_Offers.GetExtras:String;
Begin
GetExtras := Fextras;
end;
Function TZC_Offers.GetUnits:Integer;
Begin
GetUnits := FUnits;
end;
Function TZC_Offers.GetPrice:Real;
Begin
GetPrice := FPrice;
end;
Procedure TZC_Offers.ListOffers(Var NewList:TStringList);
Var I : Integer;
Begin
NewList.Clear;
FResult := ZC_DBquery('SELECT description FROM offers;');
For I := 0 to PqNTuples(FResult) -1 do
NewList.Add(AnsiString(PQGetValue(FResult,I,0)));
end;
Procedure TZC_Offers.CreateOffer;
Var Q: String;
Begin
Q := 'INSERT INTO offers VALUES('+QS(FDescription)+','+QS(FExtras)+','+QS(IntToStr(FUnits))+','+QS(FloatToStr(FPrice))+');';
FResult := ZC_DBQuery(Q);
end;
Procedure TZC_Offers.DeleteOffer;
Begin
If length(FDescription) <> 0 then
FResult := ZC_DBQuery('DELETE FROM offers WHERE description = '+QS(FDescription)+';');
end;
Function TZC_Offers.Load:Boolean;
Var Res : Boolean;
Begin
If Length(FDescription) <> 0 then
FResult := ZC_DBQuery('SELECT extras,units,price FROM offers WHERE description = '+QS(FDescription)+';');
If PQnTuples(FResult) > 0 then
begin
SetExtras(AnsiString(PQGetValue(FResult,0,0)));
SetUnits(StrToInt(AnsiString(PQGetValue(Fresult,0,1))));
SetPrice(StrToFloat(AnsiString(PQGetValue(Fresult,0,2))));
Res := True;
end else
Res := False;
Load := Res;
end;
Procedure TZC_Offers.Update;
Begin
FResult := ZC_DBQuery('UPDATE offers SET extras = '+QS(FExtras)+' , units = '+QS(IntToStr(FUnits))+' , price = '+QS(FloatToStr(FPrice))+ ' WHERE description = '+QS(FDescription)+';');
end;
initialization
end.