{ TMySQLField }
constructor TMySQLField.Create;
begin
end;
destructor TMySQLField.Destroy;
begin
end;
procedure TMySQLField.Clear;
begin
SetData(nil);
end;
procedure TMySQLField.SetFieldName(const Value: string);
begin
FFieldName := Value;
end;
function TMySQLField.GetFieldNo: integer;
begin
Result:=fFieldNo;
end;
procedure TMySQLField.SetFieldNo(const Value: integer);
begin
fFieldNo:=Value;
end;
procedure TMySQLField.SetTableName(const Value: string);
begin
fTableName:=Value;
end;
procedure TMySQLField.SetFieldLength(const Value: Integer);
begin
//check for garbage here for a float it shows 17314488
fFieldLength:=Value;
end;
procedure TMySQLField.SetData(Buffer: Pointer; NativeFormat: Boolean);
begin
FValueBuffer := Buffer;
end;
function TMySQLField.GetDataAsString: string;
begin
// overridden by descendants
end;
function TMySQLField.GetDisplayLabel: string;
begin
if fDisplayLabel <> '' then
Result := fDisplayLabel else
Result := FFieldName;
end;
function TMySQLField.IsDisplayLabelStored: Boolean;
begin
Result := FDisplayLabel <> '';
end;
procedure TMySQLField.SetDisplayLabel(const Value: string);
begin
fDisplayLabel:=Value;
end;
function TMySQLField.GetDisplayWidth: Integer;
begin
if fDisplayWidth > 0 then
Result := FDisplayWidth else
Result := GetDefaultWidth;
end;
function TMySQLField.IsDisplayWidthStored: Boolean;
begin
Result := FDisplayWidth > 0;
end;
procedure TMySQLField.SetDisplayWidth(const Value: Integer);
begin
fDisplayWidth := Value;
end;
function TMySQLField.GetDefaultWidth: Integer;
begin
Result := 80
end;
procedure TMySQLField.SetAlignment(const Value: TAlignment);
begin
fAlignment := Value;
end;
procedure TMySQLField.SetDisplayFormat(const Value: string);
begin
if fDisplayFormat <> Value then
fDisplayFormat := Value;
end;
{ TMySQLStringField }
function TMySQLStringField.GetDataAsString: string;
begin
if fValueBuffer <> nil then
Result := Pchar(fValueBuffer)
else
Result:='<null>';
end;
function TMySQLStringField.GetAsBoolean: boolean;
var
s: string;
begin
s := AsString;
Result := (s > '') and (s[1] in ['T', 't', 'Y', 'y', '1']);
end;
procedure TMySQLStringField.SetAsBoolean(Value: Boolean);
begin
// not implemented yet because the buffer (which is current held by
// mysql dlls is string based
{ // here I would use the smallest variable type UINT?
if Value then
FValueBuffer:=
else
FValueBuffer:=
}
end;
{ TMySQLFields }
constructor TMySQLFields.Create(AMySQLDB: TMySQLDatabase);
begin
FList := TList.Create;
FMySQLDB := AMySQLDB;
fDummyField:=TMySQLField.create;
end;
destructor TMySQLFields.Destroy;
begin
if FList <> nil then Clear;
FList.Free;
fDummyField.free;
inherited Destroy;
end;
procedure TMySQLFields.Clear;
var
F: TMySQLField;
begin
while FList.Count > 0 do
begin
F := FList.Last;
F.FMySQLDB := nil;
F.Free;
FList.Delete(FList.Count-1);
end;
end;
procedure TMySQLFields.Add(Field: TMySQLField);
begin
FList.Add(Field);
end;
function TMySQLFields.GetCount: Integer;
begin
Result := FList.Count;
end;
function TMySQLFields.GetField(Index: Integer): TMySQLField;
begin
Result := FList[Index];
end;
procedure TMySQLFields.SetField(Index: Integer; Value: TMySQLField);
begin
// not implemented yet because the buffer (which is current held by
// mysql dlls is string based
//Fields[Index].Assign(Value);
end;
function TMySQLFields.FindField(const FieldName: string): TMySQLField;
var
I: Integer;
begin
for I := 0 to FList.Count - 1 do
begin
Result := FList.Items[I];
if AnsiCompareText(Result.FFieldName, FieldName) = 0 then Exit;
end;
//Result := nil;
Result:=fDummyField;
end;
function TMySQLFields.FieldByName(const FieldName: string): TMySQLField;
begin
Result := FindField(FieldName);
end;
function TMySQLFields.FieldByNumber(FieldNo: Integer): TMySQLField;
var
I: Integer;
begin
for I := 0 to FList.Count - 1 do
begin
Result := FList.Items[I];
if Result.FieldNo = FieldNo then Exit;
end;
Result := nil;
end;
{MySQLParams}
constructor TMySQLParams.Create(AMySQLDB: TMySQLDatabase);
begin
FList := TList.Create;
FMySQLDB := AMySQLDB;
fDummyParam:=TMySQLParam.create;
end;
destructor TMySQLParams.Destroy;
begin
if FList <> nil then Clear;
FList.Free;
fDummyParam.free;
inherited Destroy;
end;
procedure TMySQLParams.Clear;
var
F: TMySQLParam;
begin
while FList.Count > 0 do
begin
F := FList.Last;
F.MySQLDB := nil;
F.Free;
FList.Delete(FList.Count-1);
end;
end;
procedure TMySQLParams.Add(Param: TMySQLParam);
begin
FList.Add(Param);
end;
function TMySQLParams.GetCount: Integer;
begin
Result := FList.Count;
end;
function TMySQLParams.GetParam(Index: Integer): TMySQLParam;
begin
Result := FList[Index];
end;
procedure TMySQLParams.SetParam(Index: Integer; Value: TMySQLParam);
begin
// not implemented yet because the buffer (which is current held by
// mysql dlls is string based
//Params[Index].Assign(Value);
end;
function TMySQLParams.FindParam(const ParamName: string): TMySQLParam;
var
I: Integer;
begin
for I := 0 to FList.Count - 1 do
begin
Result := FList.Items[I];
if AnsiCompareText(Result.FParamName, ParamName) = 0 then Exit;
end;
//Result := nil;
Result:=fDummyParam;
end;
function TMySQLParams.ParamByName(const ParamName: string): TMySQLParam;
begin
Result := FindParam(ParamName);
end;
function TMySQLParams.ParamByNumber(ParamNo: Integer): TMySQLParam;
var
I: Integer;
begin
for I := 0 to FList.Count - 1 do
begin
Result := FList.Items[I];
if Result.ParamNo = ParamNo then Exit;
end;
Result := nil;
end;
function TMySQLParams.ParseSQL(SQL: String; DoCreate: Boolean): String;
// this ParseSQL('SELECT * FROM temployee WHERE Salary>:in_amount and
EmpNo>:in_EmpNo',True))
// returns the string "SELECT * FROM temployee WHERE Salary>? and EmpNo>?"
// and inserts params
const
Literals = ['''', '"', '`'];
var
AParam: TMySQLParam;
Value, CurPos, StartPos: PChar;
CurChar: Char;
Literal: Boolean;
EmbeddedLiteral: Boolean;
Name: string;
function NameDelimiter: Boolean;
begin
Result := CurChar in [' ', ',', ';', ')', #13, #10];
end;
function IsLiteral: Boolean;
begin
Result := CurChar in Literals;
end;
function StripLiterals(Buffer: PChar): string;
var
Len: Word;
TempBuf: PChar;
procedure StripChar;
begin
if TempBuf^ in Literals then
StrMove(TempBuf, TempBuf + 1, Len - 1);
if TempBuf[StrLen(TempBuf) - 1] in Literals then
TempBuf[StrLen(TempBuf) - 1] := #0;
end;
begin
Len := StrLen(Buffer) + 1;
TempBuf := AllocMem(Len);
try
StrCopy(TempBuf, Buffer);
StripChar;
Result := StrPas(TempBuf);
finally
FreeMem(TempBuf, Len);
end;
end;
begin
Result := SQL;
Value := PChar(Result);
// if DoCreate then Clear;
CurPos := Value;
Literal := False;
EmbeddedLiteral := False;
repeat
while (CurPos^ in LeadBytes) do Inc(CurPos, 2);
CurChar := CurPos^;
if (CurChar = ':') and not Literal and ((CurPos + 1)^ <> ':') then
begin
StartPos := CurPos;
while (CurChar <> #0) and (Literal or not NameDelimiter) do
begin
Inc(CurPos);
while (CurPos^ in LeadBytes) do Inc(CurPos, 2);
CurChar := CurPos^;
if IsLiteral then
begin
Literal := Literal xor True;
if CurPos = StartPos + 1 then EmbeddedLiteral := True;
end;
end;
CurPos^ := #0;
if EmbeddedLiteral then
begin
Name := StripLiterals(StartPos + 1);
EmbeddedLiteral := False;
end
else Name := StrPas(StartPos + 1);
if DoCreate then begin
AParam:=TMySQLParam.create;
AParam.MySQLDB:=fMySQLDB;
AParam.ParamName:=Name;
AParam.ParamNo:=fList.Count;
fList.Add(AParam);
end;
CurPos^ := CurChar;
StartPos^ := '?';
Inc(StartPos);
StrMove(StartPos, CurPos, StrLen(CurPos) + 1);
CurPos := StartPos;
end
else if (CurChar = ':') and not Literal and ((CurPos + 1)^ = ':') then
StrMove(CurPos, CurPos + 1, StrLen(CurPos) + 1)
else if IsLiteral then Literal := Literal xor True;
Inc(CurPos);
until CurChar = #0;
end;
{MySQLParam}
constructor TMySQLParam.Create;
begin
DataType:=dtUnknown;
end;
destructor TMySQLParam.Destroy;
begin
end;
procedure TMySQLParam.Clear;
begin
SetData('');
end;
procedure TMySQLParam.SetParamName(const Value: string);
begin
FParamName := Value;
end;
function TMySQLParam.GetParamNo: integer;
begin
Result:=fParamNo;
end;
procedure TMySQLParam.SetParamNo(const Value: integer);
begin
fParamNo:=Value;
end;
procedure TMySQLParam.SetTableName(const Value: string);
begin
fTableName:=Value;
end;
procedure TMySQLParam.SetParamLength(const Value: Integer);
begin
fParamLength:=Value;
end;
procedure TMySQLParam.SetData(Buffer: string);
begin
FValueBuffer := Buffer;
end;
function TMySQLParam.GetDataAsString: string;
begin
Result:=fValueBuffer;
end;
function TMySQLParam.GetAsInteger: Longint;
begin
Result:=StrToInt(fValueBuffer);
end;
procedure TMySQLParam.SetAsInteger(const Value: Longint);
begin
fValueBuffer:=IntToStr(Value);
end;
{ TMySQLDateTimeField }
function TMySQLDateTimeField.GetDataAsString: string;
begin
if fDisplayFormat<>'' then
Result:=FormatDateTime(fDisplayFormat,fDateTime)
else
Result:=pchar(fValueBuffer); // if not specified, display as
MySQL format YYYY-MM-DD
//Result:=FormatDateTime('mm/dd/yyyy',fDateTime);
end;
procedure TMySQLDateTimeField.SetData(Buffer: Pointer;
NativeFormat: Boolean);
function MySQLDateTimeToDateTime(dt: string): TDateTime;
var
y,m,d,h,mn,s: word;
begin
//MySQL DateTime Spec
// DATETIME => YYYY-MM-DD HH:MM:SS
// DATE => YYYY-MM-DD
// TIME => HH:MM:SS
// YEAR =>YYYY
y:=StrToInt(copy(dt,1,4));
m:=StrToInt(copy(dt,6,2));
d:=StrToInt(copy(dt,9,2));
if length(dt)>=19 then begin
h:= StrToInt(copy(dt,12,2));
mn:= StrToInt(copy(dt,15,2));
s:= StrToInt(copy(dt,18,2));
end;
Result:=encodedate(y,m,d);
end;
begin
inherited;
if fValueBuffer<>nil then
fDateTime:=MySQLDateTimeToDateTime(pchar(fValueBuffer))
else
fDateTime:=MySQLDateTimeToDateTime('1900-01-01');
end;
{ TNumericField }
procedure TNumericField.SetEditFormat(const Value: string);
begin
if FEditFormat <> Value then
FEditFormat := Value;
end;
procedure TNumericField.RangeError(Value, Min, Max: Extended);
begin
//DatabaseErrorFmt(SFieldRangeError, [Value, DisplayName, Min, Max]);
end;
{TMySQLFloatField}
constructor TMySQLFloatField.Create;
begin
FPrecision := 15;
end;
function TMySQLFloatField.GetAsFloat: Double;
begin
try
Result:=StrToFloat(pchar(fValueBuffer));
except
Result:=0;
end;
end;
function TMySQLFloatField.GetDataAsString: string;
begin
if fCheckRange and (Value < FMinValue) then
Value:=fMinValue;
if fCheckRange and (Value > FMaxValue) then
Value:=fMaxValue;
if fDisplayFormat<>'' then
Result:=FormatFloat(fDisplayFormat,Value)
else
Result:=pchar(fValueBuffer);
end;
procedure TMySQLFloatField.SetAsFloat(const Value: Double);
begin
fValueBuffer:=pchar(FloatToStr(Value));
end;
procedure TMySQLFloatField.SetCurrency(Value: Boolean);
begin
if fCurrency <> Value then
fCurrency := Value;
end;
procedure TMySQLFloatField.SetMaxValue(Value: Double);
begin
fMaxValue := Value;
UpdateCheckRange;
end;
procedure TMySQLFloatField.SetMinValue(Value: Double);
begin
fMinValue := Value;
UpdateCheckRange;
end;
procedure TMySQLFloatField.SetPrecision(Value: Integer);
begin
if Value < 2 then Value := 2;
if Value > 15 then Value := 15;
if FPrecision <> Value then
FPrecision := Value;
end;
procedure TMySQLFloatField.UpdateCheckRange;
begin
fCheckRange := (FMinValue <> 0) or (FMaxValue <> 0);
end;
procedure TMySQLParam.SetDataAsString(const Value: string);
var
TargetSize: Longword;
begin
case Datatype of
dtString:
FValueBuffer:='"'+Value+'"';
dtBlob:
if Value='' then
FValueBuffer:='""'
else
begin
TargetSize:=Length(Value)*2; // assume ever byte is
an escaped character
SetLength(FValueBuffer,TargetSize); // allocate space
before calling escape formatting function
TargetSize:=MySQLDB.MySQLFunctions.mysql_real_escape_string(@MySQLDB.MySQLHandle,
pchar(FValueBuffer), pchar(Value), Length(Value));
SetLength(FValueBuffer,TargetSize);
FValueBuffer:='"'+FValueBuffer+'"';
end;
dtUnknown:
FValueBuffer:=Value;
else
FValueBuffer:=Value;
end;
end;
end.
-----------------------------------------------------
Home page: http://groups.yahoo.com/group/delphi-en/
To unsubscribe: [EMAIL PROTECTED]
Yahoo! Groups Links
<*> To visit your group on the web, go to:
http://groups.yahoo.com/group/delphi-en/
<*> To unsubscribe from this group, send an email to:
[EMAIL PROTECTED]
<*> Your use of Yahoo! Groups is subject to:
http://docs.yahoo.com/info/terms/
