unit1.pas

是一个delphi的流程制作软件

unit Unit1;
{DISCLAIMER
--------------------
This source code is the property of Core Software.  You may use and distrubute
this source code at your own risk.  Warantee as to the to the completeness,
robustness, timliness, or any issue relevant to this source code whatsoever is
not expressed or implied in any way.

FREE INFORMATION
--------------------
Most companies disallow any religious content to be published in articles or
submitted material which is made public.  This is illegal.  I have a constitutional
right to practice my religion, which includes bringing the news of Jesus Christ
to the world.  It is not my intention to invade anyone's privacy, insult, or offend
any person - religious or not.

Jesus Loves You!


Core Software
CTO, Jason 'Wedge' Perry
534 Denver Ave
Chesapeake, VA 23322
[e-mail]
AOL Instant Messager : GuiOOP
ICQ Pager Address : 37953032
}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ComObj, Security_TLB, stdvcl;

type
  TForm1 = class(TForm)
    lstUserRoles: TListBox;
    Label3: TLabel;
    btnAddUser: TButton;
    btnRemoveRole: TButton;
    lstRoles: TListBox;
    Label6: TLabel;
    btnLogin: TButton;
    txtDatabase: TEdit;
    txtServer: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    txtPassword: TEdit;
    txtLogin: TEdit;
    lstUsers: TListBox;
    Label7: TLabel;
    btnIsInRole: TButton;
    procedure btnLoginClick(Sender: TObject);
    procedure lstUsersClick(Sender: TObject);
    procedure btnAddUserClick(Sender: TObject);
    procedure btnIsInRoleClick(Sender: TObject);
    procedure btnRemoveRoleClick(Sender: TObject);
  private
    procedure FillRoles;
    procedure FillUsers;
    procedure FillUserRoles(sLogin : widestring);
    function CheckSelected : boolean;
  public
  end;

var
  Form1: TForm1;
  Security : SQLDMO_Security;

implementation

{$R *.DFM}

procedure TForm1.FillRoles;
var
  o : OleVariant;
  lcv : integer;
begin
  o := Security.GetRoles(txtDatabase.text);
  lstRoles.Items.Clear;
  for lcv := 1 to o.Count do begin
    lstRoles.Items.add(o.item(lcv).Name);
  end;
end;

procedure TForm1.FillUsers;
var
  o : OleVariant;
  lcv : integer;
begin
  o := Security.GetUsers(txtDatabase.text);
  lstUsers.Items.Clear;
  for lcv := 1 to o.Count do begin
    lstUsers.Items.add(o.item(lcv).Name);
  end;
end;

procedure TForm1.FillUserRoles(sLogin : widestring);
var
  o : IStrings;
  lcv : integer;
begin
  o := Security.GetUserRoles(sLogin, txtDatabase.text);
  if assigned(o) then begin
    lstUserRoles.Items.Clear;
    for lcv := 0 to o.Count-1 do begin
      lstUserRoles.Items.add(o.item[lcv]);
    end;
  end else begin
    raise exception.create('User not found in database');
  end;
end;

procedure TForm1.btnLoginClick(Sender: TObject);
begin
  Security := CoSQLDMO_Security.Create;
  if Security.Login(txtServer.text, txtDatabase.text,
                 txtLogin.text, txtPassword.text) then begin
    windows.beep(600, 100);
    FillRoles;
    FillUsers;
  end else begin
    raise exception.create('The login failed');
  end;
end;

procedure TForm1.lstUsersClick(Sender: TObject);
begin
  if lstUsers.ItemIndex < 0 then exit;

  FillUserRoles(lstUsers.Items[lstUsers.ItemIndex]);
end;

function TForm1.CheckSelected : boolean;
begin
  result := (lstUsers.ItemIndex >= 0) and (lstRoles.ItemIndex >= 0);
  if not result then begin
    beep;
    showmessage('Please select a user and role.');
    exit;
  end;
end;

procedure TForm1.btnRemoveRoleClick(Sender: TObject);
begin
  if CheckSelected then begin
    if Security.IsUserInRole(txtLogin.text,
                                 lstRoles.Items[lstRoles.ItemIndex],
                                 txtDatabase.text) then begin
      Security.RemoveUserFromRole(txtLogin.text,
                                  lstRoles.Items[lstRoles.ItemIndex],
                                  txtDatabase.text);
      lstUsersClick(nil);
    end else begin
      beep;
      showmessage('User is not in this role.');
    end;
  end;
end;

procedure TForm1.btnAddUserClick(Sender: TObject);
begin
  if CheckSelected then begin
    if not Security.IsUserInRole(txtLogin.text,
                                 lstRoles.Items[lstRoles.ItemIndex],
                                 txtDatabase.text) then begin
      Security.AddUserToRole(txtLogin.text,
                             lstRoles.Items[lstRoles.ItemIndex],
                             txtDatabase.text);
      lstUsersClick(nil);
    end else begin
      beep;
      showmessage('User is already in role.');
    end;
  end;
end;

procedure TForm1.btnIsInRoleClick(Sender: TObject);
begin
  if CheckSelected then begin
    if Security.IsUserInRole(txtLogin.text,
                             lstRoles.Items[lstRoles.ItemIndex],
                             txtDatabase.text) then begin
      showmessage('Login: ' + txtLogin.text +
                  ' is in the Role: ' + lstRoles.Items[lstRoles.ItemIndex] +
                  ' .');
    end else begin
      showmessage('Login: ' + txtLogin.text +
                  ' is in NOT the Role: ' + lstRoles.Items[lstRoles.ItemIndex] +
                  ' .');
    end;
  end;
end;

end.