funticon.pas

软件类别: 数据库 软件大小: 2.60M 运行环境: Win9xNT/2000/XP 一套车辆管理系统,此版本为商业版,大家一定用的着。

unit Funticon;

interface
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Buttons, Menus, ExtCtrls, ActnList, ComCtrls, StdCtrls, Db,
  DBTables, Registry,ChildUnit;

//宏定义
const IsDebug = true;

const CRPTVF_MYMESSAGE = WM_USER + 100;


  //宏定义
 //定义命令宏
const SuperUserPass = 'GT1234'; //超级用户密码
const sDatabaseName = ' ';
  //全局函数

function EncodeString(var bOut: Byte; s: string): BOOLean;
function DecodeString(var bOut: Byte; bIn: Byte): BOOLean;
function DecodeBCD(bIn: Byte): Byte;
function EncodeBCD(bIn: Byte): Byte;



//对用户输入的初始密码字符串加密
function PassProc(const InPass: PChar; var OutPass: PChar): BOOLean;
function ShMess(str: string; Flags: LongInt): Integer;

//数据库操作错误值检查
function CheckProcErr(ErrCode: Integer): BOOLEAN;

//增加和减少日期中的年或月或日,YMD:1:year;2:Month;3:day
function ADDORDecYMD(var dt: TDateTime; YMD: string; iValue: SmallInt): bool;

//读取注册表的应用初始化数据

// 数据库连接中断后的处理
procedure DealDBError;
//根据帮助文件的脚注获得相应的帮助信息
procedure GetHelp(const Context: string);
//初始化该系统的所有信息
function InitThisApplication: BOOL;
//获得要处理的表单的权限
function CheckFrmPrivilige(sFormName: string): Integer;

//写安全日志
procedure WriteSafeLog(dt: Tdatetime; UserName, SafeType, Context: string);
//写应用日志
procedure WriteAppLog(dt: Tdatetime; UserName, OpObject, OpType, sResult, Context: string);

//初始化本地统计临时表
function InitCountTempDBCreate: Bool;
function GetCurrentDir: string;
function CheckRightGroup(GroupName: string): integer;

//生成流水帐号函数
function MakeSerial(Dat: Tdate; Num: string): string;

//读卡
//function ReadCard: string;
//function WriteCard: integer;

var


  g_UserCompanyName: string; //用户公司名
  g_DevCompanyName: string; //软件开发公司名
  g_CheckDBConnectSpaceTime: Integer; //同步/检查数据连接的时间间隔，秒

  LoginUserNo: Integer; //登陆的用户号;若为-1；则为超级用户；
  LoginUserName: string; //登陆的用户名
  LoginUserPass: string; //登陆的用户密码
  LoginUserRight: integer; //登陆用户的权限
  g_FormName: array[0..150] of string; {全局表单名称}
  g_FormPrivilige: array[0..150] of integer; {全局表单的使用权限 0-无权限，1-读权限，2-读写权限}
  g_RightGroup: array[0..15] of integer;

  IC_Flag: integer; //IC卡读写表示

  bFee, lFee: real;

implementation
uses data;


//初始化该系统的所有信息
function InitThisApplication: BOOL;
var
  sTemp: string;
begin
  Result := False;
  //读入注册信息
  {	if not GetFromRegistry then
    exit;
   }
  Result := True;
end;
//增加和减少日期中的年或月或日,YMD:1:year;2:Month;3:day

function AddOrDecYMD(var dt: TDateTime; YMD: string; iValue: SmallInt): bool;
var str: string;
  tdTemp: TDateTime;
begin
  Result := false;
  str := UpperCase(YMD);
  if str = 'YEAR' then
  begin
    tdTemp := dt;
    dt := IncMonth(tdTemp, iValue * 12);
  end else if str = 'MONTH' then
  begin
    tdTemp := dt;
    dt := IncMonth(tdTemp, iValue);
  end else if str = 'DAY' then
  begin
    dt := dt + iValue;
  end else exit;

  Result := true;
end;

function ShMess(str: string; Flags: LongInt): Integer;
begin
  if Flags = MB_OK then
    Result := Application.MessageBox(PChar(str),
      '提示', Flags or MB_ICONEXCLAMATION)
  else
    Result := Application.MessageBox(PChar(str),
      '提示', Flags);
end;

//数据库操作错误值检查

function CheckProcErr(ErrCode: Integer): BOOLEAN;
var
  MessStr: string;
begin
  Result := false;
  case ErrCode of
    0: begin
        Result := true;
        exit;
      end; //'数据查询成功';
    1: begin
        Result := true;
        MessStr := '数据添加成功！';
      end;
    2: begin
        Result := true;
        MessStr := '数据删除成功！';
      end;
    3: begin
        Result := true;
        MessStr := '数据修改成功！';
      end;
    10: MessStr := '数据查询失败！';
    11: MessStr := '数据添加失败！';
    12: MessStr := '数据删除失败！';
    13: MessStr := '数据修改失败！';
    20: MessStr := '数据段范围有交叉！';
  else MessStr := '数据库操作失败！';
  end;
  ShMess(MessStr, MB_OK);

end;


// 数据库连接中断后的处理

procedure DealDBError;
begin
  ShMess('数据库连接异常！请立即与系统管理员联系！', mb_iconerror);
  ShMess('系统将停止运行！', mb_iconinformation);
  if Application.Active then
    Application.Terminate;

end;

//根据帮助文件的脚注获得相应的帮助信息

procedure GetHelp(const context: string);
begin
  try
    if not Fileexists(Application.HelpFile) then
    begin
      ShMess('帮助文件尚未装入！', mb_iconinformation);
      exit;
    end;
    Application.HelpJump(Context);
  except
    ShMess('该主题不存在！', mb_iconinformation);
  end;
end;

//获得要处理的表单的权限

function CheckFrmPrivilige(sFormName: string): Integer;
var
  i: integer;
begin
  Result := 2;
  for i := 0 to 150 - 1 do
    if g_FormName[i] = UpperCase(Trim(sFormName)) then
    begin
      Result := g_FormPrivilige[i];
      if Result = 0 then
        shMess('您无此操作权限！', mb_iconinformation);
      exit;
    end;
end;

//写安全日志
//初始化本地统计临时表

function InitCountTempDBCreate: Bool;
var
  buff: array[0..MAX_PATH - 1] of char;
  pBuff: Pchar;
  str: string;
  i: Integer;
  Tb: TTable;
  FieldStr: string;
begin
  Result := false;
  Tb := TTable.Create(Application);
  pBuff := @Buff;
  GetCurrentDirectory(MAX_PATH, Pbuff);
  str := pBuff;

  try
    with Tb do
    begin
      Close;
      TableName := str + '\temptb.db';

      TableType := ttParadox;
      //DatabaseName := 'TempTb';//ParkMainDM.LocalTempDB.DatabaseName;
      //检查临时表
      if Exists then
      begin
        try
          Tb.OPEN;
          Tb.First;
          while Tb.RecordCount <> 0 do Tb.delete;
          TB.CLOSE;

        except
          Application.MessageBox('临时表正在被其它用户使用。请先关闭！', '提示', MB_ICONERROR);
        end;
        Close;
        exit;
      end;

      //创建临时表
      with FieldDefs do
      begin
        Clear;
        Add('F01', ftString, 10, True);
        for i := 2 to 9 do
        begin
          FieldStr := Format('F%.2d', [i]);
          Add(FieldStr, ftfloat, 0, False);
        end;
      end;

      { Next, describe any indexes }
      with IndexDefs do
      begin
        Clear;
        { The first index has no name because it is a Paradox primary key }
        Add('', 'F01', [ixPrimary, ixUnique]);
      end;

      { Now that we have specified what we want, create the table }
      CreateTable;
      Close;
    end;
  finally
    Tb.free;
  end;

  Result := True;

end;

function GetCurrentDir: string;
var
  buff: array[0..MAX_PATH - 1] of char;
  pBuff: Pchar;
  str: string;

begin
  pBuff := @Buff;
  GetCurrentDirectory(MAX_PATH, Pbuff);
  str := pBuff;
  result := str;
end;

function DecodeString(var bOut: Byte; bIn: Byte): BOOLean;
begin
  Result := false;
  if bIn < 10 then
    bOut := bIn + $30
  else if bIn > 10 then
    bOut := bIn + $37
  else
    bOut := 0;
  Result := true;
end;

function DecodeBCD(bIn: Byte): Byte;
var
  bTemp: Byte;
begin
  Result := bIn;
  bTemp := bIn;
  bIn := bIn shr 4;
  bIn := bIn and $0F;
  bTemp := bTemp and $0F;
  bTemp := bTemp + bIn * 10;
  Result := bTemp;
end;

function EncodeBCD(bIn: Byte): Byte;
var
  hi, lo, bTemp: Byte;

begin
  Result := bIn;
  bTemp := bIn;
  hi := bIn div 10;
  lo := bIn mod 10;
  hi := (hi shl 4) and $F0;
  lo := lo and $0F;
  bTemp := hi or lo;
  Result := bTemp;
end;



function EncodeString(var bOut: Byte; s: string): BOOLean;
begin
  Result := false;
  if (s = 'A') or (s = 'B') or (s = 'C') or (s = 'D') or (s = 'E') or (s = 'F') then
  begin
    bout := Byte(s[1]);
    bout := bout - $37;
  end
  else
    bout := byte(s[1]) - $30;
  Result := true;
end;

function PassProc(const InPass: PChar; var OutPass: PChar): BOOLean;
var
  Key, X1, X2, X3: Byte;

  HiB, LowB: Byte;
begin
  Result := false;
  Key := $A9;

  {
    HiB := Byte( InPass[0] );
    HiB := HiB shl 4;
    LowB := Byte( InPass[1] );
    X1 := HiB xor LowB;

    HiB := Byte( InPass[2] );
    HiB := HiB shl 4;
    LowB := Byte( InPass[3] );
    X2 := HiB xor LowB;

    HiB := Byte( InPass[4] );
    HiB := HiB shl 4;
    LowB := Byte( InPass[5] );
    X3 := HiB xor LowB;

    X1 := X1 shl 3;
    X2 := X1 xor X2 xor X3;
    X3 := X3 shr 3;

    //若全为0
    if X2 = 0 then
     exit;
   //如果X1为00H，则将对应的值设置为X2或则X3；
    if X1 = 0 then
    begin
     if X2 = 0 then
       X1 := X3;
      if X3 = 0 then
       X1 := X2;
    end;
   //如果X3为00H，则将对应的值设置为X1或X2；
    if X3 = 0 then
    begin
     if X1 = 0 then
       X3 := X2;
    if X2 = 0 then
       X3 := X1;
    end;
   OutPass[0] := Char( X1 shr 4 );
   OutPass[1] := Char( X1 and $0F );
   OutPass[2] := Char( X2 shr 4 );
   OutPass[3] := Char( X2 and $0F );
   OutPass[4] := Char( X3 shr 4 );
   OutPass[5] := Char( X3 and $0F );
  }


  LowB := Byte(InPass[0]);
  OutPass[0] := Char(lowB xor key);
  LowB := Byte(InPass[1]);
  OutPass[1] := Char(lowB xor key);
  LowB := Byte(InPass[2]);
  OutPass[2] := Char(lowB xor key);
  LowB := Byte(InPass[3]);
  OutPass[3] := Char(lowB xor key);
  LowB := Byte(InPass[4]);
  OutPass[4] := Char(lowB xor key);
  LowB := Byte(InPass[5]);
  OutPass[5] := Char(lowB xor key);

  //OutPass:=InPass;  不加密

  Result := true;
end;

//写安全日志

function CheckRightGroup(GroupName: string): integer;
begin
  result := 2;
  if LowerCase(GroupName) = 'issys' then
    result := g_RightGroup[0];
  if LowerCase(GroupName) = 'isuser' then
    result := g_RightGroup[1];
  if LowerCase(GroupName) = 'isusercard' then
    result := g_RightGroup[2];
  if LowerCase(GroupName) = 'isctrlcard' then
    result := g_RightGroup[3];
  if LowerCase(GroupName) = 'isblackcard' then
    result := g_RightGroup[4];
  if LowerCase(GroupName) = 'istrade' then
    result := g_RightGroup[5];
  if LowerCase(GroupName) = 'isfinance' then
    result := g_RightGroup[6];
  if LowerCase(GroupName) = 'iscom' then
    result := g_RightGroup[7];
  if LowerCase(GroupName) = 'isequipment' then
    result := g_RightGroup[8];
  if LowerCase(GroupName) = 'isline' then
    result := g_RightGroup[9];
  if LowerCase(GroupName) = 'isdb' then
    result := g_RightGroup[10];

end;

function MakeSerial(Dat: Tdate; Num: string): string;
var
  Year, Month, Day: word;
  Serial: string;
  str: string;
begin
  DecodeDate(Dat, Year, Month, Day);
  str := Inttostr(Year);
  serial := str[3] + str[4];
  if Month < 10 then
    Serial := Serial + '0' + Inttostr(Month)
  else
    Serial := Serial + Inttostr(Month);
  if Day < 10 then
    Serial := Serial + '0' + Inttostr(Day)
  else
    Serial := Serial + Inttostr(Day);

  Serial := Serial + Num;

  result := Serial;
end;

//写安全日志

procedure WriteSafeLog(dt: Tdatetime; UserName, SafeType, Context: string);
var
  mstr: string;
begin
  //mstr:='Insert Into TSL_Safe_Log (DateTime,UserId,type,describe) Values(:pdate,:puserid,:ptype,:pcontext)';
 { try
   with ParkDataModule.SafeLogSProc do
    begin
     Parameters.ParamByName('dat').value := dt;
     Parameters.ParamByName('Loginuser').value :=LoginUserName;
     Parameters.ParamByName('type').value := SafeType;
     Parameters.ParamByName('pcontext').value := Context;
     Prepared;
     execProc;
    end;
  except
    begin
    end;
  end; }
end;


//写应用日志

procedure WriteAppLog(dt: Tdatetime; UserName, OpObject, OpType, sResult, Context: string);
var
  mstr: string;
begin
  //	mstr:='Insert TAL_App_Log (DateTime,UserId,OperateObj,Operatoin,status,describe) Values(:pDate,:pUserName,:pOpObject,:pOpType,:pResult,:pcontext)';
 { try
   with ParkDataModule.AppNoteSProc   do
    begin
     Parameters.ParamByName( 'Dat' ).value := dt;
     Parameters.ParamByName( 'LoginUser' ).value :=LoginUserName;
     Parameters.ParamByName( 'OpObject' ).value := OpObject;
     Parameters.ParamByName( 'pOpType' ).value := OpType;
     Parameters.ParamByName( 'pResult' ).value := sResult;
     Parameters.ParamByName( 'pcontext' ).value := '12345678';//Context;
      prepared;
      ExecProc;

    end;
  except
  end;
  }
end;

{function ReadCard: string;
var
  i, j: integer;
  str, str1, str2: string;
  bATR, bReadData: array[1..60] of CHAR;
begin
  //  IC_Flag 值  9：读写器连接检测失败
  //              1：串口初始划失败
  //              2：没有检测到读卡器
  //              3: 读写出现异常
  //             10: 读写器打开正常
  if IsCommOpened = 45 then
  begin
    i := Mcs_initcomm(0, 9600);
    if i <> 0 then
    begin
      shmess('串口初始划失败', mb_ok);
      MCS_ExitComm();
      ic_flag := 1; //  1：串口初始划失败
      exit;
    end;
  end;
  if IsCommOpened = 0 then
  begin
    i := MCS_TestDevice();
    if i <> 0 then
    begin
      shmess('没有检测到读卡器！', mb_OK);
      ic_Flag := 2; //没有检测到读卡器
      exit;
    end;
    j := 1;
    while j <> 0 do
    begin
      j := MCS_TestDoor(); // 如果读卡器里有卡J值就为0
      exit;
    end;

  end;

  SLE4442_OPencard(batr);
  mcs_led(2);
  MCS_SetStringMode(0);

  //  str:=stringofchar(' ',600);
  //  str1 := stringofchar(' ',600);
  //  str2 := stringofchar(' ', 600);
 //if IC_Flag = 10 then
 //   i := 0;




  mcs_setstringmode(1);
  j := sle4442_readchar(0, 256, str);
  if j <> 0 then
  begin
    shmess('读写出现异常！', mb_OK);
    IC_Flag := 3; //  读写出现异常
    exit;
  end;
  IC_Flag := 10;
  result := string(str);
  //IC_Flag:=0;
end;

function WriteCard: Integer;
var
  i: integer;
begin
  i := MCS_TestDevice();
  if i <> 0 then
  begin
    shmess('没有检测到读卡器！', mb_OK);
    ic_Flag := 2; //没有检测到读卡器
    exit;
  end;

  IC_Flag := 0;
end;
 }
end.