⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 mysqldataset.pas

📁 MYSQL 连接控件 MYSQL 连接控件
💻 PAS
📖 第 1 页 / 共 5 页
字号:
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 + -