syspublic.pas

蓝图财务进销存一体化,delphi源码,使用ACCESS数据库

unit SysPublic;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Grids, DBGrids, ExtCtrls, Buttons, Mask, DBCtrls, Db, DBTables,
  Qrctrls, ADODB, DataM, Math, WinSock, ComObj, Variants, qrprntr,
  QuickRpt, DBGridEh, FR_Class, DBGridEhImpExp,
  StrUtils, FR_DBSet, DBCtrlsEh, DBLookupEh;

const
  //加密串
 GENERAL_REGISTER_CODE = 'WSQL-2003-9561-0423-951U-BXRO';
  ROOT_PASSWORD = 'wangchw'; //万能密码

  sUserPass = 'wangchw';

  //权限类
  lInsert =0;//新增
  lEdit =1;//修改
  lDelete= 2;//删除
  lFind =3;//查找
  lFilter =4;//过滤
  lPrint =5;//打印
  lExport =6;//导出
  lmodule =100;//模块权限

  sEdit= 'dsEdit';
  sInsert ='dsInsert';


var

  bSoftRegister: Boolean = False; //是否为注册版
  bCygl : Boolean = True;   //版本控制
  sApplication : string;
  SOFTWARE_CAPTION: string;
  G_bAdmin, G_bTakeEffect: Boolean; {是否超级用户,帐套是否启用}
  G_iUserID, G_iDepID: integer; {用户内部ID,所属部门内部ID}
  G_sUserCode, G_sUserName, G_sDepName: string; {用户代码，用户名，所属部门名}
  G_sPWD: string; {用户密码}
  G_sSpace: string; {局域网/远程}
  G_bAppEnabled: Boolean;{程序是否可使用}

  Str_djid_pub: string;   ///////////2004-11-22  单据标识
  SYSStartDate: TDateTime; //登陆时开始时间

const
  DBPass= '123456'; //设置数据库密码
  
//改变DBGrid列的颜色,没什么特别，但是经过调色师检验欧
procedure ChangeDbGridColColor(ojbDbGrid:TDbGrid);

//保存操作日志
function SaveOperateLog(sTitle: string): Boolean;

//得到本机名称
function GetLocalHost: string;

//IP地址解析为主机域名
function IPToHost(IPAddr: string): string;

//得到当前焦点控件
function GetFocusedComponent(frmForm: TForm): TComponent;

{ 返回记录数据网格列显示最大宽度是否成功 }
function DBGridRecordSize(mColumn: TColumn): Boolean;

{ 返回数据网格自动适应宽度是否成功 }
function DBGridAutoSize(mDBGrid: TDBGrid; mOffset: Integer = 5): Boolean;

//获取SQL Server服务器列表
function GetSQLServerList(Combobox :TComBoBox): Boolean;

//DBGrib中的数据输出到Excel中
procedure DeriveToExcel(Title: String; DBGrid: TDBGrid; Total: Boolean);

//// 导出到打印机
procedure DeriveToPrint(Title: String; DBGrid: TDBGrid; Total: Boolean);

//如何將數字轉換成英文
Function RealToTxt(Amount : Real) : String;

(*//
标题:字符网格排序
说明:升序、降序;示例点击标题排序
设计:Zswang
日期:2002-04-27
支持:[e-mail]
//*)

//
function StringGridRowSwap(mStringGrid: TStringGrid;
  mFromRow, mToRow: Integer): Boolean;

//
function StringGridRowSort(mStringGrid: TStringGrid;
  mColIndex: Integer; mDesc: Boolean = False): Boolean;

{
procedure TForm1.StringGrid1MouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
{$J+}
//const
//  vOldCol: Integer = -1;
{$J-}
//var
//  vCol, vRow: Integer;
//begin
//  if Button = mbRight then Exit;
//  TStringGrid(Sender).MouseToCell(X, Y, vCol, vRow);
//  if (vRow < 0) or (vRow >= TStringGrid(Sender).FixedRows) then Exit;
//  StringGridRowSort(TStringGrid(Sender), vCol, vOldCol = vCol);
//  if vOldCol = vCol then
//    vOldCol := - vOldCol
//  else vOldCol := vCol;
//end;

function StrLeft(const mStr: string; mDelimiter: string): string;

function ListValue(mList: string; mIndex: Integer; mDelimiter: string = ','): string;

function StringGridToText(mStringGrid: TStringGrid;
  mStrings: TStrings): Boolean;

function TextToStringGrid(mStrings: TStrings;
  mStringGrid: TStringGrid): Boolean;

{
procedure TForm1.Button1Click(Sender: TObject);
begin
  StringGridToText(StringGrid1, Memo1.Lines);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  TextToStringGrid(Memo1.Lines, StringGrid1);
end;

}

function repl_substr(sub_old, sub_new, s: string): string; //把sub_old换成sub_new,后面有用。
function BackupSQLDataBase(connstr_sql,DatabaseName,Backup_FileName:string):Boolean;//数据库备份函数
//SQL数据数据库备份，connstr_sql是ADO控件的connectionstring,DatabaseName是数据库名称，
//Backup_FileName要备份到的目 标文件
function RestoreSQLDataBase(connstr_sql,DatabaseName,Restore_FileName:string):Boolean;//数据库恢复函数
//Restore_FileName以前备份的数据库文件，

//又一款人民币金额大小写转换的演示程序
function F2C(r: real): string;

//控件自适应窗体大小
Procedure CompentAutoSize(FormeSize:TForm;var Form_width,Form_Height:integer);

//连接ADOConnection
function GetConn(ADOQry: TADOQuery): Boolean;

//同操作Ini文件,得到一字段的值
function GetIniValue(ADOConnet: TADOConnection; sName: string): string;

//打开DataSet
function OpenDataSetEx(ADOConnet: TADOConnection; DataSet: TADOQuery; szSql: string): Boolean;

//生成注册机器码
function MakeComputerCode: string;

//得到硬盘的序列号
function GetIDESerial: string;

//得到分区序列号
function GetDiskSerial(sDisk: string): string;

//得到0-9,a-b之间的标准字符
function GetStandardStr(sStr: string): string;

//得到计算机名称
function GetPCName: string;


//生成注册号
function MakeRegisterCode(sName, sPcCode: string): string;

//字符串加密
function StringEncrypt(mStr: string; mKey: string): string;

//转换为可显示加密串
function StringToDisplay(mString: string): string;

//同操作Ini文件,修改一字段的值
function SetIniValue(ADOConnet: TADOConnection; sName, sValue: string): Boolean;
//返回数据库是否为空高级
function GetDataSetEmptyEx(ADOConnet: TADOConnection; sSql: string): Boolean;

//高级执行Sql
function ExecSqlEx(ADOConnet: TADOConnection; sSql: string): Boolean;

//返回数据库条数
function GetDataSetCount(sSql: string): Integer;


//反回数据库条数高级
function GetDataSetCountEx(ADOConnet: TADOConnection; sSql: string): Integer;

//判断资料是否使用
function JudgeDataUse(originalityTableName,OriginalityFieldName, presentFieldValue: string): Boolean;


procedure SaveButtonState(RadGro: TRadioGroup);

procedure SetDBGridState(const Rect: TRect; DataCol: Integer; Column: TColumn;
  State: TGridDrawState; DBGrid1: TDBGrid);

//设置DBGrid的颜色
procedure SetDBGridColor(DBGridEh1: TDBGridEh; const Rect: TRect; DataCol: Integer; ColumnEh: TColumnEh;
  State: TGridDrawState; Sender: TObject);

//定义提示对话框
procedure RemMsgBox(RemindText: string; Caption: string='');

//MessageBox
function MsgBox(Text: string; Flags: Longint = MB_OK): Integer;


//ShowMessage
procedure ShowMsg(sMsg: string);

//DBGridEh满页
procedure ReadDBGridEhAutoFitColWidth(Form1: TForm);

procedure SaveDBGridEhAutoFitColWidth(CheckBox1: TCheckBox);

//报表副标题
//function SetReportSubTitle: Boolean;

//


function InsCode(IniData: integer; ADOQuery1: TADOQuery; sFieldName, sTable: string): Boolean;

procedure ManipulateControl(WinControl: TControl;
  Shift: TShiftState; X, Y, precision: integer);

procedure TM(Fd:TDBNavigator);
//打开MDI窗口函数
procedure OpenForm(FormClass: TFormClass; var fm; AOwner:TComponent);
//打开带密码的ACCESS数据库函数
function LnkAccess(var ADOConnet: TADOConnection; Db, DbPwd: string):Boolean;
//连接本系统数据库函数
function LnkLocalAccess: Boolean;

function GridFieldToTitle(GridEh: TDBGridEh; sField: string):  string;


function SaveDataSet(ADOQuery1: TADOQuery; Cached: Boolean): Boolean;


function FindPublic(Grid1: TDBGridEh; var sText: string; var
  lFiled: Integer): Boolean;

procedure DBGridEhExport(DBGridEh: TDBGridEh; Form: TForm);
//返回字段类型
function GetFieldType(fField: TField): string;

function FilterPublic(Grid1: TDBGridEh): Boolean;


function CheckEditEmpty(lMsg: Integer; Form1: TForm; AsLabel, AsEdit: array of
  string): Boolean;

//根据年月日，表名，进入库类型添加的数量生成单号。作者：王承武与2003-080-06早08:41分完毕
Function GetID(Aqy: TADOQuery; TableName,DHFieldName,DateFieldName, TypeFieldName, TypeValue:String;
BeginPos,StrLen:integer):boolean;

//根据年月日，表名，添加的数量生成单号
Function IDGen(Aqy: TADOQuery; DJType, TableName,DHFieldName,DateFieldName:String;
BeginPos,StrLen:integer):boolean;

procedure ConnAccess(AdoConn: TADOConnection; FileName, UserName, Password: string);


//字段赋值函数 2004-11-16
procedure SetField(StrTarget,StrSource: string; ADOQryTarget,
  ADOQrySource: TADOQuery);
//发送一个消息
procedure SendMsg(hWnd, Msg, wParam: Integer; lParam: Integer = 0);

//用这个函数吧，入口是 字符串，分割符(分割符可以是单个字符也可以是字符串，也可以是汉字)，出口是 是一个Tstringlist数组，索引从0开始 result[0]是第一个
function SplitString(const source, ch: string): tstringlist;

//下面这个自定义函数，可以取两个任意分隔符之间的字串，目前分隔符为','，要注意的话，目前函数返回的字串包含分隔符本身，如果不想包含分隔符本身的话，你可以修改  locate_string:=copy
function locate_string(line_string:string;start_position,end_position:integer):string;

//String转换Int
function StrToInt2(s: string): Integer;

//设置GRID字段
function StrToGridField(Grid1: TDBGridEh; sFieldName, sCaption, sWidth: string; sMask: string = ''): Boolean;

//表格列配置
function SetCol(sCaption: string; DBGridEh1: TDBGridEh; lInit: Integer): Boolean;

//表格存列宽
function SetColWidth(sCaption: string; Grid: TDBGridEh): Boolean;

//执行Sql
function ExecSql(sSql: string): Boolean;

//打开DataSet(默认ADOConnet)
function OpenDataSet(DataSet: TADOQuery; szSql: string): Boolean;

//保存表格是否扁平

procedure SaveDBGridEhFlat(CheckBox1: TCheckBox);

//读取DBGridEh是否为扁平
procedure ReadDBGridEhFlat(Form1: TForm);

procedure SaveDBEditEhFlat(CheckBox3: TCheckBox);

//设置EDIT扁平
procedure ReadDBEditFlat(Form1: TForm);

//返回起始结束日期
function GetDate(var tStartDate, tEndDate: TDateTime): Boolean;

//String转换Boolean
function StrToBool2(sStr: string): Boolean;

{
  函数名称：FilterStrInBracket
  函数功能：获得[]中的值
  使用说明：
  建立人：
  建立日期：}
  function  FilterStrInBracket(value:string):String;

{
  函数名称：EncryptPassword
  函数功能：加密一个字符串
  使用说明：
  建立人：
  建立日期：}
  function EncryptPassword(value:string):string;


function SysRightLimit(Form1: string; i: integer): Boolean;

function SetID(sTitle, DHFieldName,TableName:String ; BeginPos,StrLen:integer): string;

//显示关键字重复
procedure ShowIDRepeat(sIDName: string);

var
  LoginEmployeName: string;
  LoginEmployeCode : string;

implementation

uses DiskSerialNumber, PrintStructure, Main, FindPublic, FilterPublic, ColSetup, DateForm;

procedure SetDBGridColor(DBGridEh1: TDBGridEh; const Rect: TRect; DataCol: Integer; ColumnEh: TColumnEh;
  State: TGridDrawState; Sender: TObject);
begin
Case DBGridEh1.DataSource.DataSet.RecNo Mod 2 = 0 of
True: DbGridEh1.Canvas.Brush.Color:= clInfoBk; //偶数列用蓝色
//False: DbGrid1.Canvas.Brush.Color:= clAqua;//奇数列用浅绿色
End;
DbGridEh1.Canvas.Pen.Mode:=pmMask;
DbGridEh1.DefaultDrawColumnCell (Rect, DataCol, ColumnEh, State);

{with (Sender as TDBGrid).Canvas do //画 cell 的边框
  begin
    Pen.Color := $00ff0000; //定义画笔颜色(蓝色)
    MoveTo(Rect.Left, Rect.Bottom); //画笔定位
    LineTo(Rect.Right, Rect.Bottom); //画蓝色的横线
    Pen.Color := $0000ff00; //定义画笔颜色(绿色)
    MoveTo(Rect.Right, Rect.Top); //画笔定位
    LineTo(Rect.Right, Rect.Bottom); //画绿色的竖线
  end;}

end;

procedure SetDBGridState(const Rect: TRect; DataCol: Integer; Column: TColumn;
  State: TGridDrawState; DBGrid1: TDBGrid);
begin
if ((State = [gdSelected]) or (State=[gdSelected,gdFocused])) then
DbGrid1.Canvas.Brush.color:=clRed; //当前行以红色显示，其它行使用背景的浅绿色
DbGrid1.Canvas.pen.mode:=pmmask;
DbGrid1.DefaultDrawColumnCell (Rect, DataCol, Column, State);
end;

procedure SaveButtonState(RadGro: TRadioGroup);
var
  sShape: string;
  ADOQryTmp: TADOQuery;
begin
  ADOQryTmp:= TADOQuery.Create(Nil);
  GetConn(ADOQryTmp);
  ADOQryTmp.Close;
  ADOQryTmp.SQL.Clear;
  ADOQryTmp.SQL.Add('Select * From SystemTable Where Name = ''Button''');
  ADOQryTmp.Open;

  case RadGro.ItemIndex of
  0: sShape:= 'shCapsule';
  1: sShape:= 'shOval';
  2: sShape:= 'shRectangle';
  3: sShape:= 'shRoundRect';
  end;

  ADOQryTmp.Edit;
  ADOQryTmp.FieldByName('Code').AsString:= sShape;
  ADOQryTmp.Post;

//  ReadButtonState;
end;

procedure ChangeDbGridColColor(ojbDbGrid:TDbGrid);
var
  i:integer;
begin
  for i:= 0 to ojbDbGrid.Columns.Count -1 do
  begin
    case i mod 3 of
      0: ojbDbGrid.Columns.Items[i].Color:=TColor($0023AF82);
      1: ojbDbGrid.Columns.Items[i].Color:=TColor($00339CDB);
      2: ojbDbGrid.Columns.Items[i].Color:=TColor($00C69C6D);
    end;
  end;
end;

function SaveOperateLog(sTitle: string): Boolean;
var
  sSql: string;
begin
  Result := False;
  sSql := 'INSERT INTO 新增系统日志(日期,机器名,操作员,操作) VALUES('''+
  FormatDateTime('yyyy-mm-dd', Date) +''',''' + GetLocalHost + ''',''' +
  LoginEmployeName + ''',''' + sTitle + ''')';
  DataMForm.ADOConnet.Execute(sSql);
  Result := True;
end;

function GetLocalHost: string;
begin
  Result := IPToHost('');
end;

function IPToHost(IPAddr: string): string;
var
  SockAddrIn: TSockAddrIn;
  HostEnt: PHostEnt;
  WSAData: TWSAData;
begin