glovgroup.pas

来自「一个非常好的桑拿浴管理系统」· PAS 代码 · 共 372 行

unit GlovGroup;
// 共同使用变量 及 函数的 集合 //

interface

uses
  DBTables, DB, Dialogs, Controls, Forms, Classes, SysUtils, Grids,
  WinTypes, WinProcs, Messages, ComCtrls, ToolWin, Menus, registry;

  //  实行exe文件
  Function GFunc_ExeProject(F_ExeKey: string; F_DEST: string; F_Start: string): boolean;
  // 得出系统所在路径
  Function GFunc_RegSoftPath(F_RegKey: string; var F_RegPath: string): boolean;
  // 原本字符串中摘取倒数字段
  Function GFunc_CutString(F_Demo: string; F_Len: integer): string;
  // 输入上机日志信息
  Procedure GProc_PRGLog(P_FormName: string; var P_LDT: string; var P_LTM: string);
  // 填补上机日志信息
  Procedure GProc_PRGOut(P_LDT: string; P_LTM: string);
  // 得出现登录系统的用户名称
  Function GFunc_GetUserName(): string;
  // 用于判断日期是否正确'
  Function GFunc_DateInvalidCheck(F_InDate:String; var F_RetDate:TDateTime): boolean;
  // 判断子工具栏状态
  Procedure GProc_SubMenuState(P_MdiID: integer; var MainMenu1: TMainMenu);
  // 判断主工具栏状态
  Procedure GProc_MainMenuState(var MainMenu1: TMainMenu);
  procedure Gproc_ClearSG(StringGridName: TStringGrid; StartCol, StartRow, CountCol, CountRow: Integer);

var
  GS_UID: string;  // 用户代码
  GS_UNM:String;   // 用户名称
  GS_LDT: string;  // 上机日期
  GS_LTM: string;  // 上机时间
  Gs_PDiv: string;
  Gs_PDate: string;
  Gs_DocDiv: string;
  Gs_SdNo: string;

implementation

{Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias _
  "RegOpenKeyExA" (ByVal hKey As Long, ByVal IpSubKey As String, _
  ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias _
  "RegQueryValueExA" (ByVal hKey As Long, ByVal IpValueName As String, _
  ByVal IpReserved As Long, IpType As Long, ByVal IpData As String, _
  IpcbData As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long

Private Const HKEY_CURRENT_USER = &H80000001
Private Const ERROR_SUCCESS = 0&}

//  实行exe文件
Function GFunc_ExeProject(F_ExeKey: string; F_DEST: string; F_Start: string): boolean;
var
  v_param: pchar;
  F_ExePath : string;
begin
  // 注：传送参数结构 = 包含目的地实行文件的路径 +
  //                    包含出发地实行文件的路径 +  使用者代码

  result := false;

  // 得出系统所在路径
  if GFunc_RegSoftPath(F_ExeKey, F_ExePath) then
  begin
    // 查询 exe文件 是否存在
    if (filesearch(F_DEST + '.EXE', F_ExePath) <> '')
      and (filesearch(F_Start + '.EXE', F_ExePath) <> '') then
    begin
      v_Param := pchar(F_ExePath + '\' + F_DEST + ' ' +
                       F_ExePath + '\' + F_Start + ' ' + GS_UID);
      result := true;
      // 实行exe文件
      WINEXEC(v_param, 1);
    end
    else
    Application.MessageBox('使用者操作系统启动文件时,失误！','信息',mb_OK+mb_IconInformation);
  end;
end;

// 得出系统所在路径
Function GFunc_RegSoftPath(F_RegKey: string; var F_RegPath: string ): boolean;
var
  HISRegistry: TRegistry;
begin
  // 注：查询条件 =  HKEY_CURRENT_USER\SOFTWARE\Kumho SoftWare Hospital System\KHIS
  result := false;

  HISRegistry := TRegistry.Create ;
  HisRegistry.RootKey := HKEY_CURRENT_USER;
  // Search Registry
  if HISRegistry.OpenKey ('SOFTWARE\Kumho SoftWare Hospital System', true) then
  begin
    // 得出 exe文件 所在路径
    F_RegPath := HISRegistry.ReadString (F_RegKey);
    HisRegistry.CloseKey ;
    // 判断特定文件夹是否存在
    if DirectoryExists(F_RegPath) then
      result := true;
  end
  else
    Application.MessageBox('安装应用软件时 出错！','信息',mb_OK+mb_IconInformation);
end;

Function GFunc_CutString(F_Demo: string; F_Len: integer): string;
var
  i,j: integer;
  v_compare, v_tempstr: string;
begin
  v_tempstr := '';
  j := 1;

  for i := length(Trim(F_Demo)) downto 1 do
  begin
    v_compare := copy(trim(F_Demo),i,1);
    if j = F_Len then
    begin
      GFunc_CutString := v_compare + v_tempstr;
      break;
    end
    else
      v_tempstr := v_compare + v_tempstr;

    inc(j);
  end;
end;

Procedure GProc_PRGOut(P_LDT: string; P_LTM: string);
var
   DRCQuery: TQuery;
   V_RDT, V_RTM: string;
begin
  if GS_UID = '' then Exit;
  DRCQuery := TQuery.Create(application);
  try  // finally
    try   // except
      DRCQuery.DatabaseName := 'hospital';

      V_RDT := formatdatetime('yyyymmdd', date);
      V_RTM := formatdatetime('hhnnss', time);
      V_RTM := Copy(V_RTM,1,2) + ':' + Copy(V_RTM,3,2) + ':' + Copy(V_RTM,5,2);

      with DRCQuery do
      begin
        sql.add('UPDATE THISSDRC SET RTNDATE = '''+V_RDT+''', RTNTIME = '''+V_RTM+'''');
        sql.add('WHERE (LOGDATE = '''+P_LDT+''') AND (LOGTIME = '''+P_LTM+''') AND (USERID = '''+GS_UID+''') ');
        execsql;
      end;
    except
      Application.MessageBox('系统出错!','信息',mb_OK+mb_IconInformation);
    end;
  finally
    DRCQuery.Close;
    DRCQuery.Free;
  end;
end;

Procedure GProc_PRGLog(P_FormName: string; var P_LDT: string; var P_LTM: string);
var
   DRCQuery: TQuery;
   v_PRGID: string;
   F_Len :Integer;
begin
  if GS_UID = '' then exit;
  // 原本字符串中摘取倒数字段
  F_Len := Length(P_FormName)- 3;
  v_PRGID := GFunc_CutString(P_FormName, F_Len);
  v_PRGID := 'HIS' + v_PRGID;
  DRCQuery := TQuery.Create(application);
  try  // finally
    try   // except
      DRCQuery.DatabaseName := 'hospital';

      P_LDT := formatdatetime('yyyymmdd', date);
      P_LTM := formatdatetime('hhnnss', time);
      P_LTM := Copy(P_LTM,1,2) + ':' + Copy(P_LTM,3,2) + ':' + Copy(P_LTM,5,2);

      with DRCQuery do
      begin
        sql.add('INSERT INTO THISSDRC (LOGDATE, LOGTIME, USERID, PRGID)');
        sql.add('VALUES ('''+P_LDT+''', '''+P_LTM+''', '''+GS_UID+''', '''+v_PRGID+''')');
        execsql;
      end;
    except
      Application.MessageBox('系统出错!','信息',mb_OK+mb_IconInformation);
    end;
  finally
    DRCQuery.close;
    DRCQuery.Free;
  end;
end;

// 得出现登录系统的用户名称
Function GFunc_GetUserName(): string;
var
  QueryUNM: TQuery;
begin
  QueryUNM := TQuery.Create(application);
  try  // finally
    try   // except
      QueryUNM.DatabaseName := 'hospital';

      with QueryUNM do
      begin
        Close;
        Sql.Clear;
        Sql.Add('SELECT USERNM FROM THISSUID WHERE USERID = '''+GS_UID+'''');
        Open;
        Result := FieldByName('USERNM').AsString;
      end;
    except
      Result := '';
    end;
  finally
    QueryUNM.Close;
    QueryUNM.Free;
  end;
end;

// 判断日期有效性                                            //
Function GFunc_DateInvalidCheck(F_InDate:String; var F_RetDate:TDateTime): boolean;
var
  SV_YEAR, SV_MONTH, SV_DAY: word ;
begin
  try
    DecodeDate( StrToDate(F_InDate), SV_YEAR, SV_MONTH, SV_DAY ) ;

    if SV_YEAR < 1950 then SV_YEAR := SV_YEAR + 100 ;

    F_RetDate := EncodeDate(SV_YEAR, SV_MONTH, SV_DAY);
    result := true;
  except
    on EConvertError do
        result := false;
  end;
end;

Procedure GProc_SubMenuState(P_MdiID: integer; var MainMenu1: TMainMenu);
var
  i,j: integer;
  GRPQuery: TQuery;
begin
  GRPQuery := TQuery.Create(Application);
  try  // finnally
    GRPQuery.DataBaseName := 'hospital';
    try // except
      // Clear menu bar state
      for i := 1 to Mainmenu1.Items.Count - 2 do
        for j := 0 to MainMenu1.Items[i].count - 1 do
          Mainmenu1.Items[i].Items[j].Enabled := False;

      with GRPQuery do
      begin
        // Setting menu bar state
        Close;
        SQL.Clear ;
        SQL.Add('SELECT *');
        SQL.Add('  FROM THISSRID');
        SQL.Add(' WHERE (USERID = :P_UID)');
        SQL.Add('   AND (PRGID > :P_BEGIN)');
        SQL.Add('   AND (PRGID < :P_END)');
        SQL.Add(' ORDER BY PRGID');
        ParamByName('P_UID').AsString := GS_UID;
        ParamByName('P_BEGIN').AsString := 'HIS' + inttostr(P_MdiID * 1000);
        ParamByName('P_END').AsString := 'HIS' + inttostr((P_MdiID + 1) * 1000);
        Open;
        First;
        if not FindFirst then Exit;

        while not Eof do
        begin
          for i := 0 to MainMenu1.Items.Count - 1 do
            for j := 0 to MainMenu1.Items[i].Count - 1 do
            begin
              if StrToInt(Copy(FieldByName('PRGID').AsString,4,6)) = MainMenu1.Items[i].Items[j].Tag then
                MainMenu1.Items[i].Items[j].Enabled := True;
            end;
          Next;
        end;
      end ;
    except
      Application.MessageBox('查询出错!','信息',mb_OK+mb_IconInformation);
    end;
   // free query object
  finally
    GRPQuery.Close;
    GRPQuery.Free;
  end;
end;

Procedure GProc_MainMenuState(var MainMenu1: TMainMenu);
var
  v_Parent, v_Child1: integer;
  GRPQuery: TQuery;
begin
  GRPQuery := TQuery.create(application);
  try  // finnally
    try // except
    GRPQuery.databasename := 'hospital';

    with GRPQuery do
    begin
      // Clear menu bar state
      close;
      sql.clear;
      sql.add('SELECT PRGID FROM THISSPRG');
      sql.add('  WHERE (PRGID LIKE :P_SAME)');
      sql.add('  ORDER BY PRGID');
      ParamByName('P_SAME').Asstring := 'HIS__000';
      open;
      first;
      if not recordcount > 0 then
        exit;
      while not eof do
      begin
        v_parent := strtoint(copy(fieldbyname('PRGID').asstring, 4, 1)) - 1;
        v_Child1 := strtoint(copy(fieldbyname('PRGID').asstring, 5, 1)) - 1;
        MainMenu1.items[v_parent].items[v_Child1].enabled := false;
        next;
      end;
      // Setting menu bar state
      close;
      sql.Clear ;
      sql.add('SELECT USERID, PRGID');
      sql.add('  FROM THISSGUM Thissgum, THISSGSC Thissgsc');
      sql.add('  WHERE  ((Thissgum.GRPID = Thissgsc.GRPID)');
      sql.add('         AND  (Thissgum.USERID = :P_UID))');
      sql.add('    AND  (Thissgsc.PRGID LIKE :P_LIKE)');
      sql.add('  ORDER BY Thissgsc.PRGID');

      ParamByName('P_UID').asstring := GS_UID;
      ParamByName('P_LIKE').Asstring := 'HIS__000';

      open;
      first;
      if not findfirst then
        exit;

      while not eof do
      begin
        v_parent := strtoint(copy(fieldbyname('PRGID').asstring, 4, 1)) - 1;
        v_Child1 := strtoint(copy(fieldbyname('PRGID').asstring, 5, 1)) - 1;
        MainMenu1.items[v_parent].items[v_Child1].enabled := true;

        next;
      end;
    end ;
    except
       Application.MessageBox('查询错误！','信息',mb_OK+mb_IconInformation);
    end;
   // free query object
  finally
     GRPQuery.close;
     GRPQuery.Free;
  end;
end;
procedure Gproc_ClearSG(StringGridName: TStringGrid; StartCol, StartRow, CountCol, CountRow: Integer);
var
  i, j: integer;
begin
    //with StringGridName do begin
        for j := StartRow to CountRow -1 do
            for i := StartCol to CountCol -1 do
                stringgridname.Cells[i,j] := '';
        stringgridName.RowCount := 2;
    //end;
end;

end.