u_data.pas

来自「超信人力资源管理系统,一个用Delphi编写的人事管理系统」· PAS 代码 · 共 419 行

PAS
419
字号
{-------------unit data---------}
{-----------build by francis----}
{----------date 2003-10-14------}

unit
  U_data;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Db, DBTables, dbctrls, MATH, ComObj, inifiles, menus, Qrctrls,
  QuickRpt, Wwdbcomb, DBGRIDEH, ADODB, ComCtrls, jpeg, extctrls, Grids, WINSOCK, IdStack,
  PrnDbgeh, StdCtrls;
const
  MAX_PATH = 255;
type
  TMY_popedom = record
    Is_Edit, Is_Insert, Is_Delete, Is_Find, IS_View, Is_Print, IS_Editprint, IS_Aduit, IS_Other: Boolean; //李新建增加:各种操作纪录
  end;

  TDM = class(TDataModule)
    Q_TempA: TADOQuery;
    ADOCon: TADOConnection;
    Q_TempB: TADOQuery;
    Q_LOG: TADOQuery;
    Q_TempC: TADOQuery;
    SaveD: TSaveDialog;
    PrintDBGrid: TPrintDBGridEh;
    Q_PICTURE: TADOQuery;
    DSADOReport: TDataSource;
    ADOReport: TADODataSet;
    ADODataSetReport: TADODataSet;
    QTemp: TADODataSet;
    procedure DataModuleCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;


procedure Set_com1(A: Tcombobox; DS: Tadoquery); //将DS的字段加入COM中
procedure Set_com2(A: Tcombobox; DS: Tadoquery); //将DS的字段加入COM2中
procedure SET_WWCOM(AA: TWWDBCOMBOBOX; CODE: string); //选择COMMBobo的值
procedure SET_COM_ITEM(CODE, table_NAME, field: string); //设置COmmbobox的值
procedure TO_EXCEL(FILE_NAME: string; GRID: TDBGRIDEH);
procedure Insert_Log(S: string);
function SHOW_FORM(sClassName: string): TFORM; //打开窖口
procedure SQL_OPEN(S: string);
procedure SQL_Exec(S: string);
function SQL_RESULT(S: string): string;
procedure SQL_Change(Q: TAdoquery; S: string); //直接用ADOquery
procedure SET_ITEM(ITEM: TSTRINGS; S: string); //将第一个字段加到下拉框中
function GetLocalComputerName: string; //得到本机名字
function GetLocalIP: Tstrings;
function CreateGUID(out Guid: TGUID): HResult; //建立一个全球变量
//将表格分颜色
procedure MYDBGridEHDrawColumnCell(Sender: TDBGRIDEH; const Rect: TRect; DataCol: Integer; Column: TColumnEh; State: TGridDrawState);
function getsystempath(): string; //得到系统目录
function GetCurrentpath(): string; //得到当前程序目录  //没有'\'



var
  DM: TDM;
  syslanguage: integer;
  SQL_S: string; //临时SQL语句
  NID: TGUID; //全球变量
  Sys_title: string; //系统名称
  LOGIN_CODE: string; //用户号
  LOGIN_NAME: string; //用户名

  Report_Form:string;//保存要报表的窗体名字

  SYS_Login_time: Tdatetime; //记录登录时间
  COMPANY_NAME: string; //公司名字

  USER_IP: string; //SELF  IP ADDRESS
  COMPUTER_NAME: string; //计算机名

 // CARD_BEFORE: INTEGER; //规定时间上班之前多少分钟可以打卡
 // CARD_AFTER: INTEGER; //规定时间下班之後多少分钟可以打卡

  OLD_CON: Tadoconnection;
  Current_Con: Tadoconnection;
  CONNECT: BOOLEAN; //是否已连接数据库存
  REG_FLAG: BOOLEAN; //是否已注册软件

  M_TABLE: TADOQUERY; //主表
  D_TABLE: TADOQUERY; //从表
  ReportDS: TADoquery; //报表Dataset

  OneTable_flag: boolean;

  KEY_FIELD: string; //主关键名
  MAIN_TABLE: string; //主表名
  DETAIL_TABLE: string; //从表名

  //各种权限操作
  MY_popedom: TMY_popedom = (Is_Edit: false; Is_Insert: false; Is_Delete: false; Is_Find: false; Is_View: false; IS_print: False; IS_Editprint: False; IS_Aduit: False; IS_Other: false);

  LAST_ACTIVE_FORM: string; //最后ACtive 窗体 名字
  LAST_ACTIVE_FORM_CAPTION: string; //用来记录当前ACTIVE FORM 的CAPTION  用来向日志中写数据

  PATH: string; //路径
  FILE_NAME: string; //  文件名

  DOT_COUNT: integer; //小数尾数个数

//  决定DBGRIDEH 的分行颜色
  COLOR1: TCOLOR;
  COLOR2: TCOLOR;
  COLOR3: TCOLOR; //窗口颜色
  COLOR4: TCOLOR; //GRIDEH 的TITLE 颜色



implementation

uses U_main, U_comitem;

{$R *.dfm}

function SQL_RESULT(S: string): string;
begin
  SQL_OPEN(S);
  RESULT := Dm.Q_TempA.FIELDS[0].ASSTRING;
end;


procedure Set_com1(A: Tcombobox; DS: Tadoquery); //将DS的字段加入COM中
var i: integer;
begin
  A.Items.Clear;
  for i := 0 to DS.Fields.Count - 1 do
  begin
    A.Items.Add(DS.Fields[i].DisplayLabel);
  end;
end;

procedure Set_com2(A: Tcombobox; DS: Tadoquery); //将DS的字段加入COM2中
var i: integer;
begin
  A.Items.Clear;
  for i := 0 to DS.Fields.Count - 1 do
  begin
    A.Items.Add(DS.Fields[i].FieldName);
  end;
end;




function GetCurrentpath(): string; //得到当前目录 没有'\'
begin
  Result := extractfiledir(application.exename);
end;

function getsystempath(): string; //得到系统目录
var a: array[0..MAX_PATH] of Char;
begin
  GetWindowsDirectory(A, MAX_PATH);
  Result := string(A);
end;

procedure SET_WWCOM(AA: TWWDBCOMBOBOX; CODE: string); //选择COMMBobo的值
begin
  AA.ITEMS.CLEAR;
  SQL_S := 'SELECT ISNULL(A_CHAR,'''') FROM TB_Comitem WHERE A_CODE=''' + CODE + ''' ORDER BY ORDER_NO';
  SQL_OPEN(SQL_S);
  while not DM.Q_TEMPA.EOF do
  begin
    AA.ITEMS.ADD(DM.Q_TEMPA.FIELDS[0].ASSTRING);
    DM.Q_TEMPA.NEXT;
  end;
end;

procedure SET_COM_ITEM(CODE,table_NAME,field: string); //设置COmmbobox的值
begin
  Application.CreateForm(TF_Comitem, F_Comitem);
  F_Comitem.CODE := CODE;
  F_Comitem.table_NAME := table_NAME;
  F_Comitem.field := FIELD;
  F_Comitem.showmodal;
  F_Comitem.Release;
end;


//将DBGRIDEH导入EXCEL

procedure TO_EXCEL(FILE_NAME: string; GRID: TDBGRIDEH);
var
  eclapp, workbook: variant;
  xlsFileName: string;
  ROW: INTEGER;
  I: INTEGER;
  savedialog: tsavedialog;
begin
  xlsfilename := '';
  if FILE_NAME = '' then
  begin
    savedialog := tsavedialog.Create(nil);
    savedialog.Filter := 'Microsoft Excel 文件|*.xls|所有文件|*.*';
    savedialog.Options := savedialog.Options + [ofoverwriteprompt];
    if savedialog.Execute then
      file_name := savedialog.FileName;
    savedialog.Free;
  end;
  if file_name = '' then
    exit;
  xlsfilename := FILE_NAME;
  try
    eclapp := createoleobject('excel.application');
    workbook := createoleobject('excel.sheet');
  except
    showmessage('no excel');
  end;
  workbook := eclapp.workbooks.add;
  GRID.DataSource.DataSet.First;
  ROW := 1;

  for I := 1 to GRID.Columns.Count do
  begin
    eclapp.cells(ROW, I) := GRID.Columns[I - 1].TITLE.CAPTION;
  end;
  while not GRID.DataSource.DataSet.EOF do
  begin
    ROW := ROW + 1;
    for I := 1 to GRID.Columns.COUNT do
    begin
      eclapp.cells(ROW, I) := GRID.Columns[I - 1].FIELD.ASSTRING;
    end;
    GRID.DataSource.DataSet.Next;
  end;
//  if fileexists(xlsfilename) then
//    deletefile(xlsfilename);
//  workbook.saveas(xlsfilename);
  eclapp.visible := true;
  //workbook.close;
//  SHOWMESSAGE('OK  搞定,文件名称:' + FILE_NAME);
end;



//将表格分颜色

procedure MYDBGridEHDrawColumnCell(Sender: TDBGRIDEH; const Rect: TRect; DataCol: Integer; Column: TColumnEh; State: TGridDrawState);
begin
  with Sender do
  begin
    if ((State = [gdSelected]) or (State = [gdSelected, gdFocused])) then
    begin
      Canvas.Font.Color := clYellow;
      Canvas.Brush.Color := clNavy;
    end
    else
    begin
      if Datasource.dataset.RecNo mod 2 <> 0 then
        Canvas.Brush.Color := clWhite
      else
        Canvas.Brush.Color := $00EAEAEA;
    end;
    DefaultDrawColumnCell(Rect, DataCol, Column, State);
  end;
end;


procedure SQL_CHANGE(Q: TADOQUERY; S: string);
begin
  Q.Close;
  Q.SQL.Clear;
  Q.SQL.Add(S);
  Q.Open;
end;

function CreateGUID(out Guid: TGUID): HResult;
begin
  GUID := STRINGTOGUID(CREATECLASSID());
end;

function GetLocalIP: TStrings;
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 := TStringList.Create;
  Result.Clear;
  GetHostName(Buffer, SizeOf(Buffer));
  phe := GetHostByName(buffer);
  if phe = nil then
  begin
    Exit;
  end;
  pPtr := PaPInAddr(phe^.h_addr_list);
  I := 0;
  while pPtr^[I] <> nil do
  begin
    Result.Add(inet_ntoa(pptr^[I]^));
    Inc(I);
  end;
  WSACleanup;
end;


//得到本机名字

function GetLocalComputerName: string;
var
  aName: PChar;
  Len: Cardinal;
begin
  result := '';
  Len := MAX_COMPUTERNAME_LENGTH + 1;
  GetMem(aName, Len);
  try
    if GetComputerName(aName, Len) then
      result := StrPas(aName);
  finally
    FreeMem(aName);
  end;
end;


procedure Insert_log(S: string);
begin
  DM.Q_LOG.Close;
  DM.Q_LOG.SQL.Clear;
  DM.Q_LOG.SQL.Add(S);
  DM.Q_LOG.ExecSQL;
end;

function SHOW_FORM(sClassName: string): TFORM; //打开窗口
var
  rClass: TClass;
  FLAG: BOOLEAN;
  I: INTEGER;
begin
  if TRIM(SCLASSNAME) = '' then EXIT;
  FLAG := FALSE;
  for I := 0 to APPLICATION.ComponentCount - 1 do
  begin
    if UPPERCASE(APPLICATION.Components[I].Name) = UPPERCASE(SCLASSNAME) then
    begin
      TFORM(APPLICATION.Components[I]).SHOW;
      FLAG := TRUE;
    end;
  end;
////////////////////////////////////////////////////////////////////////////////////////



////////////////////////////////////////////////////////////////////////////////////////
  if not FLAG then
  begin
    rClass := GetClass('T' + sClassName);
    if rClass <> nil then
    begin
      if F_MAIN.MDIChildCount >= 10 then
        F_MAIN.MDIChildren[F_MAIN.MDIChildCount - 1].Release;
      application.CreateForm(TComponentClass(rClass), Result);
      result.Show;
    end;
  end;

  if Result <> nil then
    if Result.FormStyle <> fsNormal then
      F_Main.Panel_main.Visible := FALSE;
end;


procedure SQL_OPEN(s: string);
begin
  DM.Q_tempA.close;
  DM.Q_TempA.SQL.Clear;
  DM.Q_TempA.SQL.Add(S);
  DM.Q_TempA.Open;
end;


procedure SQL_Exec(S: string);
begin
  DM.Q_TempB.Close;
  DM.Q_TempB.SQL.Clear;
  DM.Q_TempB.SQL.Add(S);
  DM.Q_TempB.ExecSQL;
end;

procedure SET_ITEM(ITEM: TSTRINGS; S: string);
begin
  Item.Clear;
  SQL_OPEN(S);
  while not DM.Q_TEMPA.EOF do
  begin
    ITEM.Add(DM.Q_TEMPA.FIELDS[0].ASSTRING);
    DM.Q_TEMPA.NEXT;
  end;
end;

procedure TDM.DataModuleCreate(Sender: TObject);
//var p: PInteger;
begin
  ADOCon.Connected := true;
  Current_Con := Adocon;
  Sys_title := '超信人力资源管理系统 V1.0';
  user_IP := GetLocalIP.GetText;
  COMPUTER_NAME := GetLocalComputerName;
end;

end.

⌨️ 快捷键说明

复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?