ucbase.pas

delphi 控件有需要的可以下载看看,可以用的,希望对你用 帮助

{$ENDIF}
   TTrocaSenha(FormTrocarSenha).Close;
end;


const
  Codes64 = '0A1B2C3D4E5F6G7H89IjKlMnOPqRsTuVWXyZabcdefghijkLmNopQrStUvwxYz+/';
  C1 = 52845;
  C2 = 22719;

function Decode(const S: AnsiString): AnsiString;
const
  Map: array[Char] of Byte = (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 62, 0, 0, 0, 63, 52, 53,
    54, 55, 56, 57, 58, 59, 60, 61, 0, 0, 0, 0, 0, 0, 0, 0, 1, 2,
    3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19,
    20, 21, 22, 23, 24, 25, 0, 0, 0, 0, 0, 0, 26, 27, 28, 29, 30,
    31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45,
    46, 47, 48, 49, 50, 51, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    0);
var
  I: LongInt;
begin
  case Length(S) of
    2:
      begin
        I := Map[S[1]] + (Map[S[2]] shl 6);
        SetLength(Result, 1);
        Move(I, Result[1], Length(Result))
      end;
    3:
      begin
        I := Map[S[1]] + (Map[S[2]] shl 6) + (Map[S[3]] shl 12);
        SetLength(Result, 2);
        Move(I, Result[1], Length(Result))
      end;
    4:
      begin
        I := Map[S[1]] + (Map[S[2]] shl 6) + (Map[S[3]] shl 12) +
          (Map[S[4]] shl 18);
        SetLength(Result, 3);
        Move(I, Result[1], Length(Result))
      end
  end
end;

function PreProcess(const S: AnsiString): AnsiString;
var
  SS: AnsiString;
begin
  SS := S;
  Result := '';
  while SS <> '' do
  begin
    Result := Result + Decode(Copy(SS, 1, 4));
    Delete(SS, 1, 4)
  end
end;

function InternalDecrypt(const S: AnsiString; Key: Word): AnsiString;
var
  I: Word;
  Seed: int64;
begin
  Result := S;
  Seed := Key;
  for I := 1 to Length(Result) do
  begin
    Result[I] := Char(Byte(Result[I]) xor (Seed shr 8));
    Seed := (Byte(S[I]) + Seed) * Word(C1) + Word(C2)
  end
end;

function Decrypt(const S: AnsiString; Key: Word): AnsiString;
begin
  Result := InternalDecrypt(PreProcess(S), Key)
end;

function Encode(const S: AnsiString): AnsiString;
const
  Map: array[0..63] of Char = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' +
    'abcdefghijklmnopqrstuvwxyz0123456789+/';
var
  I: LongInt;
begin
  I := 0;
  Move(S[1], I, Length(S));
  case Length(S) of
    1:
      Result := Map[I mod 64] + Map[(I shr 6) mod 64];
    2:
      Result := Map[I mod 64] + Map[(I shr 6) mod 64] +
        Map[(I shr 12) mod 64];
    3:
      Result := Map[I mod 64] + Map[(I shr 6) mod 64] +
        Map[(I shr 12) mod 64] + Map[(I shr 18) mod 64]
  end
end;

function PostProcess(const S: AnsiString): AnsiString;
var
  SS: AnsiString;
begin
  SS := S;
  Result := '';
  while SS <> '' do
  begin
    Result := Result + Encode(Copy(SS, 1, 3));
    Delete(SS, 1, 3)
  end
end;

function InternalEncrypt(const S: AnsiString; Key: Word): AnsiString;
var
  I: Word;
  Seed: int64;
begin
  Result := S;
  Seed := Key;
  for I := 1 to Length(Result) do
  begin
    Result[I] := Char(Byte(Result[I]) xor (Seed shr 8));
    Seed := (Byte(Result[I]) + Seed) * Word(C1) + Word(C2)
  end
end;

function Encrypt(const S: AnsiString; Key: Word): AnsiString;
begin
  Result := PostProcess(InternalEncrypt(S, Key))
end;

procedure TUserControl.SetFUserSettings(const Value: TUserSettings);
begin
  Settings := Value;
end;

procedure TUserControl.SetLoginWindow(Form: TCustomForm);
begin
  with Settings.Login, Form as TLoginWindow do
  begin
    Caption := WindowCaption;
    LbUsuario.Caption := LabelUser;
    LbSenha.Caption := LabelPassword;
    btOK.Caption := Settings.Login.BtOk;
    BtCancela.Caption := BtCancel;
    if LeftImage <> nil then ImgLeft.Picture.Assign(LeftImage);
    if BottomImage <> nil then ImgBottom.Picture.Assign(BottomImage);
    if TopImage <> nil then ImgTop.Picture.Assign(TopImage);

//oif - Check for e-mail control	
{$IFDEF VER130}
{$ELSE}
    if Assigned(MailUserControl) then
    begin
      lbEsqueci.Visible := MailUserControl.EsqueceuSenha.Ativo;
      lbEsqueci.Caption := MailUserControl.EsqueceuSenha.LabelLoginForm;
    end;
{$ENDIF}
    UCXPStyle.XPSettings := Self.Settings.XpStyleSet;
    UCXPStyle.Active := Self.Settings.XPStyle;
    Position := Self.Settings.WindowsPosition;
  end;

end;


procedure TUserControl.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  if (Operation = opRemove) then
  begin
    if AComponent = UsersForm.MenuItem then UsersForm.MenuItem := nil;
    if AComponent = UsersForm.Action then UsersForm.Action := nil;
    if AComponent = UsersProfile.MenuItem then UsersProfile.MenuItem := nil;
    if AComponent = UsersProfile.Action then UsersProfile.Action := nil;
    if AComponent = ChangePasswordForm.Action then ChangePasswordForm.Action := nil;
    if AComponent = ChangePasswordForm.MenuItem then ChangePasswordForm.MenuItem := nil;
    if AComponent = ControlRight.MainMenu then ControlRight.MainMenu := nil;
    if AComponent = ControlRight.ActionList then ControlRight.ActionList := nil;
    {$IFDEF UCACTMANAGER}
    if AComponent = ControlRight.ActionManager then ControlRight.ActionManager := nil;
    if AComponent = ControlRight.ActionMainMenuBar then  ControlRight.ActionMainMenuBar := nil;
    {$ENDIF}
    if AComponent = LogControl.MenuItem then LogControl.MenuItem := nil;
    if AComponent = LogControl.Action then LogControl.Action := nil;
    if AComponent = FUCDataConn then FUCDataConn := nil;

//oif -Check for e-mail access 
{$IFDEF VER130}
{$ELSE}
    if AComponent = FMailUserControl then FMailUserControl := nil;
{$ENDIF}
  end;
  inherited Notification (AComponent, Operation);
end;


procedure TUserControl.ActionLog(Sender: TObject);
begin
  FormLogControl := TViewLog.Create(self);
  TViewLog(FormLogControl).UCComponent := Self;
  with TViewLog(FormLogControl), Settings.Log do
  begin
    Caption := WindowCaption;
    lbDescricao.Caption := LabelDescription;
    lbUsuario.Caption := LabelUser;
    lbData.Caption := LabelDate;
    lbNivel.Caption := LabelLevel;
    BtFiltro.Caption := BtFilter;
    BtExclui.Caption := BtDelete;
    BtFecha.Caption := BtClose;
    DbGrid1.Columns[0].Title.Caption := ColLevel;
    DbGrid1.Columns[1].Title.Caption := ColMessage;
    DbGrid1.Columns[2].Title.Caption := ColUser;
    DbGrid1.Columns[3].Title.Caption := ColDate;
    UCXPStyle.XPSettings := Self.Settings.XpStyleSet;
    UCXPStyle.Active := Self.Settings.XPStyle;
    Position := Self.Settings.WindowsPosition;
  end;
  TViewLog(FormLogControl).ShowModal;
  FreeandNil(FormLogControl);
end;

procedure TUserControl.Log(MSG: String; Level: Integer);
begin
  if not LogControl.Active then Exit;
  DataConnector.UCExecSQL('Insert into ' + LogControl.TableLog + '( IdUser, MSG, Data, Nivel) Values ( '+
            IntToStr(CurrentUser.UserID)+', '+
            QuotedStr(Copy(MSG,1,250))+', '+
            QuotedStr(FormatDateTime('YYYYMMDDhhmmss',now))+', '+
            IntToStr(Level)+')');
end;

//oif - Check for e-mail access
{$IFDEF VER130}
{$ELSE}
procedure TUserControl.SetFMailUserControl(const Value: TMailUserControl);
begin
  FMailUserControl := Value;
  if Value <> nil then Value.FreeNotification(Self);
end;
{$ENDIF}

procedure TUserControl.RegistraCurrentUser( dados : TDataset);
begin
  with CurrentUser do
  begin
    UserID := Dados.FieldByName(TableUsers.FieldUserID).asInteger;
    Username := Dados.FieldByName(TableUsers.FieldUserName).asString;
    LoginName:= Dados.FieldByName(TableUsers.FieldLogin).asString;
    Password := Decrypt(Dados.FieldByName(TableUsers.FieldPassword).asString, EncryptKey);
    Email := Dados.FieldByName(TableUsers.FieldEmail).asString;
    Privilegiado := StrToBool(Dados.FieldByName(TableUsers.FieldPrivileged).asString);
    Profile := Dados.FieldByName(TableUsers.FieldProfile).asInteger;
    if Assigned(OnLoginSucess) then OnLoginSucess(Self, UserID, LoginName, UserName, Password, EMail, Privilegiado);
  end;
  ApplyRightsUCControlMonitor;
  NotificationLoginMonitor;
end;



{$IFDEF VER130}
{$ELSE}
procedure TUserControl.ActionEsqueceuSenha(Sender: TObject);
var
  FDataset : TDataset;
begin
  FDataset := DataConnector.UCGetSQLDataset('Select * from '+ TableUsers.TableName + ' Where '+
              TableUsers.FieldLogin+' = '+ QuotedStr(TLoginWindow(FormLogin).EditUsuario.Text));
  with FDataset do
    try
      if not IsEmpty then
        MailUserControl.EnviaEsqueceuSenha( fieldbyname(TableUsers.FieldUserName).asString,
                                            fieldbyname(TableUsers.FieldLogin).asString,
                                            fieldbyname(TableUsers.FieldPassword).asString,
                                            fieldbyname(TableUsers.FieldEmail).asString, '', EncryptKey)
      else MessageDlg(Settings.CommonMessages.InvalidLogin, mtWarning, [mbOK], 0);
    finally
      Close;
      Free;
    end;
end;
{$ENDIF}

procedure TUserControl.TryAutoLogon;
begin
  if not VerificaLogin(Login.AutoLogon.User, Login.AutoLogon.Password) then
  begin
    if Login.AutoLogon.MessageOnError then MessageDlg(Settings.CommonMessages.AutoLogonError, mtWarning, [mbOK], 0);
    ShowLogin;
  end;
end;


function TUserControl.VerificaLogin(User, Password: String): Boolean;
var
  vSenha, Key : String;
  FDataset : TDataset;
begin
  vSenha := TableUsers.FieldPassword +  ' = ' + QuotedStr(Encrypt(Password, EncryptKey));
  FDataset := DataConnector.UCGetSQLDataset('Select * from '+ TableUsers.TableName + ' Where '+
              TableUsers.FieldLogin+' = '+ QuotedStr(User) + ' and ' + vSenha);
  with FDataset do
    try
      if not IsEmpty then
      begin
        Key := Decrypt(FDataset.FieldByName(TableUsers.FieldKey).asString, EncryptKey);

        if Key <> FDataSet.FieldByName(TableUsers.FieldUserID).asString +