📄 mysqldataset.pas
字号:
begin
Result := FMasterFields.CommaText;
end;
procedure TMySQLDatasetBase.SetMasterFields(const Value: string);
var
i: integer;
S: string;
begin
if Value<>FMasterFields.CommaText then begin
FMasterFields.CommaText := Value;
S := '';
if FMasterFields.Count>0 then begin
for i := 0 to FMasterFields.Count-1 do
S := S+FMasterFields.Values[FMasterFields.Names[i]]+';';
SetLength(S,length(S)-1);
end;
FMasterLink.FieldNames := S;
if Active then Refresh;
end;
end;
function TMySQLDatasetBase.GetDataSource: TDataSource;
begin
Result := FMasterLink.DataSource;
end;
procedure TMySQLDatasetBase.SetDataSource(Value: TDataSource);
begin
if IsLinkedTo(Value) then MYSQLError(Server.Driver,FConnection,-1,'Circular Reference');
FMasterLink.DataSource := Value;
end;
procedure TMySQLDatasetBase.MasterChanged(Sender: TObject);
begin
if Active and not FMasterLink.Editing then begin
DisableControls;
try
Refresh;
finally
EnableControls;
end;
end;
end;
procedure TMySQLDatasetBase.MasterDisabled(Sender: TObject);
begin
if Active then Refresh;
end;
procedure TMySQLDatasetBase.GetNextRow;
var
i,j,k,l: integer;
m: word;
R: pointer;
Row: PMYSQL_ROW;
Lengths: PMYSQL_LENGTHS;
RecInfo: PRecInfo;
TS,TL: TStringList;
S: string;
C: boolean;
ID: TIndexDef;
begin
Row := Server.Driver.RetrieveRow(FResult);
FResultComplete := not Assigned(Row);
if not FResultComplete then begin
if (FRecInfo.Count>0) and (FResultType=rtUnidirectional) then begin
RecInfo := FRecInfo.Items[FRecInfo.Count-1];
FreeRecordBuffer(PChar(RecInfo));
end;
RecInfo := PRecInfo(AllocRecordBuffer);
Lengths := Server.Driver.RetrieveRowFieldLenghts(FResult);
RecInfo^.Bookmark := FRecInfo.Count;
FRecInfo.Add(RecInfo);
for j := 0 to FFieldInfo.Count-1 do
if TFieldInfo(FFieldInfo.Objects[j]).FieldReal and Assigned(Row[j]) then begin
if ((TFieldInfo(FFieldInfo.Objects[j]).FieldFlags and BLOB_FLAG)=BLOB_FLAG) then begin
SetLength(RecInfo^.Blob[j],Lengths^[j]);
{$IFDEF MSWINDOWS} CopyMemory(PChar(RecInfo^.Blob[j]),Row[j],Lengths^[j]);
{$ELSE} memcpy(PChar(RecInfo^.Blob[j]),Row[j],Lengths^[j]); {$ENDIF} end else begin
RecInfo^.Data[j] := StrAlloc(Lengths^[j]+1);
StrLCopy(PChar(RecInfo^.Data[j]),Row[j],Lengths^[j]);
end;
end else begin
S := '';
if Assigned(FOnCustomValue) then FOnCustomValue(Self,TFieldInfo(FFieldInfo.Objects[j]).FieldName,RecInfo^.Bookmark,S);
if length(S)>0 then begin
if ((TFieldInfo(FFieldInfo.Objects[j]).FieldFlags and BLOB_FLAG)=BLOB_FLAG) then
RecInfo^.Blob[j] := S
else begin
RecInfo^.Data[j] := StrAlloc(length(S)+1);
StrLCopy(PChar(RecInfo^.Data[j]),PChar(S),length(S));
end;
end;
end;
end else begin
Server.Driver.CloseQuery(FResult);
if (doRetrieveFieldValues in Options) and (FTableInfo.Count>0) then
for i := 0 to FTableInfo.Count-1 do begin
TL := TStringList.Create;
try
S := 'show columns from '+TTableInfo(FTableInfo.Objects[i]).TableOrigin;
C := True;
//if Assigned(FOnExecSQL) then FOnExecSQL(Self,S,C);
if not C then Continue;
R := Server.Driver.OpenQuery(FConnection,S);
if not Assigned(R) then Continue;
try
Row := Server.Driver.RetrieveRow(R);
while Assigned(Row) and Assigned(Row[0]) do begin
j := FFieldInfo.IndexOf(FTableInfo[i]+'.'+Row[0]);
if j<0 then j := FFieldInfo.IndexOf(Row[0]);
if j>-1 then begin
if ((TFieldInfo(FFieldInfo.Objects[j]).FieldType=FIELD_TYPE_SET) or (TFieldInfo(FFieldInfo.Objects[j]).FieldType=FIELD_TYPE_ENUM)) and Assigned(Row[1]) then begin
TFieldInfo(FFieldInfo.Objects[j]).FieldValues := StringReplace(WordInStr(2,Row[1],'()'),'''','"',[rfReplaceAll,rfIgnoreCase]);
if (doSetToWord in Options) and (TFieldInfo(FFieldInfo.Objects[j]).FieldType=FIELD_TYPE_SET) then begin
TS := TStringList.Create;
try
TS.CommaText := TFieldInfo(FFieldInfo.Objects[j]).FieldValues;
if FRecInfo.Count > 0 then
for k := FRecInfo.Count - 1 downto 0 do begin
if Assigned(PRecInfo(FRecInfo.Items[k])^.Data[j]) then begin
S := PRecInfo(FRecInfo.Items[k])^.Data[j];
StrDispose(PRecInfo(FRecInfo.Items[k])^.Data[j]);
PRecInfo(FRecInfo.Items[k])^.Data[j] := nil;
// Set new word value
l := 1;
m := 0;
while length(WordInStr(l,S,','))>0 do begin
m := m or (1 shl TS.IndexOf(WordInStr(l,S,',')));
inc(l);
end;
PRecInfo(FRecInfo.Items[k])^.Data[j] := StrAlloc(length(IntToStr(m))+1);
StrLCopy(PRecInfo(FRecInfo.Items[k])^.Data[j],PChar(IntToStr(m)),length(IntToStr(m)));
end;
end;
if Assigned(Row[4]) then begin
S := Row[4];
l := 1;
m := 0;
while length(WordInStr(l,S,','))>0 do begin
m := m or (1 shl TS.IndexOf(WordInStr(l,S,',')));
inc(l);
end;
TFieldInfo(FFieldInfo.Objects[j]).FieldDefault := IntToStr(m);
end else
TFieldInfo(FFieldInfo.Objects[j]).FieldDefault := '0';
finally
TS.Free;
end;
end;
end else
if Assigned(Row[4]) and (TFieldInfo(FFieldInfo.Objects[j]).FieldDefault='') then TFieldInfo(FFieldInfo.Objects[j]).FieldDefault := Row[4];
end;
Row := Server.Driver.RetrieveRow(R);
end;
finally
Server.Driver.CloseQuery(R);
end
finally
TL.Free;
end;
end;
with IndexDefs do begin
try
BeginUpdate;
Clear;
if (doRetrieveIndexDefs in Options) and (FFieldInfo.Count>0) and (FTableInfo.Count=1) then begin
S := 'show index from '+TTableInfo(FTableInfo.Objects[0]).TableOrigin;
C := True;
//if Assigned(FOnExecSQL) then FOnExecSQL(Self,S,C);
if not C then exit;
R := Server.Driver.OpenQuery(FConnection,S);
if not Assigned(R) then exit;
try
Row := Server.Driver.RetrieveRow(R);
while Assigned(Row){ and (length(Row^)>=5)) }do begin
if Assigned(Row[1]) and Assigned(Row[2]) and Assigned(Row[4]) then begin
if IndexDefs.IndexOf(Row[2])>-1 then ID := IndexDefs.Find(Row[2])
else begin
ID := AddIndexDef;
ID.Name := Row[2];
end;
ID.Fields := IFStr(length(ID.Fields)>0,ID.Fields+';',ID.Fields)+Row[4];
if SameText(ID.Name,'PRIMARY') then ID.Options := ID.Options+[ixPrimary];
if Row[1]='0' then ID.Options := ID.Options+[ixUnique];
end;
Row := Server.Driver.RetrieveRow(R);
end;
finally
Server.Driver.CloseQuery(R);
end
end;
finally
EndUpdate;
end;
end;
end;
end;
procedure TMySQLDatasetBase.GetRest;
begin
while not FResultComplete do GetNextRow;
end;
procedure TMySQLDatasetBase.ClearRest;
var
Row: PMYSQL_ROW;
begin
if Assigned(FResult) then begin
repeat Row := Server.Driver.RetrieveRow(FResult); until not Assigned(Row);
Server.Driver.CloseQuery(FResult);
FResultComplete := True;
end;
end;
procedure TMySQLDatasetBase.InternalOpenResultBlock;
var
i,j,t: integer;
S: string;
RS: PChar;
Field: TMYSQL_FIELD;
FContinue: boolean;
Script: TStringList;
begin
Script := TStringList.Create;
try
Script.AddStrings(FSQL);
ParseScript(Script,doSingleSQL in Options);
if Script.Count>0 then
for i := 0 to Script.Count-1 do begin
FContinue := true;
S := Script[i];
if doMacrosEnabled in Options then begin
RS := PChar(SQLPopulate(S,True));
FResultSQL := StrPas(RS)
end else FResultSQL := S;
if Assigned(FOnExecSQL) then FOnExecSQL(Self,FResultSQL, FContinue);
if not FContinue then Abort;
FRealSQL := FResultSQL;
if (Server.Driver.ServerVer<32200) and (length(FResultSQL)>0) and (FResultSQL[length(FResultSQL)]=';') then FResultSQL := copy(FResultSQL,1,length(FResultSQL)-1);
ClearRest;
FResult := Server.Driver.OpenQuery(FConnection,FResultSQL);
if Server.Driver.ServerVer>32111 then FLastInsertID := Server.Driver.LastInsertID(FConnection)
else FLastInsertID := '0';
FAffectedRows := Server.Driver.AffectedRows(FConnection);
FQueryInfo := Server.Driver.QueryInfo(FConnection);
end;
finally
Script.Free;
end;
FRecInfoOfs := 0;
FRecBufSize := 0;
RecInfoClear;
FreeAndNil(FRecInfo);
FDBInfo.Clear;
TableInfoClear;
FieldInfoClear;
FRecInfo := TList.Create;
if not Assigned(FResult) then begin
FResultComplete := True;
Exit;
end;
FRawBufSize := 0;
FPrimFields := '';
FUniqFields := '';
FMultFields := '';
Field := Server.Driver.RetrieveField(FResult);
while length(Field.name)>0 do begin
S := Field.name;
i := FFieldInfo.AddObject(S,TFieldInfo.Create);
with TFieldInfo(FFieldInfo.Objects[i]) do begin
FieldReal := True;
FieldName := Field.name;
FieldOriginal := IFStr(length(Field.org_name)>0,Field.org_name,Field.name);
// remove calculated field tables
if pos('#',Field.table)=0 then begin
FieldTable := Field.table;
FieldTableOriginal := IFStr(length(Field.org_table)>0,Field.org_table,Field.table);
FieldDB := IFStr(length(Field.db)>0,Field.db,'');
end;
FieldFlags := Field.flags;
FieldOrigin := IFStr(length(FieldDB)>0,FormatIdentifier(FieldDB)+'.','')+
IFStr(length(FieldTableOriginal)>0,FormatIdentifier(FieldTableOriginal)+'.','')+
FormatIdentifier(FieldOriginal);
FieldFullName := IFStr(length(FieldDB)>0,FieldDB+'.','')+
IFStr(length(FieldTable)>0,FieldTable+'.','')+
FieldName;
if (Length(FieldTable)>0) and (pos('#',Field.table)=0) then begin
t := FTableInfo.IndexOf(FieldTable);
if t<0 then t := FTableInfo.AddObject(FieldTable,TTableInfo.Create);
TTableInfo(FTableInfo.Objects[t]).TableName := FieldTable;
TTableInfo(FTableInfo.Objects[t]).TableOriginal := FieldTableOriginal;
TTableInfo(FTableInfo.Objects[t]).TableDB := FieldDB;
TTableInfo(FTableInfo.Objects[t]).TableOrigin := IFStr(length(FieldDB)>0,FormatIdentifier(FieldDB)+'.','')+
IFStr(length(FieldTableOriginal)>0,FormatIdentifier(FieldTableOriginal),'');
if (FieldFlags and PRI_KEY_FLAG)=PRI_KEY_FLAG then
TTableInfo(FTableInfo.Objects[t]).PrimFields := TTableInfo(FTableInfo.Objects[t]).PrimFields+FieldName+',';
if (FieldFlags and UNIQUE_KEY_FLAG)=UNIQUE_KEY_FLAG then
TTableInfo(FTableInfo.Objects[t]).UniqFields := TTableInfo(FTableInfo.Objects[t]).UniqFields+FieldName+',';
if (FieldFlags and MULTIPLE_KEY_FLAG)=MULTIPLE_KEY_FLAG then
TTableInfo(FTableInfo.Objects[t]).MultFields := TTableInfo(FTableInfo.Objects[t]).MultFields+FieldName+',';
end;
// Setup potential candidates for use as p
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -