wellrsgl.prg

一套难绝对能编译的人事系统,界面漂亮,构思新颖,

* -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
*  文件名: WELLRSGL.PRG(主文件) <-- 本文件由 UnFoxAll 创建
* -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-


 _SCREEN.VISIBLE = .F.
 _SCREEN.CAPTION = '公司——人事管理系统'
 DO CHECKDOUBLE
 DO CHECKFILE
 DO FORMATSET
 _SCREEN.VISIBLE = .T.
 _SCREEN.AUTOCENTER = .T.
 DO FORM login
 RELEASE LOGIN
 IF _SCREEN.LOGINCODE
    _SCREEN.WINDOWSTATE = 2
    _SCREEN.CLOSABLE = .T.
    _SCREEN.MAXBUTTON = .T.
    _SCREEN.MINBUTTON = .T.
    DO MAINMENU
    READ EVENTS 
 ENDIF 
 DECLARE INTEGER CloseHandle IN kernel32.Dll INTEGER 
 = CLOSEHANDLE(_SCREEN.FILEMAPHANDLE)
 DO CLEARIMAGE
 CLEAR DLLS
 CLEAR ALL
 RELEASE ALL
 CLOSE ALL
 CLEAR PROGRAM
 ON SHUTDOWN 
 QUIT 

PROCEDURE formatset
 PUBLIC IMAGETEMP( 21 )
 WITH _SCREEN  
  .ADDPROPERTY('logincode')
  .ADDPROPERTY('currentuser')
  .ADDPROPERTY('currentwide')
 ENDWITH 
 FOR I = 1 TO 21
    IMAGETEMP( I ) =  ;
         SYS(2023) + '\' + '~' + SUBSTR(SYS(2015),8) + SUBSTR(SYS(3),5) + '.tmp'
 ENDFOR 
 SET TALK OFF
 SET ESCAPE OFF
 SET SAFETY OFF
 SET STATUS OFF
 SET MEMOWIDTH TO 120
 SET MULTILOCKS ON
 SET DELETED ON
 SET EXCLUSIVE OFF
 SET NOTIFY OFF
 SET BELL OFF
 SET NEAR OFF
 SET EXACT OFF
 SET CONFIRM ON
 SET COMPATIBLE OFF
 SET ESCAPE OFF
 SET ECHO OFF
 ON SHUTDOWN do quitsystem
ENDPROC
*------
PROCEDURE quitsystem
 IF MESSAGEBOX('    确认退出人事管理系统？     ',292,'人事管理系统退出') = 6
    CLEAR EVENTS 
 ENDIF 
ENDPROC
*------
PROCEDURE packfile
 LPARAMETER C_TFILE , C_FILENAMES
 LOCAL HANDLEA , HANDLEB , FILESIZE , MATTER , I , FILESUM
 HANDLEA = FCREATE(C_TFILE)
 FILESUM = ALEN(C_FILENAMES)
 FOR I = 1 TO FILESUM
    HANDLEB = FOPEN(C_FILENAMES(I))
    FILESIZE = FSEEK(HANDLEB,0,2)
    = FSEEK(HANDLEB,0)
    MATTER = FREAD(HANDLEB,FILESIZE)
    = FCLOSE(HANDLEB)
    = FWRITE(HANDLEA,STR(FILESIZE,8) + MATTER)
 ENDFOR 
 = FCLOSE(HANDLEA)
ENDPROC
*------
PROCEDURE distillfile
 LPARAMETER C_SFILE , C_TFILES , C_FILELOC , C_FLAG
 LOCAL HANDLEA , HANDLEB , FILESIZE , MATTER , I , N , TMPA , TMPB
 HANDLEA = FOPEN(C_SFILE)
 STORE 1 TO I , N
 IF C_FLAG
    TMPA = C_FILELOC(1)
    TMPB = C_TFILES(1)
 ELSE 
    TMPA = C_FILELOC
    TMPB = C_TFILES
 ENDIF 
 DO WHILE  .NOT. FEOF(HANDLEA)
    FILESIZE = VAL((FREAD(HANDLEA,8)))
    IF N = TMPA
       MATTER = FREAD(HANDLEA,FILESIZE)
       HANDLEB = FCREATE(TMPB)
       IF HANDLEB < 0
          EXIT 
       ENDIF 
       = FWRITE(HANDLEB,MATTER)
       = FCLOSE(HANDLEB)
       IF  .NOT. C_FLAG .OR. I = ALEN(C_TFILES)
          EXIT 
       ELSE 
          I = I + 1
          TMPA = C_FILELOC(I)
          TMPB = C_TFILES(I)
       ENDIF 
    ELSE 
       = FSEEK(HANDLEA,FILESIZE,1)
    ENDIF 
    N = N + 1
 ENDDO 
 = FCLOSE(HANDLEA)
ENDPROC
*------
PROCEDURE backupfile
 LPARAMETER FILENAME
 LOCAL SAVEFILE1 , SAVEFILE2 , SAVEFILE3 , SAVEFILE4 , SAVEFILE5 , BFDATE , MINIDATE ,  ;
      MINIFILE
 IF  .NOT. DIRECTORY('bak')
    MD 'BAK'
 ENDIF 
 SAVEFILE1 = '.\bak\' + SUBSTR(FILENAME,1,LENC(FILENAME) - 4) + '.bf1'
 SAVEFILE2 = '.\bak\' + SUBSTR(FILENAME,1,LENC(FILENAME) - 4) + '.bf2'
 SAVEFILE3 = '.\bak\' + SUBSTR(FILENAME,1,LENC(FILENAME) - 4) + '.bf3'
 SAVEFILE4 = '.\bak\' + SUBSTR(FILENAME,1,LENC(FILENAME) - 4) + '.bf4'
 SAVEFILE5 = '.\bak\' + SUBSTR(FILENAME,1,LENC(FILENAME) - 4) + '.bf5'
 DO CASE 
 CASE  .NOT. FILE(SAVEFILE1)
    COPY File (FILENAME) TO (SAVEFILE1)
 CASE  .NOT. FILE(SAVEFILE2)
    COPY File (FILENAME) TO (SAVEFILE2)
 CASE  .NOT. FILE(SAVEFILE3)
    COPY File (FILENAME) TO (SAVEFILE3)
 CASE  .NOT. FILE(SAVEFILE4)
    COPY File (FILENAME) TO (SAVEFILE4)
 CASE  .NOT. FILE(SAVEFILE5)
    COPY File (FILENAME) TO (SAVEFILE5)
 OTHERWISE 
    MINIDATE = FDATE(SAVEFILE1,1)
    MINIFILE = SAVEFILE1
    BFDATE = FDATE(SAVEFILE2,1)
    IF MINIDATE > BFDATE
       MINIDATE = BFDATE
       MINIFILE = SAVEFILE2
    ENDIF 
    BFDATE = FDATE(SAVEFILE3,1)
    IF MINIDATE > BFDATE
       MINIDATE = BFDATE
       MINIFILE = SAVEFILE3
    ENDIF 
    BFDATE = FDATE(SAVEFILE4,1)
    IF MINIDATE > BFDATE
       MINIDATE = BFDATE
       MINIFILE = SAVEFILE4
    ENDIF 
    BFDATE = FDATE(SAVEFILE5,1)
    IF MINIDATE > BFDATE
       MINIFILE = SAVEFILE5
    ENDIF 
    DO CLEAFILE WITH MINIFILE
    ERASE (MINIFILE)
    COPY File (FILENAME) TO (MINIFILE)
 ENDCASE 
ENDPROC
*------
PROCEDURE cleafile
 PARAMETER FILENAME
 LOCAL HANDLE
 HANDLE = FOPEN(FILENAME,12)
 = FCHSIZE(HANDLE,1)
 = FSEEK(HANDLE,0)
 = FWRITE(HANDLE,CHR(26))
 = FCLOSE(HANDLE)
 ERASE (FILENAME)
ENDPROC
*------
PROCEDURE mainmenu
 SET SYSMENU ON
 SET SYSMENU TO
 SET SYSMENU AUTOMATIC 
 DEFINE PAD PAD1 OF _MSYSMENU PROMPT '系统（\<S）' MESSAGE  ;
      '更改用户身份重新登陆系统、打印人员资料或者退出系统' COLOR SCHEME 3 KEY ALT+S , ''
 DEFINE PAD PAD2 OF _MSYSMENU PROMPT '人事管理（\<R）' MESSAGE  ;
      '添加、查询或者修改人员记录' SKIP FOR SUBSTR(CHREN(_SCREEN.CURRENTWIDE,0),16,1) = '1' COLOR  ;
      SCHEME 3 KEY ALT+R , ''
 DEFINE PAD PAD3 OF _MSYSMENU PROMPT '专家管理（\<A）' MESSAGE  ;
      '本软件系统的使用人员管理、所提供的其他功能及相关参数设定' COLOR SCHEME 3 KEY ALT+A , ''
 DEFINE PAD PAD4 OF _MSYSMENU PROMPT '帮助（\<H）' MESSAGE '人事管理系统使用说明' COLOR  ;
      SCHEME 3 KEY ALT+H , ''
 ON PAD PAD1 OF _MSYSMENU ACTIVATE POPUP SYSPAD
 ON PAD PAD2 OF _MSYSMENU ACTIVATE POPUP WELLRSGL
 ON PAD PAD3 OF _MSYSMENU ACTIVATE POPUP ADMINISTRA
 ON PAD PAD4 OF _MSYSMENU ACTIVATE POPUP SYSTEM_HELP
 DEFINE POPUP SYSPAD COLOR SCHEME 4 SHADOW MARGIN RELATIVE 
 DEFINE BAR 1 OF SYSPAD PROMPT '注销（\<L）' MESSAGE '更改用户身份' KEY CTRL+L , ''
 DEFINE BAR 2 OF SYSPAD PROMPT '\-'
 DEFINE BAR 3 OF SYSPAD PROMPT '修改资料（\<G）' MESSAGE '修改你在系统记录中的个人资料'  ;
      SKIP FOR  ;
      (SUBSTR(CHREN(_SCREEN.CURRENTWIDE,0),3,1) = '2' .OR.  ;
_SCREEN.CURRENTUSER == 'ADMINISTRATOR') KEY CTRL+G , ''
 DEFINE BAR 4 OF SYSPAD PROMPT '更改密码（\<M）' MESSAGE '更改你个人用于登陆系统的密码'  ;
      SKIP FOR SUBSTR(CHREN(_SCREEN.CURRENTWIDE,0),2,1) = '2' KEY CTRL+M ,  ;
      ''
 DEFINE BAR 5 OF SYSPAD PROMPT '\-'
 DEFINE BAR 6 OF SYSPAD PROMPT '打印 （\<P）' MESSAGE '打印人员资料' SKIP FOR  ;
      SUBSTR(CHREN(_SCREEN.CURRENTWIDE,0),14,1) = '2' KEY CTRL+P , ''
 DEFINE BAR 7 OF SYSPAD PROMPT '打印设置（\<S）' MESSAGE '设置打印机打印参数' SKIP FOR  ;
      SUBSTR(CHREN(_SCREEN.CURRENTWIDE,0),14,1) = '2' KEY CTRL+S , ''
 DEFINE BAR 8 OF SYSPAD PROMPT '\-'
 DEFINE BAR 9 OF SYSPAD PROMPT '退出系统（\<Q )' MESSAGE '退出人事管理系统' KEY ALT+F4 ,  ;
      ''
 ON SELECTION BAR 1 OF SYSPAD DO relogin
 ON SELECTION BAR 3 OF SYSPAD DO Cginfomation
 ON SELECTION BAR 4 OF SYSPAD DO form cgpaswd_user
 ON SELECTION BAR 7 OF SYSPAD DO printset
 ON SELECTION BAR 9 OF SYSPAD quit
 DEFINE POPUP WELLRSGL COLOR SCHEME 4 SHADOW MARGIN RELATIVE 
 DEFINE BAR 1 OF WELLRSGL PROMPT '添加（\<A）' MESSAGE '添加新的人员记录' SKIP FOR  ;
      SUBSTR(CHREN(_SCREEN.CURRENTWIDE,0),4,1) = '2' KEY CTRL+A , ''
 DEFINE BAR 2 OF WELLRSGL PROMPT '修改（\<C）' MESSAGE  ;
      '删除或修改当前或者指定的人员记录' SKIP FOR SUBSTR(CHREN(_SCREEN.CURRENTWIDE,0),6,1) = '2' KEY CTRL+C ,  ;
      ''
 DEFINE BAR 3 OF WELLRSGL PROMPT '查询（\<X）' MESSAGE '查阅当前部门的人员资料' SKIP FOR  ;
      SUBSTR(CHREN(_SCREEN.CURRENTWIDE,0),5,1) = '2' KEY CTRL+X , ''
 ON SELECTION BAR 1 OF WELLRSGL DO Form newryluru
 DEFINE POPUP ADMINISTRA COLOR SCHEME 4 SHADOW MARGIN RELATIVE 
 DEFINE BAR 1 OF ADMINISTRA PROMPT '管理系统数据库(\<W)' MESSAGE  ;
      '添加、删除或更改系统使用人员的信息' SKIP FOR SUBSTR(CHREN(_SCREEN.CURRENTWIDE,0),1,1) = '2'  ;
      KEY CTRL+W , 'CTRL+W'
 DEFINE BAR 2 OF ADMINISTRA PROMPT '系统工具' MESSAGE '系统所提供的相关其他工具'
 DEFINE BAR 3 OF ADMINISTRA PROMPT '\-'
 DEFINE BAR 4 OF ADMINISTRA PROMPT '系统选项' MESSAGE '系统参数设置' SKIP FOR  ;
      SUBSTR(CHREN(_SCREEN.CURRENTWIDE,0),1,1) = '2'
 ON SELECTION BAR 1 OF ADMINISTRA DO systemmanger
 ON BAR 2 OF ADMINISTRA ACTIVATE POPUP 系统工具
 DEFINE POPUP 系统工具 COLOR SCHEME 4 SHADOW MARGIN RELATIVE 
 DEFINE BAR 1 OF 系统工具 PROMPT '备份系统数据(\<B)' MESSAGE  ;
      '将当前系统使用人员的数据进行备份，以防止系统灾难性的崩溃' SKIP FOR  ;
      SUBSTR(CHREN(_SCREEN.CURRENTWIDE,0),13,1) = '2' KEY CTRL+B , 'CTRL+B'
 DEFINE BAR 2 OF 系统工具 PROMPT '恢复以前系统数据(\<H)' MESSAGE  ;
      '指定恢复到以前所备份的系统数据状态' SKIP FOR SUBSTR(CHREN(_SCREEN.CURRENTWIDE,0),13,1) = '2'  ;
      KEY CTRL+H , 'CTRL+H'
 DEFINE BAR 3 OF 系统工具 PROMPT '\-'
 DEFINE BAR 4 OF 系统工具 PROMPT '打印人员登记表（空白）' MESSAGE '打印空白的人员登记表'  ;
      SKIP FOR SUBSTR(CHREN(_SCREEN.CURRENTWIDE,0),14,1) = '2'
 DEFINE BAR 5 OF 系统工具 PROMPT '\-'
 DEFINE BAR 6 OF 系统工具 PROMPT '热量损失及表面温度的计算' MESSAGE  ;
      '为公司所编写的计算工具'
 DEFINE BAR 7 OF 系统工具 PROMPT '福利彩抽奖机' MESSAGE '自己编写的趣味程序'
 ON SELECTION BAR 1 OF 系统工具 DO form date_bf
 ON SELECTION BAR 2 OF 系统工具 DO form date_hf
 ON SELECTION BAR 4 OF 系统工具 DO form printrydjb
 ON SELECTION BAR 6 OF 系统工具 DO form well
 ON SELECTION BAR 7 OF 系统工具 DO form flc
 DEFINE POPUP SYSTEM_HELP COLOR SCHEME 4 SHADOW MARGIN RELATIVE 
 DEFINE BAR 1 OF SYSTEM_HELP PROMPT '使用说明' MESSAGE  ;
      '详细的教会你如何使用人事管理系统' SKIP FOR SUBSTR(CHREN(_SCREEN.CURRENTWIDE,0),16,1) = '1' KEY F1 , ''
 DEFINE BAR 2 OF SYSTEM_HELP PROMPT '更新了什么？' MESSAGE '了解系统的更新进程' SKIP FOR  ;
      ( .NOT. FILE('update.DBF') .OR.  .NOT. FILE('update.FPT')) KEY F2 ,  ;
      'F2'
 DEFINE BAR 3 OF SYSTEM_HELP PROMPT '\-'
 DEFINE BAR 4 OF SYSTEM_HELP PROMPT '关于……'
 ON SELECTION BAR 2 OF SYSTEM_HELP DO form sysupdate
 ON SELECTION BAR 4 OF SYSTEM_HELP DO form sysabout
ENDPROC
*------
PROCEDURE printset
 LOCAL LCOLDERROR
 LCOLDERROR = ON('ERROR')
 ON ERROR *
 = SYS(1037)
  ON ERROR &lcOldError
ENDPROC
*------
PROCEDURE relogin
 IF MESSAGEBOX('    确实要注销吗？     ',292,'从系统注销……') = 6
    DO FORM LOGIN
    IF _SCREEN.LOGINCODE
       _SCREEN.WINDOWSTATE = 2
       _SCREEN.CLOSABLE = .T.
       _SCREEN.MAXBUTTON = .T.
       _SCREEN.MINBUTTON = .T.
       SET SYSMENU ON
       SET STATUS BAR ON
    ELSE 
       CLEAR EVENTS 
    ENDIF 
 ENDIF 
 RETURN 
ENDPROC
*------
PROCEDURE chren
 LPARAMETER C_CHRAST , C_FLAG