rdm4unit.pas

三层的通用架构

  begin
    FTableName := string(TableName);
    FFieldIndexs.Text := string(FieldIndexs);
    ErrorString := '';
  end;
  if FLogin and FSelf then
    ErrorString := '不允许执行!';
  FErrorStrings.Add(ErrorString);
end;

function TDefaultRDM4.GetUserInfo(AllUsersFlag: WordBool): WideString;
var
  ViewString, ErrorString: string;
begin
  ViewString := '[' + GetCurrentDateTime + '] 用户 ' + FName + ' ';
  ErrorString := '尚未登录';
  Result := '';
  if FLogin then
  begin
    Result := TheMainForm.GetUserInfo(AllUsersFlag, FUserName, FUserRealName);
    ErrorString := '';
    if not FSelf then
    begin
      ViewString := ViewString + '读取用户信息';
      Lock;
      TheMainForm.DoAddViewString(ViewString);
      Unlock;
    end;
  end;
  FErrorStrings.Add(ErrorString);
end;

function TDefaultRDM4.ProcessPassword(const BasicStr, Value: WideString;
  ToNatural: WordBool): WideString;
var
  ErrorString: string;
begin
  Result := TheMainForm.ProcessPassword(string(BasicStr), string(Value), ToNatural);
  ErrorString := '';
  FErrorStrings.Add(ErrorString);
end;

function TDefaultRDM4.GetProcedureNames: WideString;
var
  ViewString, ErrorString: string;
  List: TStringList;
begin
  ViewString := '[' + GetCurrentDateTime + '] 用户 ' + FName + ' ';
  Result := '';
  ErrorString := '尚未登录';
  if FLogin and not FSelf then
  begin
    ErrorString := '未连接数据库';
    if DefaultRDMADOConnection.Connected then
    begin
      ErrorString := '读取存储过程列表时出错';
      List := TStringList.Create;
      try
        DefaultRDMADOConnection.GetProcedureNames(List);
        Result := List.Text;
        ViewString := ViewString + '成功读取存储过程列表';
        ErrorString := '';
      except
        on E: Exception do
        begin
          ErrorString := E.Message;
          ViewString := ViewString + '读取存储过程列表时出错:'#13#10 + ErrorString;
        end;
      end;
      List.Free;
      Lock;
      TheMainForm.DoAddViewString(ViewString);
      Unlock;
    end;
  end;
  if FLogin and FSelf then
    ErrorString := '不允许执行!';
  FErrorStrings.Add(ErrorString);
end;

function TDefaultRDM4.GetTableNames(SystemTables: WordBool): WideString;
var
  ViewString, ErrorString: string;
  List: TStringList;
begin
  ViewString := '[' + GetCurrentDateTime + '] 用户 ' + FName + ' ';
  Result := '';
  ErrorString := '尚未登录';
  if FLogin and not FSelf then
  begin
    ErrorString := '未连接数据库';
    if DefaultRDMADOConnection.Connected then
    begin
      if SystemTables then
        ErrorString := '读取表名列表(含系统表)时出错'
      else
        ErrorString := '读取表名列表(不含系统表)时出错';
      List := TStringList.Create;
      try
        DefaultRDMADOConnection.GetTableNames(List, SystemTables);
        Result := List.Text;
        if SystemTables then
          ViewString := ViewString + '成功读取表名列表(含系统表)'
        else
          ViewString := ViewString + '成功读取表名列表(不含系统表)';
        ErrorString := '';
      except
        on E: Exception do
        begin
          ErrorString := E.Message;
          if SystemTables then
            ViewString := ViewString + '读取表名列表(含系统表)时出错:'#13#10 + ErrorString
          else
            ViewString := ViewString + '读取表名列表(不含系统表)时出错:'#13#10 + ErrorString;
        end;
      end;
      List.Free;
      Lock;
      TheMainForm.DoAddViewString(ViewString);
      Unlock;
    end;
  end;
  if FLogin and FSelf then
    ErrorString := '不允许执行!';
  FErrorStrings.Add(ErrorString);
end;

function TDefaultRDM4.GetFieldNames(
  const TableName: WideString): WideString;
var
  ViewString, ErrorString: string;
  List: TStringList;
begin
  ViewString := '[' + GetCurrentDateTime + '] 用户 ' + FName + ' ';
  Result := '';
  ErrorString := '尚未登录';
  if FLogin and not FSelf then
  begin
    ErrorString := '未连接数据库';
    if DefaultRDMADOConnection.Connected then
    begin
      ErrorString := '读取表' + TableName + '字段列表时出错';
      List := TStringList.Create;
      try
        DefaultRDMADOConnection.GetFieldNames(TableName, List);
        Result := List.Text;
        ViewString := ViewString + '成功读取表' + TableName + '字段列表';
        ErrorString := '';
      except
        on E: Exception do
        begin
          ErrorString := E.Message;
          ViewString := ViewString + '读取表' + TableName + '字段列表时出错:'#13#10 + ErrorString;
        end;
      end;
      List.Free;
      Lock;
      TheMainForm.DoAddViewString(ViewString);
      Unlock;
    end;
  end;
  if FLogin and FSelf then
    ErrorString := '不允许执行!';
  FErrorStrings.Add(ErrorString);
end;

function TDefaultRDM4.GetRegisterUser: WideString;
var
  ViewString, ErrorString: string;
begin
  ViewString := '[' + GetCurrentDateTime + '] 用户 ' + FName + ' ';
  Result := '';
  ErrorString := '尚未登录';
  if FLogin then
  begin
    Result := GetRegisterUser;
    ErrorString := '';
    if not FSelf then
    begin
      ViewString := ViewString + '读取注册用户名';
      Lock;
      TheMainForm.DoAddViewString(ViewString);
      Unlock;
    end;
  end;
  FErrorStrings.Add(ErrorString);
end;

function TDefaultRDM4.SetUserValue(const UserName,
  Value: WideString): WordBool;
var
  ViewString, ErrorString: string;
begin
  ViewString := '[' + GetCurrentDateTime + '] 用户 ' + FName + ' ';
  Result := False;
  ErrorString := '尚未登录';
  if FLogin then
  begin
    ViewString := ViewString + '设置用户 ' + UserName + ' 的关键值';
    Result := TheMainForm.SetUserValue(FUserRealName, UserName, Value, ErrorString);
    if not FSelf then
    begin
      if ErrorString <> '' then
        ViewString := ViewString + '时出错: ' + ErrorString;
      Lock;
      TheMainForm.DoAddViewString(ViewString);
      Unlock;
    end;
  end;
  FErrorStrings.Add(ErrorString);
end;

function TDefaultRDM4.GetDateTime: TDateTime;
var
  ErrorString: string;
begin
  Result := Now;
  ErrorString := '';
  FErrorStrings.Add(ErrorString);
end;

procedure TDefaultRDM4.BeginTrans;
var
  ViewString, ErrorString: string;
begin
  ViewString := '[' + GetCurrentDateTime + '] 用户 ' + FName + ' ';
  ErrorString := '尚未登录';
  if FLogin and not FSelf then
  begin
    ViewString := ViewString + '启动事务';
    DefaultRDMADOConnection.BeginTrans;
    ErrorString := '';
    Lock;
    TheMainForm.DoAddViewString(ViewString);
    Unlock;
  end;
  FErrorStrings.Add(ErrorString);
end;

procedure TDefaultRDM4.CommitTrans(RollbackFlag: WordBool);
var
  ViewString, ErrorString: string;
begin
  ViewString := '[' + GetCurrentDateTime + '] 用户 ' + FName + ' ';
  ErrorString := '尚未登录';
  if FLogin and not FSelf then
  begin
    try
      DefaultRDMADOConnection.CommitTrans;
      ViewString := ViewString + '成功提交事务';
      ErrorString := '';
    except
      ViewString := ViewString + '提交事务失败';
      ErrorString := '提交事务失败';
      if RollbackFlag then
        try
          DefaultRDMADOConnection.RollbackTrans;
          ViewString := ViewString + ',成功回滚';
          ErrorString := ErrorString + ',成功回滚';
        except
          ViewString := ViewString + ',回滚也失败';
          ErrorString := ErrorString + ',回滚也失败';
        end;
    end;
    Lock;
    TheMainForm.DoAddViewString(ViewString);
    Unlock;
  end;
  FErrorStrings.Add(ErrorString);
end;

procedure TDefaultRDM4.RollbackTrans;
var
  ViewString, ErrorString: string;
begin
  ViewString := '[' + GetCurrentDateTime + '] 用户 ' + FName + ' ';
  ErrorString := '尚未登录';
  if FLogin and not FSelf then
  begin
    try
      DefaultRDMADOConnection.RollbackTrans;
      ViewString := ViewString + '成功回液事务';
      ErrorString := '';
    except
      ViewString := ViewString + '回滚事务失败';
      ErrorString := '回滚事务失败';
    end;
    Lock;
    TheMainForm.DoAddViewString(ViewString);
    Unlock;
  end;
  FErrorStrings.Add(ErrorString);
end;

procedure TDefaultRDM4.Timer1Timer(Sender: TObject);
begin
  TTimer(Sender).Enabled := False;
  if (CurrentThreadModel = tmApartment) and not FSelf then
    CoDisconnectObject(ComObject, 0);
end;

function TDefaultRDM4.Get_Object0: OleVariant;
begin
  if FLogin and TheMainForm.CanConnectNewObject(FUserRealName, '0') then
    Result := FObj[0]
  else
    Result := Unassigned;
end;

function TDefaultRDM4.Get_Object1: OleVariant;
begin
  if FLogin and TheMainForm.CanConnectNewObject(FUserRealName, '1') then
    Result := FObj[1]
  else
    Result := Unassigned;
end;

function TDefaultRDM4.Get_Object2: OleVariant;
begin
  if FLogin and TheMainForm.CanConnectNewObject(FUserRealName, '2') then
    Result := FObj[2]
  else
    Result := Unassigned;
end;

function TDefaultRDM4.Get_Object3: OleVariant;
begin
  if FLogin and TheMainForm.CanConnectNewObject(FUserRealName, '3') then
    Result := FObj[3]
  else
    Result := Unassigned;
end;

function TDefaultRDM4.Get_Object4: OleVariant;
begin
  if FLogin and TheMainForm.CanConnectNewObject(FUserRealName, '4') then
    Result := FObj[4]
  else
    Result := Unassigned;
end;

function TDefaultRDM4.Get_Object5: OleVariant;
begin
  if FLogin and TheMainForm.CanConnectNewObject(FUserRealName, '5') then
    Result := FObj[5]
  else
    Result := Unassigned;
end;

function TDefaultRDM4.Get_Object6: OleVariant;
begin
  if FLogin and TheMainForm.CanConnectNewObject(FUserRealName, '6') then
    Result := FObj[6]
  else
    Result := Unassigned;
end;

function TDefaultRDM4.Get_Object7: OleVariant;
begin
  if FLogin and TheMainForm.CanConnectNewObject(FUserRealName, '7') then
    Result := FObj[7]
  else
    Result := Unassigned;
end;

function TDefaultRDM4.Get_Object8: OleVariant;
begin
  if FLogin and TheMainForm.CanConnectNewObject(FUserRealName, '8') then
    Result := FObj[8]
  else
    Result := Unassigned;
end;

function TDefaultRDM4.Get_Object9: OleVariant;
begin
  if FLogin and TheMainForm.CanConnectNewObject(FUserRealName, '9') then
    Result := FObj[9]
  else
    Result := Unassigned;
end;

function TDefaultRDM4.Get_CustomObject: OleVariant;
begin
  if FLogin and TheMainForm.CanConnectNewObject(FUserRealName) then
    Result := FCustomObj
  else
    Result := Unassigned;
end;

function TDefaultRDM4.ConnectNewObject(
  const TheClassName: WideString): WordBool;
var
  ViewString, ErrorString: string;
begin
  ViewString := '[' + GetCurrentDateTime + '] 用户 ' + FName + ' ';
  FCustomObj := Unassigned;
  FClassName := '';
  ErrorString := '无权连接自定义COM对象';
  Result := False;
  if FLogin and TheMainForm.CanConnectNewObject(FUserRealName) then
  begin
    try
      FCustomObj := CreateOleObject(TheClassName);
      FClassName := TheClassName;
      ErrorString := '';
      ViewString := ViewString + '成功连接 ' + ClassName + ' 对象';
      Result := True;
    except
      on E:Exception do
      begin
        FClassName := '';
        ErrorString := E.Message;
        ViewString := ViewString + '连接 ' + ClassName + ' 对象失败:'#13#10 + ErrorString;
        Result := False;
      end;
    end;
    if not FSelf then
    begin
      Lock;
      TheMainForm.DoAddViewString(ViewString);
      Unlock;
    end;
  end;
  FErrorStrings.Add(ErrorString);
end;

procedure TDefaultRDM4.DisConnectObject;
var
  ViewString, ErrorString: string;
begin
  ViewString := '[' + GetCurrentDateTime + '] 用户 ' + FName + ' ';
  ErrorString := '尚未连接COM对象';
  if FLogin and (FClassName <> '') then
  begin
    FCustomObj := Unassigned;
    ErrorString := '';
    ViewString := ViewString + '断开与 ' + FClassName + ' 对象的连接';
    if not FSelf then
    begin
      Lock;
      TheMainForm.DoAddViewString(ViewString);
      Unlock;
    end;
  end;
  FErrorStrings.Add(ErrorString);
end;

function TDefaultRDM4.ProcessPassword2(const BasicStr,
  Value: WideString): WideString;
var
  ErrorString: string;
begin
  Result := TheMainForm.ProcessPassword2(string(BasicStr), string(Value));
  ErrorString := '';
  FErrorStrings.Add(ErrorString);
end;

function TDefaultRDM4.StringEncrypt(const SourceString,
  Password: WideString; EncryptFlag: WordBool): WideString;
var
  ErrorString: string;
begin
  if EncryptFlag then
    Result := ShareUnit.StringEncrypt(string(SourceString), string(Password))
  else
    Result := ShareUnit.StringDecrypt(string(SourceString), string(Password));
  ErrorString := '';
  FErrorStrings.Add(ErrorString);
end;

function TDefaultRDM4.StringCompress(const SourceString: WideString;
  CompressFlag: WordBool): WideString;
var
  ErrorString: string;
begin
  if CompressFlag then
    Result := ShareUnit.StringCompress(string(SourceString))
  else
    Result := ShareUnit.StringDecompress(string(SourceString));
  ErrorString := '';
  FErrorStrings.Add(ErrorString);
end;

end.