uglobal_fun.pas

完整的进销存系统。 设计文件及完整的源代码。 Delphi6.0

procedure cl_UserLogin;
begin
  with dm.p_update1 do
    begin
      g_sqlstr:='SELECT * FROM LOG_FILE WHERE 1=2';
      close;
      sql.Clear;
      sql.Add(g_sqlstr);
      open;
      append;
      try
        g_indate:=cl_curdt;
        fieldbyname('USERID').AsString:=g_user;
        fieldbyname('INDATE').AsDateTime:=g_indate;
        fieldbyname('USERIP').AsString:=cl_localip;
        fieldbyname('STATUS').AsString:='Y';
        post;
      except
        cancel;
      end;
      close;
    end;
end;

procedure cl_userlogout;
begin
  with dm.p_update1 do
    begin
      g_sqlstr:='SELECT * FROM LOG_FILE WHERE USERID='''+g_user+''''+
                ' AND INDATE='''+datetimetostr(g_indate)+'''';
      close;
      sql.Clear;
      sql.Add(g_sqlstr);
      open;
      if not (eof and bof) then
        begin
          edit;
          fieldbyname('OUTDATE').AsDateTime:=cl_curdt;
          fieldbyname('STATUS').AsString:='N';
          try
            post;
          except
            cancel;
          end;
          close;
        end;

    end;
end;

procedure cl_loadfunction(p_prog:string;var p_user_permission:string;
                         var p_group_permission:string);
begin
  with dm do
    begin
      pub1.Close;
      pub1.sql.Clear;
      g_sqlstr:='SELECT * FROM ZE_FILE WHERE ZE01='''+g_user+''''
                +' AND ZE02='''+p_prog+'''';
      pub1.SQL.Add(g_sqlstr);
      pub1.Open;
      P_user_permission:=pub1.fieldbyname('ZE03').AsString;
      pub1.Close;
      pub1.SQL.Clear;
      g_sqlstr:='SELECT * FROM ZE_FILE WHERE ZE01='''+g_grup+''''
                +' AND ZE02='''+p_prog+'''';
      pub1.SQL.Add(g_sqlstr);
      pub1.Open;
      p_group_permission:=pub1.fieldbyname('ZE03').AsString;
    end;
end;

procedure s_OpenForm(FormClass: TFormClass; var fm; AOwner: TComponent;
                     p_transfer:g_transfer_struct);
var
  Child: TForm;
   i: integer;
begin
  if not cl_program(p_transfer.prog) then
     begin
        MessageDlg('You haven''t the permission of ' + p_transfer.prog+'!',
                    mtWarning, [mbOK], 0);
        exit;
     end;
  for i := 0 to Screen.FormCount - 1 do
    if Screen.Forms[i].ClassType = FormClass then
    begin
      Child := Screen.Forms[i];
      if Child.WindowState = wsMinimized then
        ShowWindow(Child.handle, SW_SHOWNORMAL)
      else
        ShowWindow(Child.handle, SW_SHOWNA);
      if (not Child.Visible) then Child.Visible := True;
      Child.BringToFront;
      Child.Setfocus;
      TForm(fm) := Child;
      exit;
    end;
  Child := TForm(FormClass.NewInstance);
  TForm(fm) := Child;
  g_transfer:=p_transfer;
  Child.Create(AOwner);
end;

function  cl_title(p_program:string):string;
begin
  cl_title:=p_program;
  with dm.pub1 do
    begin
      g_sqlstr:='SELECT * FROM ZA_FILE WHERE ZA03='''+p_program+'''';
      close;
      sql.Clear;
      sql.Add(g_sqlstr);
      open;
      cl_title:=fieldbyname('ZA04').AsString+'--'+p_program;
      close;
    end;
end;

function  cl_filter(p_table:string):string;
begin
  with dm.pub1 do
    begin
      g_sqlstr:='SELECT * FROM ZH_FILE WHERE ZH01='''+p_table+'''';
      close;
      sql.Clear;
      sql.add(g_sqlstr);
      open;
      if (bof and eof)or (fieldbyname('ZH03').AsString='') then
        cl_filter:=' 1=1 '
      else
        cl_filter:=fieldbyname('ZH03').AsString;
    end;
end;

function cl_curdt:Tdatetime;
begin
//for oracle
{  with dm.pub1 do
    begin
      Close;
      sql.Clear;
      sql.Add('SELECT SYSDATE FROM DUAL'); //only for oracle
      open;
      result:=fields[0].AsDateTime;
    end;
}    
//for sqlserver
  with dm.pub1 do
    begin
      Close;
      sql.Clear;
      sql.Add('select getdate()'); //only for sqlserver
      open;
      result:=fields[0].AsDateTime;
    end;
end;

function cl_LocalIP : 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 cl_floattotime(p_begindate:Tdatetime;p_float:real):string;
var
  l_days:integer;
  l_newtime:double;
  l_prefix:double;
  l_ext:double;
  l_value:string;
  l_strext:string;
  l_strprefix:string;
  l_ext1:integer;
begin
  //把起始時間轉換為天數和第一天的時間.
  l_days:=trunc(p_float/24);             //天數
  l_newtime:=p_float-l_days*24;
  l_prefix:=trunc(l_newtime);
  l_ext:=l_newtime-l_prefix;
  l_ext:=l_ext*6*10;
  l_ext1:=round(l_ext);
  p_begindate:=p_begindate+l_days;
  l_value:=datetostr(p_begindate);

  l_strprefix:=floattostr(l_prefix);
  if length(l_strprefix)<2 then l_strprefix:='0'+l_strprefix;

  l_strext:=floattostr(l_ext1);
  if length(l_strext)<2 then   l_strext:='0'+l_strext;
  l_value:=l_value+' '+l_strprefix+':'+l_strext;
  result:=l_value+':00';
end;

function cl_timetofloat(p_time:Tdatetime):real;//time to float
var
   Hour, Min, Sec, MSec: Word;
   l_value:real;
begin
   DecodeTime(p_time, Hour, Min, Sec, MSec);
   l_value:=min/60;
   l_value:=hour+l_value;
   result:=l_value;
end;

function cl_progstr(p_str:string):string;
begin
  result:='';
  with dm.pub1 do
    begin
      g_sqlstr:='SELECT ZA03 FROM ZA_FILE WHERE ZA04='''+p_str+'''';
      close;
      sql.Clear;
      sql.Add(g_sqlstr);
      open;
      result:=fieldbyname('ZA03').AsString;
    end;
end;

function cl_program(p_prog:string):boolean;
begin
  if trim(g_user)='admin' then begin cl_program:=true; exit; end;
  with dm do
    begin
      pub1.close;
      pub1.SQL.clear;
      g_sqlstr:='SELECT * FROM ZE_FILE WHERE (ZE01='''+g_user+''''
      +'OR ZE01='''+g_grup+''') '+ ' AND ZE02='''+p_prog+'''';
      pub1.SQL.Add(g_sqlstr);
      pub1.Open;
      if pub1.Bof and pub1.Eof  then
         cl_program:=false
      else
         cl_program:=true;
    end;
end;

function  cl_prichk(p_code,p_user_permission,p_grup_permission:string):boolean;
begin
  if trim(g_user)='admin' then begin result:=true; exit; end;
  result:=false;
  p_code:=uppercase(p_code);
  p_user_permission:=uppercase(p_user_permission);
  p_grup_permission:=uppercase(p_grup_permission);
  if pos(p_code,p_user_permission)>0 then  begin result:=true; exit; end;
  if pos(p_code,p_grup_permission)>0 then begin result:=true; exit; end;
end;

procedure cl_clear_transbuffer(var p_trans:g_transfer_struct);
var i:integer;
begin
  p_trans.prog:='';
  p_trans.master:='';
  p_trans.detail:='';
  p_trans.key1:='';
  p_trans.key2:='';
  p_trans.qtable:='';
  p_trans.order:='';
  for i:=1 to 10 do
    begin
      p_trans.mpkey[i]:='';
      p_trans.mpvalue[i]:='';
      p_trans.mkey[i]:='';
      p_trans.dkey[i]:='';
    end;
end;

end.