publicfunction.pas

来自「pasa人力资源考勤管理系统」· PAS 代码 · 共 1,538 行 · 第 1/4 页

procedure mealcal(monthy:string);  //就餐汇总
var  Qry1:TADOQuery;
begin
    with datamod do
    begin
      Qry1:=TADOQuery.create(application);
      Qry1.connection:=Query1.connection;
      qry1.sql.Clear;
      qry1.sql.Add('Delete from mel05010 where rq='''+monthy+''' ');
      Qry1.SQL.add('Insert into mel05010 (rq,workno,cardno,name,deptno,totalmoney) '+
                   ' select '''+monthy+''',workno,min(cardno)as cardno,min(name) as name,min(dept) as dept,sum(price) as summoney '+
                   ' from mel04010 where left(rq,7)='''+monthy+''' group by workno ');
      qry1.ExecSQL;
      qry1.close;
    end;
end;

function addpassword(p:string):string;  //加密密码
var s,longkey,toto:string;
    i:integer;
begin
   if trim(p)<>'' then
   begin
     s:=p;
     longkey:='';
     result:='';
     for i := 0 to (length(s) div length('PASA')) do
      longkey := longkey + 'PASA';
     for i := 1 to length(s) do
     begin
      toto := chr((ord(s[i]) XOR ord(longkey[i]))); // XOR algorithm
      result := result + toto;
     end;
   end;
end;

function GetGUID(var rg1,rg2,rg3,rg4,rg5:integer):String;   //获得一个键值名
var
    PassTbl1:Array [0..10] of ShortString;
    PassTbl2:Array [0..10] of ShortString;
    PassTbl3:Array [0..10] of ShortString;
    PassTbl4:Array [0..10] of ShortString;
    PassTbl5:Array [0..10] of ShortString;
begin
  PassTbl1[0]  := 'REAKY';
  PassTbl1[1]  := 'AS09D';
  PassTbl1[2]  := 'F234F';
  PassTbl1[3]  := 'AEDQH';
  PassTbl1[4]  := 'QSERR';
  PassTbl1[5]  := 'FDHFG';
  PassTbl1[6]  := '23R6D';
  PassTbl1[7]  := 'K4GIU';
  PassTbl1[8]  := 'KLFDG';
  PassTbl1[9]  := 'VBNK6';
  PassTbl1[10] := 'FGKJ4';

  PassTbl2[0]  := 'DANNY';
  PassTbl2[1]  := 'KBHIJ';
  PassTbl2[2]  := '43656';
  PassTbl2[3]  := '45645';
  PassTbl2[4]  := 'RHGHJ';
  PassTbl2[5]  := '67876';
  PassTbl2[6]  := '768HD';
  PassTbl2[7]  := 'A68MJ';
  PassTbl2[8]  := '65456';
  PassTbl2[9]  := '4HJ9D';
  PassTbl2[10] := 'AS19D';

  PassTbl3[0]  := 'APPLE';
  PassTbl3[1]  := 'AS29M';
  PassTbl3[2]  := 'AHJLX';
  PassTbl3[3]  := 'ART98';
  PassTbl3[4]  := 'SUNN0';
  PassTbl3[5]  := 'JAMEJ';
  PassTbl3[6]  := 'PETEA';
  PassTbl3[7]  := 'DAVIG';
  PassTbl3[8]  := 'VINCK';
  PassTbl3[9]  := 'DEBB7';
  PassTbl3[10] := 'E4543';

  PassTbl4[0]  := 'VICTOR';
  PassTbl4[1]  := 'J2JNI';
  PassTbl4[2]  := 'X2CGP';
  PassTbl4[3]  := 'E04XE';
  PassTbl4[4]  := 'P6XLT';
  PassTbl4[5]  := 'AJ4UW';
  PassTbl4[6]  := '3RUVZ';
  PassTbl4[7]  := 'GN39M';
  PassTbl4[8]  := 'VU04C';
  PassTbl4[9]  := 'L3XU5';
  PassTbl4[10] := 'WUG6D';

  PassTbl5[0]  := 'APASA';
  PassTbl5[1]  := 'ZPFUL';
  PassTbl5[2]  := '6UV41';
  PassTbl5[3]  := 'QI6VU';
  PassTbl5[4]  := 'DJWP6';
  PassTbl5[5]  := 'XJ3GJ';
  PassTbl5[6]  := '4CJPU';
  PassTbl5[7]  := '82J04';
  PassTbl5[8]  := 'TJ6BP';
  PassTbl5[9]  := 'Y94WU';
  PassTbl5[10] := '86FU4';
  Randomize;
  Rg1:=Random(10);
  Rg2:=Random(10);
  Rg3:=Random(10);
  Rg4:=Random(10);
  Rg5:=Random(10);
  Result:='{'+PassTbl1[Rg1]+'-'+PassTbl2[Rg2]+'-'+PassTbl3[Rg3]+'-'+PassTbl4[Rg4]+'-'+PassTbl5[Rg5]+'}';
end;

function GetOSInfo(Var systemver:string):string;
var
  Platform: string;
  BuildNumber: Integer;
begin
  case Win32Platform of
    VER_PLATFORM_WIN32_WINDOWS:
      begin
        Platform := 'Windows 98';
        BuildNumber := Win32BuildNumber and $0000FFFF;
      end;
    VER_PLATFORM_WIN32_NT:
      begin
        Platform := 'Windows NT';
        BuildNumber := Win32BuildNumber;
      end;
      else
      begin
        Platform := 'Windows';
        BuildNumber := 0;
      end;
  end;
  systemver:=platform;
  if (Win32Platform = VER_PLATFORM_WIN32_WINDOWS) or
    (Win32Platform = VER_PLATFORM_WIN32_NT) then
  begin
    if Win32CSDVersion = '' then
       result:= Format('%s %d.%d (Build %d)', [Platform, Win32MajorVersion,
        Win32MinorVersion, BuildNumber])
    else
       result:= Format('%s %d.%d (Build %d: %s)', [Platform, Win32MajorVersion,
        Win32MinorVersion, BuildNumber, Win32CSDVersion]);
  end
  else
     result:= Format('%s %d.%d', [Platform, Win32MajorVersion,
      Win32MinorVersion])
end;

function Gettablename(sql:string):string;   //获得Select 语句中table的名字
begin
   result:='';
   sql:=lowercase(sql);
   result:=copy(sql,pos('from',sql),length(sql));
   result:=trim(result);
   if pos(' ',result)<>0 then
   result:=copy(result,pos(' ',result)+1,length(result));
   if pos(' ',result)<>0 then
   result:=copy(result,1,pos(' ',result)-1);
end;

//HOOK功能
function KeyboardHookHandler(iCode: Integer;wParam: WPARAM;
lParam: LPARAM):LRESULT;  //产生键盘Hook
const
_KeyPressMask = $80000000;
begin
   Result := 0;
   If iCode < 0 Then
   begin
     Result := CallNextHookEx(hNextHookProc,iCode,wParam,lParam);
     Exit;
   end;
   if ((lParam and _KeyPressMask) = 0) then //and
   begin
     Result := 1;
     screencount:=0;
   end;
end;

function MouseHookHandler(iCode: Integer;wParam: WPARAM;
lParam: LPARAM):LRESULT;     //产生鼠标Hook
begin
   Result := 0;
   If iCode < 0 Then
   begin
     Result := CallNextHookEx(hNextHookProc,iCode,wParam,lParam);
     Exit;
   end;
   if (wparam=WM_LBUTTONDBLCLK) or (wparam=WM_MOUSEMOVE) then
   begin
      result:=1;
      screencount:=0;
   end;
end;

function EnableHotKeyHook: BOOL;  //启动Hook
begin
  Result := False;
  if (hNextHookProc <> 0) or (hMouseHookProc <> 0) then Exit;
// 挂上 WH_KEYBOARD 类型的 HOOK  同时传回值必须保留下来免得 HOOK 呼叫链结断掉
//  hNextHookProc := SetWindowsHookEx(WH_KEYBOARD,KeyboardHookHandler,Hinstance,0);
//  hMouseHookProc := SetWindowsHookEx(WH_MOUSE,MouseHookHandler,Hinstance,0);
  Result := (hNextHookProc <> 0) and (hMouseHookProc<>0);
end;

function DisableHotKeyHook: BOOL; //关闭Hook
begin
   if hNextHookProc <> 0 then
   begin
      UnhookWindowshookEx(hNextHookProc); // 解除 Keyboard Hook
      hNextHookProc := 0;
      MessageBeep(0);
      MessageBeep(0);
    end;
    Result := hNextHookProc = 0;
end;

procedure HotKeyHookExit;         //退出Hook
begin
// 如果忘了解除 HOOK 自动代理解除的动作
   if (hNextHookProc <> 0) or (hMouseHookProc <> 0) then DisableHotKeyHook;
      ExitProc := procSaveExit;
end;
//HOOK功能

procedure GetDBGridLength(Formname:String;GridName:TDBGrid);
var len:TINIFile;
    i:integer;
begin
  len:=TINIFile.create(extractfilepath(application.exename)+'Data\Length.ini');
  for i:=0 to GridName.columns.Count-1 do
    GridName.Columns[i].Width:=len.ReadInteger(Formname+'-'+GridName.Name,GridName.Columns[i].FieldName,50);
    len.free;
end;

procedure SetDBGridLength(Formname:string;GridName:TDBGrid;TableName:TCustomADODataSet);
var len,ini:TINIFile;
    i:integer;
    s:string;
begin
   s:='';
   len:=TINIFile.create(extractfilepath(application.exename)+'Data\Length.ini');
   ini:=Tinifile.Create(extractfilepath(application.exename)+'Data\fields.ini');
   for i:=0 to GridName.columns.Count-1 do
   begin
       len.WriteInteger(Formname+'-'+GridName.Name,GridName.Columns[i].FieldName,GridName.Columns[i].Width);
       s:=s+GridName.Columns[i].FieldName+',';
   end;
   s:=copy(s,1,length(s)-1);
   ini.WriteString(Formname+'-'+TableName.name,'FieldsName',s);
   ini.Free;
   len.free;
end;
procedure GetRight(Menuname:string;Formname:TForm);  //获取当前使用者的权限资料
var i,j:integer;
    vbs:TButtonSet;
begin
   if formname.FindComponent('DBNavigator1')<>nil then
   begin
      vbs:=TDBNavigator(formname.Findcomponent('DBNavigator1')).VisibleButtons;
      for i:=0 to FuncList.Count-1 do
      begin
         if UserRight(Funclist.Items[i]^).menuname=menuname then
         begin
           UserRight(Funclist.Items[i]^).Formname:=formname;
           if UserRight(Funclist.Items[i]^).R_Add=false then vbs:=vbs-[nbinsert];
           if UserRight(Funclist.Items[i]^).R_Edit=false then vbs:=vbs-[nbedit];
           if UserRight(Funclist.Items[i]^).R_Del=false then vbs:=vbs-[nbdelete];
           if (UserRight(Funclist.Items[i]^).R_Add=false) and (UserRight(Funclist.Items[i]^).R_Edit=false) then vbs:=vbs-[nbpost,nbcancel];
         end;
      end;
      TDBNavigator(formname.Findcomponent('DBNavigator1')).VisibleButtons:=vbs;
   end else
   begin
      for j:=0 to formname.ComponentCount-1 do
      begin
         if formname.Components[j].ClassType=TDBNavigator then
         begin
           vbs:=TDBNavigator(formname.components[j]).VisibleButtons;
           for i:=0 to FuncList.Count-1 do
           begin
             if UserRight(Funclist.Items[i]^).menuname=menuname then
             begin
                UserRight(Funclist.Items[i]^).Formname:=formname;
                if UserRight(Funclist.Items[i]^).R_Add=false then vbs:=vbs-[nbinsert];
                if UserRight(Funclist.Items[i]^).R_Edit=false then vbs:=vbs-[nbedit];
                if UserRight(Funclist.Items[i]^).R_Del=false then vbs:=vbs-[nbdelete];
                if (UserRight(Funclist.Items[i]^).R_Add=false) and (UserRight(Funclist.Items[i]^).R_Edit=false) then vbs:=vbs-[nbpost,nbcancel];
             end;
           end;
           TDBNavigator(formname.components[j]).VisibleButtons:=vbs;
         end;
      end;
   end;
   if formname.FindComponent('tbnprint')<>nil then
   begin
      for i:=0 to FuncList.Count-1 do
      begin
        if UserRight(Funclist.Items[i]^).menuname=menuname then
        begin
           UserRight(Funclist.Items[i]^).Formname:=formname;
           if UserRight(Funclist.Items[i]^).R_Print=false then
             TToolButton(formname.FindComponent('tbnprint')).visible:=false;
        end;
      end;
   end;
end;

function IsRight(formname:TForm; dataset:TDataset):boolean;  //判断使用者是否具有该权限 =true表示有 =false表示无
var i:integer;
begin
  result:=false;
  for i:=0 to FuncList.Count-1 do
  begin
     if UserRight(Funclist.Items[i]^).formname=formname then
     begin
       if dataset.State=dsInsert then result:=UserRight(Funclist.Items[i]^).R_Add;
       if dataset.State=dsEdit then result:=UserRight(Funclist.Items[i]^).R_Edit;
     end;
  end;
end;

function Tax:string;
var tax:textfile;
    path,s:string;
begin
      //一次扣
    try
      result:='';
      path:=extractfilepath(application.exename)+'\data\tax.inf';
      if fileexists(path) then
      begin
          assignfile(tax,path);
          reset(tax);
          readln(tax,s);
          if Pos('=1',s)>0 then     //底薪
             result:=result+'sal21010.factbasepay+';
          readln(tax,s);
          if Pos('=1',s)>0 then     //职务津贴
             result:=result+'sal21010.factprof+';
          readln(tax,s);
          if Pos('=1',s)>0 then     //技术津贴
             result:=result+'sal21010.facttech+';
          readln(tax,s);
          if Pos('=1',s)>0 then     //部门津贴
             result:=result+'sal21010.factdept+';
          readln(tax,s);
          if Pos('=1',s)>0 then     //其它津贴1
             result:=result+'sal21010.add1+';
//          readln(tax,s);
//          if Pos('=1',s)>0 then     //其它津贴2
//             result:=result+'sal21010.money2+';
          readln(tax,s);
          if Pos('=1',s)>0 then     //奖励
             result:=result+'sal21010.rewardmoney+';
          readln(tax,s);
          if Pos('=1',s)>0 then     //全勤奖
             result:=result+'sal21010.present+';
          readln(tax,s);
          if Pos('=1',s)>0 then     //加班费
             result:=result+'sal21010.otmoney+sal21010.smoney+sal21010.yearmoney+';
          readln(tax,s);
          if Pos('=1',s)>0 then     //绩效奖金
             result:=result+'case when per24010.noname1b=0 then sal21010.noname11 else (-sal21010.noname11) end +';
          readln(tax,s);
          if Pos('=1',s)>0 then     //年节奖金
             result:=result+'case when per24010.noname2b=0 then sal21010.noname22 else (-sal21010.noname22) end ';
          readln(tax,s);
          {
          if Pos('=1',s)>0 then     //生产奖金
             result:=result+'sal21010.productmoney+';
}          closefile(tax);
          result:=copy(result,1,length(result)-1);
      end else application.messagebox('系统初始化文件tax.inf文件丢失，请采取必要的补救措失！','重大错误',mb_ok+mb_iconwarning);
    except
    end;
end;

end.