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

📄 rmd_ado.pas

📁 进销存·完整的·有数据库的·非常完整·只得参考
💻 PAS
📖 第 1 页 / 共 2 页
字号:
    Result := FTable.TableName
  else if Index = 'DATABASE' then
    Result := GetDataBase(FTable.Owner, FTable.Connection)
  else if Index = 'CURSORLOCATION' then
    Result := FTable.CursorLocation
end;

procedure TRMDADOTable.LoadFromStream(Stream: TStream);
begin
  inherited LoadFromStream(Stream);
  FTable.CursorLocation := TCursorLocation(RMReadByte(Stream));
end;

procedure TRMDADOTable.SaveToStream(Stream: TStream);
begin
  LVersion := 0;
  inherited SaveToStream(Stream);
  RMWriteByte(Stream, Byte(FTable.CursorLocation));
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{TRMDADOQuery}

constructor TRMDADOQuery.Create;
begin
  inherited Create;
  FQuery := TADOQuery.Create(RMDialogForm);
  DataSet := FQuery;

  Component := FQuery;
  BaseName := 'ADOQuery';
  BmpRes := 'RMD_ADOQUERY';
end;

procedure TRMDADOQuery.DefineProperties;
begin
  inherited DefineProperties;
  AddEnumProperty('CursorLocation',
    'clUseClient;clUseServer', [clUseClient, clUseServer], nil);
end;

procedure TRMDADOQuery.SetPropValue(Index: string; Value: Variant);
var
  d: TComponent;
begin
  inherited SetPropValue(Index, Value);
  Index := AnsiUpperCase(Index);
  if index = 'DATABASE' then
  begin
    FQuery.Close;
    d := RMFindComponent(FQuery.Owner, Value);
    //lxj
    if (d = nil) and (theThirdConnection <> nil) and (theThirdConnection.Name = Value) then
      FQuery.Connection := theThirdConnection
    else
      FQuery.Connection := TADOConnection(d);
  end
  else if Index = 'DATASOURCE' then
  begin
    d := RMFindComponent(FQuery.Owner, Value);
    FQuery.DataSource := RMGetDataSource(FQuery.Owner, TDataSet(d));
  end
  else if index = 'PARAMS.COUNT' then
  begin
  end
  else if Index = 'SQL' then
  begin
    FQuery.Close;
    FQuery.SQL.Text := Value;
  end
  else if Index = 'CURSORLOCATION' then
    FQuery.CursorLocation := Value
end;

function TRMDADOQuery.GetPropValue(Index: string): Variant;

  function GetDataBase(Owner: TComponent; d: TADOConnection): string;
  begin
    Result := '';
    if d <> nil then
    begin
      Result := d.Name;
      //lxj
      if (d.Owner <> nil) and (d.Owner <> Owner) then
        Result := d.Owner.Name + '.' + Result;
    end;
  end;

begin
  Index := AnsiUpperCase(Index);
  Result := inherited GetPropValue(Index);
  if Result <> Null then Exit;
  if Index = 'DATABASE' then
    Result := GetDataBase(FQuery.Owner, FQuery.Connection)
  else if Index = 'DATASOURCE' then
    Result := RMGetDataSetName(FQuery.Owner, FQuery.DataSource)
  else if Index = 'PARAMS.COUNT' then
    Result := FQuery.Parameters.Count
  else if Index = 'SQL' then
    Result := FQuery.SQL.Text
  else if Index = 'SQL.COUNT' then
    Result := FQuery.SQL.Count
  else if Index = 'CURSORLOCATION' then
    Result := FQuery.CursorLocation
end;

function TRMDADOQuery.DoMethod(const MethodName: string; Pars: array of Variant): Variant;
begin
  Result := inherited DoMethod(MethodName, Pars);
  if Result = Null then
    Result := LinesMethod(FQuery.SQL, MethodName, 'SQL', Pars[0], Pars[1], Pars[2]);
  if MethodName = 'EXECSQL' then
  begin
    OnBeforeOpenQueryEvent(FQuery);
    FQuery.ExecSQL;
  end;
end;

procedure TRMDADOQuery.LoadFromStream(Stream: TStream);
begin
  inherited LoadFromStream(Stream);
  FQuery.CursorLocation := TCursorLocation(RMReadByte(Stream));
end;

procedure TRMDADOQuery.SaveToStream(Stream: TStream);
begin
  LVersion := 0;
  inherited SaveToStream(Stream);
  RMWriteByte(Stream, Byte(FQuery.CursorLocation));
end;

procedure TRMDADOQuery.GetDatabases(sl: TStrings);
var
  liStringList: TStringList;
begin
  liStringList := TStringList.Create;
  try
    RMGetComponents(RMDialogForm, TADOConnection, liStringList, nil);
    //lxj
    if theThirdConnection <> nil then
      liStringList.Add(theThirdConnection.Name);
    liStringList.Sort;
    sl.Assign(liStringList);
  finally
    liStringList.Free;
  end;
end;

procedure TRMDADOQuery.GetTableNames(DB: string; Strings: TStrings);
var
  sl: TStringList;
  lConnection: TADOConnection;
begin
  sl := TStringList.Create;
  try
    try
      lConnection := RMFindComponent(FQuery.Owner, DB) as TADOConnection;
      if lConnection = nil then exit;
      if not lConnection.Connected then
        lConnection.Connected := True;
      if lConnection.Connected then
        lConnection.GetTableNames(sl, False);
      sl.Sort;
      Strings.Assign(sl);
    except;
    end;
  finally
    sl.Free;
  end;
end;

procedure TRMDADOQuery.GetTableFieldNames(const DB, TName: string; sl: TStrings);
var
  i: Integer;
  lStrings: TStringList;
  t: TADOTable;
begin
  lStrings := TStringList.Create;
  t := TADOTable.Create(RMDialogForm);
  try
    t.Connection := RMFindComponent(FQuery.Owner, DB) as TADOConnection;
    t.TableName := tName;
    try
      t.FieldDefs.UpDate;
      for i := 0 to t.FieldDefs.Count - 1 do
        lStrings.Add(t.FieldDefs.Items[i].Name);
      lStrings.Sort;
      sl.Assign(lStrings);
    except;
    end;
  finally
    lStrings.Free;
    t.Free;
  end;
end;

function TRMDADOQuery.GetParamName(Index: Integer): string;
begin
  Result := FQuery.Parameters[Index].Name;
end;

function TRMDADOQuery.GetParamType(Index: Integer): TFieldType;
begin
  Result := FQuery.Parameters[Index].DataType;
end;

procedure TRMDADOQuery.SetParamType(Index: Integer; Value: TFieldType);
begin
  FQuery.Parameters[Index].DataType := Value;
end;

function TRMDADOQuery.GetParamKind(Index: Integer): TRMParamKind;
begin
  Result := rmpkValue;
  if not (paNullable in FQuery.Parameters[Index].Attributes) then
    Result := rmpkAssignFromMaster;
end;

procedure TRMDADOQuery.SetParamKind(Index: Integer; Value: TRMParamKind);
begin
  if Value = rmpkAssignFromMaster then
  begin
    FQuery.Parameters[Index].Attributes := [];
    FParams.Delete(FParams.IndexOf(FQuery.Parameters[Index].Name));
  end
  else
  begin
    FQuery.Parameters[Index].Attributes := [paNullable];
    FParams[FQuery.Parameters[Index].Name] := '';
  end;
end;

function TRMDADOQuery.GetParamText(Index: Integer): string;
var
  v: Variant;
begin
  v := '';
  if ParamKind[Index] = rmpkValue then
    v := FParams[FQuery.Parameters[Index].Name];
  if v = Null then
    v := '';
  Result := v;
end;

procedure TRMDADOQuery.SetParamText(Index: Integer; Value: string);
begin
  if ParamKind[Index] = rmpkValue then
    FParams[FQuery.Parameters[Index].Name] := Value;
end;

function TRMDADOQuery.GetParamValue(Index: Integer): Variant;
begin
  Result := FQuery.Parameters[Index].Value;
end;

procedure TRMDADOQuery.SetParamValue(Index: Integer; Value: Variant);
begin
  FQuery.Parameters[Index].Value := Value;
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{TRNDFormADOConnEdit}

procedure TRMDFormADOConnEdit.Localize;
begin
  Font.Name := RMLoadStr(SRMDefaultFontName);
  Font.Size := StrToInt(RMLoadStr(SRMDefaultFontSize));
  Font.Charset := StrToInt(RMLoadStr(SCharset));

  RMSetStrProp(SourceofConnection, 'Caption', rmRes + 3230);
  RMSetStrProp(UseDataLinkFile, 'Caption', rmRes + 3231);
  RMSetStrProp(UseConnectionString, 'Caption', rmRes + 3232);
  RMSetStrProp(Browse, 'Caption', rmRes + 3249);
  RMSetStrProp(Build, 'Caption', rmRes + 3251);

  btnOk.Caption := RMLoadStr(SOK);
  btnCancel.Caption := RMLoadStr(SCancel);
end;

function TRMDFormADOConnEdit.Edit(var ConnStr: WideString): boolean;
var
  FileName: string;
begin
  UseDataLinkFile.Checked := True;
  if Pos(CT_FILENAME, ConnStr) = 1 then
  begin
    FileName := Copy(ConnStr, Length(CT_FILENAME) + 1, MAX_PATH);
    if ExtractFilePath(FileName) = (DataLinkDir + '\') then
      DataLinkFile.Text := ExtractFileName(FileName)
    else
      DataLinkFile.Text := FileName;
  end
  else
  begin
    ConnectionString.Text := ConnStr;
    UseConnectionString.Checked := True;
  end;

  SourceButtonClick(nil);
  Result := FALSE;
  if ShowModal = mrOk then
  begin
    if UseConnectionString.Checked then
      ConnStr := ConnectionString.Text
    else if DataLinkFile.Text <> '' then
    begin
      if ExtractFilePath(DataLinkFile.Text) = '' then
        ConnStr := CT_FILENAME + DataLinkDir + '\' + DataLinkFile.Text
      else
        ConnStr := CT_FILENAME + DataLinkFile.Text
    end;
    Result := TRUE;
  end;
end;

procedure TRMDFormADOConnEdit.FormCreate(Sender: TObject);
begin
  Localize;
  GetDataLinkFiles(DataLinkFile.Items);
end;

procedure TRMDFormADOConnEdit.BrowseClick(Sender: TObject);
begin
  DataLinkFile.Text := PromptDataLinkFile(Handle, DataLinkFile.Text);
end;

procedure TRMDFormADOConnEdit.BuildClick(Sender: TObject);
begin
  ConnectionString.Text := PromptDataSource(Handle, ConnectionString.Text);
end;

const
  EnabledColor: array[Boolean] of TColor = (clBtnFace, clWindow);

procedure TRMDFormADOConnEdit.SourceButtonClick(Sender: TObject);
begin
  DataLinkFile.Enabled := UseDataLinkFile.Checked;
  DataLinkFile.Color := EnabledColor[DataLinkFile.Enabled];
  Browse.Enabled := DataLinkFile.Enabled;
  ConnectionString.Enabled := UseConnectionString.Checked;
  ConnectionString.Color := EnabledColor[ConnectionString.Enabled];
  Build.Enabled := ConnectionString.Enabled;
  if DataLinkFile.Enabled then
    ActiveControl := DataLinkFile
  else
    ActiveControl := ConnectionString;
end;

initialization
  RMRegisterControl(TRMDADODatabase, 'RMD_ADODBCONTROL', RMLoadStr(SInsertDB) + '(ADO)');
  RMRegisterControl(TRMDADOTable, 'RMD_ADOTABLECONTROL', RMLoadStr(SInsertTable) + '(ADO)');
  RMRegisterControl(TRMDADOQuery, 'RMD_ADOQUERYCONTROL', RMLoadStr(SInsertQuery) + '(ADO)');

finalization
{$ENDIF}

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -