maindm.pas

delphi 编制的服务器程序

unit MainDm;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Db, ADODB;

type
  TSystemInfo = record
    UserID: string;
    UserName: string;
    Password: string;
  end;

type
  TDmMain = class(TDataModule)
    ADOConnection1: TADOConnection;
    QueryPublic: TADOQuery;
    procedure DataModuleCreate(Sender: TObject);
  private
    { Private declarations }
    function CheckUser(AUser,APassword: string): Boolean;
  public
    { Public declarations }
    function UserLogin: Boolean;
  end;

var
  DmMain: TDmMain;
  SystemInfo: TSystemInfo;
implementation

{$R *.dfm}
uses UserCheckFrm, PublicFunc;

function TDmMain.CheckUser(AUser, APassword: string): Boolean;
const
  CON_SQL = 'SELECT * FROM Users WHERE User_ID=%s';
var
  s,Pass: string;
begin
  Result := True;
  Exit;
  s := Format(CON_SQL,[AUser]);
  OPenQuery(QueryPublic,s);
  if not QueryPublic.IsEmpty then
  begin
    Pass := DeCryPt(QueryPublic.FieldByName('EnterPass').AsString,'zzy');
    if Pass = APassWord then Result := True;
  end;
end;

procedure TDmMain.DataModuleCreate(Sender: TObject);
var
  s: string;
begin
  AdoConnection1.Close;
  s := 'Provider=Microsoft.Jet.OLEDB.4.0;User ID=Admin;'+
       'Data Source='+ExtractFilePath(Application.ExeName)+'AllFee.mdb;'+
       'Mode=Share Deny None;Extended Properties="";'+
       'Jet OLEDB:System database="";Jet OLEDB:Registry Path="";'+
       'Jet OLEDB:Database Password="100158";Jet OLEDB:Engine Type=5;'+
       'Jet OLEDB:Database Locking Mode=1;Jet OLEDB:Global Partial Bulk Ops=2;'+
       'Jet OLEDB:Global Bulk Transactions=1;Jet OLEDB:New Database Password="100158";'+
       'Jet OLEDB:Create System Database=False;Jet OLEDB:Encrypt Database=False;'+
       'Jet OLEDB:Don'+'''t Copy Locale on Compact=False;Jet OLEDB:Compact Without'+
       ' Replica Repair=False;Jet OLEDB:SFP=False';
  ADOConnection1.ConnectionString := s;
  ADOConnection1.LoginPrompt := False;
  ADOConnection1.Open;
 
end;

function TDmMain.UserLogin: Boolean;
var
  AUser,APassword: string;
  i:integer;
begin
  Result := False;
  for i := 0 to 2 do
  begin
    if not UserCheckDlg(AUser,APassword) and (TrueCancel)  then exit;
    if CheckUser(AUser,APassword) then
      Break
    else
    begin
      if i=2 then begin MessageBox(0,'非法用户，无权使用!','错误',MB_ICONERROR); Result := False; exit; end;
      MessageBox(0,'用户名或口令错误!','错误',MB_ICONERROR);
      Continue;
    end;
  end;
  Result := True;
end;

end.