usyspub.~pas

已经投入使用的商业级管理系统：液化气管理系统。 附带全部源码

unit UsysPub;

interface

uses  Classes,Windows,Messages,Dialogs,SysUtils,Contnrs,ADODB,StrUtils,Forms,DB,
      StdCtrls, Buttons, ComCtrls, dbctrls,DBGrids,UsysConst,ActnList,Variants
      ,QGraphics,Graphics,TeEngine,U_dm,Menus,Controls;
const
  C1=52845; //字符串加密算法的公匙
  C2=22719; //字符串加密算法的公匙      
//生成系统功能
Procedure BuildSysMenu(Frm:Tform);
//取得标题的背景颜色
Function GetTitleColor(nTitleType:Integer):TColor;
//取得应用程序路径
Function GetApplicatePath():String;
function RunSQL( ADOQry_Temp: TADOQuery; SQLStr: string; RunType: Byte): Boolean;
Function GetNewStr(ADOQry_Temp: TADOQuery):String;
{回车改变控件焦点}
procedure DoPerForm(Fm:TForm;Key:Word);
procedure EnterToChangeFocus(Fm:TForm;Key:Word);
{实数输入框}
procedure InputNumer(Fm:TForm;Key:Char);
function TryIsFloat(S:string):boolean;
function GetSysDate():string;
{把日期字符yyyymmdd串转换为yyyy-mm-dd}
function FormateStrtoDate( strSysDate:string ):string;
function SetCmbxItem(Cmbx: TComboBox; ADOQry_Temp: TADOQuery; SQLStr: string;
  DaiMaAndMingCheng: Boolean): TStrings;
function SetAllCmbxItem(Cmbx: TComboBox; ADOQry_Temp: TADOQuery; SQLStr: string;
  DaiMaAndMingCheng: Boolean): TStrings;
{释放指针的空间}
procedure disposepoint(mytreeview:Ttreeview);
{字符串加密、解密函数}
function EncryptString( input:string ):string;
{设置系统功能是否可用}
procedure SetActionState( var ActList:TActionList;state:integer);
{读系统参数}
function ReadSysParameters():boolean;
{生成标准编号}
function BuildBHStr( nStart:integer; nLen:integer ):string;
function BuildTableBHStr( Strtmp:string;strAdd:string; nLen:integer ):string;
{生成表编号编号}
function BuildTable(ADOQry_Temp: TADOQuery;StrTable:string;strZDM:STRING;strADD:String;nlen:integer):string;
function BuildTableDJBH(ADOQry_Temp: TADOQuery;StrTable:string;strZDM:STRING;strADD:String):string;
{生成简码}
procedure BuildJMStr( var AdoQrJM:TADOQuery; strZWZF:string; var strPYJM:string; var strWBJM:string; nMaxLen :integer );
function NontoNumber(strtmp:string):string;
function BooleantoNumber(strtmp:Boolean):string;
function NumbertoBoolean(nNumber:integer):Boolean;
function GetYear(Date: TDate): Integer;
function GetMonth(Date: TDate): Integer;
function GetDay(Date: TDate): Integer;
//得到本月的第一一天
function dateBeginOfMonth(D: TDateTime): TDateTime;
//得到本月的最后一天
function dateEndOfMonth(D: TDateTime): TDateTime;
//得到本年的最后一天
function dateEndOfYear(D: TDateTime): TDateTime;
//得到两个日期相隔的天数
function DaysBetween(Date1, Date2: TDateTime): integer;
//字符串加密函数
function Encrypt(const S: String; Key: Word): String;
function Decrypt(const S: String; Key: Word): String;
function StrToHex(AStr: string): string;
function HexToStr(AStr: string): string;
function TransChar(AChar: Char): Integer;

type
  RzRecord = record
    strCZBM:string; //操作表名
    nCZLX:integer;  //操作类型
    strCQNR:string; //操前内容
    strCHNR:string; //操后内容
    nCZYM:integer;  //操作员名
    strBZXX:string; //备注信息
end;

type
  PData = ^TData; //指针，用于给TreeView.TreeNode.Data赋值
  TData = record
  PCode:string;
  Pnode:integer;
  PName:string;
end;
{出入库模块用}
type
  pDataKF = ^TDataKF; //指针，用于给TreeView.TreeNode.Data赋值
  TDataKF = record
  pnDJBH:integer;
  pnJSRM:integer;
  pnCGRM:integer;
  pName:string;
end;

type                  //权限指针
  pDataQX = ^TDataQX;
  TDataQX = record
  pGNXH:integer;
  pGNFQ:integer;
  pName:string;
end;
type
  OPERATOR_MODE = (MODE_APPEND,MODE_MODIFY);
  TCustomException = class
  private //Attribute
    m_pErrMsg:string;
  private //Operate
  public  //Attribute
  public  //Operate
    procedure SetErrMsg( pErrMsg:string );
    procedure ShowErrMsg();
end;

type
  TtestException = class
  private //Attribute
  private //Operate
  public  //Attribute
  public  //Operate
    procedure DivData( ncs, nbc:integer );
end;

type
  TDataFieldType = (DATA_CHAR, DATA_DOUBLE,DATA_DATETIME);
  TMyField = class( TObject )
  private //Attribute
    m_eDataFieldType:TDataFieldType;
    m_dFieldData:double;
    m_strFieldData:string;
    m_dtFieldData:Tdatetime;
    m_strFieldName:string;
    m_nKey:integer;
    m_nGerm:integer;  //该列是否是种子0--不是，<>0----是
  private //Operate
  public  //Attribute
  public  //Operate
    constructor create();
    procedure SetField( strFieldName:string; etype:TDataFieldType; nkey, nGerm:integer );
    procedure SetValue( strFieldData:string );overload;
    procedure SetValue( dFieldData:double );overload;
    function CharValue():string;
    function DoubleValue():double;
    function DatetimeValue():Tdatetime;
    function FieldName():string;
    function FieldType():TDataFieldType;
    function IsKey():boolean;
    function IsGerm():boolean;
end;

type
  TAdoRet = class
  private //Attribute
    m_clObjectList:TObjectList;
    m_bEOF:boolean;
    m_bOpen:boolean;
    m_clAdoQuery:TAdoQuery;
    m_clAdoCommit:TAdoQuery;
    m_strTableName:string;
  private //Operate
    procedure InitFieldData();
  public  //Attribute
  public  //Operate
    constructor Create( var clconn:TAdoConnection );
    destructor destroy;override;
    procedure InitAdoRet( var clconn:TAdoConnection );
    procedure SetTableName( strTableName:string );
    procedure AddField( var clMyField:TMyField );
    function IsEOF():boolean;
    function IsOpen():boolean;
    function Find( const KeyFields: String; const KeyValues: Variant; Options: TLocateOptions ): Boolean;
    procedure MoveFirst();
    procedure MoveNext();
    procedure FetchOneRow();
    procedure Open( strWhere:string );
    procedure InsertRecord( );
    procedure UpdateRecord();
    procedure ExecuteSQL( strsql:string  );

end;
var
  TStrkhfl: TStrings;   //客户分类
  TStrSp: TStrings;     //商品信息
  TStrAllSp: TStrings;     //商品信息
  TStrAllYhlx: Tstrings;    //用户类型
  TStryhlx: Tstrings;      //用户类型
  TStrAllkhlx: Tstrings;      //用户类型
  TStrkhlx: Tstrings;       //用户类型
  TStrMD: Tstrings;         //门店
  TStrgplx:Tstrings;        //钢瓶类型
  TStrKH:Tstrings;          //客户
  TStrbm: Tstrings;
  TStrczy: Tstrings;

implementation

uses UTable;
//生成系统功能
Procedure BuildSysMenu(Frm:Tform);
Var
  i,j:integer;
  clXTGN:TXTGN;
  strCZSJ:string;
Begin
  j := 0;
  For i := 0 To Frm.ComponentCount - 1 Do
  Begin
    If Frm.Components[i] is TMenuItem Then
    begin
    try
      j := j + 1;
      clXTGN := TXTGN.Create( dm.AdoConn );
      If j = 1 Then
      Begin
        clXTGN.ExecuteSQL('Delete From XTGN');
      End;
      clXTGN.MKID.SetValue( '11' );
      clXTGN.GNID.SetValue( j );
      clXTGN.GNMC.SetValue( TMenuItem(Frm.Components[i]).Caption );
      clXTGN.BZXX.SetValue( '' );
      clXTGN.InsertRecord();
    except
      on e:TCustomException do e.ShowErrMsg();
    end;
    clXTGN.Free;
    End;
  End;
End;
Function GetTitleColor(nTitleType:Integer):TColor;
Var
 nskin:Integer;
 clrtitle:TColor;
Begin
   {1--MainTiltle,2---panelTitle}
   nskin := 1;
   Case nTitleType Of
   1:
    Case nskin Of
    1:
      clrtitle := clmedgray;
    End;
   2:
      Case nskin of
      1:
       clrtitle := $904430;
      End;
   End;
   Result := clrtitle;
End;
Function GetApplicatePath():String;
var
  strPath:String;
Begin
  strPath := ExtractFilePath(Application.ExeName);
  result := strPath;
End;
{Public Way end}
function RunSQL(ADOQry_Temp: TADOQuery; SQLStr: string; RunType: Byte): Boolean;
begin
  Result := True;
  try
    ADOQry_Temp.Close;
    if Length(SQLStr) > 0 then //SQLStr为空时,不修改原有ADOQry的SQL字符串
    begin
      ADOQry_Temp.SQL.Clear;
      ADOQry_Temp.SQL.Add(SQLStr);
    end;

    if RunType = 0 then //回传数据
      begin
      //ADOQry_Temp.Prepared := True;
      ADOQry_Temp.Open;
      end
    else //不回传数据
      ADOQry_Temp.ExecSQL;
  except
    Result := False;
  end;
end;
Function GetNewStr(ADOQry_Temp: TADOQuery):String;
var
  strSQL:string;
begin
  Result:='';
  strSQL:='select cast(newID() as varchar(36)) bh';
  if RunSQL(ADOQry_Temp,strSQL,0) then
  begin
     Result:=Trim(ADOQry_Temp.fieldbyname('bh').AsString);
  end;
end;
procedure DoPerForm(Fm:TForm;Key:Word) ;
var
  WParam:Longint;
begin
  WParam:=0;
  if Key=VK_UP then
    WParam:=1;
  if Key=VK_RETURN then
    Fm.Perform(WM_NEXTDLGCTL,WParam,0)
  else if not (Fm.ActiveControl is TComboBox) then
    Fm.Perform(WM_NEXTDLGCTL,WParam,0);

end;

procedure EnterToChangeFocus(Fm:TForm;Key:word);
var
  lbCancel:Boolean;
begin
  if (Fm.ActiveControl <> nil) and (key in [VK_RETURN,VK_DOWN,VK_UP])  then
  begin
    lbCancel:=False;
    if (Fm.ActiveControl is TMemo) then lbCancel:=True;
    if not lbCancel then
    begin
      DoPerForm(Fm,key);
      while not lbCancel do
        if  ((Fm.ActiveControl is TEdit) and (Fm.ActiveControl as TEdit).ReadOnly)
            or (Fm.ActiveControl is TDBGrid) or (Fm.ActiveControl is TListBox)
            or (Fm.ActiveControl is TComboBox )
            or (Fm.ActiveControl.Tag<>0)  //可把不接受焦点的控件的Tag 设为非0
      then
      begin
        DoPerForm(Fm,key);
      end
      else
        lbCancel:=True;
    end;
  end;
end;

//结束输入回车改变控件焦点函数
procedure InputNumer(Fm:TForm;Key:Char);
begin
  if (Fm.ActiveControl is TEdit) and (not (key in['0'..'9',#8,#9,#14,#23,#24,#25,#26,#27,#28,#30,#13,'.'])) then
    key:=#0;
end;
{判断S是否是浮点型 create by xsw at 2004-11-01}
function TryIsFloat(S:string):boolean;
var
  LValue: Extended;
begin
  Result := TextToFloat(PChar(S), LValue, fvExtended);
end;
//运行SQL语句
procedure ShowError();
begin
  Application.MessageBox(PChar('数据库连接出错,是不是已经删除了文件' + #13 +
    '或与供应商联系!'), MsgBxCaption, MB_OK + MB_ICONERROR);
end;

function GetSysDate( ):string;
var
  strsql:string;
  dt:TDatetime;
begin
  try
    strsql := ' select GetDate() sysdate ';
    if RunSQL( dm.m_clADOQry_Temp, strsql, 0) then
    dt := dm.m_clADOQry_Temp.fieldbyname('sysdate').asDateTime;
    strsql := FormatDateTime( 'yyyymmddhhnn',dt );
  except
    showmessage('取不到服务器时间');
  end;
  Result := strsql;
end;

function FormateStrtoDate( strSysDate:string ):string;
var
  strtmp:string;
begin
  strSysDate := trim( strSysDate );
  strtmp := midstr( strSysDate,1,4 ) + '-' + midstr( strSysDate,5,2 ) + '-' + midstr( strSysDate,7,2 );
  Result := strtmp;
end;

function SetCmbxItem(Cmbx: TComboBox; ADOQry_Temp: TADOQuery; SQLStr: string;
  DaiMaAndMingCheng: Boolean): TStrings;
var
  i: integer;
  TStr1: TStrings;
begin
  TStr1 := TStringList.Create;
  Cmbx.Clear;
  if RunSQL(ADOQry_Temp, SQLStr, 0) then
  begin
    ADOQry_Temp.First;
    for i := 1 to ADOQry_Temp.RecordCount do
    begin
      if DaiMaAndMingCheng then
        TStr1.Add(Trim(ADOQry_Temp.FieldByName('DaiMa').AsString));
      Cmbx.Items.Add(Trim(ADOQry_Temp.FieldByName('MingCheng').AsString));
      ADOQry_Temp.Next;
    end;
    Cmbx.ItemIndex := 0;
  end;
  Result := TStr1;
  if not DaiMaAndMingCheng then
    TStr1.Free;
end;
function SetAllCmbxItem(Cmbx: TComboBox; ADOQry_Temp: TADOQuery; SQLStr: string;
  DaiMaAndMingCheng: Boolean): TStrings;
var
  i: integer;
  TStr1: TStrings;
begin
  TStr1 := TStringList.Create;
  Cmbx.Clear;
  if DaiMaAndMingCheng then
     TStr1.Add('全部');
  Cmbx.Items.Add('全部');
  if RunSQL(ADOQry_Temp, SQLStr, 0) then
  begin
    ADOQry_Temp.First;
    for i := 1 to ADOQry_Temp.RecordCount do
    begin
      if DaiMaAndMingCheng then
        TStr1.Add(Trim(ADOQry_Temp.FieldByName('DaiMa').AsString));
      Cmbx.Items.Add(Trim(ADOQry_Temp.FieldByName('MingCheng').AsString));
      ADOQry_Temp.Next;
    end;
    Cmbx.ItemIndex := 0;
  end;
  Result := TStr1;