systemdm.pas

一个电力企业的后台管理程序

unit SystemDM;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Db, DBTables,winsock,inifiles, WordReport, WorddotRpt, FileCtrl;

type
  TSysDM = class(TDataModule)
    DBMain: TDatabase;
    Qr_sysTemp: TQuery;
    Qr_Temp: TQuery;
    Qry_Gzbx: TQuery;
    tbl_batch: TTable;
    WReport: TWordReport;
    Qry_Word: TQuery;
    WorddotRpt: TWorddotRpt;
    procedure DataModuleCreate(Sender: TObject);
    procedure DataModuleDestroy(Sender: TObject);
  private
    { Private declarations }
    FConnectFlag: boolean;       //系统数据模块连接标志

    FWorkId,                     //登录工号
    FWorkPwd,                    //登录工号的口令
    FWorkAuthStr,                //登录工号的权限字串
    FWorkRole,                   //登录工号的权限角色
    FWorkName :String;           //登录工号的名称

    function GetLocalComputerName : String;       //取得本机主机名称
    function GetLocalIP : string;                 //取得本机IP 地址
    function GetAppName :string;                  //取得本机内部程序名称
    function GetAppVer     :string;               //取得本机内部程序版本号
    function GetAppExplain :string;               //取得本机内部程序说明
    function GetExeName :string;                  //取得本机应用程序名称
    function GetExePath :string;                  //取得本机应用程序路径
    function GetDBName  :string;                  //取得系统内部别名
    function GetDBAliasName  :string;
    function GetDBDataBaseName  :string;
    function GetDBServerName :string;
    function GetDBUserName :string;
    function GetDBPassWord :string;
    function GetDebugstate  :boolean;             //取得系统调试状态
  public
    { Public declarations }
    Logs:TStringList;                                //日志内容
    property ConnectFlag: boolean read FConnectFlag; //系统数据模块连接标志

    property HostName :string read GetLocalComputerName;//本机主机名称
    property HostIP :string read GetLocalIP;            //本机IP 地址
    property AppName :string read GetAppName;           //本机内部程序名称
    property AppVer :string read GetAppVer;             //本机内部程序版本号
    property AppExplain :string read GetAppExplain;     //本机内部程序说明
    property ExeName :string read GetExeName;           //本机应用程序名称
    property ExePath :string read GetExePath;           //本机应用程序路径

    property WorkId :string read FWorkId write FWorkId;               //登录工号
    property WorkPwd :string read FWorkPwd write FWorkPwd;            //登录工号的口令
    property WorkAuthStr :string read FWorkAuthStr write FWorkAuthStr;//登录工号的权限字串
    property WorkRole :string read FWorkRole write FWorkRole;         //登录工号的权限角色
    property WorkName  :string read FWorkName write FWorkName;        //登录工号的名称

    property DBName :string read GetDBName;                     //系统内部别名
    property DBAliasName  :string read GetDBAliasName;
    property DBDataBaseName  :string read GetDBDataBaseName;
    property DBServerName :string read GetDBServerName;
    property DBUserName :string read GetDBUserName;
    property DBPassWord :string read GetDBPassWord;
    property Debugstate:boolean read GetDebugstate;             //系统调试状态

    function SQL_Querys(tempQuery:TQuery;Sql_Str:String):boolean;  //执行一个SQL查询语句
    function SQL_Exec(tempQuery:TQuery;Sql_Str:String;Commit:boolean=true):boolean;    //执行一个SQL语句
    function CallLogin:boolean;                         //系统登录
    function CallReLogin:boolean;                       //系统重新登录
    function GetParam(ParaName:string;default:string):string;          //取得系统参数
    function SetParam(ParaName:string;ParaVal:string):boolean;         //保存系统参数
    function GetSysVal(AItem:String;default:string):String;
    function GetRoleAuth(RoleName:string;Authindex:integer):string;
    //function GetM97_DownDesc(YyyyMm:string;Index:integer;default:char):char;          //取得系统参数

    function SelfStrCat(str:string;num:integer=10;sub:char='0'):string;
    procedure ShowModalForm(FormClass: TFormClass);     //创建并显示一个模式窗体
    procedure Write_log;                                //写日志文件
  end;

var
  SysDM: TSysDM;

implementation

uses systemPH,systemLoginFM;

{$R *.DFM}

///////////////////////////////////////////////////////////////////
//私有函数
///////////////////////////////////////////////////////////////////

function TsysDM.GetLocalComputerName : String;
var
  temp_str : String;
  buf  : array [0..255] of Char;
  name_len :DWord;
begin
  result := '';
  name_len:=255;
  if GetComputerName(@buf,name_len)=true then
    temp_str := buf
  else
    temp_Str := '<Error>' ;
  result := temp_Str ;
end;

function TsysDM.GetLocalIP : string;
type
  TaPInAddr = array [0..10] of PInAddr;
  PaPInAddr = ^TaPInAddr;
var
  phe  : PHostEnt;
  pptr : PaPInAddr;
  Buffer : array [0..63] of char;
  I    : Integer;
  GInitData      : TWSADATA;
begin
  WSAStartup($101, GInitData);
  Result := '';
  GetHostName(Buffer, SizeOf(Buffer));
  phe :=GetHostByName(buffer);
  if phe = nil then Exit;
  pptr := PaPInAddr(Phe^.h_addr_list);
  I := 0;
  while pptr^[I] <> nil do begin
    result:=StrPas(inet_ntoa(pptr^[I]^));
    Inc(I);
  end;
  WSACleanup;
end;

function TsysDM.GetAppName :string;
begin
  result:=SystemConst_AppName;
end;

function TsysDM.GetAppVer :string;
begin
  result:=SystemConst_AppVer;
end;

function TsysDM.GetAppExplain :string;
var
  sTemp:string;
begin
  case StrToInt(GetParam('TopBureauType','1')) of
    1: sTemp:=GetParam('TopBureauName','');
    2: sTemp:=GetParam('CurBureauName','');
  end;
  //result:=ReadIni('system','Title','')+SystemConst_AppExplain;
  result:=sTemp+ReadIni('system','Title','')+SystemConst_AppExplain;
end;

function TsysDM.GetExeName :string;
var
  sTemp:string;
begin
  sTemp:=ExtractFileName(Application.ExeName);
  Delete(sTemp,Pos('.',sTemp),4);
  result:=sTemp;
end;

function TsysDM.GetExePath :string;
begin
  result:=ExtractFilePath(Application.ExeName);
end;

function TsysDM.GetDBName :string;
begin
  result:=SystemConst_DatabaseName;
end;

function TsysDM.GetDBAliasName :string;
begin
  if ReadIni('system','AutoSetDBOption','true')<>'false' then
    result:=SystemConst_AliasName
  else
    result:=ReadIni('DBOption','AliasName',SystemConst_AliasName);
end;

function TsysDM.GetDBDataBaseName  :string;
begin
  if ReadIni('system','AutoSetDBOption','true')<>'false' then
    result:=SystemConst_BDEDataBaseName
  else
    result:=ReadIni('DBOption','DataBaseName',SystemConst_BDEDataBaseName);
end;

function TsysDM.GetDBServerName :string;
begin
  if ReadIni('system','AutoSetDBOption','true')<>'false' then
    result:=SystemConst_ServerName
  else
    result:=ReadIni('DBOption','ServerName',SystemConst_ServerName);
end;

function TsysDM.GetDBUserName :string;
begin
  if ReadIni('system','AutoSetDBOption','true')<>'false' then
    result:=SystemConst_UserName
  else
    result:=ReadIni('DBOption','UserName',SystemConst_UserName);
end;

function TsysDM.GetDBPassWord :string;
begin
  if ReadIni('system','AutoSetDBOption','true')<>'false' then
    result:=SystemConst_PassWord
  else
    result:=ReadIni('DBOption','PassWord',SystemConst_PassWord);
end;

function TsysDM.GetDebugstate :Boolean;
begin
  result:=SystemConst_Debugstate;
end;

function TsysDM.SQL_Querys(tempQuery:TQuery;Sql_Str:String):boolean;
begin
  result:=false;
  if Assigned(tempQuery) then
  begin
    With tempQuery do
    begin
      Close;   SQL.Clear;   SQL.Add(SQL_Str);
      try
        Prepare;   Open;    First;
        if not IsEmpty then
          result:=true;
      except
        if SystemConst_Debugstate then
          ShowMessage(SQL_Str);
      end;
    end;
  end;
end;

function TsysDM.SQL_Exec(tempQuery:TQuery;Sql_Str:String;Commit:boolean=true):boolean;
begin
  result:=false;
  if Assigned(tempQuery) then
  begin
    With tempQuery do
    begin
      Close;   SQL.Clear;   SQL.Add(SQL_Str);
      if Commit then DBMain.StartTransaction;
      try
        Prepare;   ExecSQL;
        if Commit then  DBMain.Commit;
        result:=true;
      except
        if Commit then DBMain.Rollback;
        if SystemConst_Debugstate then
          ShowMessage(SQL_Str);
      end;
    end;
  end;
end;

function TsysDM.CallLogin:boolean;
var
  frm_Login: Tfrm_Login;
begin
   //result:=true;
  //每一个应用程序均要运行此过程，以取得系统进入权限认证
  try
    Result:=False;
    Application.CreateForm(Tfrm_Login,frm_Login);
    if Assigned(frm_Login) then
    begin
      frm_Login.ShowModal;
      Result:=frm_Login.BLogin;
    end;
  finally
    frm_Login.Free;
  end;
end;

function TsysDM.CallReLogin:boolean;
var
  AppName,AppVer:string;
  frm_Login: Tfrm_Login;
begin
  ReloginFlag:=True;
  AppName := UpperCase(sysDM.AppName);
  AppVer  := Trim(sysDM.AppVer);
  //每一个应用程序均要运行此过程，以取得系统进入权限认证
  try
    Result:=False;
    Application.CreateForm(Tfrm_Login,frm_Login);
    frm_Login.BLogin := False;
    if Assigned(frm_Login) then
    begin
      frm_Login.ShowModal;
      Result:=frm_Login.BLogin;
    end;
  finally
    frm_Login.Free;
    frm_Login:=nil;
  end;
end;

function TsysDM.GetParam(ParaName:string;default:string):string;
//var
  //SQL_Str:string;
begin
  result:=default;
 { SQL_Str:=' select * from SysParam where '
          +' APPNAME = ''' + AppName + ''''
          +' AND PARANAME = ''' + ParaName + '''';
  if SQL_Querys(Qr_sysTemp,SQL_Str) then
  begin
    result:=Qr_sysTemp.FieldByName('PARAVAL').AsString;
  end;}
end;

function TsysDM.SetParam(ParaName:string;ParaVal:string):boolean;
var
  SQL_Str:string;
begin
  SQL_Str:=' select * from SysParam where '
          +' APPNAME = ''' + AppName +''''
          +' AND PARANAME = ''' + ParaName+'''';
  if SQL_Querys(Qr_sysTemp,SQL_Str) then
  begin
    SQL_Str:=' UPDATE SysParam SET '
            +' WORKID = ''' + WorkId +''','
            +' PARAVAL = ''' + ParaVal+''','
            +' EDITTIME = ''' + DateTimeToStr(Now)+''''
            +' WHERE APPNAME = ''' + AppName + ''''
            +' AND PARANAME = ''' + ParaName + '''';
    result:=SQL_Exec(Qr_sysTemp,SQL_Str);
  end else
  begin
    SQL_Str:=' INSERT INTO SysParam (WORKID,APPNAME,PARANAME,PARAVAL,PARANOTE,EDITTIME)'
            +' VALUES(''' + WorkId
            +''','''+ AppName  +''',''' + ParaName
            +''',''' + ParaVal+ ''','' '','''+ DateTimeToStr(Now)+''')';
    result:=SQL_Exec(Qr_sysTemp,SQL_Str);
  end;
end;

function TSysDM.GetSysVal(AItem:String;default:string):String;
var
    Sql_Str:String;
begin
    Result:=default;
    SQL_Str:=' select * from SysConfig where '
              +' Item = ''' + AItem + '''';
    if SQL_Querys(Qr_sysTemp,SQL_Str) then
    begin
        result:=Qr_sysTemp.FieldByName('VAL').AsString;
    end;
end;

function TsysDM.GetRoleAuth(RoleName:string;Authindex:integer):string;
var
  SQL_Str:string;
begin
  result:='';
  SQL_Str:=' select * from SysRole where '
          +' RoleName = ''' + RoleName + '''';
  if SQL_Querys(Qr_sysTemp,SQL_Str) then
    result:=copy(Qr_sysTemp.FieldByName('RoleAuth').AsString,1,1);
end;

function TsysDM.SelfStrCat(str:string;num:integer=10;sub:char='0'):string;
var
  i:integer;
begin
  result:=str;
  if Length(str)>num then Exit;
  for i:=1 to Num-Length(Str) do
  begin
    result:=sub+result;
  end;
end;

procedure TsysDM.ShowModalForm(FormClass: TFormClass);
begin
  With FormClass.Create(Application) do
  try
    ShowModal;
  finally
    Free;
  end;
end;

procedure TsysDM.Write_log;
var
  F:TextFile;
  i:integer;
begin
  AssignFile(F,ExePath+'LOG\'+ExeName+'.log');
  if FileExists(ExePath+'LOG\'+ExeName+'.log') then
    Reset(F)
  else
    ReWrite(F);
  Append(F);
  Writeln(F,'* '+DateToStr(Date)+' '+TimeToStr(Time));
  Writeln(F,'  '+Logs[0]);
  for i:=1 to Logs.Count-1 do
  begin
    Writeln(F,'  '+Logs[i]);
  end;
  Writeln(F,'');
  Logs.Clear;
  Flush(f);
  CloseFile(F);
end;

procedure TSysDM.DataModuleCreate(Sender: TObject);
begin
  if not DirectoryExists(ExePath+'Log') then CreateDir(ExePath+'Log');
  Logs:=TStringList.Create;
  with DBMain do
  begin
    Close;
    AliasName:=DBAliasName;
    DatabaseName:=DBName;
    Params.Values['DATABASE NAME']:=DBDataBaseName;
    Params.Values['SERVER NAME']:=DBServerName;
    Params.Values['USER NAME']:=DBUserName;
    Params.Values['PASSWORD']:=DBPassWord;
    try
      Open;
      FConnectFlag:=true;
    except
      FConnectFlag:=false;
    end;
   end;
  if not DBMain.Connected then exit;
  Qr_sysTemp.DatabaseName:=DBName;
  Qr_Temp.DatabaseName:=DBName;
  Qry_Gzbx.DatabaseName:=DBName;
end;

procedure TSysDM.DataModuleDestroy(Sender: TObject);
begin
  Logs.Free;
end;

end.