shareunit.pas

三層源碼,DELPHI寫的三層源碼,三層源碼,

unit shareunit;

interface

uses windows, SysUtils, JRO_TLB, forms, Graphics, adodb,
  IdHash, IdHashMessageDigest, Db, Classes, winsock;

const
//////////2006-06-05 更新  /////////////////////////////

//*********************************************************************
//*****Funid 操作常量
  public_unkonw                                         =999;
  public_add                                            =100;
  public_modify                                         =101;
  public_del                                            =102;
  public_list                                           =103;
  public_infor                                          =104;

  public_add_temp                                       =105;
  public_del_temp                                       =106;
  public_clear_temp                                     =107;
  public_list_temp                                      =108;

  public_list_sub                                       =109;
  public_copy                                           =110;
  public_rebuild                                        =111;
  public_mathall                                        =112;

  public_list_ex01                                      =113;
  public_list_ex02                                      =114;
  public_list_ex03                                      =115;
  public_list_ex04                                      =116;
  public_list_ex05                                      =117;
  public_list_ex06                                      =118;
  public_list_ex07                                      =119;
  public_list_ex08                                      =120;

  private_infor_ext01                                   =900;
  private_infor_ext02                                   =901;
  private_change_passwd                                 =990;
  private_check_passwd                                  =991;


//*****Query 查询常量
  Query_unknow                                          =999;
  Query_user                                            =110;    //1--5
  Query_dept                                            =120;    //6-10
  Query_Parchives                                       =130;    //11-15
  Query_dormitory                                       =160;    //26--30
  Query_event                                           =210;    //46--50
  Query_sysother                                        =250;
  Query_cess                                            =260;    //66--70
  Query_medicare                                        =270;    //71--75
  Query_insurance                                       =280;    //76--80
  Query_incometax                                       =290;    //81--85
//*********************************************************************
//*****authority 权限
  authority_blank                                       ='00000000000000000000'+
                                                         '00000000000000000000'+
                                                         '00000000000000000000'+
                                                         '00000000000000000000'+
                                                         '00000000000000000000'+
                                                         '00000000000000000000';
//*********************************************************************
function getmycomputer: string;
function GetIP(Name: string): string;
function getparamitem(params,item:widestring):string;
function makeparams(funid,param:string):string;  //组合字符
function clearenter(s:string):string; // 删除回车符..
procedure deltempdata(adoconn:tadoconnection);
function CompactAndRepair: Boolean;
procedure formonpaint(sender: tform);

function monthday(m:word):word;
function mothtoday(y,m:word):word;
function datetomoth(d1:tdatetime):integer;
function makemothday(d1:tdatetime;first:boolean):tdatetime;
function makeyearday(d1: tdatetime; first: boolean): tdatetime;
function md5encode(s:string):string;
function XorEncode(const Key, Source: string): String;
function XorDecode(const Key, Source: string): String;
function nextyear(d:tdatetime):tdatetime;
function nextmonth(d:tdatetime):tdatetime;
function lastyear(d:tdatetime):tdatetime;
function lastmonth(d:tdatetime):tdatetime;
function datemonthtoday(d:tdatetime):integer;
function datetoweek(d1:tdatetime):string;
function datetoyear(d1:tdatetime):string;
function datetostring(d1:tdatetime):string;
function datetoyears(d1:tdatetime;first:boolean):tdatetime;
function parsecomstring(source,key:string;number:integer):string;
function maketdate(d1:tdatetime;m,d:word):tdatetime;
function makedateday(d: tdatetime; n: integer): tdatetime;
function getmarch_srart:string;
function getmarch_end:string;
function getyear_start:string;
function getyear_end:string;
function checkisnewarithmetic(d:tdatetime):boolean;

var datapath,
  overtime_max,
  overtime_min: string;
  pubbitmap: tbitmap;
  clientsum,nx: integer;
  logmemo: tstringlist;
  
implementation

function getmycomputer: string;
var name: pchar;
  len: ^dword;
begin
  GetMem(Name, 255);
  New(Len); Len^ := 255;
  GetComputerName(Name, Len^);
  result := StrPas(Name);
  freemem(name, 255);
  dispose(len);
end;

function GetIP(Name: string): string;
type
  TaPInAddr = array[0..10] of PInAddr;
  PaPInAddr = ^TaPInAddr;
var
  phe: PHostEnt;
  pptr: PaPInAddr;
  GInitData: TWSADATA;
begin
  WSAStartup($101, GInitData);
  Result := '';
  phe := GetHostByName(pchar(Name));
  pptr := PaPInAddr(Phe^.h_addr_list);
  result := StrPas(inet_ntoa(pptr^[0]^));
  WSACleanup;
end;

//  窗体渲染....

procedure formonpaint(sender: tform);
var rect: trect;
begin
  rect.Left := 0; rect.top := 0;
  rect.Right := sender.Width;
  rect.Bottom := sender.Height;
  sender.canvas.StretchDraw(rect, pubbitmap);
end;

function md5encode(s:string):string;
Var
  Digest: T4x4LongWordRecord;
  Sx,s1: String;
  i: Integer;
begin
  SetLength(Sx, 16);
   with TIdHashMessageDigest5.Create do
     begin
     Digest := HashValue(s);
     Move(Digest, Sx[1], 16);
     Free;
     end;
  for i := 1 to Length(Sx) do
    S1 := S1 + Format('%02x', [Byte(Sx[i])]);
  while Pos(' ', S1) > 0 do S1[Pos(' ', S1)] := '0';
result:=s1;
end;

function maketdate(d1:tdatetime;m,d:word):tdatetime;
var y1,m1,ds:word;
begin
decodedate(d1,y1,m1,ds);
result:=encodedate(y1,m,d);
end;

function datetostring(d1:tdatetime):string;
var y,m,d:word;
begin
decodedate(d1,y,m,d);
result:=inttostr(y)+'年'+inttostr(m)+'月份';
end;

function datetoweek(d1:tdatetime):string;
var s:String;
begin
case DayOfWeek(d1) of
  1:s:='天';
  2:s:='一';
  3:s:='二';
  4:s:='三';
  5:s:='四';
  6:s:='五';
  7:s:='六';
  end;
result:='星期'+s;
end;

function datetoyear(d1:tdatetime):string;
var y,m,d:word;
begin
decodedate(d1,y,m,d);
result:=inttostr(y);
end;

function XorEncode(const Key, Source: string): String;
var
  I: Integer;
  C: Byte;
begin
  Result := '';
  for I := 1 to Length(Source) do begin
    if Length(Key) > 0 then
      C := Byte(Key[1 + ((I - 1) mod Length(Key))]) xor Byte(Source[I])
    else
      C := Byte(Source[I]);
    Result := Result + AnsiLowerCase(IntToHex(C, 2));
  end;
end;

function XorDecode(const Key, Source: string): String;
var
  I: Integer;
  C: Char;
begin
  Result := '';
  for I := 0 to Length(Source) div 2 - 1 do begin
    C := Chr(StrToIntDef('$' + Copy(Source, (I * 2) + 1, 2), Ord(' ')));
    if Length(Key) > 0 then
      C := Chr(Byte(Key[1 + (I mod Length(Key))]) xor Byte(C));
    Result := Result + C;
  end;
end;


// 退出执行数据清理..
procedure deltempdata(adoconn:tadoconnection);
var querys:tadoquery;
begin
try
querys:=tadoquery.create(nil);
querys.Connection:=adoconn;

  try
  adoconn.Connected:=true;
  adoconn.BeginTrans;

  querys.close;
  querys.sql.clear;
  querys.sql.add('delete from d_temp');
  querys.ExecSQL;

  adoconn.CommitTrans;
  except
  adoconn.RollbackTrans;
  end;

finally
querys.close;
adoconn.Connected:=false;
freeandnil(querys);
end;
end;

// 数据压缩并且修复....

function CompactAndRepair: Boolean;
const
  sProvider = 'Provider=Microsoft.Jet.OLEDB.4.0;';
var
  oJetEng: JetEngine;
  sOldMDB, sNewMDB: string;
begin

  sOldMDB := sProvider + 'Data Source=' + datapath + 'salary.mdb';
  sNewMDB := sProvider + 'Data Source=' + datapath + 'temps.mdb';

  try
    oJetEng := CoJetEngine.Create;
    DeleteFile(datapath + 'temps.mdb');
    oJetEng.CompactDatabase(soldmdb, snewmdb);
    ojeteng := nil;
    if DeleteFile(datapath + 'salary.mdb') then
      RenameFile(datapath + 'temps.mdb', datapath + 'salary.mdb');
    Result := True;
  except
    ojeteng := nil;
    Result := False;
  end;
end;

function makedateday(d: tdatetime; n: integer): tdatetime;
var y, m, r: word;
begin
  decodedate(d, y, m, r);
  result := encodedate(y, m, n);
end;

function datetopiret(d1:tdatetime):tdatetime;
var y,m,d:word;
begin
decodedate(d1,y,m,d);
result:=d1-d;
end;

function checkisnewarithmetic(d:tdatetime):boolean;
begin
result:=d>=encodedate(2006,07,01)
end;

function monthday(m:word):word;
var y,d:word;
begin
decodedate(date,y,d,d);
result:=mothtoday(y,m);
end;

function mothtoday(y, m: word): word;
var n: integer;
begin
  n := 0;
  case m of
    1: n := 31;
    2: begin
        if ((y mod 4) = 0) and ((y mod 100) > 0) then
          n := 29 else n := 28;
      end;
    3: n := 31;
    4: n := 30;
    5: n := 31;
    6: n := 30;
    7: n := 31;
    8: n := 31;
    9: n := 30;
    10: n := 31;
    11: n := 30;
    12: n := 31;
  end;
  result := n;
end;

function getmarch_srart:string;
var d1:tdatetime;
    y,m,d:word;
begin
decodedate(date,y,m,d);
if m>4 then m:=m-4
       else begin
       y:=y-1;
       m:=12+m-4;
       end;
d1:=encodedate(y,m,2);
result:=datetostr(d1);
end;

function getmarch_end:string;
var d1:tdatetime;
    y,m,d:word;
begin
decodedate(date,y,m,d);
if m>3 then m:=m-3
       else begin
       y:=y-1;
       m:=12+m-3;
       end;
d1:=encodedate(y,m,1);
result:=datetostr(d1);
end;

function getyear_start:string;
var d1:tdatetime;
    y,m,d:word;
begin
decodedate(date,y,m,d);
y:=y-1;
d1:=encodedate(y,m,1);
result:=datetostr(d1);
end;

function getyear_end:string;
var d1:tdatetime;
    y,m,d:word;
begin
decodedate(date,y,m,d);
y:=y-1;
d1:=encodedate(y,m,mothtoday(y,m));
result:=datetostr(d1);
end;

function monthtodate(m: integer): tdatetime;
var y, d: word;
begin
  decodedate(date, y, d, d);
  result := encodedate(y, m, 1);
end;

function datemonthtoday(d: tdatetime): integer;
var y, m, r: word;
begin
  decodedate(d, y, m, r);
  result := mothtoday(y, m);
end;

function makemothday(d1: tdatetime; first: boolean): tdatetime;
var y, m, d: word;
begin
  decodedate(d1, y, m, d);
  if first then
    result := encodedate(y, m, 1) else
    result := encodedate(y, m, mothtoday(y, m));
end;

function makeyearday(d1: tdatetime; first: boolean): tdatetime;
var y, m, d: word;
begin
  decodedate(d1, y, m, d);
  if first then
    result := encodedate(y, 1, 1) else
    result := encodedate(y, 12, 31);
end;

function makeaddday(d1: tdatetime; n: integer): tdatetime;
var y, m, d: word;
  k: integer;
begin
  while n > 0 do
  begin
    decodedate(d1, y, m, d);
    k := mothtoday(y, m);
    if k >= n + d then
    begin
      d1 := encodedate(y, m, n + d);
      n := 0;
    end else begin
      n := n - (k - d) - 1;
      d1 := encodedate(y, m + 1, 1);
    end;
  end;
  result := d1;
end;

function datetomoth(d1: tdatetime): integer;
var y, m, d: word;
begin
  decodedate(d1, y, m, d);
  result := m;
end;


function lastyear(d:tdatetime):tdatetime;
var y,m,ds:word;
begin
decodedate(d,y,m,ds);
result:=encodedate(y-1,m,ds);
end;

function nextyear(d:tdatetime):tdatetime;
var y,m,ds:word;
begin
decodedate(d,y,m,ds);
result:=encodedate(y+1,m,ds);
end;

function nextmonth(d:tdatetime):tdatetime;
var y,m,ds:word;
begin
decodedate(d,y,m,ds);
result:=encodedate(y,m+1,ds);
end;

function lastmonth(d:tdatetime):tdatetime;
var y,m,ds:word;
begin
decodedate(d,y,m,ds);
m:=m-1;
if m=0 then
  begin
  y:=y-1;
  m:=12;
  end;
result:=encodedate(y,m,1);
end;

function datetoyears(d1:tdatetime;first:boolean):tdatetime;
var y,m,d:word;
begin
decodedate(d1,y,m,d);
if first then result:=encodedate(y,1,1)
         else result:=encodedate(y,12,31);
end;

function yearmothto(d1, d2: tdatetime): string;
var y, y2, m, m2, d, ds: word;
begin
  result := '0';
  decodedate(d1, y, m, d);
  decodedate(d2, y2, m2, ds);
  if (y = y2) and (m = m2) then result := inttostr(m);
  if (y = y2) and (m <> m2) then result := inttostr(m) + '/' + inttostr(m2);
end;

function yearmothtoday(y, m: integer): integer;
var i, k: integer;
begin
  k := 0;
  if m - 1 > 0 then
    for i := 1 to m - 1 do
      k := k + mothtoday(y, i);
  result := k;
end;

function yeartoday(n: integer): integer;
var i, k: integer;
begin
  k := 0;
  for i := 1 to n do
    if ((i mod 4) = 0) and ((i mod 100) > 0) then
      k := k + 366 else k := k + 365;
  result := k;
end;

function parsecomstring(source,key:string;number:integer):string;
var s:string;n,i:integer;
begin
result:='';
for i:=1 to number do
  begin
  n:=pos(key,source);
  if n>0 then
    begin
    s:=copy(source,1,n-1);
    delete(source,1,n);
    end else break;
  end;
result:=s;
end;
//-------------------------------------------------------------------
//  解析分离 params
//-------------------------------------------------------------------
//------------------------------------------------------------
function replaceSQLstr(s:String):string;  //替换 * 为 %
var i,n:integer;
begin
n:=length(s);
if n>0 then
for i:=1 to n do
  begin
  if s[i]='*' then s[i]:='%';
  if s[i]='?' then s[i]:='_';
  end;
result:=s;
end;

function makeparams(funid,param:string):string;  //组合字符
begin
result:=clearenter(Concat(funid,'=',param));
end;

function clearenter(s:string):string; // 删除回车符..
var i:integer;
begin
if length(s)>0 then
for i:=length(s) downto 1 do
  if ord(s[i])in[10,13] then delete(s,i,1);
result:=trim(s);
end;

function getparamitem(params,item:widestring):string;
var mm:tstringlist;
    i,n:integer;s:string;
begin
result:='';
item:=item+'=';
try
mm:=tstringlist.create;
mm.Text:=params;
if mm.Count>0 then
for i:=1 to mm.count do
  begin
  s:=mm.Strings[i-1];
  n:=pos(item,s);
  if n=1 then
     begin
     delete(s,1,length(item));
     result:=s;
     break;
     end;
  end;
finally
mm.clear;
freeandnil(mm);
end;
end;

initialization
logmemo:=tstringlist.create;
DateSeparator:='-';
ShortDateFormat:='yyyy-mm-dd';
finalization
logmemo.SaveToFile('history.log');
freeandnil(logmemo);
end.