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 + -
显示快捷键?