限制同一帳戶多地登陸並選擇強行踢人操做

軟件類型：CS

開發工具：Delphi

功能：限制同一帳戶多地登陸並選擇強行踢人操做。

一、  採用臨時表判斷當前帳戶是否已經登陸。這裏簡單介紹一下臨時表法，當軟件第一次登陸成功時，建立一個全局臨時表CREATE TABLE ##UserID (ID int);其中##UserID爲表名，UserID爲當前用戶的惟一ID。關於臨時表，能夠百度一下，本地臨時表，全局臨時表。這裏建立爲全局臨時表。

二、  經過判斷該臨時表是否存在讀取當前用戶是否在登陸的狀態。

 

function TLoginFrm.UserLogined(AdoConn: TADOConnection; AUserID: string): Boolean;
var
  Qry: TADOQuery;
  strSQL: string;
begin
  try
    QryCreate(Qry,AdoConn);
    try
      strSQL := Format('SELECT OBJECT_ID(N''tempdb..##%s'', N''U'') AS TabID', [AUserID]);
      Qry.SQL.Text := strSQL;
      Qry.Open;
      result := not Qry.FieldByName('TabID').IsNull;
    finally
      Qry.Free;
    end;
  except
    Result := False;
    Exit;
  end;
end;

 

三、  當前登陸用戶表增長用戶在線狀態字段」online」默認值爲0。登陸成功時，建立臨時表並更新當前用戶狀態爲1。注：0離線，1在線；

 

function TLoginFrm.RegUserLogined(AdoConn: TADOConnection; AUserID: string): Boolean;
var
  Qry, QryComm: TADOQuery;
  strSQL: string;
begin
  try
    QryCreate(Qry,AdoConn);
    QryCreate(QryComm, adocCommon);
    try
      strSQL := Format('CREATE TABLE ##%s(ID int); ', [AUserID]);
      Qry.SQL.Text := strSQL;
      Qry.ExecSQL;
      strSQL := Format('update Personnel_set set online=1 where Per_id=%S', [QuotedStr(AUserID)]);
      QryComm.SQL.Text := strSQL;
      QryComm.ExecSQL;
    finally
      Qry.Free;
      QryComm.Free;
    end;
  except
    Result := False;
    Exit;
  end;
  Result := True;
end;

 

四、  點擊肯定按鈕登陸界面

 

//判斷 當前登陸用戶是否已經登記
  if not UserLogined(adocWMS, adoqPersonnal.FieldByName('EmployeeCode').AsString) then
  begin
    //針對 異常退出未更新人員在線狀態的狀況，更新人員狀態爲0
    if GetUserOnline(adocCommon, adoqPersonnal.FieldByName('EmployeeCode').AsString) then
      UpdateOnline(adocCommon, adoqPersonnal.FieldByName('EmployeeCode').AsString);
    //建立臨時表記錄當前人員的登陸狀態
    RegUserLogined(adocWMS, adoqPersonnal.FieldByName('EmployeeCode').AsString)
  end else begin
    if MessageBox(Handle, '當前用戶已經在登陸中, 是否強行登陸？', '提示', MB_YESNO)=id_yes then
    begin
      //更新登陸狀態 = 0
      UpdateOnline(adocCommon, adoqPersonnal.FieldByName('EmployeeCode').AsString);
      //設置timer事件監控人員狀態爲0且臨時表存在的狀況直接踢下線。等用戶下線/
      while UserLogined(adocWMS, adoqPersonnal.FieldByName('EmployeeCode').AsString) do
      begin
        //
      end;
      //從新註冊 臨時表。
      RegUserLogined(adocWMS, adoqPersonnal.FieldByName('EmployeeCode').AsString);
    end else
      Exit;
  end;

 

五、  監控人員登陸狀態，人員狀態爲0且臨時表存在的狀況直接踢下線。這裏涉及了一個非阻塞式的彈出提示框。

  

function WTSSendMessage(Server: HWND; SessionId: DWORD; Title: PChar;
  TitleLength: DWORD; AMessage: PChar; MessageLength: DWORD; Style: DWORD;
  Timeout: DWORD; var Response: DWORD; Wait: Boolean): Boolean; stdcall;
  external 'wtsapi32.dll' name 'WTSSendMessageA';

function WTSGetActiveConsoleSessionId: DWORD; stdcall;
  external kernel32 name 'WTSGetActiveConsoleSessionId';  


procedure TLoginFrm.Timer1Timer(Sender: TObject);
const
  WTS_CURRENT_SERVER_HANDLE = 0;
var
  nTitle, nMessage: string;
  nResponse: DWORD;
begin
  if UserLogined(adocCommon, Parameter[4]) and not GetUserOnline(adocCommon, Parameter[4]) then
  begin
    Timer1.Enabled := False;
    nTitle := '提示';
    nMessage := '當前用戶已在其它地方登陸, 您已被踢下線！';
    WTSSendMessage(WTS_CURRENT_SERVER_HANDLE, WTSGetActiveConsoleSessionId,
        PChar(nTitle), Length(nTitle), PChar(nMessage), Length(nMessage),
        MB_OK, 0, nResponse, False);
    TerminateProcess(GetCurrentProcess, 0);
  end;
end;

 

六、  獲取、更新人員狀態函數。

 

function TLoginFrm.GetUserOnline(AdoConn: TADOConnection; AUserID: string): Boolean;
var
  QryComm: TADOQuery;
begin
  Result := False;
  QryCreate(QryComm, AdoConn);
  try
    QryComm.SQL.Text := Format('select online from Personnel_set where per_id=%S', [QuotedStr(AUserID)]);
    QryComm.Open;
    if QryComm.FieldByName('online').AsInteger = 1 then
      Result := True;
  finally
    QryComm.Free;
  end;
end;

function TLoginFrm.UpdateOnline(AdoConn: TADOConnection; AUserID: string; online: Integer): Boolean;
var
  T: TADOQuery;
begin
  QryCreate(T, AdoConn);
  try
    T.SQL.Text := Format('update Personnel_set set online=%D where Per_id=%S', [online, QuotedStr(AUserID)]);
    T.ExecSQL;
  finally
    T.Free;
  end;
end;

 

效果