⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 dm.pas

📁 简单的电力计息系统(针对用友财务系统)
💻 PAS
字号:
UNIT DM;

INTERFACE

USES SysUtils, Classes, ADODB, DB, Forms, Windows, RzStatus, RzCommon,
  RzShellDialogs, Variants, Controls;

TYPE
  TAccInfo=RECORD
    ID:STRING;
    Name:STRING;
    master:STRING;
    funit:STRING;
    year:STRING;
    month:STRING;
  END;
  PAccinfo=^TAccInfo;

  TUser=RECORD
    ID:STRING;                          //登录ID
    Name:STRING;                        //姓名
    Desc:STRING;                        //描述
    Pass:STRING;                        //登录口令
    AccID:STRING;                       //权限ID
    Access:STRING;                      //权限列表 分隔符=';';
  END;
  TDataCheck=RECORD
    fh:boolean;                         //分户检测
    km:boolean;                         //科目检测
    fhdata:boolean;                     //分户数据核对
    kmdata:boolean;                     //科目发生数核对
    kmin:boolean;                       //科目末级检测
  END;

  TFDM=CLASS(TDataModule)
    aqTemp:TADOQuery;
    aqExec:TADOQuery;
    ADOCommand:TADOCommand;
    OpenDlg:TRzOpenDialog;
    SaveDlg:TRzSaveDialog;
    aqTmp:TADOQuery;
    aqShare:TADOQuery;
    aqAcc_sum:TADOQuery;
    aqAcc_Voucher:TADOQuery;
    atKM:TADOTable;
    DBConn:TADOConnection;
    aqUser:TADOQuery;
    aqKm:TADOQuery;
    aqCreateAccRate:TADOQuery;
    aqRateHz:TADOQuery;
    aqRateMx:TADOQuery;
    PROCEDURE DataModuleCreate(Sender:TObject);
    PROCEDURE DataModuleDestroy(Sender:TObject);
  PRIVATE
  PUBLIC
    FUNCTION InitDbsEnvir:integer;
    FUNCTION CreateTables:integer;
    FUNCTION OpenTables:integer;
    FUNCTION GetJDStr(aid:STRING):STRING;
    FUNCTION GetUserAccess:boolean;
    FUNCTION CheckUserAccOne(Acc:STRING):boolean;
    FUNCTION GetChangRowCount:integer;

    //取当前最大结帐会计期间
    FUNCTION GetMaxPeriod:integer;
    //取计息科目表
    FUNCTION GetRateAccCode(AData:TADOQuery):integer;
    //取帐套信息
    FUNCTION GetAccountInfo(AID: string):TAccinfo;
    //合并年度帐套名称
    FUNCTION GetYearDBName:STRING;
    FUNCTION UseYearDB:boolean;
  END;

FUNCTION InitApplication:integer;

VAR
  FDM:TFDM;
  VerInfo:TRzVersionInfo;
  InitOKConn:boolean;
  DBINI:TRzRegIniFile;
  WorkUser:TUser;
  IsLogin:boolean;
  UnitConn:TADOConnection;
  CurrPeroid, CurrAccYear, CurrAccID, CurrYearDB:STRING;
  sRateKM:STRING='209';
  bLinked:boolean=false;
  AAccInfo: TAccinfo;

CONST
  sUFSYS='UFSystem';
  sRemoteConn='SELECT a.* FROM OPENROWSET(''SQLOLEDB'',''%s'';''%s'';''%s'',''%s'')as a';
  sDataNameBase='UFDATA_%s_%s';

IMPLEMENTATION

{$R *.dfm}

{ TFDM }

USES TablesSQL, yjkConsts, yjkType, ADOFuncs, PublicFunction,
  Progress, Xfunc, Xfuncs;

//数据模块创建

FUNCTION InitApplication:integer;
VAR
  sSQL:STRING;
BEGIN
  Result:=0;
  FDM:=TFDM.Create(Application);
  Result:=1;
  TRY
    Result:=FDM.InitDbsEnvir;
    IF Result<1 THEN
    BEGIN
      MyInformation('请认真检查''环境设置''是否正确...'#13#10'然后退出程序,重新运行...');
      Application.ProcessMessages;
      exit;
    END;
  EXCEPT
    Mywarning('数据环境初始化失败...');
  END;
END;

//创建数据库及数据表
//返回值:0: 失败;
//        1: 成功;

FUNCTION TFDM.InitDbsEnvir:integer;
VAR
  sConnStr:STRING;

  FUNCTION DBConnect:integer;
  BEGIN
    sConnStr:=GetConnStr('master', YDB.ServerName, YDB.Pass, YDB.User);
    Result:=ConnectADO(DBConn, sConnStr);
  END;

BEGIN
  TRY
    {  //测试连接SQL Server, 失败则连接参数错
      Result:=DBConnect;
      if Result = 0 then
      begin
        Result:=DBConnect;
        if result = 0 then Application.Terminate;
      end;

      //连接系统数据
      sConnStr:=GetConnStr('FISSYS', YDB.ServerName, YDB.Pass, YDB.User);
      Result:=ConnectADO(DBConn, sConnStr);
      if Result = 0 then
      begin
        MyInformation('未找到帐务系统数据');
        Result:=DBConnect;
        if result = 0 then Application.Terminate;
      end;      }
  EXCEPT
    Result:=0;
  END;
  Result:=1;
END;

FUNCTION TFDM.CreateTables:integer;
VAR
  sTableName:STRING;
  iErrCount:integer;

  FUNCTION CreateTable(S, sDrop, W:STRING):boolean;
  VAR
    sErr:STRING;
  BEGIN
    Result:=(ExecSQL(ADOCommand, S)>0);
    IF NOT Result THEN
    BEGIN
      ExecSQL(ADOCommand, sDrop);
      sErr:='创建'+W+'失败!'#13#10'请检查数据库...';
      TRY
        Logs.Add(S+#13#10+sErr);
      EXCEPT
      END;
    END;
  END;

BEGIN
  Result:=0;
  TRY
    TRY
      sTableName:='Acc_Rate';
      //if Tables.IndexOf(sTableName) < 0 then
      //begin
      //  if not CreateTable(aqCreateAccRate.SQL.Text, '', '计息临时主表') then Exit;
      //end;
      ExecSQLS(ADOCommand, aqCreateAccRate.SQL);

    EXCEPT
    END;
    Result:=1;
  FINALLY
    Logs.SaveToFile(AppPath.Temp+'CreateTables.log');
    Logs.Clear;
  END;
END;

PROCEDURE TFDM.DataModuleCreate(Sender:TObject);
BEGIN
  VerInfo:=TRzVersionInfo.Create(Application);
  VerInfo.FilePath:=Application.ExeName;

  DBINI:=TRzRegIniFile.Create(Application);
  Logs:=TStringList.Create;
  Tables:=TStringList.Create;

  AppPath.Self:=ExtractFilePath(paramstr(0))+'\';
  AppPath.Backup:=AppPath.Self+'Backup\';
  AppPath.Report:=AppPath.Self+'Reports\';
  AppPath.Temp:=AppPath.Self+'Temp\';

  Xfunc.WriteRegStr('AppPath', AppPath.Self);

  IF NOT DirectoryExists(AppPath.Backup) THEN
    CreateDirectory(PChar(AppPath.Backup), NIL);
  IF NOT DirectoryExists(AppPath.Temp) THEN
    CreateDirectory(PChar(AppPath.Temp), NIL);
  IF NOT DirectoryExists(AppPath.Report) THEN
    CreateDirectory(PChar(AppPath.Report), NIL);

  YDB.ServerName:=Xfuncs.ReadRegStr('DBServerName', Application.Title);
  YDB.User:=Xfuncs.ReadRegStr('DBUser', Application.Title);
  YDB.Pass:=Xfuncs.ReadRegStr('DBPass', Application.Title, EncryptionKey);
  YDB.year:=Xfuncs.ReadRegStr('FISYEAR', Application.Title);
  YDB.ZT:=StrToStr('-', Xfuncs.ReadRegStr('FISZT', Application.Title));
END;

FUNCTION TFDM.OpenTables:integer;
VAR
  sSQL:STRING;
BEGIN
  //
END;

FUNCTION TFDM.GetJDStr(aid:STRING):STRING;
BEGIN
  IF aid='1' THEN
    Result:='贷'
  ELSE
    Result:='借';
END;

FUNCTION TFDM.GetUserAccess:boolean;
BEGIN
  Result:=aqUser.Active;
  TRY
    IF Result THEN
    BEGIN
      Result:=FDM.aqUser.Locate('chUserid', WorkUser.ID, []);
      IF Result THEN
        WorkUser.Access:='全区='+trim(aqUser.FieldValues['chAreaflag'])
          +'; 管理员='+trim(aqUser.FieldValues['chSysflag'])
      ELSE
        WorkUser.Access:='';
    END;
  EXCEPT
    Result:=false;
  END;
END;

FUNCTION TFDM.CheckUserAccOne(Acc:STRING):boolean;
BEGIN
  Result:=false;
  IF WorkUser.Access='' THEN exit;
  IF trim(Acc)='' THEN exit;

  Acc:=Acc+'=1';

  Result:=(pos(Acc, WorkUser.Access)>0);
END;

PROCEDURE TFDM.DataModuleDestroy(Sender:TObject);
BEGIN
  Logs.Free;
  Tables.Free;
END;

FUNCTION TFDM.GetChangRowCount:integer;
VAR
  S:STRING;
BEGIN
  S:='select @@RowCount as Rows ';
  TRY
    TRY
      OpenQuery(FDM.aqTmp, S);
      Result:=FDM.aqTmp.FieldValues['Rows'];
    EXCEPT
      Result:=0;
    END;
  FINALLY
    FDM.aqTmp.Close;
  END;
END;

FUNCTION TFDM.GetMaxPeriod:integer;
VAR sSQL:STRING;
BEGIN
  Result:=0;

  sSQL:='select iperiod, bflag from '+CurrYearDB+'..gl_mend where bflag=1 order by iperiod desc';

  TRY
    OpenSQL(FDM.aqTemp, sSQL);
    IF FDM.aqTemp.RecordCount>0 THEN
      Result:=FDM.aqTemp.FieldByName('iperiod').asInteger;
  FINALLY
    FDM.aqTemp.Close;
  END;
END;

FUNCTION TFDM.GetRateAccCode(AData:TADOQuery):integer;
VAR sSQL:STRING;
BEGIN
  Result:=0;

  IF AData=NIL THEN exit;

  sSQL:='select cclass as 类型, ccode as 编码, ccode_name as 名称, igrade as 级次, bend as 末级, bclose as 启用'
    +' from '+CurrYearDB+'..code '
    +' where bclose=0 and ccode like '''+sRateKM+'%'''
    +' order by ccode, cclass';

  TRY
    OpenSQL(AData, sSQL);
    Result:=AData.RecordCount;
  EXCEPT
    Mywarning('取科目信息失败.....');
  END;
END;

FUNCTION TFDM.GetAccountInfo(AID: string):TAccinfo;
VAR sSQL:STRING;
BEGIN
  sSQL:='select cAcc_Id, cAcc_Name, iYear, iMonth, cUnitName, cAcc_master '
    +' from '+sUFSYS+'..UA_Account '
    +' where cAcc_Id='+AID
    +' order by cAcc_Id ';

  TRY
    OpenSQL(FDM.aqTemp, sSQL);
    if FDM.aqTemp.RecordCount=1 then
    begin
      result.Name:=FDM.aqTemp.FieldByName('cAcc_Name').AsString;
      result.master:=FDM.aqTemp.FieldByName('cAcc_master').AsString;
      result.funit:=FDM.aqTemp.FieldByName('cUnitName').AsString;
      result.year:=FDM.aqTemp.FieldByName('iYear').AsString;
      result.month:=FDM.aqTemp.FieldByName('iMonth').AsString;
    end;
  FINALLY
    FDM.aqTemp.Close;
  END;
END;

FUNCTION TFDM.GetYearDBName:STRING;
BEGIN
  Result:=Format(sDataNameBase, [CurrAccID, CurrAccYear]);
END;

FUNCTION TFDM.UseYearDB:boolean;
VAR S1:STRING;
BEGIN
  Result:=false;
  IF (CurrAccID<>'')AND(CurrAccYear<>'') THEN
  BEGIN
    CurrYearDB:=GetYearDBName;

    TRY
      S1:=' use '+CurrYearDB;
      ExecSQL(FDM.ADOCommand, S1);
      Result:=true;
    EXCEPT
    END;
  END;
END;

END.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -