uglobal_fun.pas

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

//  ******************************************
//  *    Unit name   : uglobal_fun           *
//  *    AUTHOR      : Guo xuliang           *
//  *    Date        : 2005/05/12            *
//  *    程序目的    :定义公共函数，子程序   *
//  ******************************************
unit uglobal_fun;

interface
uses
SysUtils,forms,Dialogs,udm,registry,windows,controls,Classes,Math,
uglobal_var,dxDBGrid,Winsock,Graphics, DBCtrls,dxDBELib,DBTables,db,variants,
dxExEdtr, dxEdLib, dxCntner, dxEditor,
StdCtrls,DateUtils;

//procedures
procedure cl_getparameter;                   //取得系統整體參數＊＊暂不用
procedure cl_inituser;                       //初試化用戶資料
procedure cl_showmsg(p_str:string);          //簡易信息顯示函數
procedure cl_chgdtfrmt;                      //修改系統當前的時間日期格式
procedure cl_dtfrmt;                         //日期時間格式
procedure cl_toexcel(p_filename:string;p_grid:TdxDBGrid);
procedure cl_setcolor(p_form:Tform);//改变控件颜色(0:normal,1:request ,2:readonly)
procedure cl_UserLogin;
procedure cl_UserLogout;
procedure cl_loadfunction(p_prog:string;var p_user_permission:string;
                         var p_group_permission:string);//取得用户&组权限
procedure s_OpenForm(FormClass: TFormClass; var fm; AOwner: TComponent;
             p_transfer:g_transfer_struct);  //窗体打开函数                         
//functions
function  cl_title(p_program:string):string; //程序說明
function  cl_filter(p_table:string):string;  //取的程序的過濾條件
function  cl_curdt:Tdatetime;                //取得當前的時間戳
function  cl_LocalIP:String;
function  cl_floattotime(p_begindate:Tdatetime;p_float:real):string;//float to time
function  cl_timetofloat(p_time:Tdatetime):real;//time to float
function  cl_progstr(p_str:string):string;      //combine the program name.
function  cl_program(p_prog:string):boolean; //判斷是否有運行程序的權限
function  cl_prichk(p_code,p_user_permission,
                    p_grup_permission:string):boolean;//判断权限。

//=================
procedure cl_clear_transbuffer(var p_trans:g_transfer_struct);



implementation

procedure cl_getparameter;
begin
  with dm.p_update1 do
    begin
      g_sqlstr:='SELECT * FROM ZF_FILE';
      close;
      sql.Clear;
      sql.Add(g_sqlstr);
      open;
      if eof and bof then
        begin
          append;
          fieldbyname('ZF01').AsString:='Y';
          fieldbyname('ZF02').AsString:=g_ver;
          fieldbyname('ZF03').AsString:='10.134.7.21';
          fieldbyname('ZF04').AsString:='ftp001';
          fieldbyname('ZF05').AsString:='pwd001';
          fieldbyname('ZF06').AsString:='21';
          post;
        end;
      g_ftp.openflag:=fieldbyname('ZF01').AsString;
      g_ftp.version:=fieldbyname('ZF02').AsString;
      g_ftp.host:=fieldbyname('ZF03').AsString;
      g_ftp.userid:=fieldbyname('ZF04').AsString;
      g_ftp.password:=fieldbyname('ZF05').AsString;
      g_ftp.port:=fieldbyname('ZF06').AsInteger;
      close;
      g_sqlstr:='SELECT * FROM ZG_FILE';
      close;
      sql.Clear;
      sql.Add(g_sqlstr);
      open;
      g_para.para01:=fieldbyname('ZG01').AsString;
      close;
    end;
end;

procedure cl_inituser;
begin
  with dm.p_update1 do
    begin
      g_sqlstr:='SELECT * FROM ZD_FILE WHERE ZD02=''admin''';
      close;
      sql.Clear;
      sql.Add(g_sqlstr);
      open;
      if bof and eof then
        begin
          append;
          fieldbyname('ZD01').AsString:='SYSTEM';
          fieldbyname('ZD02').AsString:='admin';
          fieldbyname('ZD03').AsString:='管理员';
          fieldbyname('ZD04').AsString:='ERP';
          post;
        end;
    end;
end;

procedure cl_showmsg(p_str:string);
begin
  messagedlg(p_str,mtinformation,[mbok],0);
end;

procedure cl_chgdtfrmt;
var
 regdate,regdate2:Tregistry;
 dateconf,timeconf:string;
 sDate,sDecimal,sLongDate,sTime,s1159,s2359:string;
 NLS_DATE_FORMAT:string;
 NLS_LANG:string;
begin
  regdate:=Tregistry.Create;
  regdate2:=Tregistry.Create;
  try
   regdate.RootKey := HKEY_CURRENT_USER;
   regdate2.RootKey:=HKEY_LOCAL_MACHINE;
   regdate.OpenKey('\Control Panel\International', false);
   regdate2.OpenKey('\SOFTWARE\ORACLE\HOME0',false);
   dateconf:=regdate.ReadString('sShortDate');
   timeconf:=regdate.ReadString('sTimeFormat');
   sDate:=regdate.ReadString('sDate');
   sDecimal:=regdate.ReadString('sDecimal');
   sLongDate:=regdate.ReadString('sLongDate');
   sTime:=regdate.ReadString('sTime');
   s1159:=regdate.ReadString('s1159');
   s2359:=regdate.ReadString('s2359');
   NLS_DATE_FORMAT:=regdate2.ReadString('NLS_DATE_FORMAT');
   NLS_LANG:=regdate2.ReadString('NLS_LANG');
   if (dateconf <> 'yyyy/MM/dd') or (timeconf <>'HH:mm:ss')
      or (sDate<>'/') or(sDecimal<>'.') or(sLongDate<>'yyyy/MM/dd')
      or (sTime<>':') or(s1159<>'AM') or(s2359<>'PM') or
      (NLS_DATE_FORMAT<>'YYYY/MM/DD') or (NLS_LANG<>'TRADITIONAL CHINESE_TAIWAN.ZHT16BIG5')
   then
      begin
        if RegDate.OpenKey('\Control Panel\International', true) then
           begin
              RegDate.WriteString('sShortDate', 'yyyy/MM/dd');
              RegDate.WriteString('sTimeFormat','HH:mm:ss');
              RegDate.WriteString('sDate','/');
              RegDate.WriteString('sDecimal','.');
              RegDate.WriteString('sLongDate','yyyy/MM/dd');
              RegDate.WriteString('sTime',':');
              RegDate.WriteString('s1159','AM');
              RegDate.WriteString('s2359','PM');
           end;
        RegDate2.WriteString('NLS_DATE_FORMAT','YYYY/MM/DD');
        RegDate2.WriteString('NLS_LANG','TRADITIONAL CHINESE_TAIWAN.ZHT16BIG5');
        // use select * from nls_session_parameters to verify
        // alter session set NLS_DATE_FORMAT='DateFormat'
        if messagedlg('系统已经修正本机的日期格式，需重新运行程序，确认吗?',mtInformation, [mbYes, mbNo], 0) = mrYes then
             application.Terminate;
      end;
  finally
   RegDate.CloseKey;
   RegDate2.CloseKey;
   RegDate.Free;
   RegDate2.Free;
  end;
end;

procedure cl_dtfrmt;
begin
  DateSeparator:='/';
  ShortDateFormat:='yyyy/mm/dd';
  LongDateFormat:='yyyy/mm/dd';
  TimeSeparator:=':';
  TimeAMString:='AM';
  TimePMString:='PM';
  ShortTimeFormat:='HH:mm:ss';
  LongTimeFormat:='HH:mm:ss';
  DecimalSeparator:='.';
end;

procedure cl_toexcel(p_filename:string;p_grid:TdxDBGrid);
var
  l_savedlg:TSaveDialog;
  l_str:string;
  l_grid:TdxDBGrid;
begin
  l_grid:=TdxDBGrid.Create(nil);
  l_grid:=p_grid;
  l_savedlg:=TsaveDialog.Create(nil);
  with l_savedlg do
  begin
    l_savedlg.Filter:='Excel files (*.xls)|*.XLS';
    filename:=p_filename+'.xls';
    if Execute then
    begin
        l_str:=FileName;
        l_grid.SaveToXLS(l_str,true);
    end;
  end;
  l_savedlg.Free;
end;

procedure cl_setcolor(p_form:Tform);
var i:integer;
begin
  for i:=0 to p_form.ComponentCount-1 do
    begin
    if p_form.Components[i].ClassName='TDBComboBox' then
        begin
          (p_form.Components[i] as TDBComboBox).Ctl3D := false;
          (p_form.Components[i] as TDBComboBox).BevelKind :=bkFlat;
        end;
      if p_form.Components[i].ClassName='TComboBox' then
        begin
          (p_form.Components[i] as TComboBox).Ctl3D := false;
          (p_form.Components[i] as TComboBox).BevelKind :=bkFlat;
        end;
      if p_form.Components[i].ClassName='TDBEdit' then
        begin
          (p_form.Components[i] as TDBEdit).Ctl3D := false;
          case p_form.Components[i].Tag of
            0:(p_form.Components[i] as TDBEdit).color:=clWindow;
            1:(p_form.Components[i] as TDBEdit).Color:=clSkyBlue;
            2:(p_form.Components[i] as TDBEdit).Color:=clSilver;
          end;
        end;
      if p_form.Components[i].ClassName='TdxDBEdit' then
        begin
         (p_form.Components[i] as TdxDBEdit).Style.BorderStyle :=xbsSingle;
          case p_form.Components[i].Tag of
            0:(p_form.Components[i] as TdxDBEdit).color:=clWindow;
            1:(p_form.Components[i] as TdxDBEdit).Color:=clSkyBlue;
            2:(p_form.Components[i] as TdxDBEdit).Color:=clSilver;
          end;
        end;
      if p_form.Components[i].ClassName='TdxDBMemo' then
        begin
         (p_form.Components[i] as TdxDBMemo).Style.BorderStyle :=xbsSingle;
        end;
      if p_form.Components[i].ClassName='TdxButtonEdit' then
        begin
          (p_form.Components[i] as TdxButtonEdit).Style.BorderStyle:=xbsSingle;
          (p_form.Components[i] as TdxButtonEdit).Style.ButtonStyle := btsSimple;
        end;
      if p_form.Components[i].ClassName='TdxDBButtonEdit' then
        begin
          (p_form.Components[i] as TdxDBButtonEdit).Style.BorderStyle:=xbsSingle;
          (p_form.Components[i] as TdxDBButtonEdit).Style.ButtonStyle := btsSimple;
          case p_form.Components[i].Tag of
            0:(p_form.Components[i] as TdxDBButtonEdit).Color:=clWindow;
            1:(p_form.Components[i] as TdxDBButtonEdit).Color:=clSkyBlue;
            2:(p_form.Components[i] as TdxDBButtonEdit).Color:=clSilver;
          end;
        end;
      if p_form.Components[i].ClassName='TdxDBDateEdit' then
        begin
          (p_form.Components[i] as TdxDBDateEdit).Style.BorderStyle:=xbsSingle;
          (p_form.Components[i] as TdxDBDateEdit).Style.ButtonStyle := btsSimple;
          case p_form.Components[i].Tag of
            0:(p_form.Components[i] as TdxDBDateEdit).Color:=clWindow;
            1:(p_form.Components[i] as TdxDBDateEdit).Color:=clSkyBlue;
            2:(p_form.Components[i] as TdxDBDateEdit).Color:=clSilver;
          end;
        end;
     if p_form.Components[i].ClassName='TdxDateEdit' then
        begin
          (p_form.Components[i] as TdxDateEdit).Style.BorderStyle:=xbsSingle;
          (p_form.Components[i] as TdxDateEdit).Style.ButtonStyle := btsSimple;
          case p_form.Components[i].Tag of
            0:(p_form.Components[i] as TdxDateEdit).Color:=clWindow;
            1:(p_form.Components[i] as TdxDateEdit).Color:=clSkyBlue;
            2:(p_form.Components[i] as TdxDateEdit).Color:=clSilver;
          end;
        end;
     if p_form.Components[i].ClassName='TdxTimeEdit' then
        begin
          (p_form.Components[i] as TdxTimeEdit).Style.BorderStyle:=xbsSingle;
          (p_form.Components[i] as TdxTimeEdit).Style.ButtonStyle := btsSimple;
          case p_form.Components[i].Tag of
            0:(p_form.Components[i] as TdxTimeEdit).Color:=clWindow;
            1:(p_form.Components[i] as TdxTimeEdit).Color:=clSkyBlue;
            2:(p_form.Components[i] as TdxTimeEdit).Color:=clSilver;
          end;
        end;
    end;
end;